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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9