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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 1050 # This file is PGanswermacros.pl
2 :     # This includes the subroutines for the ANS macros, that
3 :     # is, macros allowing a more flexible answer checking
4 :     ####################################################################
5 :     # Copyright @ 1995-2000 University of Rochester
6 :     # All Rights Reserved
7 :     ####################################################################
8 :     #$Id$
9 :    
10 :     =head1 NAME
11 :    
12 :     PGanswermacros.pl -- located in the courseScripts directory
13 :    
14 :     =head1 SYNPOSIS
15 :    
16 :     Number Answer Evaluators:
17 :     num_cmp() -- uses an input hash to determine parameters
18 : apizer 1080
19 : sh002i 1050 std_num_cmp(), std_num_cmp_list(), std_num_cmp_abs, std_num_cmp_abs_list()
20 :     frac_num_cmp(), frac_num_cmp_list(), frac_num_cmp_abs, frac_num_cmp_abs_list()
21 :     arith_num_cmp(), arith_num_cmp_list(), arith_num_cmp_abs, arith_num_cmp_abs_list()
22 :     strict_num_cmp(), strict_num_cmp_list(), strict_num_cmp_abs, strict_num_cmp_abs_list()
23 :     numerical_compare_with_units() -- requires units as part of the answer
24 :     std_num_str_cmp() -- also accepts a set of strings as possible answers
25 :    
26 :     Function Answer Evaluators:
27 :     fun_cmp() -- uses an input hash to determine parameters
28 : apizer 1080
29 : sh002i 1050 function_cmp(), function_cmp_abs()
30 :     function_cmp_up_to_constant(), function_cmp_up_to_constant_abs()
31 :     multivar_function_cmp()
32 :    
33 :     String Answer Evaluators:
34 :     str_cmp() -- uses an input hash to determine parameters
35 : apizer 1080
36 : sh002i 1050 std_str_cmp(), std_str_cmp_list(), std_cs_str_cmp(), std_cs_str_cmp_list()
37 :     strict_str_cmp(), strict_str_cmp_list()
38 :     ordered_str_cmp(), ordered_str_cmp_list(), ordered_cs_str_cmp(), ordered_cs_str_cmp_list()
39 :     unordered_str_cmp(), unordered_str_cmp_list(), unordered_cs_str_cmp(), unordered_cs_str_cmp_list()
40 :    
41 :     Miscellaneous Answer Evaluators:
42 :     checkbox_cmp()
43 :     radio_cmp()
44 :    
45 :     =cut
46 :    
47 :     =head1 DESCRIPTION
48 :    
49 :     This file adds subroutines which create "answer evaluators" for checking
50 :     answers. Each answer evaluator accepts a single input from a student answer,
51 :     checks it and creates an output hash %ans_hash with seven or eight entries
52 :     (the preview_latex_string is optional). The output hash is now being created
53 :     with the AnswerHash package "class", which is located at the end of this file.
54 :     This class is currently just a wrapper for the hash, but this might change in
55 :     the future as new capabilities are added.
56 :    
57 :     score => $correctQ,
58 :     correct_ans => $originalCorrEqn,
59 :     student_ans => $modified_student_ans
60 :     original_student_ans => $original_student_answer,
61 :     ans_message => $PGanswerMessage,
62 :     type => 'typeString',
63 :     preview_text_string => $preview_text_string,
64 :     preview_latex_string => $preview_latex_string
65 :    
66 :    
67 :     $ans_hash{score} -- a number between 0 and 1 indicating
68 :     whether the answer is correct. Fractions
69 :     allow the implementation of partial
70 :     credit for incorrect answers.
71 :     $ans_hash{correct_ans} -- The correct answer, as supplied by the
72 :     instructor and then formatted. This can
73 :     be viewed by the student after the answer date.
74 :     $ans_hash{student_ans} -- This is the student answer, after reformatting;
75 :     for example the answer might be forced
76 :     to capital letters for comparison with
77 :     the instructors answer. For a numerical
78 :     answer, it gives the evaluated answer.
79 :     This is displayed in the section reporting
80 :     the results of checking the student answers.
81 :     $ans_hash{original_student_ans} -- This is the original student answer. This is displayed
82 :     on the preview page and may be used for sticky answers.
83 :     $ans_hash{ans_message} -- Any error message, or hint provided by the answer evaluator.
84 :     This is also displayed in the section reporting
85 :     the results of checking the student answers.
86 :     $ans_hash{type} -- A string indicating the type of answer evaluator. This
87 :     helps in preprocessing the student answer for errors.
88 :     Some examples:
89 :     'number_with_units'
90 :     'function'
91 :     'frac_number'
92 :     'arith_number'
93 :     $ans_hash{preview_text_string} -- This typically shows how the student answer was parsed. It is
94 :     displayed on the preview page. For a student answer of 2sin(3x)
95 :     this would be 2*sin(3*x). For string answers it is typically the
96 :     same as $ans_hash{student_ans}.
97 :     $ans_hash{preview_latex_string} -- THIS IS OPTIONAL. This is latex version of the student answer
98 :     which is used to show a typeset view on the answer on the preview
99 :     page. For a student answer of 2/3, this would be \frac{2}{3}.
100 :    
101 :     Technical note: the routines in this file are not actually answer evaluators. Instead, they create
102 :     answer evaluators. An answer evaluator is an anonymous subroutine, referenced by a named scalar. The
103 :     routines in this file build the subroutine and return a reference to it. Later, when the student
104 :     actually enters an answer, the problem processor feeds that answer to the referenced subroutine, which
105 :     evaluates it and returns a score (usually 0 or 1). For most users, this distinction is unimportant, but
106 :     if you plan on writing your own answer evaluators, you should understand this point.
107 :    
108 :     =cut
109 :    
110 :     BEGIN {
111 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
112 :     }
113 :    
114 :    
115 : gage 1250 my ($BR , # convenient localizations.
116 :     $PAR ,
117 : apizer 1080 $numRelPercentTolDefault ,
118 :     $numZeroLevelDefault ,
119 :     $numZeroLevelTolDefault ,
120 : gage 1250 $numAbsTolDefault ,
121 :     $numFormatDefault ,
122 :     $functRelPercentTolDefault ,
123 : apizer 1080 $functZeroLevelDefault ,
124 :     $functZeroLevelTolDefault ,
125 : gage 1250 $functAbsTolDefault ,
126 :     $functNumOfPoints ,
127 :     $functVarDefault ,
128 :     $functLLimitDefault ,
129 :     $functULimitDefault ,
130 :     $functMaxConstantOfIntegration ,
131 :     $CA ,
132 : gage 1463 $rh_envir ,
133 : jj 1932 $useBaseTenLog ,
134 : gage 2061 $inputs_ref ,
135 : gage 1690 $QUESTIONNAIRE_ANSWERS ,
136 : jj 3572 $user_context,
137 :     $Context,
138 : sh002i 1050 );
139 :    
140 :    
141 :    
142 :    
143 :     sub _PGanswermacros_init {
144 : apizer 1080
145 : gage 1690 $BR = main::PG_restricted_eval(q!$main::BR!);
146 :     $PAR = main::PG_restricted_eval(q!$main::PAR!);
147 : apizer 1080
148 : sh002i 1050 # import defaults
149 :     # these are now imported from the %envir variable
150 : gage 1250 $numRelPercentTolDefault = main::PG_restricted_eval(q!$main::numRelPercentTolDefault!);
151 :     $numZeroLevelDefault = main::PG_restricted_eval(q!$main::numZeroLevelDefault!);
152 :     $numZeroLevelTolDefault = main::PG_restricted_eval(q!$main::numZeroLevelTolDefault!);
153 :     $numAbsTolDefault = main::PG_restricted_eval(q!$main::numAbsTolDefault!);
154 :     $numFormatDefault = main::PG_restricted_eval(q!$main::numFormatDefault!);
155 :     $functRelPercentTolDefault = main::PG_restricted_eval(q!$main::functRelPercentTolDefault!);
156 :     $functZeroLevelDefault = main::PG_restricted_eval(q!$main::functZeroLevelDefault!);
157 :     $functZeroLevelTolDefault = main::PG_restricted_eval(q!$main::functZeroLevelTolDefault!);
158 :     $functAbsTolDefault = main::PG_restricted_eval(q!$main::functAbsTolDefault!);
159 :     $functNumOfPoints = main::PG_restricted_eval(q!$main::functNumOfPoints!);
160 :     $functVarDefault = main::PG_restricted_eval(q!$main::functVarDefault!);
161 :     $functLLimitDefault = main::PG_restricted_eval(q!$main::functLLimitDefault!);
162 :     $functULimitDefault = main::PG_restricted_eval(q!$main::functULimitDefault!);
163 :     $functMaxConstantOfIntegration = main::PG_restricted_eval(q!$main::functMaxConstantOfIntegration!);
164 :     $rh_envir = main::PG_restricted_eval(q!\%main::envir!);
165 : apizer 2781 $useBaseTenLog = main::PG_restricted_eval(q!$main::useBaseTenLog!);
166 : gage 2061 $inputs_ref = main::PG_restricted_eval(q!$main::inputs_ref!);
167 : gage 1690 $QUESTIONNAIRE_ANSWERS = '';
168 : jj 3572
169 :     if (!main::PG_restricted_eval(q!$main::useOldAnswerMacros!)) {
170 :     $user_context = main::PG_restricted_eval(q!\%context!);
171 :     $Context = sub {Parser::Context->current($user_context,@_)};
172 :     }
173 : sh002i 1050 }
174 :    
175 : gage 1463
176 :    
177 : sh002i 1050 ##########################################################################
178 : gage 1463
179 :     #Note use $rh_envir to read environment variables
180 :    
181 : sh002i 1050 ##########################################################################
182 :     ## Number answer evaluators
183 :    
184 :     =head2 Number Answer Evaluators
185 :    
186 :     Number answer evaluators take in a numerical answer, compare it to the correct answer,
187 :     and return a score. In addition, they can choose to accept or reject an answer based on
188 :     its format, closeness to the correct answer, and other criteria. There are two types
189 :     of numerical answer evaluators: num_cmp(), which takes a hash of named options as parameters,
190 :     and the "mode"_num_cmp() variety, which use different functions to access different sets of
191 :     options. In addition, there is the special case of std_num_str_cmp(), which can evaluate
192 :     both numbers and strings.
193 :    
194 :     Numerical Comparison Options
195 :    
196 :     correctAnswer -- This is the correct answer that the student answer will
197 :     be compared to. However, this does not mean that the
198 :     student answer must match this exactly. How close the
199 :     student answer must be is determined by the other
200 :     options, especially tolerance and format.
201 :    
202 :     tolerance -- These options determine how close the student answer
203 :     must be to the correct answer to qualify. There are two
204 :     types of tolerance: relative and absolute. Relative
205 :     tolerances are given in percentages. A relative
206 :     tolerance of 1 indicates that the student answer must
207 :     be within 1% of the correct answer to qualify as correct.
208 :     In other words, a student answer is correct when
209 :     abs(studentAnswer - correctAnswer) <= abs(.01*relpercentTol*correctAnswer)
210 :     Using absolute tolerance, the student answer must be a
211 :     fixed distance from the correct answer to qualify.
212 :     For example, an absolute tolerance of 5 means that any
213 :     number which is +-5 of the correct answer qualifies as correct.
214 :     Final (rarely used) tolerance options are zeroLevel
215 :     and zeroLevelTol, used in conjunction with relative
216 :     tolerance. if correctAnswer has absolute value less than
217 :     or equal to zeroLevel, then the student answer must be,
218 :     in absolute terms, within zeroLevelTol of correctAnswer, i.e.,
219 :     abs(studentAnswer - correctAnswer) <= zeroLevelTol.
220 :     In other words, if the correct answer is very near zero,
221 :     an absolute tolerance will be used. One must do this to
222 :     handle floating point answers very near zero, because of
223 :     the inaccuracy of floating point arithmetic. However, the
224 :     default values are almost always adequate.
225 :    
226 :     mode -- This determines the allowable methods for entering an
227 :     answer. Answers which do not meet this requirement will
228 :     be graded as incorrect, regardless of their numerical
229 :     value. The recognized modes are:
230 :     'std' (default) -- allows any expression which evaluates
231 :     to a number, including those using
232 :     elementary functions like sin() and
233 :     exp(), as well as the operations of
234 :     arithmetic (+, -, *, /, ^)
235 :     'strict' -- only decimal numbers are allowed
236 :     'frac' -- whole numbers and fractions are allowed
237 :     'arith' -- arithmetic expressions are allowed, but
238 :     no functions
239 :     Note that all modes allow the use of "pi" and "e" as
240 :     constants, and also the use of "E" to represent scientific
241 :     notation.
242 :    
243 :     format -- The format to use when displaying the correct and
244 :     submitted answers. This has no effect on how answers are
245 :     evaluated; it is only for cosmetic purposes. The
246 :     formatting syntax is the same as Perl uses for the sprintf()
247 :     function. Format strings are of the form '%m.nx' or '%m.nx#',
248 :     where m and n are described below, and x is a formatter.
249 :     Esentially, m is the minimum length of the field
250 :     (make this negative to left-justify). Note that the decimal
251 :     point counts as a character when determining the field width.
252 :     If m begins with a zero, the number will be padded with zeros
253 :     instead of spaces to fit the field.
254 :     The precision specifier (n) works differently, depending
255 :     on which formatter you are using. For d, i, o, u, x and X
256 :     formatters (non-floating point formatters), n is the minimum
257 :     number of digits to display. For e and f, it is the number of
258 :     digits that appear after the decimal point (extra digits will
259 :     be rounded; insufficient digits will be padded with spaces--see
260 :     '#' below). For g, it is the number of significant digits to
261 :     display.
262 :     The full list of formatters can be found in the manpage
263 :     for printf(3), or by typing "perldoc -f sprintf" at a
264 :     terminal prompt. The following is a brief summary of the
265 :     most frequent formatters:
266 :     d -- decimal number
267 :     ld -- long decimal number
268 :     u -- unsigned decimal number
269 :     lu -- long unsigned decimal number
270 :     x -- hexadecimal number
271 :     o -- octal number
272 :     e -- floating point number in scientific notation
273 :     f -- floating point number
274 :     g -- either e or f, whichever takes less space
275 :     Technically, g will use e if the exponent is less than -4 or
276 :     greater than or equal to the precision. Trailing zeros are
277 :     removed in this mode.
278 :     If the format string ends in '#', trailing zeros will be
279 :     removed in the decimal part. Note that this is not a standard
280 :     syntax; it is handled internally by WeBWorK and not by Perl
281 :     (although this should not be a concern to end users).
282 :     The default format is '%0.5f#', which displays as a floating
283 :     point number with 5 digits of precision and no trailing zeros.
284 :     Other useful format strings might be '%0.2f' for displaying
285 :     dollar amounts, or '%010d' to display an integer with leading
286 :     zeros. Setting format to an empty string ( '' ) means no
287 :     formatting will be used; this will show 'arbitrary' precision
288 :     floating points.
289 :    
290 :     Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
291 :    
292 :     Format -- $numFormatDefault -- "%0.5f#"
293 :     Relative Tolerance -- $numRelPercentTolDefault -- .1
294 :     Absolute Tolerance -- $numAbsTolDefault -- .001
295 :     Zero Level -- $numZeroLevelDefault -- 1E-14
296 :     Zero Level Tolerance -- $numZeroLevelTolDefault -- 1E-12
297 :    
298 :     =cut
299 :    
300 :    
301 :     =head3 num_cmp()
302 :    
303 :     Compares a number or a list of numbers, using a named hash of options to set
304 :     parameters. This can make for more readable code than using the "mode"_num_cmp()
305 :     style, but some people find one or the other easier to remember.
306 :    
307 :     ANS( num_cmp( answer or answer_array_ref, options_hash ) );
308 :    
309 :     1. the correct answer, or a reference to an array of correct answers
310 :     2. a hash with the following keys (all optional):
311 : apizer 1080 mode -- 'std' (default) (allows any expression evaluating to
312 : sh002i 1050 a number)
313 :     'strict' (only numbers are allowed)
314 :     'frac' (fractions are allowed)
315 :     'arith' (arithmetic expressions allowed)
316 : apizer 1080 format -- '%0.5f#' (default); defines formatting for the
317 : sh002i 1050 correct answer
318 :     tol -- an absolute tolerance, or
319 :     relTol -- a relative tolerance
320 :     units -- the units to use for the answer(s)
321 :     strings -- a reference to an array of strings which are valid
322 :     answers (works like std_num_str_cmp() )
323 :     zeroLevel -- if the correct answer is this close to zero,
324 :     then zeroLevelTol applies
325 :     zeroLevelTol -- absolute tolerance to allow when answer is close
326 :     to zero
327 : apizer 1080
328 : sh002i 1050 debug -- if set to 1, provides verbose listing of
329 :     hash entries throughout fliters.
330 :    
331 :     Returns an answer evaluator, or (if given a reference to an array of
332 :     answers), a list of answer evaluators. Note that a reference to an array of
333 :     answers results is just a shortcut for writing a separate <code>num_cmp()</code> for each
334 :     answer.
335 :    
336 :     EXAMPLES:
337 :    
338 :     num_cmp( 5 ) -- correct answer is 5, using defaults
339 :     for all options
340 : apizer 1080 num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7,
341 : sh002i 1050 using defaults for all options
342 :     num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict
343 :     num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6,
344 :     both with 5% relative tolerance
345 : apizer 1080 num_cmp( 6, strings => ["Inf", "Minf", "NaN"] )
346 : sh002i 1050 -- correct answer is 6, "Inf", "Minf",
347 :     and "NaN" recognized as valid, but
348 :     incorrect answers.
349 :     num_cmp( "-INF", strings => ["INF", "-INF"] )
350 :     -- correct answer is "-INF", "INF" and
351 :     numerical expressions recognized as valid,
352 :     but incorrect answers.
353 :    
354 :    
355 :     =cut
356 :    
357 :     sub num_cmp {
358 :     my $correctAnswer = shift @_;
359 :     $CA = $correctAnswer;
360 :     my @opt = @_;
361 :     my %out_options;
362 :    
363 :     #########################################################################
364 :     # Retain this first check for backword compatibility. Allows input of the form
365 :     # num_cmp($ans, 1, '%0.5f') but warns against it
366 :     #########################################################################
367 : apizer 1080 my %known_options = (
368 : sh002i 1050 'mode' => 'std',
369 :     'format' => $numFormatDefault,
370 :     'tol' => $numAbsTolDefault,
371 :     'relTol' => $numRelPercentTolDefault,
372 :     'units' => undef,
373 :     'strings' => undef,
374 :     'zeroLevel' => $numZeroLevelDefault,
375 :     'zeroLevelTol' => $numZeroLevelTolDefault,
376 :     'tolType' => 'relative',
377 :     'tolerance' => 1,
378 :     'reltol' => undef, #alternate spelling
379 :     'unit' => undef, #alternate spelling
380 :     'debug' => 0
381 :     );
382 : apizer 1080
383 : sh002i 1050 my @output_list;
384 :     my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
385 : apizer 1080
386 : sh002i 1050 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
387 :     ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
388 :     # unless the first parameter is a list of arrays
389 :     # or the second parameter is a known option or
390 :     # no options were used,
391 :     # use the old num_cmp which does not use options, but has inputs
392 :     # $relPercentTol,$format,$zeroLevel,$zeroLevelTol
393 :     warn "This method of using num_cmp() is deprecated. Please rewrite this" .
394 :     " problem using the options style of parameter passing (or" .
395 :     " check that your first option is spelled correctly).";
396 : apizer 1080
397 : sh002i 1050 %out_options = ( 'relTol' => $relPercentTol,
398 :     'format' => $format,
399 :     'zeroLevel' => $zeroLevel,
400 :     'zeroLevelTol' => $zeroLevelTol,
401 :     'mode' => 'std'
402 :     );
403 :     }
404 :    
405 :     #########################################################################
406 : apizer 1080 # Now handle the options assuming they are entered in the form
407 : sh002i 1050 # num_cmp($ans, relTol=>1, format=>'%0.5f')
408 :     #########################################################################
409 :     %out_options = @opt;
410 :     assign_option_aliases( \%out_options,
411 :     'reltol' => 'relTol',
412 :     'unit' => 'units',
413 :     'abstol' => 'tol',
414 :     );
415 :    
416 :     set_default_options( \%out_options,
417 :     'tolType' => (defined($out_options{'tol'}) ) ? 'absolute' : 'relative', # the existence of "tol" means that we use absolute tolerance mode
418 :     'tolerance' => (defined($out_options{'tolType'}) && $out_options{'tolType'} eq 'absolute' ) ? $numAbsTolDefault : $numRelPercentTolDefault, # relative tolerance is the default
419 :     'mode' => 'std',
420 :     'format' => $numFormatDefault,
421 :     'tol' => undef,
422 :     'relTol' => undef,
423 :     'units' => undef,
424 :     'strings' => undef,
425 :     'zeroLevel' => $numZeroLevelDefault,
426 :     'zeroLevelTol' => $numZeroLevelTolDefault,
427 :     'debug' => 0,
428 :     );
429 :    
430 :     # can't use both units and strings
431 :     if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
432 :     warn "Can't use both 'units' and 'strings' in the same problem " .
433 :     "(check your parameters to num_cmp() )";
434 :     }
435 : apizer 1080
436 :     # absolute tolType and relTol are incompatible. So are relative tolType and tol
437 : sh002i 1050 if( defined( $out_options{'relTol'} ) && $out_options{'tolType'} eq 'absolute' ) {
438 :     warn "The 'tolType' 'absolute' is not compatible with 'relTol' " .
439 :     "(check your parameters to num_cmp() )";
440 : apizer 1080 }
441 : sh002i 1050 if( defined( $out_options{'tol'} ) && $out_options{'tolType'} eq 'relative' ) {
442 :     warn "The 'tolType' 'relative' is not compatible with 'tol' " .
443 :     "(check your parameters to num_cmp() )";
444 : apizer 1080 }
445 : sh002i 1050
446 : apizer 1080
447 : sh002i 1050 # Handle legacy options
448 :     if ($out_options{tolType} eq 'absolute') {
449 :     $out_options{'tolerance'}=$out_options{'tol'} if defined($out_options{'tol'});
450 :     delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
451 :     } else {
452 :     $out_options{'tolerance'}=$out_options{'relTol'} if defined($out_options{'relTol'});
453 :     # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
454 :     }
455 :     # end legacy options
456 : apizer 1080
457 : sh002i 1050 # thread over lists
458 :     my @ans_list = ();
459 :    
460 :     if ( ref($correctAnswer) eq 'ARRAY' ) {
461 :     @ans_list = @{$correctAnswer};
462 :     }
463 :     else { push( @ans_list, $correctAnswer );
464 :     }
465 :    
466 :     # produce answer evaluators
467 :     foreach my $ans (@ans_list) {
468 :     if( defined( $out_options{'units'} ) ) {
469 :     $ans = "$ans $out_options{'units'}";
470 : apizer 1080
471 : sh002i 1050 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
472 :     'tolerance' => $out_options{'tolerance'},
473 :     'tolType' => $out_options{'tolType'},
474 :     'format' => $out_options{'format'},
475 :     'mode' => $out_options{'mode'},
476 :     'zeroLevel' => $out_options{'zeroLevel'},
477 :     'zeroLevelTol' => $out_options{'zeroLevelTol'},
478 : apizer 1080 'debug' => $out_options{'debug'},
479 : sh002i 1050 'units' => $out_options{'units'},
480 : apizer 1080 )
481 : sh002i 1050 );
482 :     } elsif( defined( $out_options{'strings'} ) ) {
483 : apizer 1080
484 :    
485 : sh002i 1050 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
486 :     'tolerance' => $out_options{tolerance},
487 :     'tolType' => $out_options{tolType},
488 :     'format' => $out_options{'format'},
489 :     'mode' => $out_options{'mode'},
490 :     'zeroLevel' => $out_options{'zeroLevel'},
491 :     'zeroLevelTol' => $out_options{'zeroLevelTol'},
492 :     'debug' => $out_options{'debug'},
493 :     'strings' => $out_options{'strings'},
494 :     )
495 :     );
496 : apizer 1080 } else {
497 : sh002i 1050 push(@output_list,
498 :     NUM_CMP( 'correctAnswer' => $ans,
499 :     'tolerance' => $out_options{tolerance},
500 :     'tolType' => $out_options{tolType},
501 :     'format' => $out_options{'format'},
502 :     'mode' => $out_options{'mode'},
503 :     'zeroLevel' => $out_options{'zeroLevel'},
504 :     'zeroLevelTol' => $out_options{'zeroLevelTol'},
505 :     'debug' => $out_options{'debug'},
506 :     ),
507 :     );
508 :     }
509 :     }
510 : apizer 1080
511 : sh002i 1050 return (wantarray) ? @output_list : $output_list[0];
512 :     }
513 :    
514 :     #legacy code for compatability purposes
515 :     sub num_rel_cmp { # compare numbers
516 :     std_num_cmp( @_ );
517 :     }
518 :    
519 :    
520 :     =head3 "mode"_num_cmp() functions
521 :    
522 :     There are 16 functions total, 4 for each mode (std, frac, strict, arith). Each mode has
523 :     one "normal" function, one which accepts a list of answers, one which uses absolute
524 :     rather than relative tolerance, and one which uses absolute tolerance and accepts a list.
525 :     The "std" family is documented below; all others work precisely the same.
526 :    
527 :     std_num_cmp($correctAnswer) OR
528 :     std_num_cmp($correctAnswer, $relPercentTol) OR
529 :     std_num_cmp($correctAnswer, $relPercentTol, $format) OR
530 :     std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel) OR
531 :     std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol)
532 :    
533 :     $correctAnswer -- the correct answer
534 :     $relPercentTol -- the tolerance, as a percentage (optional)
535 :     $format -- the format of the displayed answer (optional)
536 :     $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies (optional)
537 :     $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero (optional)
538 :    
539 :     std_num_cmp() uses standard mode (arithmetic operations and elementary
540 :     functions allowed) and relative tolerance. Options are specified by
541 :     one or more parameters. Note that if you wish to set an option which
542 :     is later in the parameter list, you must set all previous options.
543 :    
544 :     std_num_cmp_abs($correctAnswer) OR
545 :     std_num_cmp_abs($correctAnswer, $absTol) OR
546 :     std_num_cmp_abs($correctAnswer, $absTol, $format)
547 :    
548 :     $correctAnswer -- the correct answer
549 :     $absTol -- an absolute tolerance (optional)
550 :     $format -- the format of the displayed answer (optional)
551 :    
552 :     std_num_cmp_abs() uses standard mode and absolute tolerance. Options
553 :     are set as with std_num_cmp(). Note that $zeroLevel and $zeroLevelTol
554 :     do not apply with absolute tolerance.
555 :    
556 :     std_num_cmp_list($relPercentTol, $format, @answerList)
557 :    
558 :     $relPercentTol -- the tolerance, as a percentage
559 :     $format -- the format of the displayed answer(s)
560 :     @answerList -- a list of one or more correct answers
561 :    
562 :     std_num_cmp_list() uses standard mode and relative tolerance. There
563 :     is no way to set $zeroLevel or $zeroLevelTol. Note that no
564 :     parameters are optional. All answers in the list will be
565 :     evaluated with the same set of parameters.
566 :    
567 :     std_num_cmp_abs_list($absTol, $format, @answerList)
568 :    
569 :     $absTol -- an absolute tolerance
570 :     $format -- the format of the displayed answer(s)
571 :     @answerList -- a list of one or more correct answers
572 :    
573 :     std_num_cmp_abs_list() uses standard mode and absolute tolerance.
574 :     Note that no parameters are optional. All answers in the list will be
575 :     evaluated with the same set of parameters.
576 :    
577 :     arith_num_cmp(), arith_num_cmp_list(), arith_num_cmp_abs(), arith_num_cmp_abs_list()
578 :     strict_num_cmp(), strict_num_cmp_list(), strict_num_cmp_abs(), strict_num_cmp_abs_list()
579 :     frac_num_cmp(), frac_num_cmp_list(), frac_num_cmp_abs(), frac_num_cmp_abs_list()
580 :    
581 :     Examples:
582 :    
583 :     ANS( strict_num_cmp( 3.14159 ) ) -- The student answer must be a number
584 :     in decimal or scientific notation which is within .1 percent of 3.14159.
585 :     This assumes $numRelPercentTolDefault has been set to .1.
586 :     ANS( strict_num_cmp( $answer, .01 ) ) -- The student answer must be a
587 :     number within .01 percent of $answer (e.g. 3.14159 if $answer is 3.14159
588 :     or $answer is "pi" or $answer is 4*atan(1)).
589 :     ANS( frac_num_cmp( $answer) ) or ANS( frac_num_cmp( $answer,.01 )) --
590 :     The student answer can be a number or fraction, e.g. 2/3.
591 :     ANS( arith_num_cmp( $answer) ) or ANS( arith_num_cmp( $answer,.01 )) --
592 :     The student answer can be an arithmetic expression, e.g. (2+3)/7-2^.5 .
593 :     ANS( std_num_cmp( $answer) ) or ANS( std_num_cmp( $answer,.01 )) --
594 :     The student answer can contain elementary functions, e.g. sin(.3+pi/2)
595 :    
596 :     =cut
597 :    
598 :     sub std_num_cmp { # compare numbers allowing use of elementary functions
599 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
600 :    
601 : gage 1250 my %options = ( 'relTol' => $relPercentTol,
602 :     'format' => $format,
603 :     'zeroLevel' => $zeroLevel,
604 :     'zeroLevelTol' => $zeroLevelTol
605 : sh002i 1050 );
606 : apizer 1080
607 : sh002i 1050 set_default_options( \%options,
608 : gage 1250 'tolType' => 'relative',
609 :     'tolerance' => $numRelPercentTolDefault,
610 :     'mode' => 'std',
611 :     'format' => $numFormatDefault,
612 :     'relTol' => $numRelPercentTolDefault,
613 :     'zeroLevel' => $numZeroLevelDefault,
614 :     'zeroLevelTol' => $numZeroLevelTolDefault,
615 :     'debug' => 0,
616 : sh002i 1050 );
617 : apizer 1080
618 : sh002i 1050 num_cmp([$correctAnswer], %options);
619 :     }
620 :    
621 :     ## Similar to std_num_cmp but accepts a list of numbers in the form
622 :     ## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
623 :     ## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
624 :     ## You must enter a format and tolerance
625 :    
626 :     sub std_num_cmp_list {
627 :     my ( $relPercentTol, $format, @answerList) = @_;
628 :    
629 :     my %options = ( 'relTol' => $relPercentTol,
630 :     'format' => $format,
631 :     );
632 :    
633 :     set_default_options( \%options,
634 :     'tolType' => 'relative',
635 :     'tolerance' => $numRelPercentTolDefault,
636 :     'mode' => 'std',
637 :     'format' => $numFormatDefault,
638 :     'relTol' => $numRelPercentTolDefault,
639 :     'zeroLevel' => $numZeroLevelDefault,
640 :     'zeroLevelTol' => $numZeroLevelTolDefault,
641 :     'debug' => 0,
642 :     );
643 :    
644 :     num_cmp(\@answerList, %options);
645 :    
646 :     }
647 :    
648 :     sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
649 :     my ( $correctAnswer, $absTol, $format) = @_;
650 :     my %options = ( 'tolerance' => $absTol,
651 :     'format' => $format
652 :     );
653 : apizer 1080
654 : sh002i 1050 set_default_options (\%options,
655 :     'tolType' => 'absolute',
656 :     'tolerance' => $absTol,
657 :     'mode' => 'std',
658 :     'format' => $numFormatDefault,
659 :     'zeroLevel' => 0,
660 :     'zeroLevelTol' => 0,
661 :     'debug' => 0,
662 :     );
663 :    
664 :     num_cmp([$correctAnswer], %options);
665 :     }
666 :    
667 :     ## See std_num_cmp_list for usage
668 :    
669 :     sub std_num_cmp_abs_list {
670 :     my ( $absTol, $format, @answerList ) = @_;
671 :    
672 :     my %options = ( 'tolerance' => $absTol,
673 :     'format' => $format,
674 :     );
675 :    
676 :     set_default_options( \%options,
677 :     'tolType' => 'absolute',
678 :     'tolerance' => $absTol,
679 :     'mode' => 'std',
680 :     'format' => $numFormatDefault,
681 :     'zeroLevel' => 0,
682 :     'zeroLevelTol' => 0,
683 :     'debug' => 0,
684 :     );
685 :    
686 :     num_cmp(\@answerList, %options);
687 :     }
688 :    
689 :     sub frac_num_cmp { # only allow fractions and numbers as submitted answer
690 :    
691 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
692 : apizer 1080
693 : sh002i 1050 my %options = ( 'relTol' => $relPercentTol,
694 :     'format' => $format,
695 :     'zeroLevel' => $zeroLevel,
696 :     'zeroLevelTol' => $zeroLevelTol
697 :     );
698 :    
699 :     set_default_options( \%options,
700 :     'tolType' => 'relative',
701 :     'tolerance' => $relPercentTol,
702 :     'mode' => 'frac',
703 :     'format' => $numFormatDefault,
704 :     'zeroLevel' => $numZeroLevelDefault,
705 :     'zeroLevelTol' => $numZeroLevelTolDefault,
706 :     'relTol' => $numRelPercentTolDefault,
707 :     'debug' => 0,
708 :     );
709 :    
710 :     num_cmp([$correctAnswer], %options);
711 :     }
712 :    
713 :     ## See std_num_cmp_list for usage
714 :     sub frac_num_cmp_list {
715 :     my ( $relPercentTol, $format, @answerList ) = @_;
716 : apizer 1080
717 : sh002i 1050 my %options = ( 'relTol' => $relPercentTol,
718 :     'format' => $format
719 :     );
720 : apizer 1080
721 : sh002i 1050 set_default_options( \%options,
722 :     'tolType' => 'relative',
723 :     'tolerance' => $relPercentTol,
724 :     'mode' => 'frac',
725 :     'format' => $numFormatDefault,
726 :     'zeroLevel' => $numZeroLevelDefault,
727 :     'zeroLevelTol' => $numZeroLevelTolDefault,
728 :     'relTol' => $numRelPercentTolDefault,
729 :     'debug' => 0,
730 :     );
731 : apizer 1080
732 : sh002i 1050 num_cmp(\@answerList, %options);
733 :     }
734 :    
735 :     sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
736 :     my ( $correctAnswer, $absTol, $format ) = @_;
737 : apizer 1080
738 : sh002i 1050 my %options = ( 'tolerance' => $absTol,
739 :     'format' => $format
740 :     );
741 : apizer 1080
742 : sh002i 1050 set_default_options (\%options,
743 :     'tolType' => 'absolute',
744 :     'tolerance' => $absTol,
745 :     'mode' => 'frac',
746 :     'format' => $numFormatDefault,
747 :     'zeroLevel' => 0,
748 :     'zeroLevelTol' => 0,
749 :     'debug' => 0,
750 :     );
751 :    
752 :     num_cmp([$correctAnswer], %options);
753 :     }
754 : apizer 1080
755 : sh002i 1050 ## See std_num_cmp_list for usage
756 :    
757 :     sub frac_num_cmp_abs_list {
758 :     my ( $absTol, $format, @answerList ) = @_;
759 : apizer 1080
760 : sh002i 1050 my %options = ( 'tolerance' => $absTol,
761 :     'format' => $format
762 :     );
763 : apizer 1080
764 : sh002i 1050 set_default_options (\%options,
765 :     'tolType' => 'absolute',
766 :     'tolerance' => $absTol,
767 :     'mode' => 'frac',
768 :     'format' => $numFormatDefault,
769 :     'zeroLevel' => 0,
770 :     'zeroLevelTol' => 0,
771 :     'debug' => 0,
772 : apizer 1080 );
773 :    
774 : sh002i 1050 num_cmp(\@answerList, %options);
775 :     }
776 :    
777 :    
778 :     sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
779 : apizer 1080
780 : sh002i 1050 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
781 : apizer 1080
782 : sh002i 1050 my %options = ( 'relTol' => $relPercentTol,
783 :     'format' => $format,
784 :     'zeroLevel' => $zeroLevel,
785 :     'zeroLevelTol' => $zeroLevelTol
786 :     );
787 : apizer 1080
788 : sh002i 1050 set_default_options( \%options,
789 :     'tolType' => 'relative',
790 :     'tolerance' => $relPercentTol,
791 :     'mode' => 'arith',
792 :     'format' => $numFormatDefault,
793 :     'zeroLevel' => $numZeroLevelDefault,
794 :     'zeroLevelTol' => $numZeroLevelTolDefault,
795 :     'relTol' => $numRelPercentTolDefault,
796 :     'debug' => 0,
797 :     );
798 :    
799 :     num_cmp([$correctAnswer], %options);
800 :     }
801 :    
802 :     ## See std_num_cmp_list for usage
803 :     sub arith_num_cmp_list {
804 :     my ( $relPercentTol, $format, @answerList ) = @_;
805 :    
806 :     my %options = ( 'relTol' => $relPercentTol,
807 :     'format' => $format,
808 :     );
809 :    
810 :     set_default_options( \%options,
811 :     'tolType' => 'relative',
812 :     'tolerance' => $relPercentTol,
813 :     'mode' => 'arith',
814 :     'format' => $numFormatDefault,
815 :     'zeroLevel' => $numZeroLevelDefault,
816 :     'zeroLevelTol' => $numZeroLevelTolDefault,
817 :     'relTol' => $numRelPercentTolDefault,
818 :     'debug' => 0,
819 :     );
820 : apizer 1080
821 : sh002i 1050 num_cmp(\@answerList, %options);
822 :     }
823 :    
824 :     sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
825 :     my ( $correctAnswer, $absTol, $format ) = @_;
826 : apizer 1080
827 : sh002i 1050 my %options = ( 'tolerance' => $absTol,
828 :     'format' => $format
829 :     );
830 : apizer 1080
831 : sh002i 1050 set_default_options (\%options,
832 :     'tolType' => 'absolute',
833 :     'tolerance' => $absTol,
834 :     'mode' => 'arith',
835 :     'format' => $numFormatDefault,
836 :     'zeroLevel' => 0,
837 :     'zeroLevelTol' => 0,
838 :     'debug' => 0,
839 :     );
840 : apizer 1080
841 : sh002i 1050 num_cmp([$correctAnswer], %options);
842 :     }
843 :    
844 :     ## See std_num_cmp_list for usage
845 :     sub arith_num_cmp_abs_list {
846 :     my ( $absTol, $format, @answerList ) = @_;
847 : apizer 1080
848 : sh002i 1050 my %options = ( 'tolerance' => $absTol,
849 :     'format' => $format
850 :     );
851 : apizer 1080
852 : sh002i 1050 set_default_options (\%options,
853 :     'tolType' => 'absolute',
854 :     'tolerance' => $absTol,
855 :     'mode' => 'arith',
856 :     'format' => $numFormatDefault,
857 :     'zeroLevel' => 0,
858 :     'zeroLevelTol' => 0,
859 :     'debug' => 0,
860 :     );
861 : apizer 1080
862 : sh002i 1050 num_cmp(\@answerList, %options);
863 :     }
864 :    
865 :     sub strict_num_cmp { # only allow numbers as submitted answer
866 :     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
867 : apizer 1080
868 : sh002i 1050 my %options = ( 'relTol' => $relPercentTol,
869 :     'format' => $format,
870 :     'zeroLevel' => $zeroLevel,
871 :     'zeroLevelTol' => $zeroLevelTol
872 :     );
873 : apizer 1080
874 : sh002i 1050 set_default_options( \%options,
875 :     'tolType' => 'relative',
876 :     'tolerance' => $relPercentTol,
877 :     'mode' => 'strict',
878 :     'format' => $numFormatDefault,
879 :     'zeroLevel' => $numZeroLevelDefault,
880 :     'zeroLevelTol' => $numZeroLevelTolDefault,
881 :     'relTol' => $numRelPercentTolDefault,
882 :     'debug' => 0,
883 :     );
884 :     num_cmp([$correctAnswer], %options);
885 :    
886 :     }
887 :    
888 :     ## See std_num_cmp_list for usage
889 :     sub strict_num_cmp_list { # compare numbers
890 :     my ( $relPercentTol, $format, @answerList ) = @_;
891 : apizer 1080
892 : sh002i 1050 my %options = ( 'relTol' => $relPercentTol,
893 :     'format' => $format,
894 :     );
895 : apizer 1080
896 : sh002i 1050 set_default_options( \%options,
897 :     'tolType' => 'relative',
898 :     'tolerance' => $relPercentTol,
899 :     'mode' => 'strict',
900 :     'format' => $numFormatDefault,
901 :     'zeroLevel' => $numZeroLevelDefault,
902 :     'zeroLevelTol' => $numZeroLevelTolDefault,
903 :     'relTol' => $numRelPercentTolDefault,
904 :     'debug' => 0,
905 :     );
906 : apizer 1080
907 : sh002i 1050 num_cmp(\@answerList, %options);
908 :     }
909 :    
910 :    
911 :     sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
912 :     my ( $correctAnswer, $absTol, $format ) = @_;
913 :    
914 :     my %options = ( 'tolerance' => $absTol,
915 :     'format' => $format
916 :     );
917 :    
918 :     set_default_options (\%options,
919 :     'tolType' => 'absolute',
920 :     'tolerance' => $absTol,
921 :     'mode' => 'strict',
922 :     'format' => $numFormatDefault,
923 :     'zeroLevel' => 0,
924 :     'zeroLevelTol' => 0,
925 :     'debug' => 0,
926 :     );
927 :     num_cmp([$correctAnswer], %options);
928 :    
929 :     }
930 :    
931 :     ## See std_num_cmp_list for usage
932 :     sub strict_num_cmp_abs_list { # compare numbers
933 :     my ( $absTol, $format, @answerList ) = @_;
934 :    
935 :     my %options = ( 'tolerance' => $absTol,
936 :     'format' => $format
937 :     );
938 :    
939 :     set_default_options (\%options,
940 :     'tolType' => 'absolute',
941 :     'tolerance' => $absTol,
942 :     'mode' => 'strict',
943 :     'format' => $numFormatDefault,
944 :     'zeroLevel' => 0,
945 :     'zeroLevelTol' => 0,
946 :     'debug' => 0,
947 :     );
948 :    
949 :     num_cmp(\@answerList, %options);
950 :     }
951 :    
952 : apizer 1080 ## sub numerical_compare_with_units
953 : sh002i 1050 ## Compares a number with units
954 :     ## Deprecated; use num_cmp()
955 :     ##
956 :     ## IN: a string which includes the numerical answer and the units
957 :     ## a hash with the following keys (all optional):
958 :     ## mode -- 'std', 'frac', 'arith', or 'strict'
959 :     ## format -- the format to use when displaying the answer
960 :     ## tol -- an absolute tolerance, or
961 :     ## relTol -- a relative tolerance
962 :     ## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
963 :     ## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
964 :    
965 :     # This mode is depricated. send input through num_cmp -- it can handle units.
966 :    
967 :     sub numerical_compare_with_units {
968 :     my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
969 :     my %options = @_; # all of the other inputs are (key value) pairs
970 :    
971 :     # Prepare the correct answer
972 :     $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
973 :    
974 :     # it surprises me that the match below works since the first .* is greedy.
975 :     my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
976 :     $options{units} = $correct_units;
977 : apizer 1080
978 : sh002i 1050 num_cmp($correct_num_answer, %options);
979 :     }
980 :    
981 : apizer 1080
982 : sh002i 1050 =head3 std_num_str_cmp()
983 : apizer 1080
984 : sh002i 1050 NOTE: This function is maintained for compatibility. num_cmp() with the
985 :     'strings' parameter is slightly preferred.
986 :    
987 :     std_num_str_cmp() is used when the correct answer could be either a number or a
988 :     string. For example, if you wanted the student to evaluate a function at number
989 :     of points, but write "Inf" or "Minf" if the function is unbounded. This routine
990 :     will provide error messages that do not give a hint as to whether the correct
991 :     answer is a string or a number. For numerical comparisons, std_num_cmp() is
992 :     used internally; for string comparisons, std_str_cmp() is used. String answers
993 :     must consist entirely of letters except that an initial minus sign is allowed.
994 :     E.g. "inf" and "-inf" are valid strings where as "too-big" is not.
995 :    
996 :     std_num_str_cmp( $correctAnswer ) OR
997 :     std_num_str_cmp( $correctAnswer, $ra_legalStrings ) OR
998 :     std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol ) OR
999 :     std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format ) OR
1000 :     std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format, $zeroLevel ) OR
1001 :     std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format,
1002 :     $zeroLevel, $zeroLevelTol )
1003 :    
1004 :     $correctAnswer -- the correct answer
1005 :     $ra_legalStrings -- a reference to an array of legal strings, e.g. ["str1", "str2"]
1006 :     $relPercentTol -- the error tolerance as a percentage
1007 :     $format -- the display format
1008 :     $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
1009 :     $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
1010 :    
1011 :     Examples:
1012 :     ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
1013 :     ANS( std_num_str_cmp( $ans, ["INF", "-INF"] ) );
1014 :    
1015 :     =cut
1016 :    
1017 :     sub std_num_str_cmp {
1018 :     my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
1019 :     # warn ('This method is depreciated. Use num_cmp instead.');
1020 : apizer 1080 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
1021 : sh002i 1050 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
1022 :     }
1023 :    
1024 : jj 3572 sub NUM_CMP { # low level numeric compare (now uses Parser)
1025 :     return ORIGINAL_NUM_CMP(@_)
1026 :     if main::PG_restricted_eval(q!$main::useOldAnswerMacros!);
1027 :    
1028 : sh002i 1050 my %num_params = @_;
1029 : apizer 1080
1030 : jj 3572 #
1031 :     # check for required parameters
1032 :     #
1033 :     my @keys = qw(correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug);
1034 :     foreach my $key (@keys) {
1035 :     warn "$key must be defined in options when calling NUM_CMP"
1036 :     unless defined($num_params{$key});
1037 :     }
1038 :    
1039 :     my $correctAnswer = $num_params{correctAnswer};
1040 :     my $mode = $num_params{mode};
1041 :     my %options = (debug => $num_params{debug});
1042 :    
1043 :     #
1044 :     # Hack to fix up exponential notation in correct answer
1045 :     # (e.g., perl will pass .0000001 as 1e-07).
1046 :     #
1047 :     $correctAnswer = uc($correctAnswer)
1048 :     if $correctAnswer =~ m/e/ && Value::isNumber($correctAnswer);
1049 :    
1050 :     #
1051 :     # Get an apppropriate context based on the mode
1052 :     #
1053 :     my $context;
1054 :     for ($mode) {
1055 :     /^strict$/i and do {
1056 :     $context = $Parser::Context::Default::context{LimitedNumeric}->copy;
1057 :     last;
1058 :     };
1059 :     /^arith$/i and do {
1060 :     $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
1061 :     $context->functions->disable('All');
1062 :     last;
1063 :     };
1064 :     /^frac$/i and do {
1065 :     $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy;
1066 :     last;
1067 :     };
1068 :    
1069 :     # default
1070 :     $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
1071 :     }
1072 :     $context->{format}{number} = $num_params{'format'};
1073 :     $context->strings->clear;
1074 :     # FIXME: should clear variables as well? Copy them from the current context?
1075 :    
1076 :     #
1077 :     # Add the strings to the context
1078 :     #
1079 :     if ($num_params{strings}) {
1080 :     foreach my $string (@{$num_params{strings}}) {
1081 : dpvc 3616 my %tex = ($string =~ m/^(-?)inf(inity)?$/i)? (TeX => "$1\\infty"): ();
1082 :     %tex = (TeX => "-\\infty") if uc($string) eq "MINF";
1083 : jj 3572 $context->strings->add(uc($string) => {%tex});
1084 :     }
1085 :     }
1086 :    
1087 :     #
1088 :     # Set the tolerances
1089 :     #
1090 :     if ($num_params{tolType} eq 'absolute') {
1091 :     $context->flags->set(
1092 :     tolerance => $num_params{tolerance},
1093 :     tolType => 'absolute',
1094 :     );
1095 :     } else {
1096 :     $context->flags->set(
1097 :     tolerance => .01*$num_params{tolerance},
1098 :     tolType => 'relative',
1099 :     );
1100 :     }
1101 :     $context->flags->set(
1102 :     zeroLevel => $num_params{zeroLevel},
1103 :     zeroLevelTol => $num_params{zeroLevelTol},
1104 :     );
1105 :    
1106 :     #
1107 :     # Get the proper Parser object for the professor's answer
1108 :     # using the initialized context
1109 :     #
1110 :     my $oldContext = &$Context($context); my $r;
1111 :     if ($num_params{units}) {
1112 :     $r = new Parser::Legacy::NumberWithUnits($correctAnswer);
1113 :     $options{rh_correct_units} = $num_params{units};
1114 :     } else {
1115 :     $r = Value::Formula->new($correctAnswer);
1116 :     die "The professor's answer can't be a formula" unless $r->isConstant;
1117 :     $r = $r->eval; $r = new Value::Real($r) unless Value::class($r) eq 'String';
1118 :     $r->{correct_ans} = $correctAnswer;
1119 :     if ($mode eq 'phase_pi') {
1120 :     my $pi = 4*atan2(1,1);
1121 :     while ($r > $pi/2) {$r -= $pi}
1122 :     while ($r < -$pi/2) {$r += $pi}
1123 :     }
1124 :     }
1125 :     #
1126 :     # Get the answer checker from the parser object
1127 :     #
1128 :     my $cmp = $r->cmp(%options);
1129 :     $cmp->install_pre_filter(sub {
1130 :     my $rh_ans = shift;
1131 :     $rh_ans->{original_student_ans} = $rh_ans->{student_ans};
1132 :     $rh_ans->{original_correct_ans} = $rh_ans->{correct_ans};
1133 :     return $rh_ans;
1134 :     });
1135 :     $cmp->install_post_filter(sub {
1136 :     my $rh_ans = shift;
1137 :     $rh_ans->{student_ans} = $rh_ans->{student_value}->string
1138 :     if ref($rh_ans->{student_value});
1139 :     return $rh_ans;
1140 :     });
1141 :     $cmp->{debug} = $num_params{debug};
1142 :     &$Context($oldContext);
1143 :    
1144 :     return $cmp;
1145 :     }
1146 :    
1147 :     #
1148 :     # The original version, for backward compatibility
1149 :     # (can be removed when the Parser-based version is more fully tested.)
1150 :     #
1151 :     sub ORIGINAL_NUM_CMP { # low level numeric compare
1152 :     my %num_params = @_;
1153 :    
1154 : sh002i 1050 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1155 :     foreach my $key (@keys) {
1156 :     warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1157 :     }
1158 :    
1159 :     my $correctAnswer = $num_params{'correctAnswer'};
1160 : gage 1250 my $format = $num_params{'format'};
1161 :     my $mode = $num_params{'mode'};
1162 : apizer 1080
1163 : sh002i 1050 if( $num_params{tolType} eq 'relative' ) {
1164 :     $num_params{'tolerance'} = .01*$num_params{'tolerance'};
1165 :     }
1166 : apizer 1080
1167 : sh002i 1050 my $formattedCorrectAnswer;
1168 :     my $correct_units;
1169 :     my $correct_num_answer;
1170 :     my %correct_units;
1171 :     my $corrAnswerIsString = 0;
1172 :    
1173 : apizer 1080
1174 : sh002i 1050 if (defined($num_params{units}) && $num_params{units}) {
1175 :     $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1176 :     # units are in form stuff space units where units contains no spaces.
1177 : apizer 1080
1178 :     ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
1179 : sh002i 1050 %correct_units = Units::evaluate_units($correct_units);
1180 :     if ( defined( $correct_units{'ERROR'} ) ) {
1181 :     warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1182 :     "$correct_units{'ERROR'}\n");
1183 :     }
1184 :     # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1185 :     $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1186 : apizer 1080
1187 : sh002i 1050 } elsif (defined($num_params{strings}) && $num_params{strings}) {
1188 :     my $legalString = '';
1189 :     my @legalStrings = @{$num_params{strings}};
1190 :     $correct_num_answer = $correctAnswer;
1191 :     $formattedCorrectAnswer = $correctAnswer;
1192 :     foreach $legalString (@legalStrings) {
1193 :     if ( uc($correctAnswer) eq uc($legalString) ) {
1194 :     $corrAnswerIsString = 1;
1195 : apizer 1080
1196 : sh002i 1050 last;
1197 :     }
1198 :     } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1199 :     } else {
1200 :     $correct_num_answer = $correctAnswer;
1201 :     $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1202 :     }
1203 :    
1204 :     $correct_num_answer = math_constants($correct_num_answer);
1205 : apizer 1080
1206 : sh002i 1050 my $PGanswerMessage = '';
1207 : apizer 1080
1208 : sh002i 1050 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1209 : apizer 1080
1210 : sh002i 1050 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1211 :     ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1212 :     } else { # case of a string answer
1213 :     $PG_eval_errors = ' ';
1214 :     $correctVal = $correctAnswer;
1215 :     }
1216 :    
1217 :     if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1218 :     ##error message from eval or above
1219 :     warn "Error in 'correct' answer: $PG_eval_errors<br>
1220 : apizer 1080 The answer $correctAnswer evaluates to $correctVal,
1221 : sh002i 1050 which cannot be interpreted as a number. ";
1222 : apizer 1080
1223 : sh002i 1050 }
1224 :     #########################################################################
1225 :    
1226 : apizer 1080 #construct the answer evaluator
1227 :     my $answer_evaluator = new AnswerEvaluator;
1228 : sh002i 1050 $answer_evaluator->{debug} = $num_params{debug};
1229 : apizer 1080 $answer_evaluator->ans_hash(
1230 : sh002i 1050 correct_ans => $correctVal,
1231 :     type => "${mode}_number",
1232 :     tolerance => $num_params{tolerance},
1233 :     tolType => $num_params{tolType},
1234 :     units => $correct_units,
1235 :     original_correct_ans => $formattedCorrectAnswer,
1236 :     rh_correct_units => \%correct_units,
1237 :     answerIsString => $corrAnswerIsString,
1238 :     );
1239 :     my ($in, $formattedSubmittedAnswer);
1240 : apizer 1080 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1241 : sh002i 1050 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1242 :     );
1243 : toenail 1797
1244 : gage 1812
1245 : toenail 1797
1246 : sh002i 1050 if (defined($num_params{units}) && $num_params{units}) {
1247 :     $answer_evaluator->install_pre_filter(\&check_units);
1248 :     }
1249 :     if (defined($num_params{strings}) && $num_params{strings}) {
1250 :     $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
1251 :     }
1252 : gage 1812
1253 : toenail 1797 ## FIXME? - this pre filter was moved before check_units to allow
1254 :     ## for latex preview of answers with no units.
1255 :     ## seems to work but may have unintended side effects elsewhere.
1256 : gage 1812
1257 :     ## Actually it caused trouble with the check strings package so it has been moved back
1258 :     # We'll try some other method -- perhaps add code to fix_answer for display
1259 :     $answer_evaluator->install_pre_filter(\&check_syntax);
1260 : apizer 1080
1261 : sh002i 1050 $answer_evaluator->install_pre_filter(\&math_constants);
1262 : apizer 1080
1263 : sh002i 1050 if ($mode eq 'std') {
1264 : apizer 1080 # do nothing
1265 : sh002i 1050 } elsif ($mode eq 'strict') {
1266 :     $answer_evaluator->install_pre_filter(\&is_a_number);
1267 :     } elsif ($mode eq 'arith') {
1268 :     $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
1269 :     } elsif ($mode eq 'frac') {
1270 :     $answer_evaluator->install_pre_filter(\&is_a_fraction);
1271 :    
1272 :     } elsif ($mode eq 'phase_pi') {
1273 :     $answer_evaluator->install_pre_filter(\&phase_pi);
1274 :    
1275 : apizer 1080 } else {
1276 : sh002i 1050 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1277 :     $formattedSubmittedAnswer = $in;
1278 :     }
1279 : apizer 1080
1280 : sh002i 1050 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
1281 :     $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1282 :     }
1283 : apizer 1080
1284 :    
1285 : sh002i 1050 ###############################################################################
1286 :     # We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
1287 :     # can be displayed in the answer message. This may still cause a few anomolies when strings are used
1288 :     #
1289 :     ###############################################################################
1290 :    
1291 :     $answer_evaluator->install_post_filter(\&fix_answers_for_display);
1292 :    
1293 : apizer 1080 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1294 : sh002i 1050 return $rh_ans unless $rh_ans->catch_error('EVAL');
1295 :     $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1296 :     $rh_ans->clear_error('EVAL'); } );
1297 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
1298 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
1299 :     $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
1300 : gage 1780 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
1301 : sh002i 1050 $answer_evaluator;
1302 :     }
1303 :    
1304 :    
1305 :    
1306 :     ##########################################################################
1307 :     ##########################################################################
1308 :     ## Function answer evaluators
1309 :    
1310 :     =head2 Function Answer Evaluators
1311 :    
1312 :     Function answer evaluators take in a function, compare it numerically to a
1313 :     correct function, and return a score. They can require an exactly equivalent
1314 :     function, or one that is equal up to a constant. They can accept or reject an
1315 :     answer based on specified tolerances for numerical deviation.
1316 :    
1317 :     Function Comparison Options
1318 :    
1319 :     correctEqn -- The correct equation, specified as a string. It may include
1320 :     all basic arithmetic operations, as well as elementary
1321 :     functions. Variable usage is described below.
1322 :    
1323 :     Variables -- The independent variable(s). When comparing the correct
1324 :     equation to the student equation, each variable will be
1325 :     replaced by a certain number of numerical values. If
1326 :     the student equation agrees numerically with the correct
1327 :     equation, they are considered equal. Note that all
1328 :     comparison is numeric; it is possible (although highly
1329 :     unlikely and never a practical concern) for two unequal
1330 :     functions to yield the same numerical results.
1331 :    
1332 :     Limits -- The limits of evaluation for the independent variables.
1333 :     Each variable is evaluated only in the half-open interval
1334 :     [lower_limit, upper_limit). This is useful if the function
1335 :     has a singularity or is not defined in a certain range.
1336 :     For example, the function "sqrt(-1-x)" could be evaluated
1337 :     in [-2,-1).
1338 :    
1339 :     Tolerance -- Tolerance in function comparisons works exactly as in
1340 :     numerical comparisons; see the numerical comparison
1341 :     documentation for a complete description. Note that the
1342 :     tolerance does applies to the function as a whole, not
1343 :     each point individually.
1344 :    
1345 :     Number of -- Specifies how many points to evaluate each variable at. This
1346 :     Points is typically 3, but can be set higher if it is felt that
1347 :     there is a strong possibility of "false positives."
1348 :    
1349 :     Maximum -- Sets the maximum size of the constant of integration. For
1350 :     Constant of technical reasons concerning floating point arithmetic, if
1351 :     Integration the additive constant, i.e., the constant of integration, is
1352 :     greater (in absolute value) than maxConstantOfIntegration
1353 :     AND is greater than maxConstantOfIntegration times the
1354 :     correct value, WeBWorK will give an error message saying
1355 :     that it can not handle such a large constant of integration.
1356 :     This is to prevent e.g. cos(x) + 1E20 or even 1E20 as being
1357 :     accepted as a correct antiderivatives of sin(x) since
1358 :     floating point arithmetic cannot tell the difference
1359 :     between cos(x) + 1E20, 1E20, and -cos(x) + 1E20.
1360 :    
1361 :     Technical note: if you examine the code for the function routines, you will see
1362 :     that most subroutines are simply doing some basic error-checking and then
1363 :     passing the parameters on to the low-level FUNCTION_CMP(). Because this routine
1364 :     is set up to handle multivariable functions, with single-variable functions as
1365 :     a special case, it is possible to pass multivariable parameters to single-
1366 :     variable functions. This usage is strongly discouraged as unnecessarily
1367 :     confusing. Avoid it.
1368 :    
1369 :     Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
1370 :    
1371 :     Variable -- $functVarDefault -- 'x'
1372 :     Relative Tolerance -- $functRelPercentTolDefault -- .1
1373 :     Absolute Tolerance -- $functAbsTolDefault -- .001
1374 :     Lower Limit -- $functLLimitDefault -- .0000001
1375 :     Upper Limit -- $functULimitDefault -- 1
1376 :     Number of Points -- $functNumOfPoints -- 3
1377 :     Zero Level -- $functZeroLevelDefault -- 1E-14
1378 :     Zero Level Tolerance -- $functZeroLevelTolDefault -- 1E-12
1379 :     Maximum Constant -- $functMaxConstantOfIntegration -- 1E8
1380 :     of Integration
1381 :    
1382 :     =cut
1383 :    
1384 :    
1385 :    
1386 :     =head3 fun_cmp()
1387 :    
1388 :     Compares a function or a list of functions, using a named hash of options to set
1389 :     parameters. This can make for more readable code than using the function_cmp()
1390 :     style, but some people find one or the other easier to remember.
1391 :    
1392 :     ANS( fun_cmp( answer or answer_array_ref, options_hash ) );
1393 :    
1394 :     1. a string containing the correct function, or a reference to an
1395 :     array of correct functions
1396 :     2. a hash containing the following items (all optional):
1397 :     var -- either the number of variables or a reference to an
1398 :     array of variable names (see below)
1399 :     limits -- reference to an array of arrays of limits (see below), or:
1400 :     mode -- 'std' (default) (function must match exactly), or:
1401 :     'antider' (function must match up to a constant)
1402 :     relTol -- (default) a relative tolerance (as a percentage), or:
1403 :     tol -- an absolute tolerance for error
1404 :     numPoints -- the number of points to evaluate the function at
1405 :     maxConstantOfIntegration -- maximum size of the constant of integration
1406 :     zeroLevel -- if the correct answer is this close to zero, then
1407 :     zeroLevelTol applies
1408 :     zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1409 : jj 1451 test_points -- a list of points to use in checking the function, or a list of lists when there is more than one variable.
1410 : apizer 1080 params an array of "free" parameters which can be used to adapt
1411 : sh002i 1050 the correct answer to the submitted answer. (e.g. ['c'] for
1412 :     a constant of integration in the answer x^3/3 + c.
1413 : apizer 1080 debug -- when set to 1 this provides extra information while checking the
1414 : sh002i 1050 the answer.
1415 :    
1416 : apizer 1080 Returns an answer evaluator, or (if given a reference to an array
1417 : sh002i 1050 of answers), a list of answer evaluators
1418 :    
1419 :     ANSWER:
1420 :    
1421 :     The answer must be in the form of a string. The answer can contain
1422 :     functions, pi, e, and arithmetic operations. However, the correct answer
1423 :     string follows a slightly stricter syntax than student answers; specifically,
1424 :     there is no implicit multiplication. So the correct answer must be "3*x" rather
1425 :     than "3 x". Students can still enter "3 x".
1426 :    
1427 :     VARIABLES:
1428 :    
1429 :     The var parameter can contain either a number or a reference to an array of
1430 :     variable names. If it contains a number, the variables are named automatically
1431 :     as follows: 1 variable -- x
1432 :     2 variables -- x, y
1433 :     3 variables -- x, y, z
1434 :     4 or more -- x_1, x_2, x_3, etc.
1435 :     If the var parameter contains a reference to an array of variable names, then
1436 :     the number of variables is determined by the number of items in the array. A
1437 :     reference to an array is created with brackets, e.g. "var => ['r', 's', 't']".
1438 :     If only one variable is being used, you can write either "var => ['t']" for
1439 :     consistency or "var => 't'" as a shortcut. The default is one variable, x.
1440 :    
1441 :     LIMITS:
1442 :    
1443 :     Limits are specified with the limits parameter. You may NOT use llimit/ulimit.
1444 :     If you specify limits for one variable, you must specify them for all variables.
1445 :     The limit parameter must be a reference to an array of arrays of the form
1446 :     [lower_limit. upper_limit], each array corresponding to the lower and upper
1447 :     endpoints of the (half-open) domain of one variable. For example,
1448 :     "vars => 2, limits => [[0,2], [-3,8]]" would cause x to be evaluated in [0,2) and
1449 :     y to be evaluated in [-3,8). If only one variable is being used, you can write
1450 :     either "limits => [[0,3]]" for consistency or "limits => [0,3]" as a shortcut.
1451 :    
1452 : jj 1451 TEST POINTS:
1453 :    
1454 :     In some cases, the problem writer may want to specify the points
1455 :     used to check a particular function. For example, if you want to
1456 :     use only integer values, they can be specified. With one variable,
1457 :     you can specify "test_points => [1,4,5,6]" or "test_points => [[1,4,5,6]]".
1458 :     With more variables, specify the list for the first variable, then the
1459 :     second, and so on: "vars=>['x','y'], test_points => [[1,4,5],[7,14,29]]".
1460 :    
1461 :     If the problem writer wants random values which need to meet some special
1462 :     restrictions (such as being integers), they can be generated in the problem:
1463 :     "test_points=>[random(1,50), random(1,50), random(1,50), random(1,50)]".
1464 :    
1465 : jj 1452 Note that test_points should not be used for function checks which involve
1466 :     parameters (either explicitly given by "params", or as antiderivatives).
1467 :    
1468 : sh002i 1050 EXAMPLES:
1469 :    
1470 :     fun_cmp( "3*x" ) -- standard compare, variable is x
1471 :     fun_cmp( ["3*x", "4*x+3", "3*x**2"] ) -- standard compare, defaults used for all three functions
1472 :     fun_cmp( "3*t", var => 't' ) -- standard compare, variable is t
1473 :     fun_cmp( "5*x*y*z", var => 3 ) -- x, y and z are the variables
1474 :     fun_cmp( "5*x", mode => 'antider' ) -- student answer must match up to constant (i.e., 5x+C)
1475 :     fun_cmp( ["3*x*y", "4*x*y"], limits => [[0,2], [5,7]] ) -- x evaluated in [0,2)
1476 :     y evaluated in [5,7)
1477 :    
1478 :     =cut
1479 :    
1480 :     sub fun_cmp {
1481 :     my $correctAnswer = shift @_;
1482 : gage 2061 my %opt = @_;
1483 : apizer 1080
1484 : sh002i 1050 assign_option_aliases( \%opt,
1485 :     'vars' => 'var', # set the standard option 'var' to the one specified as vars
1486 :     'domain' => 'limits', # set the standard option 'limits' to the one specified as domain
1487 :     'reltol' => 'relTol',
1488 :     'param' => 'params',
1489 :     );
1490 : apizer 1080
1491 : sh002i 1050 set_default_options( \%opt,
1492 :     'var' => $functVarDefault,
1493 :     'params' => [],
1494 :     'limits' => [[$functLLimitDefault, $functULimitDefault]],
1495 : jj 1450 'test_points' => undef,
1496 : sh002i 1050 'mode' => 'std',
1497 :     'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative',
1498 :     'tol' => .01, # default mode should be relative, to obtain this tol must not be defined
1499 :     'relTol' => $functRelPercentTolDefault,
1500 :     'numPoints' => $functNumOfPoints,
1501 :     'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
1502 :     'zeroLevel' => $functZeroLevelDefault,
1503 :     'zeroLevelTol' => $functZeroLevelTolDefault,
1504 :     'debug' => 0,
1505 :     );
1506 : apizer 1080
1507 : sh002i 1050 # allow var => 'x' as an abbreviation for var => ['x']
1508 :     my %out_options = %opt;
1509 : jj 3572 unless ( ref($out_options{var}) eq 'ARRAY' || $out_options{var} =~ m/^\d+$/) {
1510 : apizer 1080 $out_options{var} = [$out_options{var}];
1511 : sh002i 1050 }
1512 :     # allow params => 'c' as an abbreviation for params => ['c']
1513 :     unless ( ref($out_options{params}) eq 'ARRAY' ) {
1514 : apizer 1080 $out_options{params} = [$out_options{params}];
1515 : sh002i 1050 }
1516 :     my ($tolType, $tol);
1517 :     if ($out_options{tolType} eq 'absolute') {
1518 :     $tolType = 'absolute';
1519 :     $tol = $out_options{'tol'};
1520 :     delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
1521 :     } else {
1522 :     $tolType = 'relative';
1523 :     $tol = $out_options{'relTol'};
1524 :     delete($out_options{'tol'}) if exists( $out_options{'tol'} );
1525 :     }
1526 : apizer 1080
1527 : sh002i 1050 my @output_list = ();
1528 :     # thread over lists
1529 :     my @ans_list = ();
1530 :    
1531 :     if ( ref($correctAnswer) eq 'ARRAY' ) {
1532 :     @ans_list = @{$correctAnswer};
1533 :     }
1534 :     else {
1535 :     push( @ans_list, $correctAnswer );
1536 :     }
1537 :    
1538 :     # produce answer evaluators
1539 :     foreach my $ans (@ans_list) {
1540 :     push(@output_list,
1541 : apizer 1080 FUNCTION_CMP(
1542 : sh002i 1050 'correctEqn' => $ans,
1543 :     'var' => $out_options{'var'},
1544 :     'limits' => $out_options{'limits'},
1545 :     'tolerance' => $tol,
1546 :     'tolType' => $tolType,
1547 :     'numPoints' => $out_options{'numPoints'},
1548 : jj 1450 'test_points' => $out_options{'test_points'},
1549 : sh002i 1050 'mode' => $out_options{'mode'},
1550 :     'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'},
1551 :     'zeroLevel' => $out_options{'zeroLevel'},
1552 :     'zeroLevelTol' => $out_options{'zeroLevelTol'},
1553 :     'params' => $out_options{'params'},
1554 :     'debug' => $out_options{'debug'},
1555 :     ),
1556 :     );
1557 :     }
1558 :    
1559 :     return (wantarray) ? @output_list : $output_list[0];
1560 :     }
1561 :    
1562 :     =head3 Single-variable Function Comparisons
1563 :    
1564 :     There are four single-variable function answer evaluators: "normal," absolute
1565 :     tolerance, antiderivative, and antiderivative with absolute tolerance. All
1566 :     parameters (other than the correct equation) are optional.
1567 :    
1568 :     function_cmp( $correctEqn ) OR
1569 :     function_cmp( $correctEqn, $var ) OR
1570 :     function_cmp( $correctEqn, $var, $llimit, $ulimit ) OR
1571 :     function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol ) OR
1572 :     function_cmp( $correctEqn, $var, $llimit, $ulimit,
1573 :     $relPercentTol, $numPoints ) OR
1574 :     function_cmp( $correctEqn, $var, $llimit, $ulimit,
1575 :     $relPercentTol, $numPoints, $zeroLevel ) OR
1576 :     function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol, $numPoints,
1577 :     $zeroLevel,$zeroLevelTol )
1578 :    
1579 :     $correctEqn -- the correct equation, as a string
1580 :     $var -- the string representing the variable (optional)
1581 :     $llimit -- the lower limit of the interval to evaluate the
1582 :     variable in (optional)
1583 :     $ulimit -- the upper limit of the interval to evaluate the
1584 :     variable in (optional)
1585 :     $relPercentTol -- the error tolerance as a percentage (optional)
1586 :     $numPoints -- the number of points at which to evaluate the
1587 :     variable (optional)
1588 :     $zeroLevel -- if the correct answer is this close to zero, then
1589 :     zeroLevelTol applies (optional)
1590 :     $zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1591 :    
1592 :     function_cmp() uses standard comparison and relative tolerance. It takes a
1593 :     string representing a single-variable function and compares the student
1594 :     answer to that function numerically.
1595 :    
1596 :     function_cmp_up_to_constant( $correctEqn ) OR
1597 :     function_cmp_up_to_constant( $correctEqn, $var ) OR
1598 :     function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit ) OR
1599 :     function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
1600 :     $relpercentTol ) OR
1601 :     function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
1602 :     $relpercentTol, $numOfPoints ) OR
1603 :     function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
1604 :     $relpercentTol, $numOfPoints,
1605 :     $maxConstantOfIntegration ) OR
1606 :     function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
1607 :     $relpercentTol, $numOfPoints,
1608 :     $maxConstantOfIntegration, $zeroLevel) OR
1609 :     function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
1610 :     $relpercentTol, $numOfPoints,
1611 :     $maxConstantOfIntegration,
1612 :     $zeroLevel, $zeroLevelTol )
1613 :    
1614 :     $maxConstantOfIntegration -- the maximum size of the constant of
1615 :     integration
1616 :    
1617 :     function_cmp_up_to_constant() uses antiderivative compare and relative
1618 :     tolerance. All options work exactly like function_cmp(), except of course
1619 :     $maxConstantOfIntegration. It will accept as correct any function which
1620 :     differs from $correctEqn by at most a constant; that is, if
1621 :     $studentEqn = $correctEqn + C
1622 :     the answer is correct.
1623 :    
1624 :     function_cmp_abs( $correctFunction ) OR
1625 :     function_cmp_abs( $correctFunction, $var ) OR
1626 :     function_cmp_abs( $correctFunction, $var, $llimit, $ulimit ) OR
1627 :     function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol ) OR
1628 :     function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol,
1629 :     $numOfPoints )
1630 :    
1631 :     $absTol -- the tolerance as an absolute value
1632 :    
1633 :     function_cmp_abs() uses standard compare and absolute tolerance. All
1634 :     other options work exactly as for function_cmp().
1635 :    
1636 :     function_cmp_up_to_constant_abs( $correctFunction ) OR
1637 :     function_cmp_up_to_constant_abs( $correctFunction, $var ) OR
1638 :     function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit ) OR
1639 :     function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
1640 :     $absTol ) OR
1641 :     function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
1642 :     $absTol, $numOfPoints ) OR
1643 :     function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
1644 :     $absTol, $numOfPoints,
1645 :     $maxConstantOfIntegration )
1646 :    
1647 :     function_cmp_up_to_constant_abs() uses antiderivative compare
1648 :     and absolute tolerance. All other options work exactly as with
1649 :     function_cmp_up_to_constant().
1650 :    
1651 :     Examples:
1652 :    
1653 :     ANS( function_cmp( "cos(x)" ) ) -- Accepts cos(x), sin(x+pi/2),
1654 :     sin(x)^2 + cos(x) + cos(x)^2 -1, etc. This assumes
1655 :     $functVarDefault has been set to "x".
1656 :     ANS( function_cmp( $answer, "t" ) ) -- Assuming $answer is "cos(t)",
1657 :     accepts cos(t), etc.
1658 :     ANS( function_cmp_up_to_constant( "cos(x)" ) ) -- Accepts any
1659 :     antiderivative of sin(x), e.g. cos(x) + 5.
1660 :     ANS( function_cmp_up_to_constant( "cos(z)", "z" ) ) -- Accepts any
1661 :     antiderivative of sin(z), e.g. sin(z+pi/2) + 5.
1662 :    
1663 :     =cut
1664 :    
1665 :     sub adaptive_function_cmp {
1666 :     my $correctEqn = shift;
1667 :     my %options = @_;
1668 :     set_default_options( \%options,
1669 :     'vars' => [qw( x y )],
1670 :     'params' => [],
1671 :     'limits' => [ [0,1], [0,1]],
1672 : gage 1250 'reltol' => $functRelPercentTolDefault,
1673 :     'numPoints' => $functNumOfPoints,
1674 :     'zeroLevel' => $functZeroLevelDefault,
1675 :     'zeroLevelTol' => $functZeroLevelTolDefault,
1676 : sh002i 1050 'debug' => 0,
1677 :     );
1678 :    
1679 :     my $var_ref = $options{'vars'};
1680 :     my $ra_params = $options{ 'params'};
1681 :     my $limit_ref = $options{'limits'};
1682 :     my $relPercentTol= $options{'reltol'};
1683 :     my $numPoints = $options{'numPoints'};
1684 :     my $zeroLevel = $options{'zeroLevel'};
1685 :     my $zeroLevelTol = $options{'zeroLevelTol'};
1686 : apizer 1080
1687 : sh002i 1050 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1688 :     'var' => $var_ref,
1689 :     'limits' => $limit_ref,
1690 :     'tolerance' => $relPercentTol,
1691 :     'tolType' => 'relative',
1692 :     'numPoints' => $numPoints,
1693 :     'mode' => 'std',
1694 :     'maxConstantOfIntegration' => 10**100,
1695 :     'zeroLevel' => $zeroLevel,
1696 :     'zeroLevelTol' => $zeroLevelTol,
1697 :     'scale_norm' => 1,
1698 :     'params' => $ra_params,
1699 :     'debug' => $options{debug} ,
1700 :     );
1701 :     }
1702 :    
1703 :     sub function_cmp {
1704 :     my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
1705 :    
1706 :     if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
1707 :     function_invalid_params( $correctEqn );
1708 :     }
1709 :     else {
1710 :     FUNCTION_CMP( 'correctEqn' => $correctEqn,
1711 :     'var' => $var,
1712 :     'limits' => [$llimit, $ulimit],
1713 :     'tolerance' => $relPercentTol,
1714 :     'tolType' => 'relative',
1715 :     'numPoints' => $numPoints,
1716 :     'mode' => 'std',
1717 :     'maxConstantOfIntegration' => 0,
1718 :     'zeroLevel' => $zeroLevel,
1719 :     'zeroLevelTol' => $zeroLevelTol
1720 :     );
1721 :     }
1722 :     }
1723 :    
1724 :     sub function_cmp_up_to_constant { ## for antiderivative problems
1725 :     my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_;
1726 :    
1727 :     if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
1728 :     function_invalid_params( $correctEqn );
1729 :     }
1730 :     else {
1731 :     FUNCTION_CMP( 'correctEqn' => $correctEqn,
1732 :     'var' => $var,
1733 :     'limits' => [$llimit, $ulimit],
1734 :     'tolerance' => $relPercentTol,
1735 :     'tolType' => 'relative',
1736 :     'numPoints' => $numPoints,
1737 :     'mode' => 'antider',
1738 :     'maxConstantOfIntegration' => $maxConstantOfIntegration,
1739 :     'zeroLevel' => $zeroLevel,
1740 :     'zeroLevelTol' => $zeroLevelTol
1741 :     );
1742 :     }
1743 :     }
1744 :    
1745 :     sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance
1746 :     my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_;
1747 :    
1748 :     if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) {
1749 :     function_invalid_params( $correctEqn );
1750 :     }
1751 :     else {
1752 :     FUNCTION_CMP( 'correctEqn' => $correctEqn,
1753 :     'var' => $var,
1754 :     'limits' => [$llimit, $ulimit],
1755 :     'tolerance' => $absTol,
1756 :     'tolType' => 'absolute',
1757 :     'numPoints' => $numPoints,
1758 :     'mode' => 'std',
1759 :     'maxConstantOfIntegration' => 0,
1760 :     'zeroLevel' => 0,
1761 :     'zeroLevelTol' => 0
1762 :     );
1763 :     }
1764 :     }
1765 :    
1766 :    
1767 :     sub function_cmp_up_to_constant_abs { ## for antiderivative problems
1768 :     ## similar to function_cmp_up_to_constant
1769 :     ## but uses absolute tolerance
1770 :     my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_;
1771 :    
1772 :     if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
1773 :     function_invalid_params( $correctEqn );
1774 :     }
1775 :    
1776 :     else {
1777 :     FUNCTION_CMP( 'correctEqn' => $correctEqn,
1778 :     'var' => $var,
1779 :     'limits' => [$llimit, $ulimit],
1780 :     'tolerance' => $absTol,
1781 :     'tolType' => 'absolute',
1782 :     'numPoints' => $numPoints,
1783 :     'mode' => 'antider',
1784 :     'maxConstantOfIntegration' => $maxConstantOfIntegration,
1785 :     'zeroLevel' => 0,
1786 :     'zeroLevelTol' => 0
1787 :     );
1788 :     }
1789 :     }
1790 :    
1791 :     ## The following answer evaluator for comparing multivarable functions was
1792 :     ## contributed by Professor William K. Ziemer
1793 :     ## (Note: most of the multivariable functionality provided by Professor Ziemer
1794 :     ## has now been integrated into fun_cmp and FUNCTION_CMP)
1795 :     ############################
1796 :     # W.K. Ziemer, Sep. 1999
1797 :     # Math Dept. CSULB
1798 :     # email: wziemer@csulb.edu
1799 :     ############################
1800 :    
1801 :     =head3 multivar_function_cmp
1802 :    
1803 :     NOTE: this function is maintained for compatibility. fun_cmp() is
1804 :     slightly preferred.
1805 :    
1806 :     usage:
1807 :    
1808 :     multivar_function_cmp( $answer, $var_reference, options)
1809 :     $answer -- string, represents function of several variables
1810 :     $var_reference -- number (of variables), or list reference (e.g. ["var1","var2"] )
1811 :     options:
1812 :     $limit_reference -- reference to list of lists (e.g. [[1,2],[3,4]])
1813 :     $relPercentTol -- relative percent tolerance in answer
1814 :     $numPoints -- number of points to sample in for each variable
1815 :     $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
1816 :     $zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1817 :    
1818 :     =cut
1819 :    
1820 :     sub multivar_function_cmp {
1821 :     my ($correctEqn,$var_ref,$limit_ref,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
1822 :    
1823 :     if ( (scalar(@_) > 7) or (scalar(@_) < 2) ) {
1824 :     function_invalid_params( $correctEqn );
1825 :     }
1826 :    
1827 :     FUNCTION_CMP( 'correctEqn' => $correctEqn,
1828 :     'var' => $var_ref,
1829 :     'limits' => $limit_ref,
1830 :     'tolerance' => $relPercentTol,
1831 :     'tolType' => 'relative',
1832 :     'numPoints' => $numPoints,
1833 :     'mode' => 'std',
1834 :     'maxConstantOfIntegration' => 0,
1835 :     'zeroLevel' => $zeroLevel,
1836 :     'zeroLevelTol' => $zeroLevelTol
1837 :     );
1838 :     }
1839 :    
1840 :     ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1841 :     ## NOTE: PG_answer_eval is used instead of PG_restricted_eval in order to insure that the answer
1842 :     ## evaluated within the context of the package the problem was originally defined in.
1843 :     ## Includes multivariable modifications contributed by Professor William K. Ziemer
1844 :     ##
1845 :     ## IN: a hash consisting of the following keys (error checking to be added later?)
1846 :     ## correctEqn -- the correct equation as a string
1847 :     ## var -- the variable name as a string,
1848 :     ## or a reference to an array of variables
1849 :     ## limits -- reference to an array of arrays of type [lower,upper]
1850 :     ## tolerance -- the allowable margin of error
1851 :     ## tolType -- 'relative' or 'absolute'
1852 :     ## numPoints -- the number of points to evaluate the function at
1853 :     ## mode -- 'std' or 'antider'
1854 :     ## maxConstantOfIntegration -- maximum size of the constant of integration
1855 :     ## zeroLevel -- if the correct answer is this close to zero,
1856 :     ## then zeroLevelTol applies
1857 :     ## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1858 : jj 1451 ## test_points -- user supplied points to use for testing the
1859 :     ## function, either array of arrays, or optionally
1860 :     ## reference to single array (for one variable)
1861 : sh002i 1050
1862 :    
1863 :     sub FUNCTION_CMP {
1864 : jj 3572 return ORIGINAL_FUNCTION_CMP(@_)
1865 :     if main::PG_restricted_eval(q!$main::useOldAnswerMacros!);
1866 :    
1867 : sh002i 1050 my %func_params = @_;
1868 : jj 3572
1869 :     my $correctEqn = $func_params{'correctEqn'};
1870 :     my $var = $func_params{'var'};
1871 :     my $ra_limits = $func_params{'limits'};
1872 :     my $tol = $func_params{'tolerance'};
1873 :     my $tolType = $func_params{'tolType'};
1874 :     my $numPoints = $func_params{'numPoints'};
1875 :     my $mode = $func_params{'mode'};
1876 :     my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
1877 :     my $zeroLevel = $func_params{'zeroLevel'};
1878 :     my $zeroLevelTol = $func_params{'zeroLevelTol'};
1879 :     my $testPoints = $func_params{'test_points'};
1880 : sh002i 2277
1881 : jj 3572 #
1882 :     # Check that everything is defined:
1883 :     #
1884 :     $func_params{debug} = 0 unless defined $func_params{debug};
1885 :     $mode = 'std' unless defined $mode;
1886 :     my @VARS = get_var_array($var);
1887 :     my @limits = get_limits_array($ra_limits);
1888 :     my @PARAMS = @{$func_params{'params'} || []};
1889 :    
1890 :     if($tolType eq 'relative') {
1891 :     $tol = $functRelPercentTolDefault unless defined $tol;
1892 :     $tol *= .01;
1893 :     } else {
1894 :     $tol = $functAbsTolDefault unless defined $tol;
1895 :     }
1896 :    
1897 :     #
1898 :     # Ensure that the number of limits matches number of variables
1899 :     #
1900 :     foreach my $i (0..scalar(@VARS)-1) {
1901 :     $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
1902 :     $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
1903 :     }
1904 :    
1905 :     #
1906 :     # Check that the test points are array references with the right number of coordinates
1907 :     #
1908 :     if ($testPoints) {
1909 :     my $n = scalar(@VARS); my $s = ($n != 1)? "s": "";
1910 :     foreach my $p (@{$testPoints}) {
1911 :     $p = [$p] unless ref($p) eq 'ARRAY';
1912 :     warn "Test point (".join(',',@{$p}).") should have $n coordiante$s"
1913 :     unless scalar(@{$p}) == $n;
1914 :     }
1915 :     }
1916 :    
1917 :     $numPoints = $functNumOfPoints unless defined $numPoints;
1918 :     $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
1919 :     $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
1920 :     $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
1921 :    
1922 :     $func_params{'var'} = \@VARS;
1923 :     $func_params{'params'} = \@PARAMS;
1924 :     $func_params{'limits'} = \@limits;
1925 :     $func_params{'tolerance'} = $tol;
1926 :     $func_params{'tolType'} = $tolType;
1927 :     $func_params{'numPoints'} = $numPoints;
1928 :     $func_params{'mode'} = $mode;
1929 :     $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
1930 :     $func_params{'zeroLevel'} = $zeroLevel;
1931 :     $func_params{'zeroLevelTol'} = $zeroLevelTol;
1932 :    
1933 :     ########################################################
1934 :     # End of cleanup of calling parameters
1935 :     ########################################################
1936 :    
1937 :     my %options = (debug => $func_params{'debug'});
1938 :    
1939 :     #
1940 :     # Initialize the context for the formula
1941 :     #
1942 :     my $context = $Parser::Context::Default::context{"LegacyNumeric"}->copy;
1943 :     $context->flags->set(
1944 :     tolerance => $func_params{'tolerance'},
1945 :     tolType => $func_params{'tolType'},
1946 :     zeroLevel => $func_params{'zeroLevel'},
1947 :     zeroLevelTol => $func_params{'zeroLevelTol'},
1948 :     num_points => $func_params{'numPoints'},
1949 :     );
1950 :     if ($func_params{'mode'} eq 'antider') {
1951 :     $context->flags->set(max_adapt => $func_params{'maxConstantOfIntegration'});
1952 :     $options{upToConstant} = 1;
1953 :     }
1954 :    
1955 :     #
1956 :     # Add the variables and parameters to the context
1957 :     #
1958 :     my %variables; my $x;
1959 :     foreach $x (@{$func_params{'var'}}) {
1960 :     if (length($x) > 1) {
1961 :     $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
1962 :     $x . '|' . $context->{_variables}->{pattern};
1963 :     $context->update;
1964 :     }
1965 :     $variables{$x} = 'Real';
1966 :     }
1967 :     foreach $x (@{$func_params{'params'}}) {$variables{$x} = 'Parameter'}
1968 :     $context->variables->are(%variables);
1969 :    
1970 :     #
1971 :     # Create the Formula object and get its answer checker
1972 :     #
1973 :     my $oldContext = &$Context($context);
1974 :     my $f = new Value::Formula($correctEqn);
1975 :     $f->{limits} = $func_params{'limits'};
1976 :     $f->{test_points} = $func_params{'test_points'};
1977 :     my $cmp = $f->cmp(%options);
1978 :     $cmp->{debug} = 1 if $func_params{'debug'};
1979 :     &$Context($oldContext);
1980 :    
1981 :     #
1982 :     # Get previous answer from hidden field of form
1983 :     #
1984 :     $cmp->install_pre_filter(
1985 :     sub {
1986 :     my $rh_ans = shift;
1987 :     $rh_ans->{_filter_name} = "fetch_previous_answer";
1988 :     my $prev_ans_label = "previous_".$rh_ans->{ans_label};
1989 :     $rh_ans->{prev_ans} =
1990 :     (defined $inputs_ref->{$prev_ans_label} and
1991 :     $inputs_ref->{$prev_ans_label} =~/\S/) ? $inputs_ref->{$prev_ans_label} : undef;
1992 :     $rh_ans;
1993 :     }
1994 :     );
1995 :    
1996 :     #
1997 :     # Parse the previous answer, if any
1998 :     #
1999 :     $cmp->install_pre_filter(
2000 :     sub {
2001 :     my $rh_ans = shift;
2002 :     $rh_ans->{_filter_name} = "parse_previous_answer";
2003 :     return $rh_ans unless defined $rh_ans->{prev_ans};
2004 :     $rh_ans->{prev_formula} = Parser::Formula($rh_ans->{prev_ans});
2005 :     $rh_ans;
2006 :     }
2007 :     );
2008 :    
2009 :     #
2010 :     # Check if previous answer equals this current one
2011 :     #
2012 :     $cmp->install_evaluator(
2013 :     sub {
2014 :     my $rh_ans = shift;
2015 :     $rh_ans->{_filter_name} = "compare_to_previous_answer";
2016 :     return $rh_ans unless defined($rh_ans->{prev_formula}) && defined($rh_ans->{student_formula});
2017 :     $rh_ans->{prev_equals_current} =
2018 :     Value::cmp_compare($rh_ans->{student_formula},$rh_ans->{prev_formula},{});
2019 :     $rh_ans;
2020 :     }
2021 :     );
2022 :    
2023 :     #
2024 :     # Produce a message if the previous answer equals this one
2025 :     # (and is not correct, and is not specified the same way)
2026 :     #
2027 :     $cmp->install_post_filter(
2028 :     sub {
2029 :     my $rh_ans = shift;
2030 :     $rh_ans->{_filter_name} = "produce_equivalence_message";
2031 :     return $rh_ans unless $rh_ans->{prev_equals_current} && $rh_ans->{score} == 0;
2032 :     return $rh_ans if $rh_ans->{prev_ans} eq $rh_ans->{original_student_ans};
2033 :     $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted or previewed.";
2034 :     $rh_ans;
2035 :     }
2036 :     );
2037 :    
2038 :     return $cmp;
2039 :     }
2040 :    
2041 :     #
2042 :     # The original version, for backward compatibility
2043 :     # (can be removed when the Parser-based version is more fully tested.)
2044 :     #
2045 :     sub ORIGINAL_FUNCTION_CMP {
2046 :     my %func_params = @_;
2047 :    
2048 : sh002i 2277 my $correctEqn = $func_params{'correctEqn'};
2049 :     my $var = $func_params{'var'};
2050 :     my $ra_limits = $func_params{'limits'};
2051 :     my $tol = $func_params{'tolerance'};
2052 :     my $tolType = $func_params{'tolType'};
2053 :     my $numPoints = $func_params{'numPoints'};
2054 :     my $mode = $func_params{'mode'};
2055 :     my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
2056 :     my $zeroLevel = $func_params{'zeroLevel'};
2057 :     my $zeroLevelTol = $func_params{'zeroLevelTol'};
2058 :     my $ra_test_points = $func_params{'test_points'};
2059 :    
2060 : sh002i 1050 # Check that everything is defined:
2061 : sh002i 2277 $func_params{debug} = 0 unless defined $func_params{debug};
2062 :     $mode = 'std' unless defined $mode;
2063 :     my @VARS = get_var_array($var);
2064 :     my @limits = get_limits_array($ra_limits);
2065 : sh002i 1050 my @PARAMS = ();
2066 : sh002i 2277 @PARAMS = @{$func_params{'params'}} if defined $func_params{'params'};
2067 : jj 1450
2068 : sh002i 2277 my @evaluation_points;
2069 :     if(defined $ra_test_points) {
2070 : jj 1450 # see if this is the standard format
2071 : sh002i 2277 if(ref $ra_test_points->[0] eq 'ARRAY') {
2072 :     $numPoints = scalar @{$ra_test_points->[0]};
2073 : jj 1450 # now a little sanity check
2074 :     my $j;
2075 :     for $j (@{$ra_test_points}) {
2076 :     warn "Test points do not give the same number of values for each variable"
2077 :     unless(scalar(@{$j}) == $numPoints);
2078 :     }
2079 :     warn "Test points do not match the number of variables"
2080 : sh002i 2277 unless scalar @{$ra_test_points} == scalar @VARS;
2081 : jj 1450 } else { # we are got the one-variable format
2082 :     $ra_test_points = [$ra_test_points];
2083 : sh002i 2277 $numPoints = scalar $ra_test_points->[0];
2084 : jj 1450 }
2085 :     # The input format for test points is the transpose of what is used
2086 :     # internally below, so take care of that now.
2087 :     my ($j1, $j2);
2088 : sh002i 2277 for ($j1 = 0; $j1 < scalar @{$ra_test_points}; $j1++) {
2089 :     for ($j2 = 0; $j2 < scalar @{$ra_test_points->[$j1]}; $j2++) {
2090 : jj 1450 $evaluation_points[$j2][$j1] = $ra_test_points->[$j1][$j2];
2091 :     }
2092 :     }
2093 :     } # end of handling of user supplied evaluation points
2094 : sh002i 2277
2095 :     if ($mode eq 'antider') {
2096 : sh002i 1050 # doctor the equation to allow addition of a constant
2097 : sh002i 2277 my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters.
2098 :     # There is the possibility of conflict here.
2099 :     # 'Q' seemed less dangerous than 'C'.
2100 : sh002i 1050 $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM";
2101 : sh002i 2277 push @PARAMS, $CONSTANT_PARAM;
2102 : sh002i 1050 }
2103 :     my $dim_of_param_space = @PARAMS; # dimension of equivalence space
2104 : sh002i 2277
2105 :     if($tolType eq 'relative') {
2106 :     $tol = $functRelPercentTolDefault unless defined $tol;
2107 : sh002i 1050 $tol *= .01;
2108 : sh002i 2277 } else {
2109 :     $tol = $functAbsTolDefault unless defined $tol;
2110 : sh002i 1050 }
2111 : sh002i 2277
2112 : sh002i 1050 #loop ensures that number of limits matches number of variables
2113 : sh002i 2277 for(my $i = 0; $i < scalar @VARS; $i++) {
2114 :     $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
2115 :     $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
2116 : sh002i 1050 }
2117 : sh002i 2277 $numPoints = $functNumOfPoints unless defined $numPoints;
2118 :     $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
2119 :     $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
2120 :     $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
2121 :    
2122 :     $func_params{'var'} = $var;
2123 :     $func_params{'limits'} = \@limits;
2124 :     $func_params{'tolerance'} = $tol;
2125 :     $func_params{'tolType'} = $tolType;
2126 :     $func_params{'numPoints'} = $numPoints;
2127 :     $func_params{'mode'} = $mode;
2128 :     $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
2129 :     $func_params{'zeroLevel'} = $zeroLevel;
2130 :     $func_params{'zeroLevelTol'} = $zeroLevelTol;
2131 :    
2132 :     ########################################################
2133 :     # End of cleanup of calling parameters
2134 :     ########################################################
2135 :    
2136 :     my $i; # for use with loops
2137 : sh002i 1050 my $PGanswerMessage = "";
2138 :     my $originalCorrEqn = $correctEqn;
2139 : sh002i 2277
2140 :     ######################################################################
2141 :     # prepare the correct answer and check its syntax
2142 :     ######################################################################
2143 :    
2144 :     my $rh_correct_ans = new AnswerHash;
2145 : sh002i 1050 $rh_correct_ans->input($correctEqn);
2146 : sh002i 2277 $rh_correct_ans = check_syntax($rh_correct_ans);
2147 : sh002i 1050 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
2148 :     $rh_correct_ans->clear_error();
2149 : sh002i 2277 $rh_correct_ans = function_from_string2($rh_correct_ans,
2150 :     ra_vars => [ @VARS, @PARAMS ],
2151 :     stdout => 'rf_correct_ans',
2152 :     debug => $func_params{debug}
2153 :     );
2154 :     my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
2155 : sh002i 1050 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
2156 : sh002i 2277
2157 :     ######################################################################
2158 :     # define the points at which the functions are to be evaluated
2159 :     ######################################################################
2160 :    
2161 :     if(not defined $ra_test_points) {
2162 : jj 1450 #create the evaluation points
2163 :     my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
2164 : sh002i 2277 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
2165 :     for(my $count = 0; $count < @PARAMS+1+$numPoints; $count++) {
2166 :     my (@vars,$iteration_limit);
2167 :     for(my $i = 0; $i < @VARS; $i++) {
2168 : jj 1450 my $iteration_limit = 10;
2169 : sh002i 2277 while (0 < --$iteration_limit) { # make sure that the endpoints of the interval are not included
2170 :     $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM);
2171 :     last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1];
2172 :     }
2173 :     warn "Unable to properly choose evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )"
2174 :     if $iteration_limit == 0;
2175 :     }
2176 : jj 1450
2177 : sh002i 2277 push @evaluation_points, \@vars;
2178 : jj 1450 }
2179 : sh002i 1050 }
2180 :     my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
2181 : sh002i 2277
2182 : sh002i 1050 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
2183 : sh002i 2277 #warn "coeff", join(" | ", @{$COEFFS});
2184 :    
2185 :     #construct the answer evaluator
2186 : apizer 1080 my $answer_evaluator = new AnswerEvaluator;
2187 : sh002i 1050 $answer_evaluator->{debug} = $func_params{debug};
2188 : gage 2056 $answer_evaluator->ans_hash(
2189 : sh002i 2277 correct_ans => $originalCorrEqn,
2190 :     rf_correct_ans => $rh_correct_ans->{rf_correct_ans},
2191 :     evaluation_points => \@evaluation_points,
2192 :     ra_param_vars => \@PARAMS,
2193 :     ra_vars => \@VARS,
2194 :     type => 'function',
2195 :     score => 0,
2196 : sh002i 1050 );
2197 : sh002i 2277
2198 : gage 2061 #########################################################
2199 :     # Prepare the previous answer for evaluation, discard errors
2200 :     #########################################################
2201 : sh002i 2277
2202 :     $answer_evaluator->install_pre_filter(
2203 :     sub {
2204 :     my $rh_ans = shift;
2205 :     $rh_ans->{_filter_name} = "fetch_previous_answer";
2206 :     my $prev_ans_label = "previous_".$rh_ans->{ans_label};
2207 :     $rh_ans->{prev_ans} = (defined $inputs_ref->{$prev_ans_label} and $inputs_ref->{$prev_ans_label} =~/\S/)
2208 :     ? $inputs_ref->{$prev_ans_label}
2209 :     : undef;
2210 :     $rh_ans;
2211 :     }
2212 :     );
2213 :    
2214 :     $answer_evaluator->install_pre_filter(
2215 :     sub {
2216 :     my $rh_ans = shift;
2217 :     return $rh_ans unless defined $rh_ans->{prev_ans};
2218 :     check_syntax($rh_ans,
2219 :     stdin => 'prev_ans',
2220 :     stdout => 'prev_ans',
2221 :     error_msg_flag => 0
2222 :     );
2223 :     $rh_ans->{_filter_name} = "check_syntax_of_previous_answer";
2224 :     $rh_ans;
2225 :     }
2226 :     );
2227 :    
2228 :     $answer_evaluator->install_pre_filter(
2229 :     sub {
2230 :     my $rh_ans = shift;
2231 :     return $rh_ans unless defined $rh_ans->{prev_ans};
2232 :     function_from_string2($rh_ans,
2233 :     stdin => 'prev_ans',
2234 :     stdout => 'rf_prev_ans',
2235 :     ra_vars => \@VARS,
2236 :     debug => $func_params{debug}
2237 :     );
2238 :     $rh_ans->{_filter_name} = "compile_previous_answer";
2239 :     $rh_ans;
2240 :     }
2241 :     );
2242 :    
2243 : gage 2061 #########################################################
2244 :     # Prepare the current answer for evaluation
2245 :     #########################################################
2246 : sh002i 2277
2247 :     $answer_evaluator->install_pre_filter(\&check_syntax);
2248 :     $answer_evaluator->install_pre_filter(\&function_from_string2,
2249 :     ra_vars => \@VARS,
2250 :     debug => $func_params{debug}
2251 : gage 2061 ); # @VARS has been guaranteed to be an array, $var might be a single string.
2252 : sh002i 2277
2253 : gage 2061 #########################################################
2254 :     # Compare the previous and current answer. Discard errors
2255 :     #########################################################
2256 : sh002i 2277
2257 :     $answer_evaluator->install_evaluator(
2258 :     sub {
2259 :     my $rh_ans = shift;
2260 :     return $rh_ans unless defined $rh_ans->{rf_prev_ans};
2261 :     calculate_difference_vector($rh_ans,
2262 :     %func_params,
2263 :     stdin1 => 'rf_student_ans',
2264 :     stdin2 => 'rf_prev_ans',
2265 :     stdout => 'ra_diff_with_prev_ans',
2266 :     error_msg_flag => 0,
2267 :     );
2268 :     $rh_ans->{_filter_name} = "calculate_difference_vector_of_previous_answer";
2269 :     $rh_ans;
2270 :     }
2271 :     );
2272 :    
2273 :     $answer_evaluator->install_evaluator(
2274 :     sub {
2275 :     my $rh_ans = shift;
2276 :     return $rh_ans unless defined $rh_ans->{ra_diff_with_prev_ans};
2277 : jj 3572 ##
2278 :     ## DPVC -- only give the message if the answer is specified differently
2279 :     ##
2280 :     return $rh_ans if $rh_ans->{prev_ans} eq $rh_ans->{student_ans};
2281 :     ##
2282 :     ## /DPVC
2283 :     ##
2284 : sh002i 2277 is_zero_array($rh_ans,
2285 :     stdin => 'ra_diff_with_prev_ans',
2286 :     stdout => 'ans_equals_prev_ans'
2287 :     );
2288 :     }
2289 :     );
2290 :    
2291 : gage 2061 #########################################################
2292 :     # Calculate values for approximation parameters and
2293 :     # compare the current answer with the correct answer. Keep errors this time.
2294 :     #########################################################
2295 :    
2296 : sh002i 1050 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS);
2297 :     $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params);
2298 :     $answer_evaluator->install_evaluator(\&is_zero_array, tolerance => $tol );
2299 : gage 2061
2300 : sh002i 1050 $answer_evaluator->install_post_filter(
2301 : sh002i 2277 sub {
2302 :     my $rh_ans = shift;
2303 :     $rh_ans->clear_error('SYNTAX');
2304 :     $rh_ans;
2305 :     }
2306 :     );
2307 :    
2308 :     $answer_evaluator->install_post_filter(
2309 :     sub {
2310 :     my $rh_ans = shift;
2311 :     if ($rh_ans->catch_error('EVAL')) {
2312 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
2313 :     $rh_ans->clear_error('EVAL');
2314 :     }
2315 :     $rh_ans;
2316 :     }
2317 : sh002i 1050 );
2318 : sh002i 2277
2319 : gage 2061 $answer_evaluator->install_post_filter(
2320 : sh002i 2277 sub {
2321 :     my $rh_ans = shift;
2322 :     if ( defined($rh_ans->{'ans_equals_prev_ans'}) and $rh_ans->{'ans_equals_prev_ans'} and $rh_ans->{score}==0) {
2323 : jj 3572 ## $rh_ans->{ans_message} = "This answer is the same as the one you just submitted or previewed.";
2324 :     $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted or previewed."; ## DPVC
2325 : sh002i 2277 }
2326 :     $rh_ans;
2327 :     }
2328 : gage 2061 );
2329 : sh002i 2277
2330 :     $answer_evaluator;
2331 : sh002i 1050 }
2332 :    
2333 :    
2334 :     ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
2335 :     ##
2336 :     ## IN: a hash containing the following items (error-checking to be added later?):
2337 :     ## correctAnswer -- the correct answer
2338 :     ## tolerance -- the allowable margin of error
2339 :     ## tolType -- 'relative' or 'absolute'
2340 :     ## format -- the display format of the answer
2341 :     ## mode -- one of 'std', 'strict', 'arith', or 'frac';
2342 :     ## determines allowable formats for the input
2343 :     ## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
2344 :     ## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
2345 :    
2346 :    
2347 :     ##########################################################################
2348 :     ##########################################################################
2349 :     ## String answer evaluators
2350 :    
2351 :     =head2 String Answer Evaluators
2352 :    
2353 :     String answer evaluators compare a student string to the correct string.
2354 :     Different filters can be applied to allow various degrees of variation.
2355 :     Both the student and correct answers are subject to the same filters, to
2356 :     ensure that there are no unexpected matches or rejections.
2357 :    
2358 :     String Filters
2359 :    
2360 :     remove_whitespace -- Removes all whitespace from the string.
2361 :     It applies the following substitution
2362 :     to the string:
2363 :     $filteredAnswer =~ s/\s+//g;
2364 :    
2365 :     compress_whitespace -- Removes leading and trailing whitespace, and
2366 :     replaces all other blocks of whitespace by a
2367 :     single space. Applies the following substitutions:
2368 :     $filteredAnswer =~ s/^\s*//;
2369 :     $filteredAnswer =~ s/\s*$//;
2370 :     $filteredAnswer =~ s/\s+/ /g;
2371 :    
2372 :     trim_whitespace -- Removes leading and trailing whitespace.
2373 :     Applies the following substitutions:
2374 :     $filteredAnswer =~ s/^\s*//;
2375 :     $filteredAnswer =~ s/\s*$//;
2376 :    
2377 :     ignore_case -- Ignores the case of the string. More accurately,
2378 :     it converts the string to uppercase (by convention).
2379 :     Applies the following function:
2380 :     $filteredAnswer = uc $filteredAnswer;
2381 :    
2382 :     ignore_order -- Ignores the order of the letters in the string.
2383 :     This is used for problems of the form "Choose all
2384 :     that apply." Specifically, it removes all
2385 :     whitespace and lexically sorts the letters in
2386 :     ascending alphabetical order. Applies the following
2387 :     functions:
2388 :     $filteredAnswer = join( "", lex_sort(
2389 :     split( /\s*/, $filteredAnswer ) ) );
2390 :    
2391 :     =cut
2392 :    
2393 :     ################################
2394 :     ## STRING ANSWER FILTERS
2395 :    
2396 :     ## IN: --the string to be filtered
2397 :     ## --a list of the filters to use
2398 :     ##
2399 :     ## OUT: --the modified string
2400 :     ##
2401 :     ## Use this subroutine instead of the
2402 :     ## individual filters below it
2403 :    
2404 : gage 3338 sub str_filters {
2405 :     my $stringToFilter = shift @_;
2406 :     # filters now take an answer hash, so encapsulate the string
2407 :     # in the answer hash.
2408 :     my $rh_ans = new AnswerHash;
2409 :     $rh_ans->{student_ans} = $stringToFilter;
2410 :     $rh_ans->{correct_ans}='';
2411 :     my @filters_to_use = @_;
2412 :     my %known_filters = (
2413 :     'remove_whitespace' => \&remove_whitespace,
2414 :     'compress_whitespace' => \&compress_whitespace,
2415 :     'trim_whitespace' => \&trim_whitespace,
2416 :     'ignore_case' => \&ignore_case,
2417 :     'ignore_order' => \&ignore_order,
2418 :     );
2419 :    
2420 :     #test for unknown filters
2421 :     foreach my $filter ( @filters_to_use ) {
2422 :     #check that filter is known
2423 :     die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
2424 :     unless exists $known_filters{$filter};
2425 :     $rh_ans = $known_filters{$filter}($rh_ans); # apply filter.
2426 :     }
2427 : gage 3323 # foreach $filter (@filters_to_use) {
2428 :     # die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
2429 :     # unless exists $known_filters{$filter};
2430 :     # }
2431 :     #
2432 :     # if( grep( /remove_whitespace/i, @filters_to_use ) ) {
2433 : gage 3338 # $rh_ans = remove_whitespace( $rh_ans );
2434 : gage 3323 # }
2435 :     # if( grep( /compress_whitespace/i, @filters_to_use ) ) {
2436 : gage 3338 # $rh_ans = compress_whitespace( $rh_ans );
2437 : gage 3323 # }
2438 :     # if( grep( /trim_whitespace/i, @filters_to_use ) ) {
2439 : gage 3338 # $rh_ans = trim_whitespace( $rh_ans );
2440 : gage 3323 # }
2441 :     # if( grep( /ignore_case/i, @filters_to_use ) ) {
2442 : gage 3338 # $rh_ans = ignore_case( $rh_ans );
2443 : gage 3323 # }
2444 :     # if( grep( /ignore_order/i, @filters_to_use ) ) {
2445 : gage 3338 # $rh_ans = ignore_order( $rh_ans );
2446 : gage 3323 # }
2447 : sh002i 1050
2448 : gage 3338 return $rh_ans->{student_ans};
2449 :     }
2450 : sh002i 1050 sub remove_whitespace {
2451 : gage 3323 my $rh_ans = shift;
2452 :     die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
2453 :     $rh_ans->{_filter_name} = 'remove_whitespace';
2454 :     $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace
2455 :     $rh_ans->{correct_ans} =~ s/\s+//g; # remove all whitespace
2456 :     return $rh_ans;
2457 : sh002i 1050 }
2458 :    
2459 :     sub compress_whitespace {
2460 : gage 3323 my $rh_ans = shift;
2461 :     die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
2462 :     $rh_ans->{_filter_name} = 'compress_whitespace';
2463 :     $rh_ans->{student_ans} =~ s/^\s*//; # remove initial whitespace
2464 :     $rh_ans->{student_ans} =~ s/\s*$//; # remove trailing whitespace
2465 :     $rh_ans->{student_ans} =~ s/\s+/ /g; # replace spaces by single space
2466 :     $rh_ans->{correct_ans} =~ s/^\s*//; # remove initial whitespace
2467 :     $rh_ans->{correct_ans} =~ s/\s*$//; # remove trailing whitespace
2468 :     $rh_ans->{correct_ans} =~ s/\s+/ /g; # replace spaces by single space
2469 : sh002i 1050
2470 : gage 3323 return $rh_ans;
2471 : sh002i 1050 }
2472 :    
2473 :     sub trim_whitespace {
2474 : gage 3323 my $rh_ans = shift;
2475 :     die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
2476 :     $rh_ans->{_filter_name} = 'trim_whitespace';
2477 :     $rh_ans->{student_ans} =~ s/^\s*//; # remove initial whitespace
2478 :     $rh_ans->{student_ans} =~ s/\s*$//; # remove trailing whitespace
2479 :     $rh_ans->{correct_ans} =~ s/^\s*//; # remove initial whitespace
2480 :     $rh_ans->{correct_ans} =~ s/\s*$//; # remove trailing whitespace
2481 : sh002i 1050
2482 : gage 3323 return $rh_ans;
2483 : sh002i 1050 }
2484 :    
2485 :     sub ignore_case {
2486 : gage 3323 my $rh_ans = shift;
2487 :     die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
2488 :     $rh_ans->{_filter_name} = 'ignore_case';
2489 :     $rh_ans->{student_ans} =~ tr/a-z/A-Z/;
2490 :     $rh_ans->{correct_ans} =~ tr/a-z/A-Z/;
2491 :     return $rh_ans;
2492 : sh002i 1050 }
2493 :    
2494 :     sub ignore_order {
2495 : gage 3323 my $rh_ans = shift;
2496 :     die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
2497 : gage 3346 $rh_ans->{_filter_name} = 'ignore_order';
2498 : gage 3323 $rh_ans->{student_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{student_ans} ) ) );
2499 :     $rh_ans->{correct_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{correct_ans} ) ) );
2500 :    
2501 :     return $rh_ans;
2502 : sh002i 1050 }
2503 : gage 3323 # sub remove_whitespace {
2504 :     # my $filteredAnswer = shift;
2505 :     #
2506 :     # $filteredAnswer =~ s/\s+//g; # remove all whitespace
2507 :     #
2508 :     # return $filteredAnswer;
2509 :     # }
2510 :     #
2511 :     # sub compress_whitespace {
2512 :     # my $filteredAnswer = shift;
2513 :     #
2514 :     # $filteredAnswer =~ s/^\s*//; # remove initial whitespace
2515 :     # $filteredAnswer =~ s/\s*$//; # remove trailing whitespace
2516 :     # $filteredAnswer =~ s/\s+/ /g; # replace spaces by single space
2517 :     #
2518 :     # return $filteredAnswer;
2519 :     # }
2520 :     #
2521 :     # sub trim_whitespace {
2522 :     # my $filteredAnswer = shift;
2523 :     #
2524 :     # $filteredAnswer =~ s/^\s*//; # remove initial whitespace
2525 :     # $filteredAnswer =~ s/\s*$//; # remove trailing whitespace
2526 :     #
2527 :     # return $filteredAnswer;
2528 :     # }
2529 :     #
2530 :     # sub ignore_case {
2531 :     # my $filteredAnswer = shift;
2532 :     # #warn "filtered answer is ", $filteredAnswer;
2533 :     # #$filteredAnswer = uc $filteredAnswer; # this didn't work on webwork xmlrpc, but does elsewhere ????
2534 :     # $filteredAnswer =~ tr/a-z/A-Z/;
2535 :     #
2536 :     # return $filteredAnswer;
2537 :     # }
2538 :     #
2539 :     # sub ignore_order {
2540 :     # my $filteredAnswer = shift;
2541 :     #
2542 :     # $filteredAnswer = join( "", lex_sort( split( /\s*/, $filteredAnswer ) ) );
2543 :     #
2544 :     # return $filteredAnswer;
2545 :     # }
2546 : sh002i 1050 ################################
2547 :     ## END STRING ANSWER FILTERS
2548 :    
2549 :    
2550 :     =head3 str_cmp()
2551 :    
2552 :     Compares a string or a list of strings, using a named hash of options to set
2553 :     parameters. This can make for more readable code than using the "mode"_str_cmp()
2554 :     style, but some people find one or the other easier to remember.
2555 :    
2556 :     ANS( str_cmp( answer or answer_array_ref, options_hash ) );
2557 :    
2558 :     1. the correct answer or a reference to an array of answers
2559 :     2. either a list of filters, or:
2560 :     a hash consisting of
2561 :     filters - a reference to an array of filters
2562 :    
2563 :     Returns an answer evaluator, or (if given a reference to an array of answers),
2564 :     a list of answer evaluators
2565 :    
2566 :     FILTERS:
2567 :    
2568 :     remove_whitespace -- removes all whitespace
2569 :     compress_whitespace -- removes whitespace from the beginning and end of the string,
2570 :     and treats one or more whitespace characters in a row as a
2571 :     single space (true by default)
2572 :     trim_whitespace -- removes whitespace from the beginning and end of the string
2573 :     ignore_case -- ignores the case of the letters (true by default)
2574 :     ignore_order -- ignores the order in which letters are entered
2575 :    
2576 :     EXAMPLES:
2577 :    
2578 :     str_cmp( "Hello" ) -- matches "Hello", " hello" (same as std_str_cmp() )
2579 :     str_cmp( ["Hello", "Goodbye"] ) -- same as std_str_cmp_list()
2580 :     str_cmp( " hello ", trim_whitespace ) -- matches "hello", " hello "
2581 :     str_cmp( "ABC", filters => 'ignore_order' ) -- matches "ACB", "A B C", but not "abc"
2582 :     str_cmp( "D E F", remove_whitespace, ignore_case ) -- matches "def" and "d e f" but not "fed"
2583 :    
2584 :    
2585 :     =cut
2586 :    
2587 :     sub str_cmp {
2588 :     my $correctAnswer = shift @_;
2589 :     $correctAnswer = '' unless defined($correctAnswer);
2590 :     my @options = @_;
2591 : gage 3323 my %options = ();
2592 :     # backward compatibility
2593 :     if (grep /filters|debug|filter/, @options) { # see whether we have hash keys in the input.
2594 :     %options = @options;
2595 :     } elsif (@options) { # all options are names of filters.
2596 :     $options{filters} = [@options];
2597 :     }
2598 : sh002i 1050 my $ra_filters;
2599 : gage 3323 assign_option_aliases( \%options,
2600 :     'filter' => 'filters',
2601 :     );
2602 :     set_default_options( \%options,
2603 :     'filters' => [qw(trim_whitespace compress_whitespace ignore_case)],
2604 :     'debug' => 0,
2605 :     'type' => 'str_cmp',
2606 :     );
2607 :     $options{filters} = (ref($options{filters}))?$options{filters}:[$options{filters}];
2608 :     # make sure this is a reference to an array.
2609 : sh002i 1050 # error-checking for filters occurs in the filters() subroutine
2610 : gage 3323 # if( not defined( $options[0] ) ) { # used with no filters as alias for std_str_cmp()
2611 :     # @options = ( 'compress_whitespace', 'ignore_case' );
2612 :     # }
2613 :     #
2614 :     # if( $options[0] eq 'filters' ) { # using filters => [f1, f2, ...] notation
2615 :     # $ra_filters = $options[1];
2616 :     # }
2617 :     # else { # using a list of filters
2618 :     # $ra_filters = \@options;
2619 :     # }
2620 : sh002i 1050
2621 :     # thread over lists
2622 :     my @ans_list = ();
2623 :    
2624 :     if ( ref($correctAnswer) eq 'ARRAY' ) {
2625 :     @ans_list = @{$correctAnswer};
2626 :     }
2627 :     else {
2628 :     push( @ans_list, $correctAnswer );
2629 :     }
2630 :    
2631 :     # final_answer;
2632 :     my @output_list = ();
2633 :    
2634 :     foreach my $ans (@ans_list) {
2635 : gage 3323 push(@output_list, STR_CMP(
2636 :     'correct_ans' => $ans,
2637 :     'filters' => $options{filters},
2638 :     'type' => $options{type},
2639 :     'debug' => $options{debug},
2640 : sh002i 1050 )
2641 :     );
2642 :     }
2643 :    
2644 :     return (wantarray) ? @output_list : $output_list[0] ;
2645 :     }
2646 :    
2647 :     =head3 "mode"_str_cmp functions
2648 :    
2649 :     The functions of the the form "mode"_str_cmp() use different functions to
2650 :     specify which filters to apply. They take no options except the correct
2651 :     string. There are also versions which accept a list of strings.
2652 :    
2653 :     std_str_cmp( $correctString )
2654 :     std_str_cmp_list( @correctStringList )
2655 :     Filters: compress_whitespace, ignore_case
2656 :    
2657 :     std_cs_str_cmp( $correctString )
2658 :     std_cs_str_cmp_list( @correctStringList )
2659 :     Filters: compress_whitespace
2660 :    
2661 :     strict_str_cmp( $correctString )
2662 :     strict_str_cmp_list( @correctStringList )
2663 :     Filters: trim_whitespace
2664 :    
2665 :     unordered_str_cmp( $correctString )
2666 :     unordered_str_cmp_list( @correctStringList )
2667 :     Filters: ignore_order, ignore_case
2668 :    
2669 :     unordered_cs_str_cmp( $correctString )
2670 :     unordered_cs_str_cmp_list( @correctStringList )
2671 :     Filters: ignore_order
2672 :    
2673 :     ordered_str_cmp( $correctString )
2674 :     ordered_str_cmp_list( @correctStringList )
2675 :     Filters: remove_whitespace, ignore_case
2676 :    
2677 :     ordered_cs_str_cmp( $correctString )
2678 :     ordered_cs_str_cmp_list( @correctStringList )
2679 :     Filters: remove_whitespace
2680 :    
2681 :     Examples
2682 :    
2683 :     ANS( std_str_cmp( "W. Mozart" ) ) -- Accepts "W. Mozart", "W. MOZarT",
2684 :     and so forth. Case insensitive. All internal spaces treated
2685 :     as single spaces.
2686 :     ANS( std_cs_str_cmp( "Mozart" ) ) -- Rejects "mozart". Same as
2687 :     std_str_cmp() but case sensitive.
2688 :     ANS( strict_str_cmp( "W. Mozart" ) ) -- Accepts only the exact string.
2689 :     ANS( unordered_str_cmp( "ABC" ) ) -- Accepts "a c B", "CBA" and so forth.
2690 :     Unordered, case insensitive, spaces ignored.
2691 :     ANS( unordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc". Same as
2692 :     unordered_str_cmp() but case sensitive.
2693 :     ANS( ordered_str_cmp( "ABC" ) ) -- Accepts "a b C", "A B C" and so forth.
2694 :     Ordered, case insensitive, spaces ignored.
2695 :     ANS( ordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc", accepts "A BC" and
2696 :     so forth. Same as ordered_str_cmp() but case sensitive.
2697 :    
2698 :     =cut
2699 :    
2700 :     sub std_str_cmp { # compare strings
2701 :     my $correctAnswer = shift @_;
2702 :     my @filters = ( 'compress_whitespace', 'ignore_case' );
2703 :     my $type = 'std_str_cmp';
2704 : gage 3323 STR_CMP('correct_ans' => $correctAnswer,
2705 : sh002i 1050 'filters' => \@filters,
2706 :     'type' => $type
2707 :     );
2708 :     }
2709 :    
2710 :     sub std_str_cmp_list { # alias for std_str_cmp
2711 :     my @answerList = @_;
2712 :     my @output;
2713 :     while (@answerList) {
2714 :     push( @output, std_str_cmp(shift @answerList) );
2715 :     }
2716 :     @output;
2717 :     }
2718 :    
2719 :     sub std_cs_str_cmp { # compare strings case sensitive
2720 :     my $correctAnswer = shift @_;
2721 :     my @filters = ( 'compress_whitespace' );
2722 :     my $type = 'std_cs_str_cmp';
2723 : gage 3323 STR_CMP( 'correct_ans' => $correctAnswer,
2724 : sh002i 1050 'filters' => \@filters,
2725 :     'type' => $type
2726 :     );
2727 :     }
2728 :    
2729 :     sub std_cs_str_cmp_list { # alias for std_cs_str_cmp
2730 :     my @answerList = @_;
2731 :     my @output;
2732 :     while (@answerList) {
2733 :     push( @output, std_cs_str_cmp(shift @answerList) );
2734 :     }
2735 :     @output;
2736 :     }
2737 :    
2738 :     sub strict_str_cmp { # strict string compare
2739 :     my $correctAnswer = shift @_;
2740 :     my @filters = ( 'trim_whitespace' );
2741 :     my $type = 'strict_str_cmp';
2742 : gage 3323 STR_CMP( 'correct_ans' => $correctAnswer,
2743 : sh002i 1050 'filters' => \@filters,
2744 :     'type' => $type
2745 :     );
2746 :     }
2747 :    
2748 :     sub strict_str_cmp_list { # alias for strict_str_cmp
2749 :     my @answerList = @_;
2750 :     my @output;
2751 :     while (@answerList) {
2752 :     push( @output, strict_str_cmp(shift @answerList) );
2753 :     }
2754 :     @output;
2755 :     }
2756 :    
2757 :     sub unordered_str_cmp { # unordered, case insensitive, spaces ignored
2758 :     my $correctAnswer = shift @_;
2759 :     my @filters = ( 'ignore_order', 'ignore_case' );
2760 :     my $type = 'unordered_str_cmp';
2761 : gage 3323 STR_CMP( 'correct_ans' => $correctAnswer,
2762 : sh002i 1050 'filters' => \@filters,
2763 :     'type' => $type
2764 :     );
2765 :     }
2766 :    
2767 :     sub unordered_str_cmp_list { # alias for unordered_str_cmp
2768 :     my @answerList = @_;
2769 :     my @output;
2770 :     while (@answerList) {
2771 :     push( @output, unordered_str_cmp(shift @answerList) );
2772 :     }
2773 :     @output;
2774 :     }
2775 :    
2776 :     sub unordered_cs_str_cmp { # unordered, case sensitive, spaces ignored
2777 :     my $correctAnswer = shift @_;
2778 :     my @filters = ( 'ignore_order' );
2779 :     my $type = 'unordered_cs_str_cmp';
2780 : gage 3323 STR_CMP( 'correct_ans' => $correctAnswer,
2781 : sh002i 1050 'filters' => \@filters,
2782 :     'type' => $type
2783 :     );
2784 :     }
2785 :    
2786 :     sub unordered_cs_str_cmp_list { # alias for unordered_cs_str_cmp
2787 :     my @answerList = @_;
2788 :     my @output;
2789 :     while (@answerList) {
2790 :     push( @output, unordered_cs_str_cmp(shift @answerList) );
2791 :     }
2792 :     @output;
2793 :     }
2794 :    
2795 :     sub ordered_str_cmp { # ordered, case insensitive, spaces ignored
2796 :     my $correctAnswer = shift @_;
2797 :     my @filters = ( 'remove_whitespace', 'ignore_case' );
2798 :     my $type = 'ordered_str_cmp';
2799 : gage 3323 STR_CMP( 'correct_ans' => $correctAnswer,
2800 : sh002i 1050 'filters' => \@filters,
2801 :     'type' => $type
2802 :     );
2803 :     }
2804 :    
2805 :     sub ordered_str_cmp_list { # alias for ordered_str_cmp
2806 :     my @answerList = @_;
2807 :     my @output;
2808 :     while (@answerList) {
2809 :     push( @output, ordered_str_cmp(shift @answerList) );
2810 :     }
2811 :     @output;
2812 :     }
2813 :    
2814 :     sub ordered_cs_str_cmp { # ordered, case sensitive, spaces ignored
2815 :     my $correctAnswer = shift @_;
2816 :     my @filters = ( 'remove_whitespace' );
2817 :     my $type = 'ordered_cs_str_cmp';
2818 : gage 3323 STR_CMP( 'correct_ans' => $correctAnswer,
2819 : sh002i 1050 'filters' => \@filters,
2820 :     'type' => $type
2821 :     );
2822 :     }
2823 :    
2824 :     sub ordered_cs_str_cmp_list { # alias for ordered_cs_str_cmp
2825 :     my @answerList = @_;
2826 :     my @output;
2827 :     while (@answerList) {
2828 :     push( @output, ordered_cs_str_cmp(shift @answerList) );
2829 :     }
2830 :     @output;
2831 :     }
2832 :    
2833 :    
2834 :     ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
2835 :     ##
2836 :     ## IN: a hashtable with the following entries (error-checking to be added later?):
2837 :     ## correctAnswer -- the correct answer, before filtering
2838 :     ## filters -- reference to an array containing the filters to be applied
2839 :     ## type -- a string containing the type of answer evaluator in use
2840 :     ## OUT: a reference to an answer evaluator subroutine
2841 :     sub STR_CMP {
2842 :     my %str_params = @_;
2843 : gage 3323 #my $correctAnswer = str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
2844 :     my $answer_evaluator = new AnswerEvaluator;
2845 :     $answer_evaluator->{debug} = $str_params{debug};
2846 :     $answer_evaluator->ans_hash(
2847 :     correct_ans => $str_params{correct_ans}||'',
2848 :     type => $str_params{type}||'str_cmp',
2849 :     score => 0,
2850 :    
2851 :     );
2852 :     my %known_filters = (
2853 :     'remove_whitespace' => \&remove_whitespace,
2854 :     'compress_whitespace' => \&compress_whitespace,
2855 :     'trim_whitespace' => \&trim_whitespace,
2856 :     'ignore_case' => \&ignore_case,
2857 :     'ignore_order' => \&ignore_order,
2858 :     );
2859 :    
2860 :     foreach my $filter ( @{$str_params{filters}} ) {
2861 :     #check that filter is known
2862 :     die "Unknown string filter |$filter|. Known filters are ".
2863 :     join(" ", keys %known_filters) .
2864 :     "(try checking the parameters to str_cmp() )"
2865 :     unless exists $known_filters{$filter};
2866 :     # install related pre_filter
2867 :     $answer_evaluator->install_pre_filter( $known_filters{$filter} );
2868 :     }
2869 :     $answer_evaluator->install_evaluator(sub {
2870 :     my $rh_ans = shift;
2871 :     $rh_ans->{_filter_name} = "Evaluator: Compare string answers with eq";
2872 :     $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans})?1:0 ;
2873 :     $rh_ans;
2874 :     });
2875 :     $answer_evaluator->install_post_filter(sub {
2876 :     my $rh_hash = shift;
2877 :     $rh_hash->{_filter_name} = "clean up preview strings";
2878 :     $rh_hash->{'preview_text_string'} = $rh_hash->{student_ans};
2879 :     $rh_hash->{'preview_latex_string'} = "\\text{ ".$rh_hash->{student_ans}." }";
2880 :     $rh_hash;
2881 :     });
2882 : sh002i 1050 return $answer_evaluator;
2883 :     }
2884 :    
2885 : gage 3323 # sub STR_CMP_old {
2886 :     # my %str_params = @_;
2887 :     # $str_params{'correct_ans'} = str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
2888 :     # my $answer_evaluator = sub {
2889 :     # my $in = shift @_;
2890 :     # $in = '' unless defined $in;
2891 :     # my $original_student_ans = $in;
2892 :     # $in = str_filters( $in, @{$str_params{'filters'}} );
2893 :     # my $correctQ = ( $in eq $str_params{'correct_ans'} ) ? 1: 0;
2894 :     # my $ans_hash = new AnswerHash( 'score' => $correctQ,
2895 :     # 'correct_ans' => $str_params{'correctAnswer'},
2896 :     # 'student_ans' => $in,
2897 :     # 'ans_message' => '',
2898 :     # 'type' => $str_params{'type'},
2899 :     # 'preview_text_string' => $in,
2900 :     # 'preview_latex_string' => $in,
2901 :     # 'original_student_ans' => $original_student_ans
2902 :     # );
2903 :     # return $ans_hash;
2904 :     # };
2905 :     # return $answer_evaluator;
2906 :     # }
2907 :    
2908 : sh002i 1050 ##########################################################################
2909 :     ##########################################################################
2910 :     ## Miscellaneous answer evaluators
2911 :    
2912 :     =head2 Miscellaneous Answer Evaluators (Checkboxes and Radio Buttons)
2913 :    
2914 :     These evaluators do not fit any of the other categories.
2915 :    
2916 :     checkbox_cmp( $correctAnswer )
2917 :    
2918 :     $correctAnswer -- a string containing the names of the correct boxes,
2919 :     e.g. "ACD". Note that this means that individual
2920 :     checkbox names can only be one character. Internally,
2921 :     this is largely the same as unordered_cs_str_cmp().
2922 :    
2923 :     radio_cmp( $correctAnswer )
2924 :    
2925 :     $correctAnswer -- a string containing the name of the correct radio
2926 :     button, e.g. "Choice1". This is case sensitive and
2927 :     whitespace sensitive, so the correct answer must match
2928 :     the name of the radio button exactly.
2929 :    
2930 :     =cut
2931 :    
2932 :     # added 6/14/2000 by David Etlinger
2933 :     # because of the conversion of the answer
2934 :     # string to an array, I thought it better not
2935 :     # to force STR_CMP() to work with this
2936 : gage 1071
2937 :     #added 2/26/2003 by Mike Gage
2938 :     # handled the case where multiple answers are passed as an array reference
2939 :     # rather than as a \0 delimited string.
2940 : sh002i 1050 sub checkbox_cmp {
2941 :     my $correctAnswer = shift @_;
2942 : gage 3346 my %options = @_;
2943 :     assign_option_aliases( \%options,
2944 :     );
2945 :     set_default_options( \%options,
2946 :     'debug' => 0,
2947 :     'type' => 'checkbox_cmp',
2948 :     );
2949 :     my $answer_evaluator = new AnswerEvaluator(
2950 :     correct_ans => $correctAnswer,
2951 :     type => $options{type},
2952 :     );
2953 :     # pass along debug requests
2954 :     $answer_evaluator->{debug} = $options{debug};
2955 :    
2956 :     # join student answer array into a single string if necessary
2957 :     $answer_evaluator->install_pre_filter(sub {
2958 :     my $rh_ans = shift;
2959 :     $rh_ans->{_filter_name} = 'convert student_ans to string';
2960 :     $rh_ans->{student_ans} = join("", @{$rh_ans->{student_ans}})
2961 :     if ref($rh_ans->{student_ans}) =~/ARRAY/i;
2962 :     $rh_ans;
2963 :     });
2964 :     # ignore order of check boxes
2965 :     $answer_evaluator->install_pre_filter(\&ignore_order);
2966 :     # compare as strings
2967 :     $answer_evaluator->install_evaluator(sub {
2968 :     my $rh_ans = shift;
2969 :     $rh_ans->{_filter_name} = 'compare strings generated by checked boxes';
2970 :     $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans}) ? 1 : 0;
2971 :     $rh_ans;
2972 :     });
2973 :     # fix up preview displays
2974 :     $answer_evaluator->install_post_filter( sub {
2975 :     my $rh_ans = shift;
2976 :     $rh_ans->{_filter_name} = 'adjust preview strings';
2977 :     $rh_ans->{type} = $options{type};
2978 :     $rh_ans->{preview_text_string} = '\\text{'.$rh_ans->{student_ans}.'}',
2979 :     $rh_ans->{preview_latex_string} = '\\text{'.$rh_ans->{student_ans}.'}',
2980 :     $rh_ans;
2981 :    
2982 :    
2983 :     });
2984 :    
2985 :     # my $answer_evaluator = sub {
2986 :     # my $in = shift @_;
2987 :     # $in = '' unless defined $in; #in case no boxes checked
2988 :     # # multiple answers could come in two forms
2989 :     # # either a \0 delimited string or
2990 :     # # an array reference. We handle both.
2991 :     # if (ref($in) eq 'ARRAY') {
2992 :     # $in = join("",@{$in}); # convert array to single no-delimiter string
2993 :     # } else {
2994 :     # my @temp = split( "\0", $in ); #convert "\0"-delimited string to array...
2995 :     # $in = join( "", @temp ); #and then to a single no-delimiter string
2996 :     # }
2997 :     # my $original_student_ans = $in; #well, almost original
2998 :     # $in = str_filters( $in, 'ignore_order' );
2999 :     #
3000 :     # my $correctQ = ($in eq $correctAnswer) ? 1: 0;
3001 :     #
3002 :     # my $ans_hash = new AnswerHash(
3003 :     # 'score' => $correctQ,
3004 :     # 'correct_ans' => "$correctAnswer",
3005 :     # 'student_ans' => $in,
3006 :     # 'ans_message' => "",
3007 :     # 'type' => "checkbox_cmp",
3008 :     # 'preview_text_string' => $in,
3009 :     # 'preview_latex_string' => $in,
3010 :     # 'original_student_ans' => $original_student_ans
3011 :     # );
3012 :     # return $ans_hash;
3013 :     #
3014 :     # };
3015 : sh002i 1050 return $answer_evaluator;
3016 :     }
3017 : gage 3346 # sub checkbox_cmp {
3018 :     # my $correctAnswer = shift @_;
3019 :     # $correctAnswer = str_filters( $correctAnswer, 'ignore_order' );
3020 :     #
3021 :     # my $answer_evaluator = sub {
3022 :     # my $in = shift @_;
3023 :     # $in = '' unless defined $in; #in case no boxes checked
3024 :     # # multiple answers could come in two forms
3025 :     # # either a \0 delimited string or
3026 :     # # an array reference. We handle both.
3027 :     # if (ref($in) eq 'ARRAY') {
3028 :     # $in = join("",@{$in}); # convert array to single no-delimiter string
3029 :     # } else {
3030 :     # my @temp = split( "\0", $in ); #convert "\0"-delimited string to array...
3031 :     # $in = join( "", @temp ); #and then to a single no-delimiter string
3032 :     # }
3033 :     # my $original_student_ans = $in; #well, almost original
3034 :     # $in = str_filters( $in, 'ignore_order' );
3035 :     #
3036 :     # my $correctQ = ($in eq $correctAnswer) ? 1: 0;
3037 :     #
3038 :     # my $ans_hash = new AnswerHash(
3039 :     # 'score' => $correctQ,
3040 :     # 'correct_ans' => "$correctAnswer",
3041 :     # 'student_ans' => $in,
3042 :     # 'ans_message' => "",
3043 :     # 'type' => "checkbox_cmp",
3044 :     # 'preview_text_string' => $in,
3045 :     # 'preview_latex_string' => $in,
3046 :     # 'original_student_ans' => $original_student_ans
3047 :     # );
3048 :     # return $ans_hash;
3049 :     #
3050 :     # };
3051 :     # return $answer_evaluator;
3052 :     # }
3053 : sh002i 1050
3054 :     #added 6/28/2000 by David Etlinger
3055 :     #exactly the same as strict_str_cmp,
3056 :     #but more intuitive to the user
3057 : gage 3324
3058 :     # check that answer is really a string and not an array
3059 :     # also use ordinary string compare
3060 : sh002i 1050 sub radio_cmp {
3061 : gage 3324 #strict_str_cmp( @_ );
3062 :     my $response = shift; # there should be only one item.
3063 :     warn "Multiple choices -- this should not happen with radio buttons. Have
3064 : gage 3325 you used checkboxes perhaps?" if ref($response); #triggered if an ARRAY is passed
3065 : gage 3324 str_cmp($response);
3066 : sh002i 1050 }
3067 :    
3068 :     ##########################################################################
3069 :     ##########################################################################
3070 :     ## Text and e-mail routines
3071 :    
3072 :     sub store_ans_at {
3073 :     my $answerStringRef = shift;
3074 :     my %options = @_;
3075 :     my $ans_eval= '';
3076 :     if ( ref($answerStringRef) eq 'SCALAR' ) {
3077 :     $ans_eval= sub {
3078 :     my $text = shift;
3079 :     $text = '' unless defined($text);
3080 :     $$answerStringRef = $$answerStringRef . $text;
3081 :     my $ans_hash = new AnswerHash(
3082 :     'score' => 1,
3083 :     'correct_ans' => '',
3084 :     'student_ans' => $text,
3085 :     'ans_message' => '',
3086 :     'type' => 'store_ans_at',
3087 :     'original_student_ans' => $text,
3088 :     'preview_text_string' => ''
3089 :     );
3090 :    
3091 :     return $ans_hash;
3092 :     };
3093 :     }
3094 :     else {
3095 :     die "Syntax error: \n The argument to store_ans_at() must be a pointer to a scalar.\n(e.g. store_ans_at(~~\$MSG) )\n\n";
3096 :     }
3097 :    
3098 :     return $ans_eval;
3099 :     }
3100 :    
3101 :     #### subroutines used in producing a questionnaire
3102 :     #### these are at least good models for other answers of this type
3103 :    
3104 : gage 1690 # my $QUESTIONNAIRE_ANSWERS=''; # stores the answers until it is time to send them
3105 : sh002i 1050 # this must be initialized before the answer evaluators are run
3106 :     # but that happens long after all of the text in the problem is
3107 :     # evaluated.
3108 :     # this is a utility script for cleaning up the answer output for display in
3109 :     #the answers.
3110 :    
3111 :     sub DUMMY_ANSWER {
3112 :     my $num = shift;
3113 :     qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">}
3114 :     }
3115 :    
3116 :     sub escapeHTML {
3117 :     my $string = shift;
3118 :     $string =~ s/\n/$BR/ge;
3119 :     $string;
3120 :     }
3121 :    
3122 :     # these next three subroutines show how to modify the "store_ans_at()" answer
3123 :     # evaluator to add extra information before storing the info
3124 :     # They provide a good model for how to tweak answer evaluators in special cases.
3125 :    
3126 :     sub anstext {
3127 :     my $num = shift;
3128 :     my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
3129 : gage 1455 my $psvnNumber = PG_restricted_eval(q!$main::psvnNumber!);
3130 :     my $probNum = PG_restricted_eval(q!$main::probNum!);
3131 :     my $ans_eval = sub {
3132 : sh002i 1050 my $text = shift;
3133 :     $text = '' unless defined($text);
3134 : apizer 1620 my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n $text "; # modify entered text
3135 : sh002i 1050 my $out = &$ans_eval_template($new_text); # standard evaluator
3136 :     #warn "$QUESTIONNAIRE_ANSWERS";
3137 :     $out->{student_ans} = escapeHTML($text); # restore original entered text
3138 :     $out->{correct_ans} = "Question $num answered";
3139 :     $out->{original_student_ans} = escapeHTML($text);
3140 :     $out;
3141 :     };
3142 :     $ans_eval;
3143 :     }
3144 :    
3145 : gage 1455
3146 : sh002i 1050 sub ansradio {
3147 :     my $num = shift;
3148 : gage 1455 my $psvnNumber = PG_restricted_eval(q!$main::psvnNumber!);
3149 :     my $probNum = PG_restricted_eval(q!$main::probNum!);
3150 : gage 1267
3151 : sh002i 1050 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
3152 :     my $ans_eval = sub {
3153 :     my $text = shift;
3154 :     $text = '' unless defined($text);
3155 : gage 1267 my $new_text = "\n$psvnNumber-Problem-$probNum-RADIO-$num:\n $text "; # modify entered text
3156 : sh002i 1050 my $out = $ans_eval_template->($new_text); # standard evaluator
3157 :     $out->{student_ans} =escapeHTML($text); # restore original entered text
3158 :     $out->{original_student_ans} = escapeHTML($text);
3159 :     $out;
3160 :     };
3161 :    
3162 :     $ans_eval;
3163 :     }
3164 :    
3165 :     sub anstext_non_anonymous {
3166 :     ## this emails identifying information
3167 : gage 1463 my $num = shift;
3168 :     my $psvnNumber = PG_restricted_eval(q!$main::psvnNumber!);
3169 :     my $probNum = PG_restricted_eval(q!$main::probNum!);
3170 :     my $studentLogin = PG_restricted_eval(q!$main::studentLogin!);
3171 :     my $studentID = PG_restricted_eval(q!$main::studentID!);
3172 : gage 1455 my $studentName = PG_restricted_eval(q!$main::studentName!);
3173 : gage 1267
3174 :    
3175 : sh002i 1050 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
3176 :     my $ans_eval = sub {
3177 :     my $text = shift;
3178 :     $text = '' unless defined($text);
3179 : gage 1267 my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n$studentLogin $main::studentID $studentName\n$text "; # modify entered text
3180 : sh002i 1050 my $out = &$ans_eval_template($new_text); # standard evaluator
3181 :     #warn "$QUESTIONNAIRE_ANSWERS";
3182 :     $out->{student_ans} = escapeHTML($text); # restore original entered text
3183 :     $out->{correct_ans} = "Question $num answered";
3184 :     $out->{original_student_ans} = escapeHTML($text);
3185 :     $out;
3186 :     };
3187 :     $ans_eval;
3188 :     }
3189 :    
3190 :    
3191 :     # This is another example of how to modify an answer evaluator to obtain
3192 :     # the desired behavior in a special case. Here the object is to have
3193 :     # have the last answer trigger the send_mail_to subroutine which mails
3194 :     # all of the answers to the designated address.
3195 :     # (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
3196 :    
3197 : gage 1071 # Fix me?? why is the body hard wired to the string QUESTIONNAIRE_ANSWERS?
3198 :    
3199 : sh002i 1050 sub mail_answers_to { #accepts the last answer and mails off the result
3200 :     my $user_address = shift;
3201 :     my $ans_eval = sub {
3202 :    
3203 :     # then mail out all of the answers, including this last one.
3204 :    
3205 :     send_mail_to( $user_address,
3206 : gage 1250 'subject' => "$main::courseName WeBWorK questionnaire",
3207 :     'body' => $QUESTIONNAIRE_ANSWERS,
3208 : gage 1463 'ALLOW_MAIL_TO' => $rh_envir->{ALLOW_MAIL_TO}
3209 : sh002i 1050 );
3210 :    
3211 :     my $ans_hash = new AnswerHash( 'score' => 1,
3212 :     'correct_ans' => '',
3213 :     'student_ans' => 'Answer recorded',
3214 :     'ans_message' => '',
3215 :     'type' => 'send_mail_to',
3216 :     );
3217 :    
3218 :     return $ans_hash;
3219 :     };
3220 :    
3221 : gage 1456 return $ans_eval;
3222 : sh002i 1050 }
3223 : gage 1071
3224 :     sub save_answer_to_file { #accepts the last answer and mails off the result
3225 :     my $fileID = shift;
3226 :     my $ans_eval = new AnswerEvaluator;
3227 :     $ans_eval->install_evaluator(
3228 :     sub {
3229 :     my $rh_ans = shift;
3230 : apizer 1080
3231 : gage 1071 unless ( defined( $rh_ans->{student_ans} ) ) {
3232 :     $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined");
3233 :     return $rh_ans;
3234 :     }
3235 : apizer 1080
3236 : gage 1071 my $error;
3237 :     my $string = '';
3238 :     $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!.
3239 :     $rh_ans->{student_ans}. qq!\n\n============================\n\n!;
3240 : apizer 1080
3241 : gage 1071 if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) {
3242 :     $rh_ans->throw_error("save_answers_to_file","Error: $error");
3243 :     } else {
3244 :     $rh_ans->{'student_ans'} = 'Answer saved';
3245 : apizer 1080 $rh_ans->{'score'} = 1;
3246 : gage 1071 }
3247 :     $rh_ans;
3248 :     }
3249 :     );
3250 :    
3251 :     return $ans_eval;
3252 :     }
3253 :    
3254 : sh002i 1050 sub mail_answers_to2 { #accepts the last answer and mails off the result
3255 : gage 1456 my $user_address = shift;
3256 :     my $subject = shift;
3257 :     my $ra_allow_mail_to = shift;
3258 : sh002i 1050 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
3259 :     send_mail_to($user_address,
3260 :     'subject' => $subject,
3261 :     'body' => $QUESTIONNAIRE_ANSWERS,
3262 : gage 1463 'ALLOW_MAIL_TO' => $rh_envir->{ALLOW_MAIL_TO},
3263 : sh002i 1050 );
3264 :     }
3265 :    
3266 :     ##########################################################################
3267 :     ##########################################################################
3268 :    
3269 :    
3270 :     ###########################################################################
3271 :     ### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT.
3272 :    
3273 :     ## Internal routine that converts variables into the standard array format
3274 :     ##
3275 :     ## IN: one of the following:
3276 :     ## an undefined value (i.e., no variable was specified)
3277 :     ## a reference to an array of variable names -- [var1, var2]
3278 :     ## a number (the number of variables desired) -- 3
3279 :     ## one or more variable names -- (var1, var2)
3280 :     ## OUT: an array of variable names
3281 :    
3282 :     sub get_var_array {
3283 :     my $in = shift @_;
3284 :     my @out;
3285 :    
3286 :     if( not defined($in) ) { #if nothing defined, build default array and return
3287 :     @out = ( $functVarDefault );
3288 :     return @out;
3289 :     }
3290 :     elsif( ref( $in ) eq 'ARRAY' ) { #if given an array ref, dereference and return
3291 :     return @{$in};
3292 :     }
3293 :     elsif( $in =~ /^\d+/ ) { #if given a number, set up the array and return
3294 :     if( $in == 1 ) {
3295 :     $out[0] = 'x';
3296 :     }
3297 :     elsif( $in == 2 ) {
3298 :     $out[0] = 'x';
3299 :     $out[1] = 'y';
3300 :     }
3301 :     elsif( $in == 3 ) {
3302 :     $out[0] = 'x';
3303 :     $out[1] = 'y';
3304 :     $out[2] = 'z';
3305 :     }
3306 :     else { #default to the x_1, x_2, ... convention
3307 :     my ($i, $tag);
3308 : jj 3572 for($i = 0; $i < $in; $i++) {$out[$i] = "${functVarDefault}_".($i+1)}
3309 : sh002i 1050 }
3310 :     return @out;
3311 :     }
3312 :     else { #if given one or more names, return as an array
3313 :     unshift( @_, $in );
3314 :     return @_;
3315 :     }
3316 :     }
3317 :    
3318 :     ## Internal routine that converts limits into the standard array of arrays format
3319 :     ## Some of the cases are probably unneccessary, but better safe than sorry
3320 :     ##
3321 :     ## IN: one of the following:
3322 :     ## an undefined value (i.e., no limits were specified)
3323 :     ## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
3324 :     ## a reference to an array of limits -- [llim, ulim]
3325 :     ## an array of array references -- ([llim,ulim], [llim,ulim])
3326 :     ## an array of limits -- (llim,ulim)
3327 :     ## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
3328 :    
3329 :     sub get_limits_array {
3330 :     my $in = shift @_;
3331 :     my @out;
3332 :    
3333 :     if( not defined($in) ) { #if nothing defined, build default array and return
3334 :     @out = ( [$functLLimitDefault, $functULimitDefault] );
3335 :     return @out;
3336 :     }
3337 :     elsif( ref($in) eq 'ARRAY' ) { #$in is either ref to array, or ref to array of refs
3338 :     my @deref = @{$in};
3339 :    
3340 :     if( ref( $in->[0] ) eq 'ARRAY' ) { #$in is a ref to an array of array refs
3341 :     return @deref;
3342 :     }
3343 :     else { #$in was just a ref to an array of numbers
3344 :     @out = ( $in );
3345 :     return @out;
3346 :     }
3347 :     }
3348 :     else { #$in was an array of references or numbers
3349 :     unshift( @_, $in );
3350 :    
3351 :     if( ref($_[0]) eq 'ARRAY' ) { #$in was an array of references, so just return it
3352 :     return @_;
3353 :     }
3354 :     else { #$in was an array of numbers
3355 :     @out = ( \@_ );
3356 :     return @out;
3357 :     }
3358 :     }
3359 :     }
3360 :    
3361 :     #sub check_option_list {
3362 :     # my $size = scalar(@_);
3363 :     # if( ( $size % 2 ) != 0 ) {
3364 :     # warn "ERROR in answer evaluator generator:\n" .
3365 :     # "Usage: <CODE>str_cmp([\$ans1, \$ans2],%options)</CODE>
3366 :     # or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR>
3367 :     # A list of inputs must be inclosed in square brackets <CODE>[\$ans1, \$ans2]</CODE>";
3368 :     # }
3369 :     #}
3370 :    
3371 :     # simple subroutine to display an error message when
3372 :     # function compares are called with invalid parameters
3373 :     sub function_invalid_params {
3374 :     my $correctEqn = shift @_;
3375 :     my $error_response = sub {
3376 :     my $PGanswerMessage = "Tell your professor that there is an error with the parameters " .
3377 :     "to the function answer evaluator";
3378 :     return ( 0, $correctEqn, "", $PGanswerMessage );
3379 :     };
3380 :     return $error_response;
3381 :     }
3382 :    
3383 :     sub clean_up_error_msg {
3384 :     my $msg = $_[0];
3385 :     $msg =~ s/^\[[^\]]*\][^:]*://;
3386 :     $msg =~ s/Unquoted string//g;
3387 :     $msg =~ s/may\s+clash.*/does not make sense here/;
3388 :     $msg =~ s/\sat.*line [\d]*//g;
3389 : gage 2061 $msg = 'Error: '. $msg;
3390 : sh002i 1050
3391 :     return $msg;
3392 :     }
3393 :    
3394 :     #formats the student and correct answer as specified
3395 :     #format must be of a form suitable for sprintf (e.g. '%0.5g'),
3396 :     #with the exception that a '#' at the end of the string
3397 :     #will cause trailing zeros in the decimal part to be removed
3398 :     sub prfmt {
3399 :     my($number,$format) = @_; # attention, the order of format and number are reversed
3400 :     my $out;
3401 :     if ($format) {
3402 :     warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>"
3403 :     unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/;
3404 :    
3405 :     if( $format =~ s/#\s*$// ) { # remove trailing zeros in the decimal
3406 :     $out = sprintf( $format, $number );
3407 :     $out =~ s/(\.\d*?)0+$/$1/;
3408 :     $out =~ s/\.$//; # in case all decimal digits were zero, remove the decimal
3409 :     $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3410 :     } elsif (is_a_number($number) ){
3411 :     $out = sprintf( $format, $number );
3412 :     $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3413 :     } else { # number is probably a string representing an arithmetic expression
3414 :     $out = $number;
3415 :     }
3416 : apizer 1080
3417 : sh002i 1050 } else {
3418 :     if (is_a_number($number)) {# only use capital E's for exponents. Little e is for 2.71828...
3419 :     $out = $number;
3420 :     $out =~ s/e/E/g;
3421 : apizer 1080 } else { # number is probably a string representing an arithmetic expression
3422 : sh002i 1050 $out = $number;
3423 : apizer 1080 }
3424 : sh002i 1050 }
3425 :     return $out;
3426 :     }
3427 :     #########################################################################
3428 :     # Filters for answer evaluators
3429 :     #########################################################################
3430 :    
3431 :     =head2 Filters
3432 :    
3433 :     =pod
3434 :    
3435 :     A filter is a short subroutine with the following structure. It accepts an
3436 :     AnswerHash, followed by a hash of options. It returns an AnswerHash
3437 :    
3438 :     $ans_hash = filter($ans_hash, %options);
3439 :    
3440 :     See the AnswerHash.pm file for a list of entries which can be expected to be found
3441 :     in an AnswerHash, such as 'student_ans', 'score' and so forth. Other entries
3442 :     may be present for specialized answer evaluators.
3443 :    
3444 :     The hope is that a well designed set of filters can easily be combined to form
3445 : apizer 1080 a new answer_evaluator and that this method will produce answer evaluators which are
3446 : sh002i 1050 are more robust than the method of copying existing answer evaluators and modifying them.
3447 :    
3448 :     Here is an outline of how a filter is constructed:
3449 :    
3450 :     sub filter{
3451 :     my $rh_ans = shift;
3452 :     my %options = @_;
3453 :     assign_option_aliases(\%options,
3454 :     'alias1' => 'option5'
3455 :     'alias2' => 'option7'
3456 :     );
3457 :     set_default_options(\%options,
3458 :     '_filter_name' => 'filter',
3459 :     'option5' => .0001,
3460 :     'option7' => 'ascii',
3461 :     'allow_unknown_options => 0,
3462 :     }
3463 :     .... body code of filter .......
3464 :     if ($error) {
3465 : apizer 1080 $rh_ans->throw_error("FILTER_ERROR", "Something went wrong");
3466 : sh002i 1050 # see AnswerHash.pm for details on using the throw_error method.
3467 : apizer 1080
3468 : sh002i 1050 $rh_ans; #reference to an AnswerHash object is returned.
3469 :     }
3470 :    
3471 :     =cut
3472 :    
3473 :     =head4 compare_numbers
3474 :    
3475 :    
3476 :     =cut
3477 :    
3478 :    
3479 :     sub compare_numbers {
3480 :     my ($rh_ans, %options) = @_;
3481 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
3482 :     if ($PG_eval_errors) {
3483 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
3484 :     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
3485 :     # return $rh_ans;
3486 :     } else {
3487 :     $rh_ans->{student_ans} = prfmt($inVal,$options{format});
3488 :     }
3489 : apizer 1080
3490 : sh002i 1050 my $permitted_error;
3491 : apizer 1080
3492 : sh002i 1050 if ($rh_ans->{tolType} eq 'absolute') {
3493 :     $permitted_error = $rh_ans->{tolerance};
3494 :     }
3495 :     elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
3496 :     $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
3497 :     }
3498 :     else {
3499 :     $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
3500 :     }
3501 : apizer 1080
3502 : sh002i 1050 my $is_a_number = is_a_number($inVal);
3503 :     $rh_ans->{score} = 1 if ( ($is_a_number) and
3504 :     (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
3505 :     if (not $is_a_number) {
3506 :     $rh_ans->{error_message} = "$rh_ans->{error_message}". 'Your answer does not evaluate to a number ';
3507 :     }
3508 : apizer 1080
3509 : sh002i 1050 $rh_ans;
3510 :     }
3511 :    
3512 :     =head4 std_num_filter
3513 :    
3514 :     std_num_filter($rh_ans, %options)
3515 :     returns $rh_ans
3516 :    
3517 :     Replaces some constants using math_constants, then evaluates a perl expression.
3518 :    
3519 :    
3520 :     =cut
3521 :    
3522 :     sub std_num_filter {
3523 :     my $rh_ans = shift;
3524 :     my %options = @_;
3525 :     my $in = $rh_ans->input();
3526 :     $in = math_constants($in);
3527 :     $rh_ans->{type} = 'std_number';
3528 :     my ($inVal,$PG_eval_errors,$PG_full_error_report);
3529 :     if ($in =~ /\S/) {
3530 :     ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
3531 : apizer 1080 } else {
3532 : sh002i 1050 $PG_eval_errors = '';
3533 :     }
3534 :    
3535 : apizer 1080 if ($PG_eval_errors) { ##error message from eval or above
3536 : sh002i 1050 $rh_ans->{ans_message} = 'There is a syntax error in your answer';
3537 : gage 2061 $rh_ans->{student_ans} =
3538 :     clean_up_error_msg($PG_eval_errors);
3539 : sh002i 1050 } else {
3540 :     $rh_ans->{student_ans} = $inVal;
3541 :     }
3542 :     $rh_ans;
3543 :     }
3544 :    
3545 :     =head std_num_array_filter
3546 :    
3547 :     std_num_array_filter($rh_ans, %options)
3548 :     returns $rh_ans
3549 : apizer 1080
3550 : sh002i 1050 Assumes the {student_ans} field is a numerical array, and applies BOTH check_syntax and std_num_filter
3551 :     to each element of the array. Does it's best to generate sensible error messages for syntax errors.
3552 :     A typical error message displayed in {studnet_ans} might be ( 56, error message, -4).
3553 :    
3554 :     =cut
3555 :    
3556 : apizer 1080 sub std_num_array_filter {
3557 : sh002i 1050 my $rh_ans= shift;
3558 :     my %options = @_;
3559 :     set_default_options( \%options,
3560 : apizer 1080 '_filter_name' => 'std_num_array_filter',
3561 : sh002i 1050 );
3562 :     my @in = @{$rh_ans->{student_ans}};
3563 :     my $temp_hash = new AnswerHash;
3564 :     my @out=();
3565 :     my $PGanswerMessage = '';
3566 :     foreach my $item (@in) { # evaluate each number in the vector
3567 :     $temp_hash->input($item);
3568 :     $temp_hash = check_syntax($temp_hash);
3569 :     if (defined($temp_hash->{error_flag}) and $temp_hash->{error_flag} eq 'SYNTAX') {
3570 :     $PGanswerMessage .= $temp_hash->{ans_message};
3571 :     $temp_hash->{ans_message} = undef;
3572 :     } else {
3573 :     #continue processing
3574 :     $temp_hash = std_num_filter($temp_hash);
3575 :     if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) {
3576 :     $PGanswerMessage .= $temp_hash->{ans_message};
3577 :     $temp_hash->{ans_message} = undef;
3578 : apizer 1080 }
3579 : sh002i 1050 }
3580 :     push(@out, $temp_hash->input());
3581 : apizer 1080
3582 : sh002i 1050 }
3583 :     if ($PGanswerMessage) {
3584 :     $rh_ans->input( "( " . join(", ", @out ) . " )" );
3585 :     $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
3586 :     } else {
3587 :     $rh_ans->input( [@out] );
3588 :     }
3589 :     $rh_ans;
3590 :     }
3591 :    
3592 :     =head4 function_from_string2
3593 :    
3594 :    
3595 :    
3596 :     =cut
3597 :    
3598 :     sub function_from_string2 {
3599 :     my $rh_ans = shift;
3600 :     my %options = @_;
3601 :     assign_option_aliases(\%options,
3602 :     'vars' => 'ra_vars',
3603 :     'var' => 'ra_vars',
3604 : gage 2056 'store_in' => 'stdout',
3605 : sh002i 1050 );
3606 :     set_default_options( \%options,
3607 : gage 2056 'stdin' => 'student_ans',
3608 :     'stdout' => 'rf_student_ans',
3609 : sh002i 1050 'ra_vars' => [qw( x y )],
3610 :     'debug' => 0,
3611 : apizer 1080 '_filter_name' => 'function_from_string2',
3612 : sh002i 1050 );
3613 : gage 2056 # initialize
3614 : sh002i 1050 $rh_ans->{_filter_name} = $options{_filter_name};
3615 : gage 2056
3616 : gage 2061 my $eqn = $rh_ans->{ $options{stdin} };
3617 :     my @VARS = @{ $options{ 'ra_vars'} };
3618 : sh002i 1050 #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
3619 :     my $originalEqn = $eqn;
3620 : gage 2061 $eqn = &math_constants($eqn);
3621 : sh002i 1050 for( my $i = 0; $i < @VARS; $i++ ) {
3622 :     # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1
3623 :     my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"');
3624 : gage 2056 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
3625 : sh002i 1050 $eqn =~ s/\b$temp\b/\$VARS[$i]/g;
3626 :    
3627 :     }
3628 :     #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
3629 : apizer 1080 # pretty_print(\%options)
3630 : sh002i 1050 # if defined($options{debug}) and $options{debug} ==1;
3631 :     my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q!
3632 :     sub {
3633 :     my @VARS = @_;
3634 : apizer 1080 my $input_str = '';
3635 : sh002i 1050 for( my $i=0; $i<@VARS; $i++ ) {
3636 :     $input_str .= "\$VARS[$i] = $VARS[$i]; ";
3637 :     }
3638 :     my $PGanswerMessage;
3639 : apizer 1080 $input_str .= '! . $eqn . q!'; # need the single quotes to keep the contents of $eqn from being
3640 : sh002i 1050 # evaluated when it is assigned to $input_str;
3641 :     my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated
3642 : apizer 1080
3643 : sh002i 1050 if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) {
3644 : apizer 1080 $PGanswerMessage = clean_up_error_msg($PG_eval_errors);
3645 : sh002i 1050 # This message seemed too verbose, but it does give extra information, we'll see if it is needed.
3646 :     # "<br> There was an error in evaluating your function <br>
3647 : apizer 1080 # !. $originalEqn . q! <br>
3648 : sh002i 1050 # at ( " . join(', ', @VARS) . " ) <br>
3649 :     # $PG_eval_errors
3650 :     # "; # this message appears in the answer section which is not process by Latex2HTML so it must
3651 :     # # be in HTML. That is why $BR is NOT used.
3652 : apizer 1080
3653 :     }
3654 : sh002i 1050 (wantarray) ? ($out, $PGanswerMessage): $out; # PGanswerMessage may be undefined.
3655 :     };
3656 :     !);
3657 :    
3658 :     if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) {
3659 :     $PG_eval_errors = clean_up_error_msg($PG_eval_errors);
3660 : apizer 1080
3661 :     my $PGanswerMessage = "There was an error in converting the expression
3662 : gage 1250 $BR $originalEqn $BR into a function.
3663 :     $BR $PG_eval_errors.";
3664 : sh002i 1050 $rh_ans->{rf_student_ans} = $function_sub;
3665 :     $rh_ans->{ans_message} = $PGanswerMessage;
3666 :     $rh_ans->{error_message} = $PGanswerMessage;
3667 :     $rh_ans->{error_flag} = 1;
3668 :     # we couldn't compile the equation, we'll return an error message.
3669 :     } else {
3670 : gage 2056 # if (defined($options{stdout} )) {
3671 :     # $rh_ans ->{$options{stdout}} = $function_sub;
3672 : sh002i 1050 # } else {
3673 :     # $rh_ans->{rf_student_ans} = $function_sub;
3674 :     # }
3675 : gage 2056 $rh_ans ->{$options{stdout}} = $function_sub;
3676 : sh002i 1050 }
3677 : apizer 1080
3678 :     $rh_ans;
3679 : sh002i 1050 }
3680 :    
3681 :     =head4 is_zero_array
3682 :    
3683 :    
3684 :     =cut
3685 :    
3686 :    
3687 :     sub is_zero_array {
3688 :     my $rh_ans = shift;
3689 :     my %options = @_;
3690 :     set_default_options( \%options,
3691 : apizer 1080 '_filter_name' => 'is_zero_array',
3692 : gage 2056 'tolerance' => 0.000001,
3693 : gage 2061 'stdin' => 'ra_differences',
3694 :     'stdout' => 'score',
3695 : sh002i 1050 );
3696 : gage 2056 #intialize
3697 :     $rh_ans->{_filter_name} = $options{_filter_name};
3698 :    
3699 : gage 2061 my $array = $rh_ans -> {$options{stdin}}; # default ra_differences
3700 : sh002i 1050 my $num = @$array;
3701 :     my $i;
3702 :     my $max = 0; my $mm;
3703 :     for ($i=0; $i< $num; $i++) {
3704 :     $mm = $array->[$i] ;
3705 :     if (not is_a_number($mm) ) {
3706 :     $max = $mm; # break out if one of the elements is not a number
3707 :     last;
3708 :     }
3709 :     $max = abs($mm) if abs($mm) > $max;
3710 :     }
3711 :     if (not is_a_number($max)) {
3712 :     $rh_ans->{score} = 0;
3713 : apizer 1080 my $error = "WeBWorK was unable evaluate your function. Please check that your
3714 : sh002i 1050 expression doesn't take roots of negative numbers, or divide by zero.";
3715 :     $rh_ans->throw_error('EVAL',$error);
3716 :     } else {
3717 : gage 2061 $rh_ans->{$options{stdout}} = ($max < $options{tolerance} ) ? 1: 0; # set 'score' to 1 if the array is close to 0;
3718 : sh002i 1050 }
3719 :     $rh_ans;
3720 :     }
3721 :    
3722 :     =head4 best_approx_parameters
3723 :    
3724 :     best_approx_parameters($rh_ans,%options); #requires the following fields in $rh_ans
3725 :     {rf_student_ans} # reference to the test answer
3726 : apizer 1080 {rf_correct_ans} # reference to the comparison answer
3727 : sh002i 1050 {evaluation_points}, # an array of row vectors indicating the points
3728 :     # to evaluate when comparing the functions
3729 : apizer 1080
3730 : sh002i 1050 %options # debug => 1 gives more error answers
3731 :     # param_vars => [''] additional parameters used to adapt to function
3732 :     )
3733 :    
3734 :    
3735 :     The parameters for the comparison function which best approximates the test_function are stored
3736 : apizer 1080 in the field {ra_parameters}.
3737 : sh002i 1050
3738 :    
3739 :     The last $dim_of_parms_space variables are assumed to be parameters, and it is also
3740 :     assumed that the function \&comparison_fun
3741 : apizer 1080 depends linearly on these variables. This function finds the values for these parameters which minimizes the
3742 : sh002i 1050 Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified
3743 :     by the array reference \@rows_of_test_points. This is assumed to be an array of arrays, with the inner arrays
3744 : apizer 1080 determining a test point.
3745 : sh002i 1050
3746 :     The comparison function should have $dim_of_params_space more input variables than the test function.
3747 :    
3748 :    
3749 :    
3750 :    
3751 : apizer 1080
3752 : sh002i 1050 =cut
3753 :    
3754 :     # Used internally:
3755 : apizer 1080 #
3756 : sh002i 1050 # &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function
3757 :     # $ra_variables # an array of the active input variables to the functions
3758 : apizer 1080 # $dim_of_params_space # indicates the number of parameters upon which the
3759 : sh002i 1050 # # the comparison function depends linearly. These are assumed to
3760 :     # # be the last group of inputs to the comparison function.
3761 : apizer 1080 #
3762 : sh002i 1050 # %options # $options{debug} gives more error messages
3763 : apizer 1080 #
3764 :     # # A typical function might look like
3765 : sh002i 1050 # # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter
3766 :     # # space of dimension 2 and a variable space of dimension 3.
3767 :     # )
3768 :     # # returns a list of coefficients
3769 : apizer 1080
3770 : sh002i 1050 sub best_approx_parameters {
3771 :     my $rh_ans = shift;
3772 :     my %options = @_;
3773 :     set_default_options(\%options,
3774 :     '_filter_name' => 'best_approx_paramters',
3775 :     'allow_unknown_options' => 1,
3776 :     );
3777 :     my $errors = undef;
3778 :     # This subroutine for the determining the coefficents of the parameters at a given point
3779 :     # is pretty specialized, so it is included here as a sub-subroutine.
3780 :     my $determine_param_coeffs = sub {
3781 :     my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_;
3782 :     my @zero_params=();
3783 :     for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); }
3784 :     my @vars = @$ra_variables;
3785 :     my @coeff = ();
3786 :     my @inputs = (@vars,@zero_params);
3787 :     my ($f0, $f1, $err);
3788 :     ($f0, $err) = &{$rf_fun}(@inputs);
3789 :     if (defined($err) ) {
3790 :     $errors .= "$err ";
3791 :     } else {
3792 :     for (my $i=@vars;$i<@inputs;$i++) {
3793 :     $inputs[$i]=1; # set one parameter to 1;
3794 :     my($f1,$err) = &$rf_fun(@inputs);
3795 :     if (defined($err) ) {
3796 :     $errors .= " $err ";
3797 :     } else {
3798 :     push(@coeff, $f1-$f0);
3799 :     }
3800 :     $inputs[$i]=0; # set it back
3801 :     }
3802 :     }
3803 :     (\@coeff, $errors);
3804 :     };
3805 :     my $rf_fun = $rh_ans->{rf_student_ans};
3806 :     my $rf_correct_fun = $rh_ans->{rf_correct_ans};
3807 :     my $ra_vars_matrix = $rh_ans->{evaluation_points};
3808 :     my $dim_of_param_space = @{$options{param_vars}};
3809 :     # Short cut. Bail if there are no param_vars
3810 :     unless ($dim_of_param_space >0) {
3811 :     $rh_ans ->{ra_parameters} = [];
3812 :     return $rh_ans;
3813 :     }
3814 :     # inputs are row arrays in this case.
3815 :     my @zero_params=();
3816 : apizer 1080
3817 : sh002i 1050 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); }
3818 :     my @rows_of_vars = @$ra_vars_matrix;
3819 :     warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug};
3820 :     my $rows = @rows_of_vars;
3821 :     my $matrix =new Matrix($rows,$dim_of_param_space);
3822 :     my $rhs_vec = new Matrix($rows, 1);
3823 :     my $row_num = 1;
3824 :     my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars);
3825 :     my $number_of_data_points = $dim_of_param_space +2;
3826 :     while (@rows_of_vars and $row_num <= $number_of_data_points) {
3827 :     # get one set of data points from the test function;
3828 : apizer 1080 @vars = @{ shift(@rows_of_vars) };
3829 : sh002i 1050 ($val2, $err1) = &{$rf_fun}(@vars);
3830 :     $errors .= " $err1 " if defined($err1);
3831 :     @inputs = (@vars,@zero_params);
3832 :     ($val1, $err2) = &{$rf_correct_fun}(@inputs);
3833 :     $errors .= " $err2 " if defined($err2);
3834 : apizer 1080
3835 : sh002i 1050 unless (defined($err1) or defined($err2) ) {
3836 :     $rhs_vec->assign($row_num,1, $val2-$val1 );
3837 : apizer 1080
3838 : sh002i 1050 # warn "rhs data val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug};
3839 :     # warn "vars ", join(" | ", @vars) if $options{debug};
3840 : apizer 1080
3841 : sh002i 1050 ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options);
3842 :     if (defined($err1) ) {
3843 :     $errors .= " $err1 ";
3844 :     } else {
3845 :     my @coeff = @$ra_coeff;
3846 :     my $col_num=1;
3847 :     while(@coeff) {
3848 :     $matrix->assign($row_num,$col_num, shift(@coeff) );
3849 :     $col_num++;
3850 :     }
3851 :     }
3852 :     }
3853 :     $row_num++;
3854 : apizer 1080 last if $errors; # break if there are any errors.
3855 : sh002i 1050 # This cuts down on the size of error messages.
3856 :     # However it impossible to check for equivalence at 95% of points
3857 :     # which might be useful for functions that are not defined at some points.
3858 : apizer 1080 }
3859 : sh002i 1050 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug};
3860 :     warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug};
3861 : apizer 1080
3862 : sh002i 1050 # we have Matrix * parameter = data_vec + perpendicular vector
3863 :     # where the matrix has column vectors defining the span of the parameter space
3864 :     # multiply both sides by Matrix_transpose and solve for the parameters
3865 :     # This is exactly what the method proj_coeff method does.
3866 :     my @array;
3867 :     if (defined($errors) ) {
3868 :     @array = (); # new Matrix($dim_of_param_space,1);
3869 :     } else {
3870 :     @array = $matrix->proj_coeff($rhs_vec)->list();
3871 :     }
3872 :     # check size (hack)
3873 :     my $max = 0;
3874 :     foreach my $val (@array ) {
3875 :     $max = abs($val) if $max < abs($val);
3876 :     if (not is_a_number($val) ) {
3877 :     $max = "NaN: $val";
3878 :     last;
3879 :     }
3880 :     }
3881 :     if ($max =~/NaN/) {
3882 : apizer 1080 $errors .= "WeBWorK was unable evaluate your function. Please check that your
3883 : sh002i 1050 expression doesn't take roots of negative numbers, or divide by zero.";
3884 :     } elsif ($max > $options{maxConstantOfIntegration} ) {
3885 : apizer 1080 $errors .= "At least one of the adapting parameters
3886 :     (perhaps the constant of integration) is too large: $max,
3887 :     ( the maximum allowed is $options{maxConstantOfIntegration} )";
3888 : sh002i 1050 }
3889 : apizer 1080
3890 : sh002i 1050 $rh_ans->{ra_parameters} = \@array;
3891 :     $rh_ans->throw_error('EVAL', $errors) if defined($errors);
3892 :     $rh_ans;
3893 :     }
3894 :    
3895 :     =head4 calculate_difference_vector
3896 :    
3897 :     calculate_difference_vector( $ans_hash, %options);
3898 : apizer 1080
3899 : sh002i 1050 {rf_student_ans}, # a reference to the test function
3900 :     {rf_correct_ans}, # a reference to the correct answer function
3901 :     {evaluation_points}, # an array of row vectors indicating the points
3902 :     # to evaluate when comparing the functions
3903 : apizer 1080 {ra_parameters} # these are the (optional) additional inputs to
3904 :     # the comparison function which adapt it properly
3905 : sh002i 1050 # to the problem at hand.
3906 : apizer 1080
3907 :     %options # mode => 'rel' specifies that each element in the
3908 : sh002i 1050 # difference matrix is divided by the correct answer.
3909 :     # unless the correct answer is nearly 0.
3910 : apizer 1080 )
3911 : sh002i 1050
3912 :     =cut
3913 :    
3914 :     sub calculate_difference_vector {
3915 :     my $rh_ans = shift;
3916 :     my %options = @_;
3917 : gage 2061 assign_option_aliases( \%options,
3918 :     );
3919 :     set_default_options( \%options,
3920 :     allow_unknown_options => 1,
3921 :     stdin1 => 'rf_student_ans',
3922 :     stdin2 => 'rf_correct_ans',
3923 :     stdout => 'ra_differences',
3924 :     debug => 0,
3925 :     tolType => 'absolute',
3926 :     error_msg_flag => 1,
3927 :     );
3928 : sh002i 1050 # initialize
3929 : gage 2061 $rh_ans->{_filter_name} = 'calculate_difference_vector';
3930 :     my $rf_fun = $rh_ans -> {$options{stdin1}}; # rf_student_ans by default
3931 :     my $rf_correct_fun = $rh_ans -> {$options{stdin2}}; # rf_correct_ans by default
3932 :     my $ra_parameters = $rh_ans -> {ra_parameters};
3933 :     my @evaluation_points = @{$rh_ans->{evaluation_points} };
3934 :     my @parameters = ();
3935 :     @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY';
3936 :     my $errors = undef;
3937 :     my @zero_params = ();
3938 :     for (my $i=1;$i<=@{$ra_parameters};$i++) {
3939 :     push(@zero_params,0);
3940 :     }
3941 :     my @differences = ();
3942 : sh002i 1050 my @student_values;
3943 :     my @adjusted_student_values;
3944 :     my @instructorVals;
3945 :     my ($diff,$instructorVal);
3946 :     # calculate the vector of differences between the test function and the comparison function.
3947 :     while (@evaluation_points) {
3948 :     my ($err1, $err2,$err3);
3949 :     my @vars = @{ shift(@evaluation_points) };
3950 :     my @inputs = (@vars, @parameters);
3951 :     my ($inVal, $correctVal);
3952 :     ($inVal, $err1) = &{$rf_fun}(@vars);
3953 :     $errors .= " $err1 " if defined($err1);
3954 : jj 2243 $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if defined($options{debug}) and $options{debug}==1 and defined($err1);
3955 : sh002i 1050 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs);
3956 :     $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2);
3957 :     $errors .= " Error detected evaluating correct adapted answer at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2);
3958 :     ($instructorVal,$err3)= &$rf_correct_fun(@vars, @zero_params);
3959 :     $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
3960 :     $errors .= " Error detected evaluating instructor answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3);
3961 :     unless (defined($err1) or defined($err2) or defined($err3) ) {
3962 :     $diff = ( $inVal - ($correctVal -$instructorVal ) ) - $instructorVal; #prevents entering too high a number?
3963 :     #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
3964 : gage 2061 if ( $options{tolType} eq 'relative' ) { #relative tolerance
3965 : sh002i 1050 #warn "diff = $diff";
3966 :     #$diff = ( $inVal - ($correctVal-$instructorVal ) )/abs($instructorVal) -1 if abs($instructorVal) > $options{zeroLevel};
3967 :     $diff = ( $inVal - ($correctVal-$instructorVal ) )/$instructorVal -1 if abs($instructorVal) > $options{zeroLevel};
3968 :     #$diff = ( $inVal - ($correctVal-$instructorVal- $instructorVal ) )/abs($instructorVal) if abs($instructorVal) > $options{zeroLevel};
3969 :     #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
3970 :     }
3971 :     }
3972 : apizer 1080 last if $errors; # break if there are any errors.
3973 : sh002i 1050 # This cuts down on the size of error messages.
3974 :     # However it impossible to check for equivalence at 95% of points
3975 :     # which might be useful for functions that are not defined at some points.
3976 :     push(@student_values,$inVal);
3977 : apizer 1080 push(@adjusted_student_values,( $inVal - ($correctVal -$instructorVal) ) );
3978 :     push(@differences, $diff);
3979 :     push(@instructorVals,$instructorVal);
3980 : sh002i 1050 }
3981 : gage 3039 if (( not defined($errors) ) or $errors eq '' or $options{error_msg_flag} ) {
3982 : gage 2061 $rh_ans ->{$options{stdout}} = \@differences;
3983 :     $rh_ans ->{ra_student_values} = \@student_values;
3984 :     $rh_ans ->{ra_adjusted_student_values} = \@adjusted_student_values;
3985 :     $rh_ans->{ra_instructor_values}=\@instructorVals;
3986 :     $rh_ans->throw_error('EVAL', $errors) if defined($errors);
3987 :     } else {
3988 :    
3989 :     } # no output if error_msg_flag is set to 0.
3990 :    
3991 : sh002i 1050 $rh_ans;
3992 :     }
3993 :    
3994 :     =head4 fix_answer_for_display
3995 :    
3996 :     =cut
3997 :    
3998 :     sub fix_answers_for_display {
3999 :     my ($rh_ans, %options) = @_;
4000 :     if ( $rh_ans->{answerIsString} ==1) {
4001 :     $rh_ans = evaluatesToNumber ($rh_ans, %options);
4002 :     }
4003 :     if (defined ($rh_ans->{student_units})) {
4004 :     $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units};
4005 : gage 1812
4006 : sh002i 1050 }
4007 : gage 1812 if ( $rh_ans->catch_error('UNITS') ) { # create preview latex string for expressions even if the units are incorrect
4008 :     my $rh_temp = new AnswerHash;
4009 :     $rh_temp->{student_ans} = $rh_ans->{student_ans};
4010 :     $rh_temp = check_syntax($rh_temp);
4011 :     $rh_ans->{preview_latex_string} = $rh_temp->{preview_latex_string};
4012 :     }
4013 : sh002i 1050 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
4014 : apizer 1080
4015 : sh002i 1050 $rh_ans;
4016 :     }
4017 :    
4018 :     =head4 evaluatesToNumber
4019 :    
4020 :     =cut
4021 :    
4022 :     sub evaluatesToNumber {
4023 :     my ($rh_ans, %options) = @_;
4024 :     if (is_a_numeric_expression($rh_ans->{student_ans})) {
4025 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
4026 :     if ($PG_eval_errors) { # this if statement should never be run
4027 :     # change nothing
4028 :     } else {
4029 :     # change this
4030 :     $rh_ans->{student_ans} = prfmt($inVal,$options{format});
4031 :     }
4032 :     }
4033 :     $rh_ans;
4034 :     }
4035 :    
4036 :     =head4 is_numeric_expression
4037 :    
4038 :     =cut
4039 :    
4040 :     sub is_a_numeric_expression {
4041 :     my $testString = shift;
4042 :     my $is_a_numeric_expression = 0;
4043 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString);
4044 :     if ($PG_eval_errors) {
4045 :     $is_a_numeric_expression = 0;
4046 :     } else {
4047 :     $is_a_numeric_expression = 1;
4048 :     }
4049 :     $is_a_numeric_expression;
4050 :     }
4051 :    
4052 :     =head4 is_a_number
4053 :    
4054 :     =cut
4055 :    
4056 :     sub is_a_number {
4057 :     my ($num,%options) = @_;
4058 :     my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
4059 :     my ($rh_ans);
4060 :     if ($process_ans_hash) {
4061 :     $rh_ans = $num;
4062 :     $num = $rh_ans->{student_ans};
4063 :     }
4064 : apizer 1080
4065 : sh002i 1050 my $is_a_number = 0;
4066 :     return $is_a_number unless defined($num);
4067 :     $num =~ s/^\s*//; ## remove initial spaces
4068 :     $num =~ s/\s*$//; ## remove trailing spaces
4069 :    
4070 :     ## the following is copied from the online perl manual
4071 :     if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
4072 :     $is_a_number = 1;
4073 :     }
4074 : apizer 1080
4075 : sh002i 1050 if ($process_ans_hash) {
4076 :     if ($is_a_number == 1 ) {
4077 :     $rh_ans->{student_ans}=$num;
4078 :     return $rh_ans;
4079 :     } else {
4080 :     $rh_ans->{student_ans} = "Incorrect number format: You must enter a number, e.g. -6, 5.3, or 6.12E-3";
4081 :     $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
4082 :     return $rh_ans;
4083 :     }
4084 :     } else {
4085 :     return $is_a_number;
4086 :     }
4087 :     }
4088 :    
4089 :     =head4 is_a_fraction
4090 :    
4091 :     =cut
4092 :    
4093 :     sub is_a_fraction {
4094 :     my ($num,%options) = @_;
4095 :     my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
4096 :     my ($rh_ans);
4097 :     if ($process_ans_hash) {
4098 :     $rh_ans = $num;
4099 :     $num = $rh_ans->{student_ans};
4100 :     }
4101 : apizer 1080
4102 : sh002i 1050 my $is_a_fraction = 0;
4103 :     return $is_a_fraction unless defined($num);
4104 :     $num =~ s/^\s*//; ## remove initial spaces
4105 :     $num =~ s/\s*$//; ## remove trailing spaces
4106 : apizer 1080
4107 : sh002i 1050 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
4108 :     $is_a_fraction = 1;
4109 :     }
4110 : apizer 1080
4111 : sh002i 1050 if ($process_ans_hash) {
4112 :     if ($is_a_fraction == 1 ) {
4113 :     $rh_ans->{student_ans}=$num;
4114 :     return $rh_ans;
4115 :     } else {
4116 :     $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
4117 :     $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
4118 :     return $rh_ans;
4119 :     }
4120 : apizer 1080
4121 : sh002i 1050 } else {
4122 :     return $is_a_fraction;
4123 :     }
4124 :     }
4125 :    
4126 :     =head4 phase_pi
4127 :     I often discovered that the answers I was getting, when using the arctan function would be off by phases of
4128 :     pi, which for the tangent function, were equivalent values. This method allows for this.
4129 :     =cut
4130 :    
4131 :     sub phase_pi {
4132 :     my ($num,%options) = @_;
4133 :     my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
4134 :     my ($rh_ans);
4135 :     if ($process_ans_hash) {
4136 :     $rh_ans = $num;
4137 :     $num = $rh_ans->{correct_ans};
4138 :     }
4139 :     while( ($rh_ans->{correct_ans}) > 3.14159265358979/2 ){
4140 :     $rh_ans->{correct_ans} -= 3.14159265358979;
4141 :     }
4142 :     while( ($rh_ans->{correct_ans}) <= -3.14159265358979/2 ){
4143 :     $rh_ans->{correct_ans} += 3.14159265358979;
4144 :     }
4145 :     $rh_ans;
4146 :     }
4147 :    
4148 :     =head4 is_an_arithemetic_expression
4149 :    
4150 :     =cut
4151 :    
4152 :     sub is_an_arithmetic_expression {
4153 :     my ($num,%options) = @_;
4154 :     my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
4155 :     my ($rh_ans);
4156 :     if ($process_ans_hash) {
4157 :     $rh_ans = $num;
4158 :     $num = $rh_ans->{student_ans};
4159 :     }
4160 : apizer 1080
4161 : sh002i 1050 my $is_an_arithmetic_expression = 0;
4162 :     return $is_an_arithmetic_expression unless defined($num);
4163 :     $num =~ s/^\s*//; ## remove initial spaces
4164 :     $num =~ s/\s*$//; ## remove trailing spaces
4165 : apizer 1080
4166 : sh002i 1050 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
4167 :     $is_an_arithmetic_expression = 1;
4168 :     }
4169 : apizer 1080
4170 : sh002i 1050 if ($process_ans_hash) {
4171 :     if ($is_an_arithmetic_expression == 1 ) {
4172 :     $rh_ans->{student_ans}=$num;
4173 :     return $rh_ans;
4174 :     } else {
4175 : apizer 1080
4176 : sh002i 1050 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
4177 :     $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
4178 :     return $rh_ans;
4179 :     }
4180 : apizer 1080
4181 : sh002i 1050 } else {
4182 :     return $is_an_arithmetic_expression;
4183 :     }
4184 :     }
4185 :    
4186 :     #
4187 :    
4188 :     =head4 math_constants
4189 :    
4190 :     replaces pi, e, and ^ with their Perl equivalents
4191 :     if useBaseTenLog is non-zero, convert log to logten
4192 :    
4193 :     =cut
4194 :    
4195 :     sub math_constants {
4196 :     my($in,%options) = @_;
4197 :     my $rh_ans;
4198 :     my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
4199 :     if ($process_ans_hash) {
4200 :     $rh_ans = $in;
4201 :     $in = $rh_ans->{student_ans};
4202 : apizer 1080 }
4203 : sh002i 1050 # The code fragment above allows this filter to be used when the input is simply a string
4204 :     # as well as when the input is an AnswerHash, and options.
4205 :     $in =~s/\bpi\b/(4*atan2(1,1))/ge;
4206 :     $in =~s/\be\b/(exp(1))/ge;
4207 :     $in =~s/\^/**/g;
4208 : jj 1932 if($useBaseTenLog) {
4209 : sh002i 1050 $in =~ s/\blog\b/logten/g;
4210 :     }
4211 : apizer 1080
4212 : sh002i 1050 if ($process_ans_hash) {
4213 :     $rh_ans->{student_ans}=$in;
4214 :     return $rh_ans;
4215 :     } else {
4216 :     return $in;
4217 :     }
4218 :     }
4219 :    
4220 :    
4221 :    
4222 :     =head4 is_array
4223 :    
4224 :     is_array($rh_ans)
4225 :     returns: $rh_ans. Throws error "NOTARRAY" if this is not an array
4226 :    
4227 :     =cut
4228 :    
4229 :     sub is_array {
4230 :     my $rh_ans = shift;
4231 :     # return if the result is an array
4232 :     return($rh_ans) if ref($rh_ans->{student_ans}) eq 'ARRAY' ;
4233 :     $rh_ans->throw_error("NOTARRAY","The answer is not an array");
4234 :     $rh_ans;
4235 :     }
4236 :    
4237 :     =head4 check_syntax
4238 :    
4239 :     check_syntax( $rh_ans, %options)
4240 : apizer 1080 returns an answer hash.
4241 : sh002i 1050
4242 :     latex2html preview code are installed in the answer hash.
4243 :     The input has been transformed, changing 7pi to 7*pi or 7x to 7*x.
4244 :     Syntax error messages may be generated and stored in student_ans
4245 :     Additional syntax error messages are stored in {ans_message} and duplicated in {error_message}
4246 :    
4247 :    
4248 :     =cut
4249 :    
4250 :     sub check_syntax {
4251 :     my $rh_ans = shift;
4252 :     my %options = @_;
4253 : gage 2056 assign_option_aliases(\%options,
4254 :     );
4255 :     set_default_options( \%options,
4256 :     'stdin' => 'student_ans',
4257 :     'stdout' => 'student_ans',
4258 :     'ra_vars' => [qw( x y )],
4259 :     'debug' => 0,
4260 :     '_filter_name' => 'check_syntax',
4261 : gage 2061 error_msg_flag => 1,
4262 : gage 2056 );
4263 :     #initialize
4264 :     $rh_ans->{_filter_name} = $options{_filter_name};
4265 :     unless ( defined( $rh_ans->{$options{stdin}} ) ) {
4266 :     warn "Check_syntax requires an equation in the field '$options{stdin}' or input";
4267 :     $rh_ans->throw_error("1","'$options{stdin}' field not defined");
4268 : sh002i 1050 return $rh_ans;
4269 :     }
4270 : gage 2056 my $in = $rh_ans->{$options{stdin}};
4271 : sh002i 1050 my $parser = new AlgParserWithImplicitExpand;
4272 : gage 2056 my $ret = $parser -> parse($in); #for use with loops
4273 : apizer 1080
4274 : sh002i 1050 if ( ref($ret) ) { ## parsed successfully
4275 : gage 2061 # $parser -> tostring(); # FIXME? was this needed for some reason?????
4276 : sh002i 1050 $parser -> normalize();
4277 : gage 2061 $rh_ans -> {$options{stdout}} = $parser -> tostring();
4278 :     $rh_ans -> {preview_text_string} = $in;
4279 : gage 2056 $rh_ans -> {preview_latex_string} = $parser -> tolatex();
4280 : sh002i 1050
4281 : gage 2061 } elsif ($options{error_msg_flag} ) { ## error in parsing
4282 : apizer 1080
4283 : gage 2056 $rh_ans->{$options{stdout}} = 'syntax error:'. $parser->{htmlerror},
4284 : sh002i 1050 $rh_ans->{'ans_message'} = $parser -> {error_msg},
4285 :     $rh_ans->{'preview_text_string'} = '',
4286 :     $rh_ans->{'preview_latex_string'} = '',
4287 : apizer 1080 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg});
4288 : gage 2061 } # no output is produced if there is an error and the error_msg_flag is set to zero
4289 : gage 2056 $rh_ans;
4290 : sh002i 1050
4291 :     }
4292 :    
4293 :     =head4 check_strings
4294 :    
4295 :     check_strings ($rh_ans, %options)
4296 :     returns $rh_ans
4297 :    
4298 :     =cut
4299 :    
4300 :     sub check_strings {
4301 :     my ($rh_ans, %options) = @_;
4302 : apizer 1080
4303 : sh002i 1050 # if the student's answer is a number, simply return the answer hash (unchanged).
4304 : apizer 1080
4305 : sh002i 1050 # we allow constructions like -INF to be treated as a string. Thus we ignore an initial
4306 :     # - in deciding whether the student's answer is a number or string
4307 :    
4308 :     my $temp_ans = $rh_ans->{student_ans};
4309 :     $temp_ans =~ s/^\s*\-//; # remove an initial -
4310 :    
4311 :     if ( $temp_ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
4312 :     # if ( $rh_ans->{answerIsString} == 1) {
4313 :     # #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
4314 :     # }
4315 : apizer 1080 return $rh_ans;
4316 : sh002i 1050 }
4317 :     # the student's answer is recognized as a string
4318 :     my $ans = $rh_ans->{student_ans};
4319 :    
4320 :     # OVERVIEW of reminder of function:
4321 :     # if answer is correct, return correct. (adjust score to 1)
4322 :     # if answer is incorect:
4323 : apizer 1080 # 1) determine if the answer is sensible. if it is, return incorrect.
4324 : sh002i 1050 # 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
4325 :     # no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
4326 :     # last: 'STRING' post_filter will clear the error (avoiding pink screen.)
4327 :    
4328 :     my $sensibleAnswer = 0;
4329 :     $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
4330 :     my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
4331 : dpvc 3615 my $temp_ans_hash = $ans_eval->evaluate($ans);
4332 : sh002i 1050 $rh_ans->{test} = $temp_ans_hash;
4333 : gage 1506
4334 : sh002i 1050 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
4335 : apizer 1080 $rh_ans->{score} = 1;
4336 : sh002i 1050 $sensibleAnswer = 1;
4337 :     } else { # students answer does not match the correct answer.
4338 :     my $legalString = ''; # find out if string makes sense
4339 :     my @legalStrings = @{$options{strings}};
4340 :     foreach $legalString (@legalStrings) {
4341 :     if ( uc($ans) eq uc($legalString) ) {
4342 :     $sensibleAnswer = 1;
4343 :     last;
4344 :     }
4345 :     }
4346 :