[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 5573 - (download) (as text) (annotate)
Mon Oct 29 02:33:27 2007 UTC (12 years, 3 months ago) by gage
File size: 17921 byte(s)
Modifications PGgraphicsmacros.pl suggested by Davide Cervone.


1. Don't load  MathObjects (since this causes conflicts if the webwork
question also uses Matrices as well as GraphObjects).
(This incompatibility is itself a bug, but not one we can solve immediately.)

2. Make sure that the variable is defined by defining the new rule in a local
context and insuring that the variable is defined.

(Unfortunately we don't have the original Formula, just the normalString created by the Formula
so we won't be able to guarantee the same context that created the original Formula.  However
we can get the current context and add the independent variable if it is missing.)

3. Evaluate using Parser::Evaluate so that the errors are trapped if the input is
not in the domain of definition of the function.

-------

A reasonable  next step would be to define plot_formula with syntax something like
plot_formula($formula, domain=>[0,10],color=>'red',weight=>2)
which could take further advantage of the MathObjects paradigm, but we'll probably
have to find a more robust solution to the Matrix confusion at the same time.

--Mike

    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);
  326           my $subRef = sub {my $x=shift; Parser::Evaluate($formula, $var=>$x)};
  327                #traps errors when
  328                # graph domain is larger than the function's domain.
  329 
  330           #my $subRef    = string_to_sub($rule,$var);
  331       my $funRef = new Fun($subRef,$graph);
  332       $funRef->color($color);
  333       $funRef->weight($weight);
  334       $funRef->domain($left_end , $right_end);
  335       push(@functions,$funRef);
  336         # place open (1,3) or closed (1,3) circle at the endpoints or do nothing <1,3>
  337         if ($left_br eq '[' ) {
  338           $graph->stamps(closed_circle($left_end,&$subRef($left_end),$color) );
  339         } elsif ($left_br eq '(' ) {
  340           $graph->stamps(open_circle($left_end, &$subRef($left_end), $color) );
  341         }
  342         if ($right_br eq ']' ) {
  343           $graph->stamps(closed_circle($right_end,&$subRef($right_end),$color) );
  344         } elsif ($right_br eq ')' ) {
  345           $graph->stamps(open_circle($right_end, &$subRef($right_end), $color) );
  346         }
  347 
  348     } else {
  349       $error .= "Error in parsing: $fn $main::BR";
  350     }
  351 
  352   }
  353   die ("Error in plot_functions: \n\t $error ") if $error;
  354   @functions;   # return function references unless there is an error.
  355 }
  356 
  357 
  358 
  359 
  360 =head2 insertGraph
  361 
  362   $filePath = insertGraph(graphObject);
  363       returns a path to the file containing the graph image.
  364 
  365 B<Note:> Because insertGraph involves writing to the disk, it is actually defined in dangerousMacros.pl.
  366 
  367 insertGraph(graphObject) writes a image file to the C<html/tmp/gif> directory of the current course.
  368 The file name is obtained from the graphObject.  Warnings are issued if errors occur while writing to
  369 the file.
  370 
  371 The permissions and ownership of the file are controlled by C<$main::tmp_file_permission>
  372 and C<$main::numericalGroupID>.
  373 
  374 B<Returns:>   A string containing the full path to the temporary file containing the  image.
  375 
  376 
  377 
  378 InsertGraph draws the object $graph, stores it in "${tempDirectory}gif/$imageName.gif (or .png)" where
  379 the $imageName is obtained from the graph object.  ConvertPath and surePathToTmpFile are used to insure
  380 that the correct directory separators are used for the platform and that the necessary directories
  381 are created if they are not already present.  The directory address to the file is the result.
  382 
  383 The most common use of C,insertGraph> is
  384 
  385   TEXT(image(insertGraph($graph)) );
  386 
  387 where C<image> takes care of creating the proper URL for accessing the graph and for creating the HTML code to display the image.
  388 
  389 Another common usage is:
  390 
  391   TEXT(htmlLink( alias(insertGraph($graph), "picture" ) ) );
  392 
  393 which inserts the URL pointing to the picture.
  394 alias converts the directory address to a URL when serving HTML pages and insures that
  395 an eps file is generated when creating TeX code for downloading. (Image, automatically applies alias to its input
  396 in order to obtain the URL.)
  397 
  398 See the documentation in F<dangerousMacros.pl> for the latest details.
  399 
  400 =cut
  401 
  402 =head2  'Circle' lables
  403 
  404   Usage: $circle_object = open_circle( $x_position, $y_position, $color );
  405           $circle_object2 = closed_circle( $x_position, $y_position, $color );
  406 
  407 Creates a small open (resp. filled in or closed) circle for use as a stamp in marking graphs.
  408 For example
  409 
  410   $graph -> stamps($circle_object2); # puts a filled dot at $x_position, $y_position
  411 
  412 =cut
  413 
  414 #########################################################
  415 sub open_circle {
  416     my ($cx,$cy,$color) = @_;
  417   new Circle ($cx, $cy, 4,$color,'nearwhite');
  418 }
  419 
  420 sub closed_circle {
  421     my ($cx,$cy, $color) = @_;
  422     $color = 'black' unless defined $color;
  423   new Circle ($cx, $cy, 4,$color, $color);
  424 }
  425 
  426 
  427 =head2 Auxiliary macros
  428 
  429 =head3  string_to_sub and my_math_constants
  430 
  431 
  432 These are internal macros which govern the interpretation of equations.
  433 
  434 
  435   Usage: $string = my_math_constants($string)
  436          $subroutine_reference = my_string_to_sub($string)
  437 
  438 C<my_math_constants>
  439 interprets pi, e  as mathematical constants 3.1415926... and 2.71828... respectively. (Case is important).
  440 The power operator ^ is replaced by ** to conform with perl constructs
  441 
  442 C<string_to_sub>
  443 converts a string defining a single perl arithmetic expression with independent variable $XVAR into a subroutine.
  444 The string is first filtered through C<my_math_macros>. The resulting subroutine
  445 takes a single real number as input and produces a single output value.
  446 
  447 =cut
  448 
  449 sub my_math_constants {
  450   my($in) = @_;
  451   $in =~s/\bpi\b/(4*atan2(1,1))/g;
  452   $in =~s/\be\b/(exp(1))/g;
  453   $in =~s/\^/**/g;
  454   $in;
  455 }
  456 
  457 sub string_to_sub {
  458   my $str_in = shift;
  459   my $var    = shift;
  460   my $out = undef;
  461   if ( defined(&check_syntax)  ) {
  462     #prepare the correct answer and check it's syntax
  463       my $rh_correct_ans = new AnswerHash;
  464     $rh_correct_ans->input($str_in);
  465     $rh_correct_ans = check_syntax($rh_correct_ans);
  466     warn  $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  467     $rh_correct_ans->clear_error();
  468     $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => ['x'], store_in =>'rf_correct_ans');
  469     my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
  470     warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  471     $out = sub{ scalar( &$correct_eqn_sub(@_) ) };  #ignore the error messages from the function.
  472 
  473   } else {
  474     my $in =$str_in;
  475 
  476     $in =~ s/\b$var\b/\$XVAR/g;
  477     $in = &my_math_constants($in);
  478     my ($subRef, $PG_eval_errors,$PG_full_error_report) = PG_restricted_eval( " sub { my \$XVAR = shift; my \$out = $in; \$out; } ");
  479     if ($PG_eval_errors) {
  480       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"
  481     } else {
  482       $out = $subRef;
  483     }
  484 
  485   }
  486   $out;
  487 }
  488 
  489 
  490 
  491 
  492 
  493 
  494 
  495 
  496 
  497 #########################################################
  498 
  499 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9