[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 1451 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9