[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 6451 - (download) (as text) (annotate)
Tue Oct 12 00:04:19 2010 UTC (9 years, 4 months ago) by gage
File size: 18165 byte(s)
protect @ signs in user_id when naming graphs.
add Quiz prefix in MultiAnswer questions
replace psvnNumber by psvn


    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::psvn; #$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, commmas and @ signs in set and user names to keep latex and html happy
  114   # this should be abstracted and placed in PGalias.pm or PGcore.pm or perhaps PG.pm
  115   #FIXME
  116   $setName =~ s/Q/QQ/g;
  117   $setName =~ s/\./-Q-/g;
  118   my $studentLogin = $main::studentLogin;
  119   $studentLogin =~ s/Q/QQ/g;
  120   $studentLogin =~ s/\./-Q-/g;
  121   $studentLogin =~ s/\,/-Q-/g;
  122   $studentLogin =~ s/\@/-Q-/g;
  123   my $imageName = "$studentLogin-$main::problemSeed-set${setName}prob${main::probNum}";
  124   # $imageNum counts the number of graphs with this name which have been created since PGgraphmacros.pl was initiated.
  125   my $imageNum  = ++$main::images_created{$imageName};
  126   # this provides a unique name for the graph -- it does not include an extension.
  127   $graphRef->imageName("${imageName}image${imageNum}");
  128 
  129   $graphRef->xmin($xmin) if defined($xmin);
  130   $graphRef->xmax($xmax) if defined($xmax);
  131   $graphRef->ymin($ymin) if defined($ymin);
  132   $graphRef->ymax($ymax) if defined($ymax);
  133   my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/8;
  134   my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/8;
  135   if (defined($options{grid})) {   #   draw grid
  136       my $xdiv = ( ${$options{'grid'}}[0]) ? ${$options{'grid'}}[0] : 8; # number of ticks (8 is default)
  137       my $ydiv = ( ${$options{'grid'}}[1] )  ? ${$options{'grid'}}[1] : 8;
  138     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  139       my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  140       my $i; my @x_values=(); my @y_values=();
  141       foreach $i (1..($xdiv-1) ) {
  142         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  143       }
  144       foreach $i (1..($ydiv-1) ) {
  145         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  146       }
  147     $graphRef->v_grid('gray',@x_values);
  148     $graphRef->h_grid('gray',@y_values);
  149     $graphRef->lb(new Label($x_delta,0,sprintf("%1.1f",$x_delta),'black','center','middle'));
  150     $graphRef->lb(new Label(0,$y_delta,sprintf("%1.1f",$y_delta),'black','center','middle'));
  151 
  152     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  153     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  154     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top'));
  155     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  156 
  157   } elsif ($options{ticks}) {   #   draw ticks -- grid over rides ticks
  158     my $xdiv = ${$options{ticks}}[0]? ${$options{ticks}}[0] : 8; # number of ticks (8 is default)
  159           my $ydiv = ${$options{ticks}}[1]? ${$options{ticks}}[1] : 8;
  160     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  161           my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  162           my $i; my @x_values=(); my @y_values=();
  163       foreach $i (1..($xdiv-1) ) {
  164         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  165       }
  166       foreach $i (1..($ydiv-1) ) {
  167         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  168       }
  169     $graphRef->h_ticks(0,'black',@x_values);
  170     $graphRef->v_ticks(0,'black',@y_values);
  171     $graphRef->lb(new Label($x_delta,0,$x_delta,'black','right'));
  172     $graphRef->lb(new Label(0,$y_delta,$y_delta,'black','top'));
  173 
  174     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  175     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  176     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top'));
  177     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  178   }
  179 
  180   if ($options{axes}) {   #   draw axis
  181       my $ra_axes = $options{axes};
  182     $graphRef->h_axis($ra_axes->[1],'black');
  183     $graphRef->v_axis($ra_axes->[0],'black');
  184   }
  185 
  186 
  187   $graphRef;
  188 }
  189 
  190 sub init_graph_no_labels {
  191   my ($xmin,$ymin,$xmax,$ymax,%options) = @_;
  192   my @size;
  193   if ( defined($options{'size'}) ) {
  194     @size = @{$options{'size'}};
  195   } elsif ( defined($options{'pixels'}) ) {
  196     @size = @{$options{'pixels'}};
  197   }   else {
  198     my $defaultSize = $main::envir{onTheFlyImageSize} || 200;
  199     @size=($defaultSize,  $defaultSize);
  200   }
  201     my $graphRef = new WWPlot(@size);
  202   # select a  name for this graph based on the user, the psvn and the problem
  203   my $imageName = "$main::studentLogin-$main::psvn-set${main::setNumber}prob${main::probNum}";
  204   # $imageNum counts the number of graphs with this name which have been created since PGgraphmacros.pl was initiated.
  205   my $imageNum  = ++$main::images_created{$imageName};
  206   # this provides a unique name for the graph -- it does not include an extension.
  207   $graphRef->imageName("${imageName}image${imageNum}");
  208 
  209   $graphRef->xmin($xmin) if defined($xmin);
  210   $graphRef->xmax($xmax) if defined($xmax);
  211   $graphRef->ymin($ymin) if defined($ymin);
  212   $graphRef->ymax($ymax) if defined($ymax);
  213   my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/8;
  214   my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/8;
  215   if (defined($options{grid})) {   #   draw grid
  216       my $xdiv = ( ${$options{'grid'}}[0]) ? ${$options{'grid'}}[0] : 8; # number of ticks (8 is default)
  217       my $ydiv = ( ${$options{'grid'}}[1] )  ? ${$options{'grid'}}[1] : 8;
  218     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  219       my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  220       my $i; my @x_values=(); my @y_values=();
  221       foreach $i (1..($xdiv-1) ) {
  222         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  223       }
  224       foreach $i (1..($ydiv-1) ) {
  225         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  226       }
  227     $graphRef->v_grid('gray',@x_values);
  228     $graphRef->h_grid('gray',@y_values);
  229     #$graphRef->lb(new Label($x_delta,0,sprintf("%1.1f",$x_delta),'black','center','top'));
  230     #$graphRef->lb(new Label($x_delta,0,"|",'black','center','middle'));
  231     #$graphRef->lb(new Label(0,$y_delta,sprintf("%1.1f ",$y_delta),'black','right','middle'));
  232     #$graphRef->lb(new Label(0,$y_delta,"-",'black','center','middle'));
  233 
  234 
  235     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  236     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  237     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top','right'));
  238     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  239 
  240   } elsif ($options{ticks}) {   #   draw ticks -- grid over rides ticks
  241     my $xdiv = ${$options{ticks}}[0]? ${$options{ticks}}[0] : 8; # number of ticks (8 is default)
  242           my $ydiv = ${$options{ticks}}[1]? ${$options{ticks}}[1] : 8;
  243     my $x_delta = ($graphRef->xmax -  $graphRef->xmin)/$xdiv;
  244           my $y_delta = ($graphRef->ymax -  $graphRef->ymin)/$ydiv;
  245           my $i; my @x_values=(); my @y_values=();
  246       foreach $i (1..($xdiv-1) ) {
  247         push( @x_values, $i*$x_delta+$graphRef->{xmin});
  248       }
  249       foreach $i (1..($ydiv-1) ) {
  250         push( @y_values, $i*$y_delta+$graphRef->{ymin});
  251       }
  252     $graphRef->v_ticks(0,'black',@x_values);
  253     $graphRef->h_ticks(0,'black',@y_values);
  254     $graphRef->lb(new Label($x_delta,0,$x_delta,'black','right'));
  255     $graphRef->lb(new Label(0,$y_delta,$y_delta,'black','top'));
  256 
  257     $graphRef->lb(new Label($xmax,0,$xmax,'black','right'));
  258     $graphRef->lb(new Label($xmin,0,$xmin,'black','left'));
  259     $graphRef->lb(new Label(0,$ymax,$ymax,'black','top'));
  260     $graphRef->lb(new Label(0,$ymin,$ymin,'black','bottom','right'));
  261   }
  262 
  263   if ($options{axes}) {   #   draw axis
  264       my $ra_axes = $options{axes};
  265     $graphRef->h_axis($ra_axes->[1],'black');
  266     $graphRef->v_axis($ra_axes->[0],'black');
  267   }
  268 
  269 
  270   $graphRef;
  271 }
  272 
  273 
  274 
  275 =head2  plot_functions
  276 
  277 =pod
  278 
  279   Usage:  ($f1, $f2, $f3) = plot_functions($graph, $f1, $f2, $f3);
  280   Synonym: add_functions($graph,$f1,$f2,$f3);
  281 
  282 Where $f1 is a string of the form
  283 
  284   $f1 = qq! x^2 - 3*x + 45 for x in [0, 45) using color:red and weight:2!
  285 
  286 The phrase translates as: formula    B<for> variable B<in>  interval B<using>   option-list.
  287 The option-list contains pairs of the form attribute:value.
  288 The default for color is "default_color" which is usually black.
  289 The default for the weight (pixel width) of the pen is 2 pixels.
  290 
  291 The string_to_sub subroutine is used to translate the formula into a subroutine.
  292 
  293 The functions in the list are installed in the graph object $graph and will appear when the graph object is next drawn.
  294 
  295 =cut
  296 
  297 sub add_functions {
  298   &plot_functions;
  299 }
  300 
  301 sub plot_functions {
  302   my $graph = shift;
  303   my @function_list = @_;
  304   my $error = "";
  305   $error .= "The first argument to plot_functions must be a graph object" unless ref($graph) =~/WWPlot/;
  306   my $fn;
  307   my @functions=();
  308   foreach $fn (@function_list) {
  309 
  310       # model:   "2.5-x^2 for x in <-1,0> using color:red and weight:2"
  311     if ($fn =~ /^(.+)for\s*(\w+)\s*in\s*([\(\[\<])\s*([\d\.\-]+)\s*,\s*([\d\.\-]+)\s*([\)\]\>])\s*using\s*(.*)$/ )  {
  312       my ($rule,$var, $left_br, $left_end, $right_end, $right_br, $options)=  ($1, $2, $3, $4, $5, $6, $7);
  313 
  314       my %options = split( /\s*and\s*|\s*:\s*|\s*,\s*|\s*=\s*|\s+/,$options);
  315       my ($color, $weight);
  316       if ( defined($options{'color'})  ){
  317         $color = $options{'color'}; #set pen color
  318       } else {
  319         $color = 'default_color';
  320       }
  321       if ( defined($options{'weight'}) ) {
  322         $weight = $options{'weight'}; # set pen weight (width in pixels)
  323       } else {
  324         $weight =2;
  325       }
  326       # a workaround to call Parser code without loading MathObjects.
  327       my $localContext= Parser::Context->current(\%main::context)->copy;
  328       $localContext->variables->add($var=>'Real') unless $localContext->variables->get($var);
  329       my $formula = Value->Package("Formula()")->new($localContext,$rule)->perlFunction(undef,[$var]);
  330       my $subRef = sub {
  331         my $x = shift;
  332         my $y = Parser::Eval($formula,$x);  # traps errors, e.g. graph domain is larger than
  333                       #  the function's domain.
  334         $y = $y->value if defined $y;
  335         return $y;
  336       };
  337           #my $subRef    = string_to_sub($rule,$var);
  338       my $funRef = new Fun($subRef,$graph);
  339       $funRef->color($color);
  340       $funRef->weight($weight);
  341       $funRef->domain($left_end , $right_end);
  342       push(@functions,$funRef);
  343         # place open (1,3) or closed (1,3) circle at the endpoints or do nothing <1,3>
  344         if ($left_br eq '[' ) {
  345           $graph->stamps(closed_circle($left_end,&$subRef($left_end),$color) );
  346         } elsif ($left_br eq '(' ) {
  347           $graph->stamps(open_circle($left_end, &$subRef($left_end), $color) );
  348         }
  349         if ($right_br eq ']' ) {
  350           $graph->stamps(closed_circle($right_end,&$subRef($right_end),$color) );
  351         } elsif ($right_br eq ')' ) {
  352           $graph->stamps(open_circle($right_end, &$subRef($right_end), $color) );
  353         }
  354 
  355     } else {
  356       $error .= "Error in parsing: $fn $main::BR";
  357     }
  358 
  359   }
  360   die ("Error in plot_functions: \n\t $error ") if $error;
  361   @functions;   # return function references unless there is an error.
  362 }
  363 
  364 
  365 
  366 
  367 =head2 insertGraph
  368 
  369   $filePath = insertGraph(graphObject);
  370       returns a path to the file containing the graph image.
  371 
  372 B<Note:> Because insertGraph involves writing to the disk, it is actually defined in dangerousMacros.pl.
  373 
  374 insertGraph(graphObject) writes a image file to the C<html/tmp/gif> directory of the current course.
  375 The file name is obtained from the graphObject.  Warnings are issued if errors occur while writing to
  376 the file.
  377 
  378 The permissions and ownership of the file are controlled by C<$main::tmp_file_permission>
  379 and C<$main::numericalGroupID>.
  380 
  381 B<Returns:>   A string containing the full path to the temporary file containing the  image.
  382 
  383 
  384 
  385 InsertGraph draws the object $graph, stores it in "${tempDirectory}gif/$imageName.gif (or .png)" where
  386 the $imageName is obtained from the graph object.  ConvertPath and surePathToTmpFile are used to insure
  387 that the correct directory separators are used for the platform and that the necessary directories
  388 are created if they are not already present.  The directory address to the file is the result.
  389 
  390 The most common use of C,insertGraph> is
  391 
  392   TEXT(image(insertGraph($graph)) );
  393 
  394 where C<image> takes care of creating the proper URL for accessing the graph and for creating the HTML code to display the image.
  395 
  396 Another common usage is:
  397 
  398   TEXT(htmlLink( alias(insertGraph($graph), "picture" ) ) );
  399 
  400 which inserts the URL pointing to the picture.
  401 alias converts the directory address to a URL when serving HTML pages and insures that
  402 an eps file is generated when creating TeX code for downloading. (Image, automatically applies alias to its input
  403 in order to obtain the URL.)
  404 
  405 See the documentation in F<dangerousMacros.pl> for the latest details.
  406 
  407 =cut
  408 
  409 =head2  'Circle' lables
  410 
  411   Usage: $circle_object = open_circle( $x_position, $y_position, $color );
  412           $circle_object2 = closed_circle( $x_position, $y_position, $color );
  413 
  414 Creates a small open (resp. filled in or closed) circle for use as a stamp in marking graphs.
  415 For example
  416 
  417   $graph -> stamps($circle_object2); # puts a filled dot at $x_position, $y_position
  418 
  419 =cut
  420 
  421 #########################################################
  422 sub open_circle {
  423     my ($cx,$cy,$color) = @_;
  424   new Circle ($cx, $cy, 4,$color,'nearwhite');
  425 }
  426 
  427 sub closed_circle {
  428     my ($cx,$cy, $color) = @_;
  429     $color = 'black' unless defined $color;
  430   new Circle ($cx, $cy, 4,$color, $color);
  431 }
  432 
  433 
  434 =head2 Auxiliary macros
  435 
  436 =head3  string_to_sub and my_math_constants
  437 
  438 
  439 These are internal macros which govern the interpretation of equations.
  440 
  441 
  442   Usage: $string = my_math_constants($string)
  443          $subroutine_reference = my_string_to_sub($string)
  444 
  445 C<my_math_constants>
  446 interprets pi, e  as mathematical constants 3.1415926... and 2.71828... respectively. (Case is important).
  447 The power operator ^ is replaced by ** to conform with perl constructs
  448 
  449 C<string_to_sub>
  450 converts a string defining a single perl arithmetic expression with independent variable $XVAR into a subroutine.
  451 The string is first filtered through C<my_math_macros>. The resulting subroutine
  452 takes a single real number as input and produces a single output value.
  453 
  454 =cut
  455 
  456 sub my_math_constants {
  457   my($in) = @_;
  458   $in =~s/\bpi\b/(4*atan2(1,1))/g;
  459   $in =~s/\be\b/(exp(1))/g;
  460   $in =~s/\^/**/g;
  461   $in;
  462 }
  463 
  464 sub string_to_sub {
  465   my $str_in = shift;
  466   my $var    = shift;
  467   my $out = undef;
  468   if ( defined(&check_syntax)  ) {
  469     #prepare the correct answer and check it's syntax
  470       my $rh_correct_ans = new AnswerHash;
  471     $rh_correct_ans->input($str_in);
  472     $rh_correct_ans = check_syntax($rh_correct_ans);
  473     warn  $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  474     $rh_correct_ans->clear_error();
  475     $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => ['x'], store_in =>'rf_correct_ans');
  476     my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
  477     warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  478     $out = sub{ scalar( &$correct_eqn_sub(@_) ) };  #ignore the error messages from the function.
  479 
  480   } else {
  481     my $in =$str_in;
  482 
  483     $in =~ s/\b$var\b/\$XVAR/g;
  484     $in = &my_math_constants($in);
  485     my ($subRef, $PG_eval_errors,$PG_full_error_report) = PG_restricted_eval( " sub { my \$XVAR = shift; my \$out = $in; \$out; } ");
  486     if ($PG_eval_errors) {
  487       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"
  488     } else {
  489       $out = $subRef;
  490     }
  491 
  492   }
  493   $out;
  494 }
  495 
  496 #########################################################
  497 
  498 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9