[system] / trunk / pg / macros / PGgraphmacros.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGgraphmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5930 - (download) (as text) (annotate)
Tue Oct 7 23:14:10 2008 UTC (11 years, 3 months ago) by dpvc
File size: 17985 byte(s)
Use a compiled vesion of the MathObjects formula rather than the
less-efficient eval method.  This should bring graphing speeds back in
line with the original non-MathObject version.

    1 
    2 
    3 =head1 NAME
    4 
    5   PGgraphmacros -- in courseScripts directory
    6 
    7 =head1 SYNPOSIS
    8 
    9 
   10 #   use Fun;
   11 #   use Label;
   12 #   use Circle;
   13 #   use WWPlot;
   14 
   15 =head1 DESCRIPTION
   16 
   17 This collection of macros provides easy access to the facilities provided by the graph
   18 module WWPlot and the modules for objects which can be drawn on a graph: functions (Fun.pm)
   19 labels (Label.pm) and images.  The only images implemented currently are open and closed circles
   20 (Circle) which can be used to mark graphs of functions defined on open and closed intervals.
   21 
   22 These macros provide an easy ability to graph simple functions.  More complicated projects
   23 may require direct access to the underlying modules.  If these complicated projects are common
   24 then it may be desirable to create additional macros.  (See numericalmacros.pl for one example.)
   25 
   26 
   27 =cut
   28 
   29 =head2 Other constructs
   30 
   31 See F<PGbasicmacros> for definitions of C<image> and C<caption>
   32 
   33 =cut
   34 
   35 
   36 #my $User = $main::studentLogin;
   37 #my $psvn = $main::psvnNumber; #$main::in{'probSetKey'};  #in{'probSetNumber'}; #$main::probSetNumber;
   38 #my $setNumber     = $main::setNumber;
   39 #my $probNum       = $main::probNum;
   40 
   41 #########################################################
   42 # this initializes a graph object
   43 #########################################################
   44 # graphObject = init_graph(xmin,ymin,xmax,ymax,options)
   45 # options include  'grid' =>[8,8] or
   46 #          'ticks'=>[8,8] and/or
   47 #                  'axes'
   48 #########################################################
   49 
   50 #loadMacros("MathObjects.pl");   # avoid loading the entire package
   51                                  # of MathObjects since that can mess up
   52                                  # problems that don't use MathObjects but use Matrices.
   53 
   54 my %images_created = ();  # this keeps track of the base names of the images created during this session.
   55                      #  We tack on
   56                      # $imageNum  = ++$images_created{$imageName} to keep from overwriting files
   57                      # when we don't want to.
   58 
   59 
   60 
   61 
   62 =head2 init_graph
   63 
   64 =pod
   65 
   66     $graphObject = init_graph(xmin,ymin,xmax,ymax,'ticks'=>[4,4],'axes'=>[0,0])
   67     options are
   68       'grid' =>[8,8] or
   69       # there are 8 evenly spaced lines intersecting the horizontal axis
   70       'ticks'=>[8,8] and/or
   71       # there are 8 ticks on the horizontal axis, 8 on the vertical
   72       'axes' => [0,0]
   73       # axes pass through the point (0,0) in real coordinates
   74       'size' => [200,200]
   75       # dimensions of the graph in pixels.
   76       'pixels' =>[200,200]  # synonym for size
   77 
   78 Creates a graph object with the default size 200 by 200 pixels.
   79 If you want axes or grids you need to specify them in options. But the default values can be selected for you.
   80 
   81 
   82 =cut
   83 BEGIN {
   84   be_strict();
   85 }
   86 sub _PGgraphmacros_init {
   87 
   88 
   89 }
   90 #sub _PGgraphmacros_export {
   91 #
   92 # my @EXPORT = (
   93 #   '&init_graph', '&add_functions', '&plot_functions', '&open_circle',
   94 #   '&closed_circle', '&my_math_constants', '&string_to_sub',
   95 #    );
   96 #    @EXPORT;
   97 #}
   98 
   99 sub init_graph {
  100   my ($xmin,$ymin,$xmax,$ymax,%options) = @_;
  101   my @size;
  102   if ( defined($options{'size'}) ) {
  103     @size = @{$options{'size'}};
  104   } elsif ( defined($options{'pixels'}) ) {
  105     @size = @{$options{'pixels'}};
  106   }   else {
  107     my $defaultSize = $main::envir{onTheFlyImageSize} || 200;
  108     @size=($defaultSize,  $defaultSize);
  109   }
  110     my $graphRef = new WWPlot(@size);
  111   # select a  name for this graph based on the user, the psvn and the problem
  112   my $setName = $main::setNumber;
  113   # replace dots in set name to keep latex happy
  114   $setName =~ s/Q/QQ/g;
  115   $setName =~ s/\./-Q-/g;
  116   my $studentLogin = $main::studentLogin;
  117   $studentLogin =~ s/Q/QQ/g;
  118   $studentLogin =~ s/\./-Q-/g;
  119   my $imageName = "$studentLogin-$main::problemSeed-set${setName}prob${main::probNum}";
  120   # $imageNum counts the number of graphs with this name which have been created since PGgraphmacros.pl was initiated.
  121   my $imageNum  = ++$main::images_created{$imageName};
  122   # this provides a unique name for the graph -- it does not include an extension.
  123   $graphRef->imageName("${imageName}image${imageNum}");
  124 
  125   $graphRef->xmin($xmin) if defined($xmin);
  126   $graphRef->xmax($xmax) if defined($xmax);
  127   $graphRef->ymin($ymin) if defined($ymin);
  128   $graphRef->ymax($ymax) if defined($ymax);
  129   my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/8;
  130   my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/8;
  131   if (defined($options{grid})) {   #   draw grid
  132       my $xdiv = ( ${$options{'grid'}}[0]) ? ${$options{'grid'}}[0] : 8; # number of ticks (8 is default)
  133       my $ydiv = ( ${$options{'grid'}}[1] )  ? ${$options{'grid'}}[1] : 8;
  134     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  135       my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  136       my $i; my @x_values=(); my @y_values=();
  137       foreach $i (1..($xdiv-1) ) {
  138         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  139       }
  140       foreach $i (1..($ydiv-1) ) {
  141         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  142       }
  143     $graphRef->v_grid('gray',@x_values);
  144     $graphRef->h_grid('gray',@y_values);
  145     $graphRef->lb(new Label($x_delta,0,sprintf("%1.1f",$x_delta),'black','center','middle'));
  146     $graphRef->lb(new Label(0,$y_delta,sprintf("%1.1f",$y_delta),'black','center','middle'));
  147 
  148     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  149     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  150     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top'));
  151     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  152 
  153   } elsif ($options{ticks}) {   #   draw ticks -- grid over rides ticks
  154     my $xdiv = ${$options{ticks}}[0]? ${$options{ticks}}[0] : 8; # number of ticks (8 is default)
  155           my $ydiv = ${$options{ticks}}[1]? ${$options{ticks}}[1] : 8;
  156     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  157           my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  158           my $i; my @x_values=(); my @y_values=();
  159       foreach $i (1..($xdiv-1) ) {
  160         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  161       }
  162       foreach $i (1..($ydiv-1) ) {
  163         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  164       }
  165     $graphRef->h_ticks(0,'black',@x_values);
  166     $graphRef->v_ticks(0,'black',@y_values);
  167     $graphRef->lb(new Label($x_delta,0,$x_delta,'black','right'));
  168     $graphRef->lb(new Label(0,$y_delta,$y_delta,'black','top'));
  169 
  170     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  171     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  172     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top'));
  173     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  174   }
  175 
  176   if ($options{axes}) {   #   draw axis
  177       my $ra_axes = $options{axes};
  178     $graphRef->h_axis($ra_axes->[1],'black');
  179     $graphRef->v_axis($ra_axes->[0],'black');
  180   }
  181 
  182 
  183   $graphRef;
  184 }
  185 
  186 sub init_graph_no_labels {
  187   my ($xmin,$ymin,$xmax,$ymax,%options) = @_;
  188   my @size;
  189   if ( defined($options{'size'}) ) {
  190     @size = @{$options{'size'}};
  191   } elsif ( defined($options{'pixels'}) ) {
  192     @size = @{$options{'pixels'}};
  193   }   else {
  194     my $defaultSize = $main::envir{onTheFlyImageSize} || 200;
  195     @size=($defaultSize,  $defaultSize);
  196   }
  197     my $graphRef = new WWPlot(@size);
  198   # select a  name for this graph based on the user, the psvn and the problem
  199   my $imageName = "$main::studentLogin-$main::psvnNumber-set${main::setNumber}prob${main::probNum}";
  200   # $imageNum counts the number of graphs with this name which have been created since PGgraphmacros.pl was initiated.
  201   my $imageNum  = ++$main::images_created{$imageName};
  202   # this provides a unique name for the graph -- it does not include an extension.
  203   $graphRef->imageName("${imageName}image${imageNum}");
  204 
  205   $graphRef->xmin($xmin) if defined($xmin);
  206   $graphRef->xmax($xmax) if defined($xmax);
  207   $graphRef->ymin($ymin) if defined($ymin);
  208   $graphRef->ymax($ymax) if defined($ymax);
  209   my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/8;
  210   my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/8;
  211   if (defined($options{grid})) {   #   draw grid
  212       my $xdiv = ( ${$options{'grid'}}[0]) ? ${$options{'grid'}}[0] : 8; # number of ticks (8 is default)
  213       my $ydiv = ( ${$options{'grid'}}[1] )  ? ${$options{'grid'}}[1] : 8;
  214     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  215       my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  216       my $i; my @x_values=(); my @y_values=();
  217       foreach $i (1..($xdiv-1) ) {
  218         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  219       }
  220       foreach $i (1..($ydiv-1) ) {
  221         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  222       }
  223     $graphRef->v_grid('gray',@x_values);
  224     $graphRef->h_grid('gray',@y_values);
  225     #$graphRef->lb(new Label($x_delta,0,sprintf("%1.1f",$x_delta),'black','center','top'));
  226     #$graphRef->lb(new Label($x_delta,0,"|",'black','center','middle'));
  227     #$graphRef->lb(new Label(0,$y_delta,sprintf("%1.1f ",$y_delta),'black','right','middle'));
  228     #$graphRef->lb(new Label(0,$y_delta,"-",'black','center','middle'));
  229 
  230 
  231     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  232     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  233     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top','right'));
  234     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  235 
  236   } elsif ($options{ticks}) {   #   draw ticks -- grid over rides ticks
  237     my $xdiv = ${$options{ticks}}[0]? ${$options{ticks}}[0] : 8; # number of ticks (8 is default)
  238           my $ydiv = ${$options{ticks}}[1]? ${$options{ticks}}[1] : 8;
  239     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  240           my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  241           my $i; my @x_values=(); my @y_values=();
  242       foreach $i (1..($xdiv-1) ) {
  243         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  244       }
  245       foreach $i (1..($ydiv-1) ) {
  246         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  247       }
  248     $graphRef->v_ticks(0,'black',@x_values);
  249     $graphRef->h_ticks(0,'black',@y_values);
  250     $graphRef->lb(new Label($x_delta,0,$x_delta,'black','right'));
  251     $graphRef->lb(new Label(0,$y_delta,$y_delta,'black','top'));
  252 
  253     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  254     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  255     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top'));
  256     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  257   }
  258 
  259   if ($options{axes}) {   #   draw axis
  260       my $ra_axes = $options{axes};
  261     $graphRef->h_axis($ra_axes->[1],'black');
  262     $graphRef->v_axis($ra_axes->[0],'black');
  263   }
  264 
  265 
  266   $graphRef;
  267 }
  268 
  269 
  270 
  271 =head2  plot_functions
  272 
  273 =pod
  274 
  275   Usage:  ($f1, $f2, $f3) = plot_functions($graph, $f1, $f2, $f3);
  276   Synonym: add_functions($graph,$f1,$f2,$f3);
  277 
  278 Where $f1 is a string of the form
  279 
  280   $f1 = qq! x^2 - 3*x + 45 for x in [0, 45) using color:red and weight:2!
  281 
  282 The phrase translates as: formula    B<for> variable B<in>  interval B<using>   option-list.
  283 The option-list contains pairs of the form attribute:value.
  284 The default for color is "default_color" which is usually black.
  285 The default for the weight (pixel width) of the pen is 2 pixels.
  286 
  287 The string_to_sub subroutine is used to translate the formula into a subroutine.
  288 
  289 The functions in the list are installed in the graph object $graph and will appear when the graph object is next drawn.
  290 
  291 =cut
  292 
  293 sub add_functions {
  294   &plot_functions;
  295 }
  296 
  297 sub plot_functions {
  298   my $graph = shift;
  299   my @function_list = @_;
  300   my $error = "";
  301   $error .= "The first argument to plot_functions must be a graph object" unless ref($graph) =~/WWPlot/;
  302   my $fn;
  303   my @functions=();
  304   foreach $fn (@function_list) {
  305 
  306       # model:   "2.5-x^2 for x in <-1,0> using color:red and weight:2"
  307     if ($fn =~ /^(.+)for\s*(\w+)\s*in\s*([\(\[\<])\s*([\d\.\-]+)\s*,\s*([\d\.\-]+)\s*([\)\]\>])\s*using\s*(.*)$/ )  {
  308       my ($rule,$var, $left_br, $left_end, $right_end, $right_br, $options)=  ($1, $2, $3, $4, $5, $6, $7);
  309 
  310       my %options = split( /\s*and\s*|\s*:\s*|\s*,\s*|\s*=\s*|\s+/,$options);
  311       my ($color, $weight);
  312       if ( defined($options{'color'})  ){
  313         $color = $options{'color'}; #set pen color
  314       } else {
  315         $color = 'default_color';
  316       }
  317       if ( defined($options{'weight'}) ) {
  318         $weight = $options{'weight'}; # set pen weight (width in pixels)
  319       } else {
  320         $weight =2;
  321       }
  322       # a workaround to call Parser code without loading MathObjects.
  323       my $localContext= Parser::Context->current(\%main::context)->copy;
  324       $localContext->variables->add($var=>'Real') unless $localContext->variables->get($var);
  325       my $formula = Value->Package("Formula()")->new($localContext,$rule)->perlFunction(undef,[$var]);
  326       my $subRef = sub {
  327         my $x = shift;
  328         my $y = Parser::Eval($formula,$x);  # traps errors, e.g. graph domain is larger than
  329                       #  the function's domain.
  330         $y = $y->value if defined $y;
  331         return $y;
  332       };
  333           #my $subRef    = string_to_sub($rule,$var);
  334       my $funRef = new Fun($subRef,$graph);
  335       $funRef->color($color);
  336       $funRef->weight($weight);
  337       $funRef->domain($left_end , $right_end);
  338       push(@functions,$funRef);
  339         # place open (1,3) or closed (1,3) circle at the endpoints or do nothing <1,3>
  340         if ($left_br eq '[' ) {
  341           $graph->stamps(closed_circle($left_end,&$subRef($left_end),$color) );
  342         } elsif ($left_br eq '(' ) {
  343           $graph->stamps(open_circle($left_end, &$subRef($left_end), $color) );
  344         }
  345         if ($right_br eq ']' ) {
  346           $graph->stamps(closed_circle($right_end,&$subRef($right_end),$color) );
  347         } elsif ($right_br eq ')' ) {
  348           $graph->stamps(open_circle($right_end, &$subRef($right_end), $color) );
  349         }
  350 
  351     } else {
  352       $error .= "Error in parsing: $fn $main::BR";
  353     }
  354 
  355   }
  356   die ("Error in plot_functions: \n\t $error ") if $error;
  357   @functions;   # return function references unless there is an error.
  358 }
  359 
  360 
  361 
  362 
  363 =head2 insertGraph
  364 
  365   $filePath = insertGraph(graphObject);
  366       returns a path to the file containing the graph image.
  367 
  368 B<Note:> Because insertGraph involves writing to the disk, it is actually defined in dangerousMacros.pl.
  369 
  370 insertGraph(graphObject) writes a image file to the C<html/tmp/gif> directory of the current course.
  371 The file name is obtained from the graphObject.  Warnings are issued if errors occur while writing to
  372 the file.
  373 
  374 The permissions and ownership of the file are controlled by C<$main::tmp_file_permission>
  375 and C<$main::numericalGroupID>.
  376 
  377 B<Returns:>   A string containing the full path to the temporary file containing the  image.
  378 
  379 
  380 
  381 InsertGraph draws the object $graph, stores it in "${tempDirectory}gif/$imageName.gif (or .png)" where
  382 the $imageName is obtained from the graph object.  ConvertPath and surePathToTmpFile are used to insure
  383 that the correct directory separators are used for the platform and that the necessary directories
  384 are created if they are not already present.  The directory address to the file is the result.
  385 
  386 The most common use of C,insertGraph> is
  387 
  388   TEXT(image(insertGraph($graph)) );
  389 
  390 where C<image> takes care of creating the proper URL for accessing the graph and for creating the HTML code to display the image.
  391 
  392 Another common usage is:
  393 
  394   TEXT(htmlLink( alias(insertGraph($graph), "picture" ) ) );
  395 
  396 which inserts the URL pointing to the picture.
  397 alias converts the directory address to a URL when serving HTML pages and insures that
  398 an eps file is generated when creating TeX code for downloading. (Image, automatically applies alias to its input
  399 in order to obtain the URL.)
  400 
  401 See the documentation in F<dangerousMacros.pl> for the latest details.
  402 
  403 =cut
  404 
  405 =head2  'Circle' lables
  406 
  407   Usage: $circle_object = open_circle( $x_position, $y_position, $color );
  408           $circle_object2 = closed_circle( $x_position, $y_position, $color );
  409 
  410 Creates a small open (resp. filled in or closed) circle for use as a stamp in marking graphs.
  411 For example
  412 
  413   $graph -> stamps($circle_object2); # puts a filled dot at $x_position, $y_position
  414 
  415 =cut
  416 
  417 #########################################################
  418 sub open_circle {
  419     my ($cx,$cy,$color) = @_;
  420   new Circle ($cx, $cy, 4,$color,'nearwhite');
  421 }
  422 
  423 sub closed_circle {
  424     my ($cx,$cy, $color) = @_;
  425     $color = 'black' unless defined $color;
  426   new Circle ($cx, $cy, 4,$color, $color);
  427 }
  428 
  429 
  430 =head2 Auxiliary macros
  431 
  432 =head3  string_to_sub and my_math_constants
  433 
  434 
  435 These are internal macros which govern the interpretation of equations.
  436 
  437 
  438   Usage: $string = my_math_constants($string)
  439          $subroutine_reference = my_string_to_sub($string)
  440 
  441 C<my_math_constants>
  442 interprets pi, e  as mathematical constants 3.1415926... and 2.71828... respectively. (Case is important).
  443 The power operator ^ is replaced by ** to conform with perl constructs
  444 
  445 C<string_to_sub>
  446 converts a string defining a single perl arithmetic expression with independent variable $XVAR into a subroutine.
  447 The string is first filtered through C<my_math_macros>. The resulting subroutine
  448 takes a single real number as input and produces a single output value.
  449 
  450 =cut
  451 
  452 sub my_math_constants {
  453   my($in) = @_;
  454   $in =~s/\bpi\b/(4*atan2(1,1))/g;
  455   $in =~s/\be\b/(exp(1))/g;
  456   $in =~s/\^/**/g;
  457   $in;
  458 }
  459 
  460 sub string_to_sub {
  461   my $str_in = shift;
  462   my $var    = shift;
  463   my $out = undef;
  464   if ( defined(&check_syntax)  ) {
  465     #prepare the correct answer and check it's syntax
  466       my $rh_correct_ans = new AnswerHash;
  467     $rh_correct_ans->input($str_in);
  468     $rh_correct_ans = check_syntax($rh_correct_ans);
  469     warn  $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  470     $rh_correct_ans->clear_error();
  471     $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => ['x'], store_in =>'rf_correct_ans');
  472     my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
  473     warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  474     $out = sub{ scalar( &$correct_eqn_sub(@_) ) };  #ignore the error messages from the function.
  475 
  476   } else {
  477     my $in =$str_in;
  478 
  479     $in =~ s/\b$var\b/\$XVAR/g;
  480     $in = &my_math_constants($in);
  481     my ($subRef, $PG_eval_errors,$PG_full_error_report) = PG_restricted_eval( " sub { my \$XVAR = shift; my \$out = $in; \$out; } ");
  482     if ($PG_eval_errors) {
  483       die " ERROR while defining a function from the string:\n\n$main::BR $main::BR $str_in $main::BR $main::BR\n\n  $PG_eval_errors"
  484     } else {
  485       $out = $subRef;
  486     }
  487 
  488   }
  489   $out;
  490 }
  491 
  492 #########################################################
  493 
  494 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9