Annotation of /trunk/webwork/system/courseScripts/PGanswermacros.pl

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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9