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