[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 5892 - (download) (as text) (annotate)
Thu Sep 4 21:59:03 2008 UTC (11 years, 5 months ago) by dpvc
File size: 17916 byte(s)
Demote Real() results of Formula() evaluation back to Perl reals.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9