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

Annotation of /trunk/pg/macros/PGnumericevaluators.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6058 - (view) (download) (as text)

1 : sh002i 5584 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 :     # Copyright 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4 : gage 6058 # $CVSHeader$
5 : sh002i 5584 #
6 :     # This program is free software; you can redistribute it and/or modify it under
7 :     # the terms of either: (a) the GNU General Public License as published by the
8 :     # Free Software Foundation; either version 2, or (at your option) any later
9 :     # version, or (b) the "Artistic License" which comes with this package.
10 :     #
11 :     # This program is distributed in the hope that it will be useful, but WITHOUT
12 :     # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 :     # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 :     # Artistic License for more details.
15 :     ################################################################################
16 :    
17 :     =head1 NAME
18 :    
19 :     PGnumericevaluators.pl - Macros that generate numeric answer evaluators.
20 :    
21 :     =head1 SYNOPSIS
22 :    
23 :     ANS(num_cmp($answer_or_answer_array_ref, %options_hash));
24 :    
25 :     ANS(std_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
26 :     ANS(std_num_cmp_abs($correctAnswer, $absTol, $format));
27 :     ANS(std_num_cmp_list($relTol, $format, @answerList));
28 :     ANS(std_num_cmp_abs_list($absTol, $format, @answerList));
29 :    
30 :     ANS(arith_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
31 :     ANS(arith_num_cmp_abs($correctAnswer, $absTol, $format));
32 :     ANS(arith_num_cmp_list($relTol, $format, @answerList));
33 :     ANS(arith_num_cmp_abs_list($absTol, $format, @answerList));
34 :    
35 :     ANS(strict_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
36 :     ANS(strict_num_cmp_abs($correctAnswer, $absTol, $format));
37 :     ANS(strict_num_cmp_list($relTol, $format, @answerList));
38 :     ANS(strict_num_cmp_abs_list($absTol, $format, @answerList));
39 :    
40 :     ANS(frac_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
41 :     ANS(frac_num_cmp_abs($correctAnswer, $absTol, $format));
42 :     ANS(frac_num_cmp_list($relTol, $format, @answerList));
43 :     ANS(frac_num_cmp_abs_list($absTol, $format, @answerList));
44 :    
45 :     =head1 DESCRIPTION
46 :    
47 :     Numeric answer evaluators take in a numerical answer, compare it to the correct
48 :     answer, and return a score. In addition, they can choose to accept or reject an
49 :     answer based on its format, closeness to the correct answer, and other criteria.
50 :    
51 :     The general numeric answer evaluator is num_cmp(). It takes a hash of named
52 :     options as parameters. There are also sixteen specific "mode"_num_cmp() answer
53 :     evaluators for use in common situations which feature a simplified syntax.
54 :    
55 :     =head2 MathObjects and answer evaluators
56 :    
57 :     The MathObjects system provides $obj->cmp() methods that produce answer
58 :     evaluators for a wide variety of answer types. num_cmp() has been rewritten to
59 :     use the appropriate MathObject to produce the answer evaluator. It is
60 :     recommended that you use the MathObjects cmp() methods directly if possible.
61 :    
62 :     =cut
63 :    
64 :     BEGIN { be_strict() }
65 :    
66 :     # Until we get the PG cacheing business sorted out, we need to use
67 :     # PG_restricted_eval to get the correct values for some(?) PG environment
68 :     # variables. We do this once here and place the values in lexicals for later
69 :     # access.
70 :     my $CA;
71 :     my $Context;
72 :     my $numAbsTolDefault;
73 :     my $numFormatDefault;
74 :     my $numRelPercentTolDefault;
75 :     my $numZeroLevelDefault;
76 :     my $numZeroLevelTolDefault;
77 :     my $useOldAnswerMacros;
78 :     my $user_context;
79 :     sub _PGnumericevaluators_init {
80 :     $CA = PG_restricted_eval(q/$CA/);
81 : gage 5585 $numAbsTolDefault = PG_restricted_eval(q/$envir{numAbsTolDefault}/);
82 :     $numFormatDefault = PG_restricted_eval(q/$envir{numFormatDefault}/);
83 :     $numRelPercentTolDefault = PG_restricted_eval(q/$envir{numRelPercentTolDefault}/);
84 :     $numZeroLevelDefault = PG_restricted_eval(q/$envir{numZeroLevelDefault}/);
85 :     $numZeroLevelTolDefault = PG_restricted_eval(q/$envir{numZeroLevelTolDefault}/);
86 :     $useOldAnswerMacros = PG_restricted_eval(q/$envir{useOldAnswerMacros}/);
87 : sh002i 5584 unless ($useOldAnswerMacros) {
88 :     $user_context = PG_restricted_eval(q/\%context/);
89 :     $Context = sub { Parser::Context->current($user_context, @_) };
90 :     }
91 :     }
92 :    
93 :     =head1 num_cmp
94 :    
95 :     ANS(num_cmp($answer_or_answer_array_ref, %options));
96 :    
97 :     num_cmp() returns one or more answer evaluators (subroutine references) that
98 :     compare the student's answer to a numeric value. Evaluation options are
99 :     specified as items in the %options hash. This can make for more readable code
100 :     than using the "mode"_num_cmp() style, but some people find one or the other
101 :     easier to remember.
102 :    
103 :     =head2 Options
104 :    
105 :     $answer_or_answer_array_ref can either be a scalar containing a numeric value or
106 :     a reference to an array of numeric scalars. If multiple answers are provided,
107 :     num_cmp() will return a list of answer evaluators, one for each answer
108 :     specified. %options is a hash containing options that affect the way the
109 :     comparison is performed. All hash items are optional. Allowed options are:
110 :    
111 :     =over
112 :    
113 :     =item mode
114 :    
115 :     This determines the allowable methods for entering an answer. Answers which do
116 :     not meet this requirement will be graded as incorrect, regardless of their
117 :     numerical value. The recognized modes are:
118 :    
119 :     =over
120 :    
121 :     =item std (default)
122 :    
123 :     The default mode allows any expression which evaluates to a number, including
124 :     those using elementary functions like sin() and exp(), as well as the operations
125 :     of arithmetic (+, -, *, /, and ^).
126 :    
127 :     =item strict
128 :    
129 :     Only decimal numbers are allowed.
130 :    
131 :     =item frac
132 :    
133 :     Only whole numbers and fractions are allowed.
134 :    
135 :     =item arith
136 :    
137 :     Arithmetic expressions are allowed, but no functions.
138 :    
139 :     =back
140 :    
141 :     Note that all modes allow the use of "pi" and "e" as constants, and also the use
142 :     of "E" to represent scientific notation.
143 :    
144 :     =item format
145 :    
146 :     The format to use when displaying the correct and submitted answers. This has no
147 :     effect on how answers are evaluated; it is only for cosmetic purposes. The
148 :     formatting syntax is the same as Perl uses for the sprintf() function. Format
149 :     strings are of the form '%m.nx' or '%m.nx#', where m and n are described below,
150 :     and x is a formatter.
151 :    
152 :     Esentially, m is the minimum length of the field (make this negative to
153 :     left-justify). Note that the decimal point counts as a character when
154 :     determining the field width. If m begins with a zero, the number will be padded
155 :     with zeros instead of spaces to fit the field.
156 :    
157 :     The precision specifier (n) works differently depending on which formatter you
158 :     are using. For d, i, o, u, x and X formatters (non-floating point formatters), n
159 :     is the minimum number of digits to display. For e and f, it is the number of
160 :     digits that appear after the decimal point (extra digits will be rounded;
161 :     insufficient digits will be padded with spaces--see '#' below). For g, it is the
162 :     number of significant digits to display.
163 :    
164 :     The full list of formatters can be found in the manpage for printf(3), or by
165 :     typing "perldoc -f sprintf" at a terminal prompt. The following is a brief
166 :     summary of the most frequent formatters:
167 :    
168 :     %d decimal number
169 :     %ld long decimal number
170 :     %u unsigned decimal number
171 :     %lu long unsigned decimal number
172 :     %x hexadecimal number
173 :     %o octal number
174 :     %e floating point number in scientific notation
175 :     %f floating point number
176 :     %g either %e or %f, whichever takes less space
177 :    
178 :     Technically, %g will use %e if the exponent is less than -4 or greater than or
179 :     equal to the precision. Trailing zeros are removed in this mode.
180 :    
181 :     If the format string ends in '#', trailing zeros will be removed in the decimal
182 :     part. Note that this is not a standard syntax; it is handled internally by
183 :     WeBWorK and not by Perl (although this should not be a concern to end users).
184 :     The default format is '%0.5f#', which displays as a floating point number with 5
185 :     digits of precision and no trailing zeros. Other useful format strings might be
186 :     '%0.2f' for displaying dollar amounts, or '%010d' to display an integer with
187 :     leading zeros. Setting format to an empty string ( '' ) means no formatting will
188 :     be used; this will show 'arbitrary' precision floating points.
189 :    
190 :     =item tol
191 :    
192 :     An absolute tolerance value. The student answer must be a fixed distance from
193 :     the correct answer to qualify. For example, an absolute tolerance of 5 means
194 :     that any number which is +-5 of the correct answer qualifies as correct. abstol
195 :     is accepted as a synonym for tol.
196 :    
197 :     =item relTol
198 :    
199 :     A relative tolerance. Relative tolerances are given in percentages. A relative
200 :     tolerance of 1 indicates that the student answer must be within 1% of the
201 :     correct answer to qualify as correct. In other words, a student answer is
202 :     correct when
203 :    
204 :     abs(studentAnswer - correctAnswer) <= abs(.01*relTol*correctAnswer)
205 :    
206 :     tol and relTol are mutually exclusive. reltol is also accpeted as a synonym for
207 :     relTol.
208 :    
209 :     =item zeroLevel, zeroLevelTol
210 :    
211 :     zeroLevel and zeroLevelTol specify a alternative absolute tolerance to use when
212 :     the correct answer is very close to zero.
213 :    
214 :     If the correct answer has an absolute value less than or equal to zeroLevel,
215 :     then the student answer must be, in absolute terms, within zeroLevelTol of
216 :     correctAnswer, i.e.,
217 :    
218 :     abs(studentAnswer - correctAnswer) <= zeroLevelTol
219 :    
220 :     In other words, if the correct answer is very near zero, an absolute tolerance
221 :     will be used. One must do this to handle floating point answers very near zero,
222 :     because of the inaccuracy of floating point arithmetic. However, the default
223 :     values are almost always adequate.
224 :    
225 :     =item units
226 :    
227 :     A string representing the units of the correct answer. If specified, the student
228 :     answer must include these units. The strings and units options are mutually
229 :     exclusive.
230 :    
231 :     =item strings
232 :    
233 :     A reference to an array of strings which are valid (but incorrect) answers. This
234 :     prevents non-numeric entries like "NaN" or "None" from causing a syntax error.
235 :     The strings and units options are mutually exclusive.
236 :    
237 :     =item debug
238 :    
239 :     If set to 1, extra debugging information will be output.
240 :    
241 :     =back
242 :    
243 :     =head2 Examples
244 :    
245 :     # correct answer is 5, using defaults for all options
246 :     num_cmp(5);
247 :    
248 :     # correct answers are 5, 6, and 7, using defaults for all options
249 :     num_cmp([5,6,7]);
250 :    
251 :     # correct answer is 5, mode is strict
252 :     num_cmp(5, mode=>'strict');
253 :    
254 :     # correct answers are 5 and 6, both with 5% relative tolerance
255 :     num_cmp([5,6], relTol=>5);
256 :    
257 :     # correct answer is 6, "Inf", "Minf", and "NaN" recognized as valid, but
258 :     # incorrect answers.
259 :     num_cmp(6, strings=>["Inf", "Minf", "NaN"]);
260 :    
261 :     # correct answer is "-INF", "INF" and numerical expressions recognized as
262 :     # valid, but incorrect answers.
263 :     num_cmp("-INF", strings => ["INF", "-INF"]);
264 :    
265 :     =cut
266 :    
267 :     sub num_cmp {
268 :     my $correctAnswer = shift @_;
269 :     $CA = $correctAnswer;
270 :     my @opt = @_;
271 :     my %out_options;
272 :    
273 :     #########################################################################
274 :     # Retain this first check for backword compatibility. Allows input of the form
275 :     # num_cmp($ans, 1, '%0.5f') but warns against it
276 :     #########################################################################
277 :     my %known_options = (
278 :     'mode' => 'std',
279 :     'format' => $numFormatDefault,
280 :     'tol' => $numAbsTolDefault,
281 :     'relTol' => $numRelPercentTolDefault,
282 :     'units' => undef,
283 :     'strings' => undef,
284 :     'zeroLevel' => $numZeroLevelDefault,
285 :     'zeroLevelTol' => $numZeroLevelTolDefault,
286 :     'tolType' => 'relative',
287 :     'tolerance' => 1,
288 :     'reltol' => undef, #alternate spelling
289 :     'unit' => undef, #alternate spelling
290 :     'debug' => 0
291 :     );
292 :    
293 :     my @output_list;
294 :     my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
295 :    
296 :     unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
297 :     ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
298 :     # unless the first parameter is a list of arrays
299 :     # or the second parameter is a known option or
300 :     # no options were used,
301 :     # use the old num_cmp which does not use options, but has inputs
302 :     # $relPercentTol,$format,$zeroLevel,$zeroLevelTol
303 :     warn "This method of using num_cmp() is deprecated. Please rewrite this" .
304 :     " problem using the options style of parameter passing (or" .
305 :     " check that your first option is spelled correctly).";
306 :    
307 :     %out_options = ( 'relTol' => $relPercentTol,
308 :     'format' => $format,
309 :     'zeroLevel' => $zeroLevel,
310 :     'zeroLevelTol' => $zeroLevelTol,
311 :     'mode' => 'std'
312 :     );
313 :     }
314 :    
315 :     #########################################################################
316 :     # Now handle the options assuming they are entered in the form
317 :     # num_cmp($ans, relTol=>1, format=>'%0.5f')
318 :     #########################################################################
319 :     %out_options = @opt;
320 :     assign_option_aliases( \%out_options,
321 :     'reltol' => 'relTol',
322 :     'unit' => 'units',
323 :     'abstol' => 'tol',
324 :     );
325 :    
326 :     set_default_options( \%out_options,
327 :     'tolType' => (defined($out_options{'tol'}) ) ? 'absolute' : 'relative', # the existence of "tol" means that we use absolute tolerance mode
328 :     'tolerance' => (defined($out_options{'tolType'}) && $out_options{'tolType'} eq 'absolute' ) ? $numAbsTolDefault : $numRelPercentTolDefault, # relative tolerance is the default
329 :     'mode' => 'std',
330 :     'format' => $numFormatDefault,
331 :     'tol' => undef,
332 :     'relTol' => undef,
333 :     'units' => undef,
334 :     'strings' => undef,
335 :     'zeroLevel' => $numZeroLevelDefault,
336 :     'zeroLevelTol' => $numZeroLevelTolDefault,
337 :     'debug' => 0,
338 :     );
339 :    
340 :     # can't use both units and strings
341 :     if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
342 :     warn "Can't use both 'units' and 'strings' in the same problem " .
343 :     "(check your parameters to num_cmp() )";
344 :     }
345 :    
346 :     # absolute tolType and relTol are incompatible. So are relative tolType and tol
347 :     if( defined( $out_options{'relTol'} ) && $out_options{'tolType'} eq 'absolute' ) {
348 :     warn "The 'tolType' 'absolute' is not compatible with 'relTol' " .
349 :     "(check your parameters to num_cmp() )";
350 :     }
351 :     if( defined( $out_options{'tol'} ) && $out_options{'tolType'} eq 'relative' ) {
352 :     warn "The 'tolType' 'relative' is not compatible with 'tol' " .
353 :     "(check your parameters to num_cmp() )";
354 :     }
355 :    
356 :    
357 :     # Handle legacy options
358 :     if ($out_options{tolType} eq 'absolute') {
359 :     $out_options{'tolerance'}=$out_options{'tol'} if defined($out_options{'tol'});
360 :     delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
361 :     } else {
362 :     $out_options{'tolerance'}=$out_options{'relTol'} if defined($out_options{'relTol'});
363 :     # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
364 :     }
365 :     # end legacy options
366 :    
367 :     # thread over lists
368 :     my @ans_list = ();
369 :    
370 :     if ( ref($correctAnswer) eq 'ARRAY' ) {
371 :     @ans_list = @{$correctAnswer};
372 :     }
373 :     else { push( @ans_list, $correctAnswer );
374 :     }
375 :    
376 :     # produce answer evaluators
377 :     foreach my $ans (@ans_list) {
378 :     if( defined( $out_options{'units'} ) ) {
379 :     $ans = "$ans $out_options{'units'}";
380 :    
381 : gage 5585 push( @output_list, NUM_CMP(
382 :     'correctAnswer' => $ans,
383 : sh002i 5584 'tolerance' => $out_options{'tolerance'},
384 :     'tolType' => $out_options{'tolType'},
385 :     'format' => $out_options{'format'},
386 :     'mode' => $out_options{'mode'},
387 :     'zeroLevel' => $out_options{'zeroLevel'},
388 :     'zeroLevelTol' => $out_options{'zeroLevelTol'},
389 :     'debug' => $out_options{'debug'},
390 :     'units' => $out_options{'units'},
391 :     )
392 :     );
393 :     } elsif( defined( $out_options{'strings'} ) ) {
394 :    
395 :    
396 : gage 5585 push( @output_list, NUM_CMP(
397 :     'correctAnswer' => $ans,
398 :     'tolerance' => $out_options{tolerance},
399 :     'tolType' => $out_options{tolType},
400 :     'format' => $out_options{'format'},
401 :     'mode' => $out_options{'mode'},
402 :     'zeroLevel' => $out_options{'zeroLevel'},
403 : sh002i 5584 'zeroLevelTol' => $out_options{'zeroLevelTol'},
404 : gage 5585 'debug' => $out_options{'debug'},
405 :     'strings' => $out_options{'strings'},
406 : sh002i 5584 )
407 :     );
408 :     } else {
409 :     push(@output_list,
410 : gage 5585 NUM_CMP(
411 :     'correctAnswer' => $ans,
412 : sh002i 5584 'tolerance' => $out_options{tolerance},
413 :     'tolType' => $out_options{tolType},
414 :     'format' => $out_options{'format'},
415 :     'mode' => $out_options{'mode'},
416 :     'zeroLevel' => $out_options{'zeroLevel'},
417 : gage 5585 'zeroLevelTol' => $out_options{'zeroLevelTol'},
418 : sh002i 5584 'debug' => $out_options{'debug'},
419 :     ),
420 :     );
421 :     }
422 :     }
423 :    
424 :     return (wantarray) ? @output_list : $output_list[0];
425 :     }
426 :    
427 :     #legacy code for compatability purposes
428 :     sub num_rel_cmp { # compare numbers
429 :     std_num_cmp( @_ );
430 :     }
431 :    
432 :     =head1 "mode"_num_cmp() functions
433 :    
434 :     There are 16 functions that provide simplified interfaces to num_cmp(). They are
435 :     organized into four groups, based on the number of answers accpeted (single or
436 :     list) and whether relative or absolute tolerances are used. Each group contains
437 :     four functions, one for each evaluation mode. See the mode option to num_cmp()
438 :     above for details about each mode.
439 :    
440 :     GROUP:| "normal" | "list" | "abs" | "abs_list" |
441 :     | single answer | list of answers | single answer | list of answers |
442 :     MODE: | relative tol. | relative tolerance | absolute tolerance | absolute tolerance |
443 :     -------+----------------+---------------------+--------------------+-------------------------+
444 :     std | std_num_cmp | std_num_cmp_list | std_num_cmp_abs | std_num_cmp_abs_list |
445 :     frac | frac_num_cmp | frac_num_cmp_list | frac_num_cmp_abs | frac_num_cmp_abs_list |
446 :     strict | strict_num_cmp | strict_num_cmp_list | strict_num_cmp_abs | strict_num_cmp_abs_list |
447 :     arith | arith_num_cmp | arith_num_cmp_list | arith_num_cmp_abs | arith_num_cmp_abs_list |
448 :    
449 :     The functions in each group take the same arguments.
450 :    
451 :     =head2 The normal group
452 :    
453 :     ANS(std_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
454 :     ANS(arith_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
455 :     ANS(strict_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
456 :     ANS(frac_num_cmp($correctAnswer, $relTol, $format, $zeroLevel, $zeroLevelTol));
457 :    
458 :     This group of functions produces answer evaluators for a single correct answer
459 :     using relative tolerances. The first argument, $correctAnswer, is required. The
460 :     rest are optional. The arguments are equivalent to the identically-named options
461 :     to num_cmp(), above.
462 :    
463 :     =head2 The list group
464 :    
465 :     ANS(std_num_cmp_list($relTol, $format, @answerList));
466 :     ANS(arith_num_cmp_list($relTol, $format, @answerList));
467 :     ANS(strict_num_cmp_list($relTol, $format, @answerList));
468 :     ANS(frac_num_cmp_list($relTol, $format, @answerList));
469 :    
470 :     This group of functions produces answer evaluators for a list of correct answers
471 :     using relative tolerances. $relTol and $format are equivelent to the
472 :     identically-named options to num_cmp() above. @answerList must contain one or
473 :     more correct answers. A list of answer evaluators is returned, one for each
474 :     answer provided in @answerList. All answer returned evaluators will use the
475 :     relative tolerance and format specified.
476 :    
477 :     =head2 The abs group
478 :    
479 :     ANS(std_num_cmp_abs($correctAnswer, $absTol, $format));
480 :     ANS(arith_num_cmp_abs($correctAnswer, $absTol, $format));
481 :     ANS(strict_num_cmp_abs($correctAnswer, $absTol, $format));
482 :     ANS(frac_num_cmp_abs($correctAnswer, $absTol, $format));
483 :    
484 :     This group of functions produces answer evaluators for a single correct answer
485 :     using absolute tolerances. The first argument, $correctAnswer, is required. The
486 :     rest are optional. The arguments are equivalent to the identically-named options
487 :     to num_cmp(), above.
488 :    
489 :     =head2 The abs_list group
490 :    
491 :     ANS(std_num_cmp_abs_list($absTol, $format, @answerList));
492 :     ANS(arith_num_cmp_abs_list($absTol, $format, @answerList));
493 :     ANS(strict_num_cmp_abs_list($absTol, $format, @answerList));
494 :     ANS(frac_num_cmp_abs_list($absTol, $format, @answerList));
495 :    
496 :     This group of functions produces answer evaluators for a list of correct answers
497 :     using absolute tolerances. $absTol and $format are equivelent to the
498 :     identically-named options to num_cmp() above. @answerList must contain one or
499 :     more correct answers. A list of answer evaluators is returned, one for each
500 :     answer provided in @answerList. All answer returned evaluators will use the
501 :     absolute tolerance and format specified.
502 :    
503 :     =head2 Examples
504 :    
505 :     # The student answer must be a number in decimal or scientific notation
506 :     # which is within .1 percent of 3.14159. This assumes
507 :     # $numRelPercentTolDefault has been set to .1.
508 :     ANS(strict_num_cmp(3.14159));
509 :    
510 :     # The student answer must be a number within .01 percent of $answer (e.g. #
511 :     3.14159 if $answer is 3.14159 or $answer is "pi" or $answer is 4*atan(1)).
512 :     ANS(strict_num_cmp($answer, .01));
513 :    
514 :     # The student answer can be a number or fraction, e.g. 2/3.
515 :     ANS(frac_num_cmp($answer)); # or
516 :     ANS(frac_num_cmp($answer, .01));
517 :    
518 :     # The student answer can be an arithmetic expression, e.g. (2+3)/7-2^.5 .
519 :     ANS(arith_num_cmp($answer)); # or
520 :     ANS(arith_num_cmp($answer, .01));
521 :    
522 :     # The student answer can contain elementary functions, e.g. sin(.3+pi/2)
523 :     ANS(std_num_cmp($answer)); # or
524 :     ANS(std_num_cmp( $answer, .01));
525 :    
526 :     =cut
527 :    
528 :     sub std_num_cmp { # compare numbers allowing use of elementary functions
529 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
530 :    
531 :     my %options = ( 'relTol' => $relPercentTol,
532 :     'format' => $format,
533 :     'zeroLevel' => $zeroLevel,
534 :     'zeroLevelTol' => $zeroLevelTol
535 :     );
536 :    
537 :     set_default_options( \%options,
538 :     'tolType' => 'relative',
539 :     'tolerance' => $numRelPercentTolDefault,
540 :     'mode' => 'std',
541 :     'format' => $numFormatDefault,
542 :     'relTol' => $numRelPercentTolDefault,
543 :     'zeroLevel' => $numZeroLevelDefault,
544 :     'zeroLevelTol' => $numZeroLevelTolDefault,
545 :     'debug' => 0,
546 :     );
547 :    
548 :     num_cmp([$correctAnswer], %options);
549 :     }
550 :    
551 :     ## Similar to std_num_cmp but accepts a list of numbers in the form
552 :     ## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
553 :     ## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
554 :     ## You must enter a format and tolerance
555 :    
556 :     sub std_num_cmp_list {
557 :     my ( $relPercentTol, $format, @answerList) = @_;
558 : gage 5586
559 : sh002i 5584 my %options = ( 'relTol' => $relPercentTol,
560 : gage 5585 'format' => $format,
561 : sh002i 5584 );
562 :    
563 :     set_default_options( \%options,
564 :     'tolType' => 'relative',
565 :     'tolerance' => $numRelPercentTolDefault,
566 :     'mode' => 'std',
567 :     'format' => $numFormatDefault,
568 :     'relTol' => $numRelPercentTolDefault,
569 :     'zeroLevel' => $numZeroLevelDefault,
570 :     'zeroLevelTol' => $numZeroLevelTolDefault,
571 :     'debug' => 0,
572 :     );
573 :    
574 :     num_cmp(\@answerList, %options);
575 :    
576 :     }
577 :    
578 :     sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
579 :     my ( $correctAnswer, $absTol, $format) = @_;
580 :     my %options = ( 'tolerance' => $absTol,
581 :     'format' => $format
582 :     );
583 :    
584 :     set_default_options (\%options,
585 :     'tolType' => 'absolute',
586 :     'tolerance' => $absTol,
587 :     'mode' => 'std',
588 :     'format' => $numFormatDefault,
589 :     'zeroLevel' => 0,
590 :     'zeroLevelTol' => 0,
591 :     'debug' => 0,
592 :     );
593 :    
594 :     num_cmp([$correctAnswer], %options);
595 :     }
596 :    
597 :     ## See std_num_cmp_list for usage
598 :    
599 :     sub std_num_cmp_abs_list {
600 :     my ( $absTol, $format, @answerList ) = @_;
601 :    
602 :     my %options = ( 'tolerance' => $absTol,
603 :     'format' => $format,
604 :     );
605 :    
606 :     set_default_options( \%options,
607 :     'tolType' => 'absolute',
608 :     'tolerance' => $absTol,
609 :     'mode' => 'std',
610 :     'format' => $numFormatDefault,
611 :     'zeroLevel' => 0,
612 :     'zeroLevelTol' => 0,
613 :     'debug' => 0,
614 :     );
615 :    
616 :     num_cmp(\@answerList, %options);
617 :     }
618 :    
619 :     sub frac_num_cmp { # only allow fractions and numbers as submitted answer
620 :    
621 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
622 :    
623 :     my %options = ( 'relTol' => $relPercentTol,
624 :     'format' => $format,
625 :     'zeroLevel' => $zeroLevel,
626 :     'zeroLevelTol' => $zeroLevelTol
627 :     );
628 :    
629 :     set_default_options( \%options,
630 :     'tolType' => 'relative',
631 :     'tolerance' => $relPercentTol,
632 :     'mode' => 'frac',
633 :     'format' => $numFormatDefault,
634 :     'zeroLevel' => $numZeroLevelDefault,
635 :     'zeroLevelTol' => $numZeroLevelTolDefault,
636 :     'relTol' => $numRelPercentTolDefault,
637 :     'debug' => 0,
638 :     );
639 :    
640 :     num_cmp([$correctAnswer], %options);
641 :     }
642 :    
643 :     ## See std_num_cmp_list for usage
644 :     sub frac_num_cmp_list {
645 :     my ( $relPercentTol, $format, @answerList ) = @_;
646 :    
647 :     my %options = ( 'relTol' => $relPercentTol,
648 :     'format' => $format
649 :     );
650 :    
651 :     set_default_options( \%options,
652 :     'tolType' => 'relative',
653 :     'tolerance' => $relPercentTol,
654 :     'mode' => 'frac',
655 :     'format' => $numFormatDefault,
656 :     'zeroLevel' => $numZeroLevelDefault,
657 :     'zeroLevelTol' => $numZeroLevelTolDefault,
658 :     'relTol' => $numRelPercentTolDefault,
659 :     'debug' => 0,
660 :     );
661 :    
662 :     num_cmp(\@answerList, %options);
663 :     }
664 :    
665 :     sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
666 :     my ( $correctAnswer, $absTol, $format ) = @_;
667 :    
668 :     my %options = ( 'tolerance' => $absTol,
669 :     'format' => $format
670 :     );
671 :    
672 :     set_default_options (\%options,
673 :     'tolType' => 'absolute',
674 :     'tolerance' => $absTol,
675 :     'mode' => 'frac',
676 :     'format' => $numFormatDefault,
677 :     'zeroLevel' => 0,
678 :     'zeroLevelTol' => 0,
679 :     'debug' => 0,
680 :     );
681 :    
682 :     num_cmp([$correctAnswer], %options);
683 :     }
684 :    
685 :     ## See std_num_cmp_list for usage
686 :    
687 :     sub frac_num_cmp_abs_list {
688 :     my ( $absTol, $format, @answerList ) = @_;
689 :    
690 :     my %options = ( 'tolerance' => $absTol,
691 :     'format' => $format
692 :     );
693 :    
694 :     set_default_options (\%options,
695 :     'tolType' => 'absolute',
696 :     'tolerance' => $absTol,
697 :     'mode' => 'frac',
698 :     'format' => $numFormatDefault,
699 :     'zeroLevel' => 0,
700 :     'zeroLevelTol' => 0,
701 :     'debug' => 0,
702 :     );
703 :    
704 :     num_cmp(\@answerList, %options);
705 :     }
706 :    
707 :    
708 :     sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
709 :    
710 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
711 :    
712 :     my %options = ( 'relTol' => $relPercentTol,
713 :     'format' => $format,
714 :     'zeroLevel' => $zeroLevel,
715 :     'zeroLevelTol' => $zeroLevelTol
716 :     );
717 :    
718 :     set_default_options( \%options,
719 :     'tolType' => 'relative',
720 :     'tolerance' => $relPercentTol,
721 :     'mode' => 'arith',
722 :     'format' => $numFormatDefault,
723 :     'zeroLevel' => $numZeroLevelDefault,
724 :     'zeroLevelTol' => $numZeroLevelTolDefault,
725 :     'relTol' => $numRelPercentTolDefault,
726 :     'debug' => 0,
727 :     );
728 :    
729 :     num_cmp([$correctAnswer], %options);
730 :     }
731 :    
732 :     ## See std_num_cmp_list for usage
733 :     sub arith_num_cmp_list {
734 :     my ( $relPercentTol, $format, @answerList ) = @_;
735 :    
736 :     my %options = ( 'relTol' => $relPercentTol,
737 :     'format' => $format,
738 :     );
739 :    
740 :     set_default_options( \%options,
741 :     'tolType' => 'relative',
742 :     'tolerance' => $relPercentTol,
743 :     'mode' => 'arith',
744 :     'format' => $numFormatDefault,
745 :     'zeroLevel' => $numZeroLevelDefault,
746 :     'zeroLevelTol' => $numZeroLevelTolDefault,
747 :     'relTol' => $numRelPercentTolDefault,
748 :     'debug' => 0,
749 :     );
750 :    
751 :     num_cmp(\@answerList, %options);
752 :     }
753 :    
754 :     sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
755 :     my ( $correctAnswer, $absTol, $format ) = @_;
756 :    
757 :     my %options = ( 'tolerance' => $absTol,
758 :     'format' => $format
759 :     );
760 :    
761 :     set_default_options (\%options,
762 :     'tolType' => 'absolute',
763 :     'tolerance' => $absTol,
764 :     'mode' => 'arith',
765 :     'format' => $numFormatDefault,
766 :     'zeroLevel' => 0,
767 :     'zeroLevelTol' => 0,
768 :     'debug' => 0,
769 :     );
770 :    
771 :     num_cmp([$correctAnswer], %options);
772 :     }
773 :    
774 :     ## See std_num_cmp_list for usage
775 :     sub arith_num_cmp_abs_list {
776 :     my ( $absTol, $format, @answerList ) = @_;
777 :    
778 :     my %options = ( 'tolerance' => $absTol,
779 :     'format' => $format
780 :     );
781 :    
782 :     set_default_options (\%options,
783 :     'tolType' => 'absolute',
784 :     'tolerance' => $absTol,
785 :     'mode' => 'arith',
786 :     'format' => $numFormatDefault,
787 :     'zeroLevel' => 0,
788 :     'zeroLevelTol' => 0,
789 :     'debug' => 0,
790 :     );
791 :    
792 :     num_cmp(\@answerList, %options);
793 :     }
794 :    
795 :     sub strict_num_cmp { # only allow numbers as submitted answer
796 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
797 :    
798 :     my %options = ( 'relTol' => $relPercentTol,
799 :     'format' => $format,
800 :     'zeroLevel' => $zeroLevel,
801 :     'zeroLevelTol' => $zeroLevelTol
802 :     );
803 :    
804 :     set_default_options( \%options,
805 :     'tolType' => 'relative',
806 :     'tolerance' => $relPercentTol,
807 :     'mode' => 'strict',
808 :     'format' => $numFormatDefault,
809 :     'zeroLevel' => $numZeroLevelDefault,
810 :     'zeroLevelTol' => $numZeroLevelTolDefault,
811 :     'relTol' => $numRelPercentTolDefault,
812 :     'debug' => 0,
813 :     );
814 :     num_cmp([$correctAnswer], %options);
815 :    
816 :     }
817 :    
818 :     ## See std_num_cmp_list for usage
819 :     sub strict_num_cmp_list { # compare numbers
820 :     my ( $relPercentTol, $format, @answerList ) = @_;
821 :    
822 :     my %options = ( 'relTol' => $relPercentTol,
823 :     'format' => $format,
824 :     );
825 :    
826 :     set_default_options( \%options,
827 :     'tolType' => 'relative',
828 :     'tolerance' => $relPercentTol,
829 :     'mode' => 'strict',
830 :     'format' => $numFormatDefault,
831 :     'zeroLevel' => $numZeroLevelDefault,
832 :     'zeroLevelTol' => $numZeroLevelTolDefault,
833 :     'relTol' => $numRelPercentTolDefault,
834 :     'debug' => 0,
835 :     );
836 :    
837 :     num_cmp(\@answerList, %options);
838 :     }
839 :    
840 :    
841 :     sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
842 :     my ( $correctAnswer, $absTol, $format ) = @_;
843 :    
844 :     my %options = ( 'tolerance' => $absTol,
845 :     'format' => $format
846 :     );
847 :    
848 :     set_default_options (\%options,
849 :     'tolType' => 'absolute',
850 :     'tolerance' => $absTol,
851 :     'mode' => 'strict',
852 :     'format' => $numFormatDefault,
853 :     'zeroLevel' => 0,
854 :     'zeroLevelTol' => 0,
855 :     'debug' => 0,
856 :     );
857 :     num_cmp([$correctAnswer], %options);
858 :    
859 :     }
860 :    
861 :     ## See std_num_cmp_list for usage
862 :     sub strict_num_cmp_abs_list { # compare numbers
863 :     my ( $absTol, $format, @answerList ) = @_;
864 :    
865 :     my %options = ( 'tolerance' => $absTol,
866 :     'format' => $format
867 :     );
868 :    
869 :     set_default_options (\%options,
870 :     'tolType' => 'absolute',
871 :     'tolerance' => $absTol,
872 :     'mode' => 'strict',
873 :     'format' => $numFormatDefault,
874 :     'zeroLevel' => 0,
875 :     'zeroLevelTol' => 0,
876 :     'debug' => 0,
877 :     );
878 :    
879 :     num_cmp(\@answerList, %options);
880 :     }
881 :    
882 :     =head1 Miscellaneous functions
883 :    
884 :     =head2 [DEPRECATED] numerical_compare_with_units
885 :    
886 :     ANS(numerical_compare_with_units($correct_ans_with_units, %options))
887 :    
888 :     This function is deprecated. Use num_cmp with the units option instead:
889 :    
890 :     ANS(num_cmp($correct_ans, units=>$units));
891 :    
892 :     =cut
893 :    
894 :     ## sub numerical_compare_with_units
895 :     ## Compares a number with units
896 :     ## Deprecated; use num_cmp()
897 :     ##
898 :     ## IN: a string which includes the numerical answer and the units
899 :     ## a hash with the following keys (all optional):
900 :     ## mode -- 'std', 'frac', 'arith', or 'strict'
901 :     ## format -- the format to use when displaying the answer
902 :     ## tol -- an absolute tolerance, or
903 :     ## relTol -- a relative tolerance
904 :     ## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
905 :     ## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
906 :    
907 :     # This mode is depricated. send input through num_cmp -- it can handle units.
908 :    
909 :     sub numerical_compare_with_units {
910 :     my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
911 :     my %options = @_; # all of the other inputs are (key value) pairs
912 :    
913 :     # Prepare the correct answer
914 :     $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
915 :    
916 :     # it surprises me that the match below works since the first .* is greedy.
917 :     my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
918 :     $options{units} = $correct_units;
919 :    
920 :     num_cmp($correct_num_answer, %options);
921 :     }
922 :    
923 :     =head2 [DEPRECATED] std_num_str_cmp()
924 :    
925 :     ANS(std_num_str_cmp($correctAnswer, $ra_legalStrings, $relTol, $format, $zeroLevel, $zeroLevelTol))
926 :    
927 :     This function is deprecated. Use num_cmp() with the strings option instead:
928 :    
929 :     ANS(num_cmp($correctAnswer, strings=>$ra_legalStrings, ...));
930 :    
931 :     =cut
932 :    
933 :     sub std_num_str_cmp {
934 :     my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
935 :     # warn ('This method is depreciated. Use num_cmp instead.');
936 :     return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
937 :     zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
938 :     }
939 :    
940 :     sub NUM_CMP { # low level numeric compare (now uses Parser)
941 :     return ORIGINAL_NUM_CMP(@_)
942 :     if $useOldAnswerMacros;
943 :    
944 :     my %num_params = @_;
945 :    
946 :     #
947 :     # check for required parameters
948 :     #
949 :     my @keys = qw(correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug);
950 :     foreach my $key (@keys) {
951 : gage 5585 warn( "$key must be defined in options when calling NUM_CMP" )
952 : sh002i 5584 unless defined($num_params{$key});
953 :     }
954 :    
955 :     my $correctAnswer = $num_params{correctAnswer};
956 :     my $mode = $num_params{mode};
957 :     my %options = (debug => $num_params{debug});
958 :    
959 :     #
960 :     # Hack to fix up exponential notation in correct answer
961 :     # (e.g., perl will pass .0000001 as 1e-07).
962 :     #
963 :     $correctAnswer = uc($correctAnswer)
964 :     if $correctAnswer =~ m/e/ && Value::isNumber($correctAnswer);
965 :    
966 :     #
967 :     # Get an apppropriate context based on the mode
968 :     #
969 :     my $context;
970 :     for ($mode) {
971 :     /^strict$/i and do {
972 :     $context = Parser::Context->getCopy($user_context,"LimitedNumeric");
973 :     last;
974 :     };
975 :     /^arith$/i and do {
976 :     $context = Parser::Context->getCopy($user_context,"LegacyNumeric");
977 :     $context->functions->disable('All');
978 :     last;
979 :     };
980 :     /^frac$/i and do {
981 :     $context = Parser::Context->getCopy($user_context,"LimitedNumeric-Fraction");
982 :     last;
983 :     };
984 :    
985 :     # default
986 :     $context = Parser::Context->getCopy($user_context,"LegacyNumeric");
987 :     }
988 :     $context->{format}{number} = $num_params{'format'};
989 :     $context->strings->clear;
990 :     # FIXME: should clear variables as well? Copy them from the current context?
991 :    
992 :     #
993 :     # Add the strings to the context
994 :     #
995 :     if ($num_params{strings}) {
996 :     foreach my $string (@{$num_params{strings}}) {
997 :     my %tex = ($string =~ m/^(-?)inf(inity)?$/i)? (TeX => "$1\\infty"): ();
998 :     %tex = (TeX => "-\\infty") if uc($string) eq "MINF";
999 :     $context->strings->add(uc($string) => {%tex})
1000 :     unless $context->strings->get(uc($string));
1001 :     }
1002 :     }
1003 :    
1004 :     #
1005 :     # Set the tolerances
1006 :     #
1007 :     if ($num_params{tolType} eq 'absolute') {
1008 :     $context->flags->set(
1009 :     tolerance => $num_params{tolerance},
1010 :     tolType => 'absolute',
1011 :     );
1012 :     } else {
1013 :     $context->flags->set(
1014 :     tolerance => .01*$num_params{tolerance},
1015 :     tolType => 'relative',
1016 :     );
1017 :     }
1018 :     $context->flags->set(
1019 :     zeroLevel => $num_params{zeroLevel},
1020 :     zeroLevelTol => $num_params{zeroLevelTol},
1021 :     );
1022 :    
1023 :     #
1024 :     # Get the proper Parser object for the professor's answer
1025 :     # using the initialized context
1026 :     #
1027 :     my $oldContext = &$Context(); &$Context($context); my $r;
1028 :     if ($num_params{units}) {
1029 :     $r = new Parser::Legacy::NumberWithUnits($correctAnswer);
1030 :     $options{rh_correct_units} = $num_params{units};
1031 :     } else {
1032 :     $r = Value::Formula->new($correctAnswer);
1033 :     die "The professor's answer can't be a formula" unless $r->isConstant;
1034 :     $r = $r->eval; $r = new Value::Real($r) unless Value::class($r) eq 'String';
1035 :     $r->{correct_ans} = $correctAnswer;
1036 :     if ($mode eq 'phase_pi') {
1037 :     my $pi = 4*atan2(1,1);
1038 :     while ($r > $pi/2) {$r -= $pi}
1039 :     while ($r < -$pi/2) {$r += $pi}
1040 :     }
1041 :     }
1042 :     #
1043 :     # Get the answer checker from the parser object
1044 :     #
1045 :     my $cmp = $r->cmp(%options);
1046 :     $cmp->install_pre_filter(sub {
1047 :     my $rh_ans = shift;
1048 :     $rh_ans->{original_student_ans} = $rh_ans->{student_ans};
1049 :     $rh_ans->{original_correct_ans} = $rh_ans->{correct_ans};
1050 :     return $rh_ans;
1051 :     });
1052 :     $cmp->install_post_filter(sub {
1053 :     my $rh_ans = shift;
1054 :     $rh_ans->{student_ans} = $rh_ans->{student_value}->string
1055 :     if ref($rh_ans->{student_value});
1056 :     return $rh_ans;
1057 :     });
1058 :     &$Context($oldContext);
1059 :    
1060 :     return $cmp;
1061 :     }
1062 :    
1063 :     #
1064 :     # The original version, for backward compatibility
1065 :     # (can be removed when the Parser-based version is more fully tested.)
1066 :     #
1067 :     sub ORIGINAL_NUM_CMP { # low level numeric compare
1068 :     my %num_params = @_;
1069 :    
1070 :     my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1071 :     foreach my $key (@keys) {
1072 :     warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1073 :     }
1074 :    
1075 :     my $correctAnswer = $num_params{'correctAnswer'};
1076 :     my $format = $num_params{'format'};
1077 :     my $mode = $num_params{'mode'};
1078 :    
1079 :     if( $num_params{tolType} eq 'relative' ) {
1080 :     $num_params{'tolerance'} = .01*$num_params{'tolerance'};
1081 :     }
1082 :    
1083 :     my $formattedCorrectAnswer;
1084 :     my $correct_units;
1085 :     my $correct_num_answer;
1086 :     my %correct_units;
1087 :     my $corrAnswerIsString = 0;
1088 :    
1089 :    
1090 :     if (defined($num_params{units}) && $num_params{units}) {
1091 :     $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1092 :     # units are in form stuff space units where units contains no spaces.
1093 :    
1094 :     ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
1095 :     %correct_units = Units::evaluate_units($correct_units);
1096 :     if ( defined( $correct_units{'ERROR'} ) ) {
1097 :     warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1098 :     "$correct_units{'ERROR'}\n");
1099 :     }
1100 :     # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1101 :     $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1102 :    
1103 :     } elsif (defined($num_params{strings}) && $num_params{strings}) {
1104 :     my $legalString = '';
1105 :     my @legalStrings = @{$num_params{strings}};
1106 :     $correct_num_answer = $correctAnswer;
1107 :     $formattedCorrectAnswer = $correctAnswer;
1108 :     foreach $legalString (@legalStrings) {
1109 :     if ( uc($correctAnswer) eq uc($legalString) ) {
1110 :     $corrAnswerIsString = 1;
1111 :    
1112 :     last;
1113 :     }
1114 :     } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1115 :     } else {
1116 :     $correct_num_answer = $correctAnswer;
1117 :     $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1118 :     }
1119 :    
1120 :     $correct_num_answer = math_constants($correct_num_answer);
1121 :    
1122 :     my $PGanswerMessage = '';
1123 :    
1124 :     my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1125 :    
1126 :     if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1127 :     ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1128 :     } else { # case of a string answer
1129 :     $PG_eval_errors = ' ';
1130 :     $correctVal = $correctAnswer;
1131 :     }
1132 :    
1133 :     if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1134 :     ##error message from eval or above
1135 :     warn "Error in 'correct' answer: $PG_eval_errors<br>
1136 :     The answer $correctAnswer evaluates to $correctVal,
1137 :     which cannot be interpreted as a number. ";
1138 :    
1139 :     }
1140 :     #########################################################################
1141 :    
1142 :     #construct the answer evaluator
1143 :     my $answer_evaluator = new AnswerEvaluator;
1144 :     $answer_evaluator->{debug} = $num_params{debug};
1145 :     $answer_evaluator->ans_hash(
1146 :     correct_ans => $correctVal,
1147 :     type => "${mode}_number",
1148 :     tolerance => $num_params{tolerance},
1149 :     tolType => $num_params{tolType},
1150 :     units => $correct_units,
1151 :     original_correct_ans => $formattedCorrectAnswer,
1152 :     rh_correct_units => \%correct_units,
1153 :     answerIsString => $corrAnswerIsString,
1154 :     );
1155 :     my ($in, $formattedSubmittedAnswer);
1156 :     $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1157 :     $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1158 :     );
1159 :    
1160 :    
1161 :    
1162 :     if (defined($num_params{units}) && $num_params{units}) {
1163 :     $answer_evaluator->install_pre_filter(\&check_units);
1164 :     }
1165 :     if (defined($num_params{strings}) && $num_params{strings}) {
1166 :     $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
1167 :     }
1168 :    
1169 :     ## FIXME? - this pre filter was moved before check_units to allow
1170 :     ## for latex preview of answers with no units.
1171 :     ## seems to work but may have unintended side effects elsewhere.
1172 :    
1173 :     ## Actually it caused trouble with the check strings package so it has been moved back
1174 :     # We'll try some other method -- perhaps add code to fix_answer for display
1175 :     $answer_evaluator->install_pre_filter(\&check_syntax);
1176 :    
1177 :     $answer_evaluator->install_pre_filter(\&math_constants);
1178 :    
1179 :     if ($mode eq 'std') {
1180 :     # do nothing
1181 :     } elsif ($mode eq 'strict') {
1182 :     $answer_evaluator->install_pre_filter(\&is_a_number);
1183 :     } elsif ($mode eq 'arith') {
1184 :     $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
1185 :     } elsif ($mode eq 'frac') {
1186 :     $answer_evaluator->install_pre_filter(\&is_a_fraction);
1187 :    
1188 :     } elsif ($mode eq 'phase_pi') {
1189 :     $answer_evaluator->install_pre_filter(\&phase_pi);
1190 :    
1191 :     } else {
1192 :     $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1193 :     $formattedSubmittedAnswer = $in;
1194 :     }
1195 :    
1196 :     if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
1197 :     $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1198 :     }
1199 :    
1200 :    
1201 :     ###############################################################################
1202 :     # We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
1203 :     # can be displayed in the answer message. This may still cause a few anomolies when strings are used
1204 :     #
1205 :     ###############################################################################
1206 :    
1207 :     $answer_evaluator->install_post_filter(\&fix_answers_for_display);
1208 :    
1209 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1210 :     return $rh_ans unless $rh_ans->catch_error('EVAL');
1211 :     $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1212 :     $rh_ans->clear_error('EVAL'); } );
1213 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
1214 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
1215 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
1216 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
1217 :     $answer_evaluator;
1218 :     }
1219 :    
1220 :     =head1 SEE ALSO
1221 :    
1222 :     L<PGanswermacros.pl>, L<MathObjects>.
1223 :    
1224 :     =cut
1225 :    
1226 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9