Parent Directory
| 
Revision Log
Modified num_cmp to use filters for string comparsions. Routed std_num_str_cmp through num_cmp routines.
1 #!/usr/local/bin/webwork-perl 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 #$Id$ 11 12 =head1 NAME 13 14 PGanswermacros.pl -- located in the courseScripts directory 15 16 =head1 SYNPOSIS 17 18 Number Answer Evaluators: 19 num_cmp() -- uses an input hash to determine parameters 20 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 2*sin(3*x). 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 113 114 115 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 150 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 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 = PG_restricted_eval(q{$main::numRelPercentTolDefault}); 164 $numZeroLevelDefault = PG_restricted_eval(q{$main::numZeroLevelDefault}); 165 $numZeroLevelTolDefault = PG_restricted_eval(q{$main::numZeroLevelTolDefault}); 166 $numAbsTolDefault = PG_restricted_eval(q{$main::numAbsTolDefault}); 167 $numFormatDefault = PG_restricted_eval(q{$main::numFormatDefault}); 168 169 $functRelPercentTolDefault = PG_restricted_eval(q{$main::functRelPercentTolDefault}); 170 $functZeroLevelDefault = PG_restricted_eval(q{$main::functZeroLevelDefault}); 171 $functZeroLevelTolDefault = PG_restricted_eval(q{$main::functZeroLevelTolDefault}); 172 $functAbsTolDefault = PG_restricted_eval(q{$main::functAbsTolDefault}); 173 $functNumOfPoints = PG_restricted_eval(q{$main::functNumOfPoints}); 174 $functVarDefault = PG_restricted_eval(q{$main::functVarDefault}); 175 $functLLimitDefault = PG_restricted_eval(q{$main::functLLimitDefault}); 176 $functULimitDefault = PG_restricted_eval(q{$main::functULimitDefault}); 177 $functMaxConstantOfIntegration = PG_restricted_eval(q{$main::functMaxConstantOfIntegration}); 178 179 180 181 } 182 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(.01*relpercentTol*correctAnswer) 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 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 383 384 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 } 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 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 } 429 430 sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance 431 my ( $correctAnswer, $absTol, $format) = @_; 432 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 445 num_cmp([$correctAnswer], %options); 446 } 447 448 ## See std_num_cmp_list for usage 449 450 sub std_num_cmp_abs_list { 451 my ( $absTol, $format, @answerList ) = @_; 452 453 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 } 470 471 sub frac_num_cmp { # only allow fractions and numbers as submitted answer 472 473 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 } 494 495 ## See std_num_cmp_list for usage 496 sub frac_num_cmp_list { 497 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 } 517 518 519 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 538 } 539 540 ## See std_num_cmp_list for usage 541 sub frac_num_cmp_abs_list { 542 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 } 560 561 562 sub arith_num_cmp { # only allow arithmetic expressions as submitted answer 563 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 583 num_cmp([$correctAnswer], %options); 584 } 585 586 ## See std_num_cmp_list for usage 587 sub arith_num_cmp_list { 588 my ( $relPercentTol, $format, @answerList ) = @_; 589 590 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 } 606 607 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 625 626 } 627 628 ## See std_num_cmp_list for usage 629 sub arith_num_cmp_abs_list { 630 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 } 648 649 sub strict_num_cmp { # only allow numbers as submitted answer 650 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 672 } 673 674 ## See std_num_cmp_list for usage 675 sub strict_num_cmp_list { # compare numbers 676 my ( $relPercentTol, $format, @answerList ) = @_; 677 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 693 num_cmp(\@answerList, %options); 694 } 695 696 697 sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance 698 699 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 } 718 719 ## See std_num_cmp_list for usage 720 sub strict_num_cmp_abs_list { # compare numbers 721 my ( $absTol, $format, @answerList ) = @_; 722 723 724 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 741 742 } 743 744 745 ## 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 sub check_strings { 759 my ($rh_ans, %options) = @_; 760 761 # if the student's answer is a number, simply return the answer hash (unchanged). 762 763 if ( $rh_ans->{student_ans} =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) { 764 if ( $rh_ans->{answerIsString} == 1) { 765 $rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number 766 } 767 return $rh_ans; 768 } 769 # the student's answer is recognized as a string 770 my $ans = $rh_ans->{student_ans}; 771 772 # OVERVIEW of remindar of function: 773 # if answer is correct, return correct. (adjust score to 1) 774 # if answer is incorect: 775 # 1) determine if the answer is sensible. if it is, return incorrect. 776 # 2) if the answer is not sensible (and incorrect), then return an error message indicating so. 777 # no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators) 778 # last: 'STRING' post_filter will clear the error (avoiding pink screen.) 779 780 my $sensibleAnswer = 0; 781 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces. 782 my ($ans_eval) = str_cmp($rh_ans->{correct_ans}); 783 my $temp_ans_hash = &$ans_eval($ans); 784 $rh_ans->{test} = $temp_ans_hash; 785 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer. 786 $rh_ans->{score} = 1; 787 $sensibleAnswer = 1; 788 } else { # students answer does not match the correct answer. 789 ## find out if string makes sense 790 my $legalString = ''; 791 my @legalStrings = @{$options{strings}}; 792 foreach $legalString (@legalStrings) { 793 if ( uc($ans) eq uc($legalString) ) { 794 $sensibleAnswer = 1; 795 last; 796 } 797 } 798 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 799 $rh_ans->throw_error('EVAL', "$BR Your answer is not a recognized answer") unless ($sensibleAnswer); 800 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer); 801 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) ); 802 } 803 $rh_ans->{student_ans} = $ans; 804 if ($sensibleAnswer) { 805 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string."); 806 } 807 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}"); 808 809 $rh_ans; 810 811 } 812 813 814 815 sub check_units { 816 my ($rh_ans, %options) = @_; 817 818 my %correct_units = %{$rh_ans-> {rh_correct_units}}; 819 820 my $ans = $rh_ans->{student_ans}; 821 # $ans = '' unless defined ($ans); 822 $ans = str_filters ($ans, 'trim_whitespace'); 823 my $original_student_ans = $ans; 824 825 $rh_ans->{original_student_ans} = $original_student_ans; 826 827 # it surprises me that the match below works since the first .* is greedy. 828 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/; 829 830 unless ( defined($num_answer) && $units ) { 831 # there is an error reading the input 832 if ( $ans =~ /\S/ ) { # the answer is not blank 833 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " . 834 "as a number or an arithmetic expression followed by a unit specification. " . 835 "Your answer must contain units." ); 836 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " . 837 "as a number or an arithmetic expression followed by a unit specification. " . 838 "Your answer must contain units." ); 839 } 840 841 return $rh_ans; 842 } 843 844 # we have been able to parse the answer into a numerical part and a unit part 845 846 # $num_answer = $1; #$1 and $2 from the regular expression above 847 # $units = $2; 848 849 my %units = Units::evaluate_units($units); 850 if ( defined( $units{'ERROR'} ) ) { 851 # handle error condition 852 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'}); 853 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" ); 854 return $rh_ans; 855 } 856 857 my $units_match = 1; 858 my $fund_unit; 859 foreach $fund_unit (keys %correct_units) { 860 next if $fund_unit eq 'factor'; 861 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit}; 862 } 863 864 if ( $units_match ) { 865 # units are ok. Evaluate the numerical part of the answer 866 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if 867 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor. 868 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'}); 869 $rh_ans->{student_ans} = $num_answer; 870 871 } else { 872 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' ); 873 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' ); 874 } 875 876 return $rh_ans; 877 } 878 879 880 # This mode is depricated. send input through num_cmp -- it can handle units. 881 sub numerical_compare_with_units { 882 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 883 my %options = @_; # all of the other inputs are (key value) pairs 884 885 # Prepare the correct answer 886 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' ); 887 888 # it surprises me that the match below works since the first .* is greedy. 889 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/; 890 891 $options{units} = $correct_units; 892 893 894 num_cmp($correct_num_answer, %options); 895 } 896 897 898 =head3 std_num_str_cmp() 899 900 NOTE: This function is maintained for compatibility. num_cmp() with the 901 'strings' parameter is slightly preferred. 902 903 std_num_str_cmp() is used when the correct answer could be either a number or a 904 string. For example, if you wanted the student to evaluate a function at number 905 of points, but write "Inf" or "Minf" if the function is unbounded. This routine 906 will provide error messages that do not give a hint as to whether the correct 907 answer is a string or a number. For numerical comparisons, std_num_cmp() is 908 used internally; for string comparisons, std_str_cmp() is used. 909 910 std_num_str_cmp( $correctAnswer ) OR 911 std_num_str_cmp( $correctAnswer, $ra_legalStrings ) OR 912 std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol ) OR 913 std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format ) OR 914 std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format, $zeroLevel ) OR 915 std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format, 916 $zeroLevel, $zeroLevelTol ) 917 918 $correctAnswer -- the correct answer 919 $ra_legalStrings -- a reference to an array of legal strings, e.g. ["str1", "str2"] 920 $relPercentTol -- the error tolerance as a percentage 921 $format -- the display format 922 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 923 $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero 924 925 Example: 926 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) ); 927 928 =cut 929 930 sub std_num_str_cmp { 931 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 932 # warn ('This method is depreciated. Use num_cmp instead.'); 933 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format, 934 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol); 935 } 936 937 #sub old_std_num_str_cmp { 938 # my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 939 # 940 # $ra_legalStrings = [''] unless defined $ra_legalStrings; 941 # my @legalStrings = @{$ra_legalStrings}; 942 # 943 # my $ans_evaluator = sub { 944 # 945 # my $ans = shift; 946 # my $ans_hash; 947 # my $corrAnswerIsString = 0; 948 ## my $studAnswerIsString = 0; ## uses new incorrect logic 949 # my $studAnswerIsString = 1; 950 # 951 # my $legalString = ''; 952 # foreach $legalString (@legalStrings) { 953 # if ( uc($correctAnswer) eq uc($legalString) ) { 954 # $corrAnswerIsString = 1; 955 # last; 956 # } 957 # } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 958 # 959 # # Neither of these is perfect; the first is more general, but 960 # # has problems with certain special strings like "ee", while the 961 # # second doesn't support arithmetic expressions. 962 # # 963 ## if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) { 964 ## $studAnswerIsString = 1; 965 ## } 966 # #if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) { 967 # # $studAnswerIsString = 1; 968 # #} 969 # 970 # ## Both the above new versions are incorrect. We replace this by the original logic namely that 971 # ## an answer that contain any of the symbols 972 # ## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ] 973 # ## or an answer that consists of "pi" or "e" alone 974 # ## will be considered an arithmetic expression rather than a string answer. 975 # 976 # if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;} 977 # 978 # 979 # ## at this point $studAnswerIsString = 0 iff correct answer is numeric 980 # 981 # if( $studAnswerIsString ) { 982 # $ans = str_filters( $ans, 'compress_whitespace' ) 983 # } 984 # 985 # 986 # 987 # 988 # if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) { 989 # my $string_answer_evaluator = std_str_cmp( $correctAnswer ); 990 # $ans_hash = &$string_answer_evaluator( $ans ); 991 # 992 # if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense 993 # my $sensibleAnswer = 0; 994 # foreach $legalString (@legalStrings) { 995 # if ( uc($ans) eq uc($legalString) ) { 996 # $sensibleAnswer = 1; 997 # last; 998 # } 999 # } 1000 # $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 1001 # 1002 # $ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) 1003 # unless ($sensibleAnswer); 1004 # $ans_hash -> setKeys( 'student_ans' => uc($ans) ); 1005 # } 1006 # } 1007 # elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) { 1008 # my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol); 1009 # $ans_hash = &$numeric_answer_evaluator($ans); 1010 # } 1011 # elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) { 1012 # my $numeric_answer_evaluator = std_num_cmp(1); 1013 # $ans_hash = &$numeric_answer_evaluator($ans); 1014 # $ans_hash -> setKeys( 'score' => 0, 1015 # 'correct_ans' => $correctAnswer 1016 # ); 1017 # } 1018 # elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) { 1019 # my $string_answer_evaluator = std_str_cmp('bad'); 1020 # $ans_hash = &$string_answer_evaluator($ans); 1021 # 1022 # $ans_hash -> setKeys( 'score' => 0, 1023 # 'correct_ans' => $correctAnswer 1024 # ); 1025 # 1026 # ## find out if string makes sense 1027 # my $sensibleAnswer = 0; 1028 # foreach $legalString (@legalStrings) { 1029 # if ( uc($ans) eq uc($legalString) ) { 1030 # $sensibleAnswer = 1; 1031 # last; 1032 # } 1033 # } 1034 # $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 1035 # 1036 # $ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" ) 1037 # unless $sensibleAnswer; 1038 # } 1039 # 1040 # return $ans_hash; 1041 # }; 1042 # 1043 # return $ans_evaluator; 1044 #} 1045 1046 =head3 num_cmp() 1047 1048 Compares a number or a list of numbers, using a named hash of options to set 1049 parameters. This can make for more readable code than using the "mode"_num_cmp() 1050 style, but some people find one or the other easier to remember. 1051 1052 ANS( num_cmp( answer or answer_array_ref, options_hash ) ); 1053 1054 1. the correct answer, or a reference to an array of correct answers 1055 2. a hash with the following keys (all optional): 1056 mode -- 'std' (default) (allows any expression evaluating to a number) 1057 'strict' (only numbers are allowed) 1058 'frac' (fractions are allowed) 1059 'arith' (arithmetic expressions allowed) 1060 format -- '%0.5f#' (default); defines formatting for the correct answer 1061 tol -- an absolute tolerance, or 1062 relTol -- a relative tolerance 1063 units -- the units to use for the answer(s) 1064 strings -- a reference to an array of strings which are valid 1065 answers (works like std_num_str_cmp() ) 1066 zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1067 zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1068 1069 Returns an answer evaluator, or (if given a reference to an array of 1070 answers), a list of answer evaluators. Note that a reference to an array of 1071 answers results is just a shortcut to writing a separate cum_cmp() for each 1072 answer. It does not mean that any of those answers are considered correct 1073 for one question. 1074 1075 EXAMPLES: 1076 1077 num_cmp( 5 ) -- correct answer is 5, using defaults for all options 1078 num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7, using defaults for all options 1079 num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict 1080 num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6, both with 5% relative tolerance 1081 num_cmp( 6, strings => ["Inf", "Minf", "NaN"] ) -- correct answer is 6, "Inf", "Minf", and "NaN" 1082 recognized as valid answers 1083 1084 =cut 1085 1086 sub num_cmp { 1087 my $correctAnswer = shift @_; 1088 my @opt = @_; 1089 my %out_options; 1090 1091 ######################################################################### 1092 # Retain this first check for backword compatibility. Allows input of the form 1093 # num_cmp($ans, 1, '%0.5f') but warns against it 1094 ######################################################################### 1095 1096 my %known_options = ( 'mode' => 'std', 1097 'format' => $numFormatDefault, 1098 'tol' => $numAbsTolDefault, 1099 'relTol' => $numRelPercentTolDefault, 1100 'units' => undef, 1101 'strings' => undef, 1102 'zeroLevel' => $numZeroLevelDefault, 1103 'zeroLevelTol' => $numZeroLevelTolDefault, 1104 'tolType' => 'relative', 1105 'tolerance' => 1, 1106 'reltol' => undef, #alternate spelling 1107 'unit' => undef); #alternate spelling 1108 1109 my @output_list; 1110 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt; 1111 1112 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 || 1113 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) { 1114 # unless the first parameter is a list of arrays 1115 # or the second parameter is a known option or 1116 # no options were used, 1117 # use the old num_cmp which does not use options, but has inputs 1118 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol 1119 warn "This method of using num_cmp() is deprecated. Please rewrite this" . 1120 " problem using the options style of parameter passing (or" . 1121 " check that your first option is spelled correctly)."; 1122 1123 1124 %out_options = ( 'relTol' => $relPercentTol, 1125 'format' => $format, 1126 'zeroLevel' => $zeroLevel, 1127 'zeroLevelTol' => $zeroLevelTol, 1128 'mode' => 'std' 1129 ); 1130 } 1131 # else { 1132 # # handle options 1133 # 1134 # 1135 # @opt = ( 'relTol' => $relPercentTol, 1136 # 'format' => $format, 1137 # 'zeroLevel' => $numZeroLevelDefault, 1138 # 'zeroLevelTol' => $numZeroLevelTolDefault, 1139 # 'mode' => 'std' 1140 # ); 1141 # } 1142 ######################################################################### 1143 # Now handle the options assuming they are entered in the form 1144 # num_cmp($ans, relTol=>1, format=>'%0.5f') 1145 ######################################################################### 1146 %out_options = @opt; 1147 assign_option_aliases( \%out_options, 1148 'reltol' => 'relTol', 1149 'unit' => 'units', 1150 ); 1151 1152 1153 1154 1155 set_default_options( \%out_options, 1156 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative', 1157 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault, 1158 'mode' => 'std', 1159 'format' => $numFormatDefault, 1160 'tol' => $numAbsTolDefault, 1161 'relTol' => $numRelPercentTolDefault, 1162 'units' => undef, 1163 'strings' => undef, 1164 'zeroLevel' => $numZeroLevelDefault, 1165 'zeroLevelTol' => $numZeroLevelTolDefault, 1166 'debug' => 0, 1167 1168 ); 1169 1170 1171 1172 1173 1174 1175 # can't use both units and strings 1176 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) { 1177 warn "Can't use both 'units' and 'strings' in the same problem " . 1178 "(check your parameters to num_cmp() )"; 1179 1180 } 1181 1182 1183 # my ($tolType, $tol); 1184 if ($out_options{tolType} eq 'absolute') { 1185 # $tolType = 'absolute'; 1186 # $out_options{tolType} = 'absolute'; 1187 # $tol = $out_options{'tol'}; 1188 $out_options{'tolerance'}=$out_options{'tol'}; 1189 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} ); 1190 } else { 1191 # $tolType = 'relative'; 1192 # $out_options{tolType} = 'relative'; 1193 # $tol = $out_options{'relTol'}; 1194 # $out_options{'tolType'} = $out_options{'relative'}; 1195 $out_options{'tolerance'}=$out_options{'relTol'}; 1196 # delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 1197 } 1198 1199 # thread over lists 1200 my @ans_list = (); 1201 1202 if ( ref($correctAnswer) eq 'ARRAY' ) { 1203 @ans_list = @{$correctAnswer}; 1204 } 1205 else { 1206 push( @ans_list, $correctAnswer ); 1207 } 1208 1209 # produce answer evaluators 1210 foreach my $ans (@ans_list) { 1211 if( defined( $out_options{'units'} ) ) { 1212 $ans = "$ans $out_options{'units'}"; 1213 1214 push( @output_list, NUM_CMP( 'correctAnswer' => $ans, 1215 'tolerance' => $out_options{tolerance}, 1216 'tolType' => $out_options{tolType}, 1217 'format' => $out_options{'format'}, 1218 'mode' => $out_options{'mode'}, 1219 'zeroLevel' => $out_options{'zeroLevel'}, 1220 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1221 'debug' => $out_options{'debug'}, 1222 'units' => $out_options{'units'}, 1223 ) 1224 ); 1225 } 1226 elsif( defined( $out_options{'strings'} ) ) { 1227 #if( defined $out_options{'tol'} ) { 1228 # warn "You are using 'tol' (for absolute tolerance) with a num/str " . 1229 # "compare, which currently only uses relative tolerance. The default " . 1230 # "tolerance will be used."; 1231 #} 1232 1233 push( @output_list, NUM_CMP( 'correctAnswer' => $ans, 1234 'tolerance' => $out_options{tolerance}, 1235 'tolType' => $out_options{tolType}, 1236 'format' => $out_options{'format'}, 1237 'mode' => $out_options{'mode'}, 1238 'zeroLevel' => $out_options{'zeroLevel'}, 1239 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1240 'debug' => $out_options{'debug'}, 1241 'strings' => $out_options{'strings'}, 1242 1243 ) 1244 ); 1245 } 1246 else { 1247 1248 push(@output_list, 1249 NUM_CMP( 'correctAnswer' => $ans, 1250 'tolerance' => $out_options{tolerance}, 1251 'tolType' => $out_options{tolType}, 1252 'format' => $out_options{'format'}, 1253 'mode' => $out_options{'mode'}, 1254 'zeroLevel' => $out_options{'zeroLevel'}, 1255 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1256 'debug' => $out_options{'debug'}, 1257 1258 ), 1259 ); 1260 } 1261 } 1262 1263 return @output_list; 1264 } 1265 1266 #legacy code for compatability purposes 1267 sub num_rel_cmp { # compare numbers 1268 std_num_cmp( @_ ); 1269 } 1270 1271 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1272 ## 1273 ## IN: a hash containing the following items (error-checking to be added later?): 1274 ## correctAnswer -- the correct answer 1275 ## tolerance -- the allowable margin of error 1276 ## tolType -- 'relative' or 'absolute' 1277 ## format -- the display format of the answer 1278 ## mode -- one of 'std', 'strict', 'arith', or 'frac'; 1279 ## determines allowable formats for the input 1280 ## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1281 ## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1282 1283 sub compare_numbers { 1284 my ($rh_ans, %options) = @_; 1285 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans}); 1286 if ($PG_eval_errors) { 1287 $rh_ans->throw_error('EVAL','There is a syntax error in your answer'); 1288 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors); 1289 1290 1291 } else { 1292 $rh_ans->{student_ans} = prfmt($inVal,$options{format}); 1293 } 1294 1295 my $permitted_error; 1296 1297 if ($rh_ans->{tolType} eq 'absolute') { 1298 $permitted_error = $rh_ans->{tolerance}; 1299 1300 } 1301 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) { 1302 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero 1303 } 1304 else { 1305 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}); 1306 } 1307 1308 my $is_a_number = is_a_number($inVal); 1309 $rh_ans->{score} = 1 if ( ($is_a_number) and 1310 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) ); 1311 if (not $is_a_number) { 1312 $rh_ans->throw_error('EVAL','Your answer does not evaluate to a number'); 1313 } 1314 1315 $rh_ans; 1316 } 1317 1318 sub NUM_CMP { # low level numeric compare 1319 my %num_params = @_; 1320 1321 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug ); 1322 foreach my $key (@keys) { 1323 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key}); 1324 } 1325 1326 my $correctAnswer = $num_params{'correctAnswer'}; 1327 my $format = $num_params{'format'}; 1328 my $mode = $num_params{'mode'}; 1329 1330 # my $tol = $num_params{'tolerance'}; 1331 # my $tolType = $num_params{'tolType'}; 1332 # my $zeroLevel = $num_params{'zeroLevel'}; 1333 # my $zeroLevelTol = $num_params{'zeroLevelTol'}; 1334 1335 if( $num_params{tolType} eq 'relative' ) { 1336 $num_params{'tolerance'} = .01*$num_params{'tolerance'}; 1337 } 1338 1339 #$format = $numFormatDefault unless defined $format; 1340 #$mode = 'std' unless defined $mode; 1341 #$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel; 1342 #$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol; 1343 1344 my $formattedCorrectAnswer; 1345 my $correct_units; 1346 my $correct_num_answer; 1347 my %correct_units; 1348 my $corrAnswerIsString = 0; 1349 1350 1351 if (defined($num_params{units}) && $num_params{units}) { 1352 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' ); 1353 # units are in form stuff space units where units contains no spaces. 1354 1355 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/; 1356 %correct_units = Units::evaluate_units($correct_units); 1357 if ( defined( $correct_units{'ERROR'} ) ) { 1358 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" . 1359 "$correct_units{'ERROR'}\n"); 1360 } 1361 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1362 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1363 1364 } elsif (defined($num_params{strings}) && $num_params{strings}) { 1365 1366 my $legalString = ''; 1367 my @legalStrings = @{$num_params{strings}}; 1368 $correct_num_answer = $correctAnswer; 1369 $formattedCorrectAnswer = $correctAnswer; 1370 foreach $legalString (@legalStrings) { 1371 if ( uc($correctAnswer) eq uc($legalString) ) { 1372 $corrAnswerIsString = 1; 1373 last; 1374 } 1375 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 1376 1377 1378 } else { 1379 $correct_num_answer = $correctAnswer; 1380 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} ); 1381 } 1382 1383 $correct_num_answer = math_constants($correct_num_answer); 1384 1385 my $PGanswerMessage = ''; 1386 1387 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report); 1388 1389 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) { 1390 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer); 1391 } 1392 else { 1393 $PG_eval_errors = ' '; 1394 } 1395 1396 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) { 1397 ##error message from eval or above 1398 warn "Error in 'correct' answer: $PG_eval_errors<br> 1399 The answer $correctAnswer evaluates to $correctVal, 1400 which cannot be interpreted as a number. "; 1401 1402 } 1403 ######################################################################### 1404 1405 #construct the answer evaluator 1406 my $answer_evaluator = new AnswerEvaluator; 1407 $answer_evaluator->{debug} = $num_params{debug}; 1408 $answer_evaluator->ans_hash( correct_ans => $correct_num_answer, 1409 type => "${mode}_number", 1410 tolerance => $num_params{tolerance}, 1411 tolType => $num_params{tolType}, 1412 units => $correct_units, 1413 original_correct_ans => $formattedCorrectAnswer, 1414 rh_correct_units => \%correct_units, 1415 answerIsString => $corrAnswerIsString, 1416 ); 1417 my ($in, $formattedSubmittedAnswer); 1418 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift; 1419 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;} 1420 ); 1421 if (defined($num_params{units}) && $num_params{units}) { 1422 $answer_evaluator->install_pre_filter(\&check_units); 1423 } 1424 if (defined($num_params{strings}) && $num_params{strings}) { 1425 $answer_evaluator->install_pre_filter(\&check_strings, %num_params); 1426 } 1427 1428 1429 $answer_evaluator->install_pre_filter(\&check_syntax); 1430 1431 $answer_evaluator->install_pre_filter(\&math_constants); 1432 1433 1434 1435 if ($mode eq 'std') { 1436 # do nothing 1437 } elsif ($mode eq 'strict') { 1438 $answer_evaluator->install_pre_filter(\&is_a_number); 1439 } elsif ($mode eq 'arith') { 1440 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression); 1441 } elsif ($mode eq 'frac') { 1442 $answer_evaluator->install_pre_filter(\&is_a_fraction); 1443 1444 } else { 1445 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.'; 1446 $formattedSubmittedAnswer = $in; 1447 } 1448 1449 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string. 1450 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params); 1451 } 1452 1453 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 1454 1455 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}; 1456 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans}; 1457 $rh_ans;} 1458 ); 1459 1460 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 1461 return $rh_ans unless $rh_ans->catch_error('EVAL'); 1462 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message}; 1463 $rh_ans->clear_error('EVAL'); } ); 1464 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } ); 1465 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } ); 1466 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } ); 1467 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } ); 1468 1469 1470 $answer_evaluator; 1471 } 1472 1473 1474 1475 1476 1477 ########################################################################## 1478 ########################################################################## 1479 ## Function answer evaluators 1480 1481 =head2 Function Answer Evaluators 1482 1483 Function answer evaluators take in a function, compare it numerically to a 1484 correct function, and return a score. They can require an exactly equivalent 1485 function, or one that is equal up to a constant. They can accept or reject an 1486 answer based on specified tolerances for numerical deviation. 1487 1488 Function Comparison Options 1489 1490 correctEqn -- The correct equation, specified as a string. It may include 1491 all basic arithmetic operations, as well as elementary 1492 functions. Variable usage is described below. 1493 1494 Variables -- The independent variable(s). When comparing the correct 1495 equation to the student equation, each variable will be 1496 replaced by a certain number of numerical values. If 1497 the student equation agrees numerically with the correct 1498 equation, they are considered equal. Note that all 1499 comparison is numeric; it is possible (although highly 1500 unlikely and never a practical concern) for two unequal 1501 functions to yield the same numerical results. 1502 1503 Limits -- The limits of evaluation for the independent variables. 1504 Each variable is evaluated only in the half-open interval 1505 [lower_limit, upper_limit). This is useful if the function 1506 has a singularity or is not defined in a certain range. 1507 For example, the function "sqrt(-1-x)" could be evaluated 1508 in [-2,-1). 1509 1510 Tolerance -- Tolerance in function comparisons works exactly as in 1511 numerical comparisons; see the numerical comparison 1512 documentation for a complete description. Note that the 1513 tolerance does applies to the function as a whole, not 1514 each point individually. 1515 1516 Number of -- Specifies how many points to evaluate each variable at. This 1517 Points is typically 3, but can be set higher if it is felt that 1518 there is a strong possibility of "false positives." 1519 1520 Maximum -- Sets the maximum size of the constant of integration. For 1521 Constant of technical reasons concerning floating point arithmetic, if 1522 Integration the additive constant, i.e., the constant of integration, is 1523 greater (in absolute value) than maxConstantOfIntegration 1524 AND is greater than maxConstantOfIntegration times the 1525 correct value, WeBWorK will give an error message saying 1526 that it can not handle such a large constant of integration. 1527 This is to prevent e.g. cos(x) + 1E20 or even 1E20 as being 1528 accepted as a correct antiderivatives of sin(x) since 1529 floating point arithmetic cannot tell the difference 1530 between cos(x) + 1E20, 1E20, and -cos(x) + 1E20. 1531 1532 Technical note: if you examine the code for the function routines, you will see 1533 that most subroutines are simply doing some basic error-checking and then 1534 passing the parameters on to the low-level FUNCTION_CMP(). Because this routine 1535 is set up to handle multivariable functions, with single-variable functions as 1536 a special case, it is possible to pass multivariable parameters to single- 1537 variable functions. This usage is strongly discouraged as unnecessarily 1538 confusing. Avoid it. 1539 1540 Default Values (As of 7/24/2000) (Option -- Variable Name -- Value) 1541 1542 Variable -- $functVarDefault -- 'x' 1543 Relative Tolerance -- $functRelPercentTolDefault -- .1 1544 Absolute Tolerance -- $functAbsTolDefault -- .001 1545 Lower Limit -- $functLLimitDefault -- .0000001 1546 Upper Limit -- $functULimitDefault -- 1 1547 Number of Points -- $functNumOfPoints -- 3 1548 Zero Level -- $functZeroLevelDefault -- 1E-14 1549 Zero Level Tolerance -- $functZeroLevelTolDefault -- 1E-12 1550 Maximum Constant -- $functMaxConstantOfIntegration -- 1E8 1551 of Integration 1552 1553 =cut 1554 1555 =head3 Single-variable Function Comparisons 1556 1557 There are four single-variable function answer evaluators: "normal," absolute 1558 tolerance, antiderivative, and antiderivative with absolute tolerance. All 1559 parameters (other than the correct equation) are optional. 1560 1561 function_cmp( $correctEqn ) OR 1562 function_cmp( $correctEqn, $var ) OR 1563 function_cmp( $correctEqn, $var, $llimit, $ulimit ) OR 1564 function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol ) OR 1565 function_cmp( $correctEqn, $var, $llimit, $ulimit, 1566 $relPercentTol, $numPoints ) OR 1567 function_cmp( $correctEqn, $var, $llimit, $ulimit, 1568 $relPercentTol, $numPoints, $zeroLevel ) OR 1569 function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol, $numPoints, 1570 $zeroLevel,$zeroLevelTol ) 1571 1572 $correctEqn -- the correct equation, as a string 1573 $var -- the string representing the variable (optional) 1574 $llimit -- the lower limit of the interval to evaluate the 1575 variable in (optional) 1576 $ulimit -- the upper limit of the interval to evaluate the 1577 variable in (optional) 1578 $relPercentTol -- the error tolerance as a percentage (optional) 1579 $numPoints -- the number of points at which to evaluate the 1580 variable (optional) 1581 $zeroLevel -- if the correct answer is this close to zero, then 1582 zeroLevelTol applies (optional) 1583 $zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1584 1585 function_cmp() uses standard comparison and relative tolerance. It takes a 1586 string representing a single-variable function and compares the student 1587 answer to that function numerically. 1588 1589 function_cmp_up_to_constant( $correctEqn ) OR 1590 function_cmp_up_to_constant( $correctEqn, $var ) OR 1591 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit ) OR 1592 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1593 $relpercentTol ) OR 1594 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1595 $relpercentTol, $numOfPoints ) OR 1596 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1597 $relpercentTol, $numOfPoints, 1598 $maxConstantOfIntegration ) OR 1599 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1600 $relpercentTol, $numOfPoints, 1601 $maxConstantOfIntegration, $zeroLevel) OR 1602 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1603 $relpercentTol, $numOfPoints, 1604 $maxConstantOfIntegration, 1605 $zeroLevel, $zeroLevelTol ) 1606 1607 $maxConstantOfIntegration -- the maximum size of the constant of 1608 integration 1609 1610 function_cmp_up_to_constant() uses antiderivative compare and relative 1611 tolerance. All options work exactly like function_cmp(), except of course 1612 $maxConstantOfIntegration. It will accept as correct any function which 1613 differs from $correctEqn by at most a constant; that is, if 1614 $studentEqn = $correctEqn + C 1615 the answer is correct. 1616 1617 function_cmp_abs( $correctFunction ) OR 1618 function_cmp_abs( $correctFunction, $var ) OR 1619 function_cmp_abs( $correctFunction, $var, $llimit, $ulimit ) OR 1620 function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol ) OR 1621 function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol, 1622 $numOfPoints ) 1623 1624 $absTol -- the tolerance as an absolute value 1625 1626 function_cmp_abs() uses standard compare and absolute tolerance. All 1627 other options work exactly as for function_cmp(). 1628 1629 function_cmp_up_to_constant_abs( $correctFunction ) OR 1630 function_cmp_up_to_constant_abs( $correctFunction, $var ) OR 1631 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit ) OR 1632 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit, 1633 $absTol ) OR 1634 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit, 1635 $absTol, $numOfPoints ) OR 1636 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit, 1637 $absTol, $numOfPoints, 1638 $maxConstantOfIntegration ) 1639 1640 function_cmp_up_to_constant_abs() uses antiderivative compare 1641 and absolute tolerance. All other options work exactly as with 1642 function_cmp_up_to_constant(). 1643 1644 Examples: 1645 1646 ANS( function_cmp( "cos(x)" ) ) -- Accepts cos(x), sin(x+pi/2), 1647 sin(x)^2 + cos(x) + cos(x)^2 -1, etc. This assumes 1648 $functVarDefault has been set to "x". 1649 ANS( function_cmp( $answer, "t" ) ) -- Assuming $answer is "cos(t)", 1650 accepts cos(t), etc. 1651 ANS( function_cmp_up_to_constant( "cos(x)" ) ) -- Accepts any 1652 antiderivative of sin(x), e.g. cos(x) + 5. 1653 ANS( function_cmp_up_to_constant( "cos(z)", "z" ) ) -- Accepts any 1654 antiderivative of sin(z), e.g. sin(z+pi/2) + 5. 1655 1656 =cut 1657 sub adaptive_function_cmp { 1658 my $correctEqn = shift; 1659 my %options = @_; 1660 set_default_options( \%options, 1661 'vars' => [qw( x y )], 1662 'params' => [], 1663 'limits' => [ [0,1], [0,1]], 1664 'reltol' => $main::functRelPercentTolDefault, 1665 'numPoints' => $main::functNumOfPoints, 1666 'zeroLevel' => $main::functZeroLevelDefault, 1667 'zeroLevelTol' => $main::functZeroLevelTolDefault, 1668 'debug' => 0, 1669 ); 1670 1671 my $var_ref = $options{'vars'}; 1672 my $ra_params = $options{ 'params'}; 1673 my $limit_ref = $options{'limits'}; 1674 my $relPercentTol= $options{'reltol'}; 1675 my $numPoints = $options{'numPoints'}; 1676 my $zeroLevel = $options{'zeroLevel'}; 1677 my $zeroLevelTol = $options{'zeroLevelTol'}; 1678 1679 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1680 'var' => $var_ref, 1681 'limits' => $limit_ref, 1682 'tolerance' => $relPercentTol, 1683 'tolType' => 'relative', 1684 'numPoints' => $numPoints, 1685 'mode' => 'std', 1686 'maxConstantOfIntegration' => 10**100, 1687 'zeroLevel' => $zeroLevel, 1688 'zeroLevelTol' => $zeroLevelTol, 1689 'scale_norm' => 1, 1690 'params' => $ra_params, 1691 'debug' => $options{debug} , 1692 ); 1693 1694 } 1695 1696 sub function_cmp { 1697 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_; 1698 1699 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) { 1700 function_invalid_params( $correctEqn ); 1701 } 1702 else { 1703 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1704 'var' => $var, 1705 'limits' => [$llimit, $ulimit], 1706 'tolerance' => $relPercentTol, 1707 'tolType' => 'relative', 1708 'numPoints' => $numPoints, 1709 'mode' => 'std', 1710 'maxConstantOfIntegration' => 0, 1711 'zeroLevel' => $zeroLevel, 1712 'zeroLevelTol' => $zeroLevelTol 1713 ); 1714 } 1715 } 1716 1717 sub function_cmp_up_to_constant { ## for antiderivative problems 1718 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_; 1719 1720 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) { 1721 function_invalid_params( $correctEqn ); 1722 } 1723 else { 1724 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1725 'var' => $var, 1726 'limits' => [$llimit, $ulimit], 1727 'tolerance' => $relPercentTol, 1728 'tolType' => 'relative', 1729 'numPoints' => $numPoints, 1730 'mode' => 'antider', 1731 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1732 'zeroLevel' => $zeroLevel, 1733 'zeroLevelTol' => $zeroLevelTol 1734 ); 1735 } 1736 } 1737 1738 sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance 1739 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_; 1740 1741 if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) { 1742 function_invalid_params( $correctEqn ); 1743 } 1744 else { 1745 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1746 'var' => $var, 1747 'limits' => [$llimit, $ulimit], 1748 'tolerance' => $absTol, 1749 'tolType' => 'absolute', 1750 'numPoints' => $numPoints, 1751 'mode' => 'std', 1752 'maxConstantOfIntegration' => 0, 1753 'zeroLevel' => 0, 1754 'zeroLevelTol' => 0 1755 ); 1756 } 1757 } 1758 1759 1760 sub function_cmp_up_to_constant_abs { ## for antiderivative problems 1761 ## similar to function_cmp_up_to_constant 1762 ## but uses absolute tolerance 1763 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_; 1764 1765 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) { 1766 function_invalid_params( $correctEqn ); 1767 } 1768 1769 else { 1770 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1771 'var' => $var, 1772 'limits' => [$llimit, $ulimit], 1773 'tolerance' => $absTol, 1774 'tolType' => 'absolute', 1775 'numPoints' => $numPoints, 1776 'mode' => 'antider', 1777 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1778 'zeroLevel' => 0, 1779 'zeroLevelTol' => 0 1780 ); 1781 } 1782 } 1783 1784 ## The following answer evaluator for comparing multivarable functions was 1785 ## contributed by Professor William K. Ziemer 1786 ## (Note: most of the multivariable functionality provided by Professor Ziemer 1787 ## has now been integrated into fun_cmp and FUNCTION_CMP) 1788 ############################ 1789 # W.K. Ziemer, Sep. 1999 1790 # Math Dept. CSULB 1791 # email: wziemer@csulb.edu 1792 ############################ 1793 1794 =head3 multivar_function_cmp 1795 1796 NOTE: this function is maintained for compatibility. fun_cmp() is 1797 slightly preferred. 1798 1799 usage: 1800 1801 multivar_function_cmp( $answer, $var_reference, options) 1802 $answer -- string, represents function of several variables 1803 $var_reference -- number (of variables), or list reference (e.g. ["var1","var2"] ) 1804 options: 1805 $limit_reference -- reference to list of lists (e.g. [[1,2],[3,4]]) 1806 $relPercentTol -- relative percent tolerance in answer 1807 $numPoints -- number of points to sample in for each variable 1808 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1809 $zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1810 1811 =cut 1812 1813 sub multivar_function_cmp { 1814 my ($correctEqn,$var_ref,$limit_ref,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_; 1815 1816 if ( (scalar(@_) > 7) or (scalar(@_) < 2) ) { 1817 function_invalid_params( $correctEqn ); 1818 } 1819 1820 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1821 'var' => $var_ref, 1822 'limits' => $limit_ref, 1823 'tolerance' => $relPercentTol, 1824 'tolType' => 'relative', 1825 'numPoints' => $numPoints, 1826 'mode' => 'std', 1827 'maxConstantOfIntegration' => 0, 1828 'zeroLevel' => $zeroLevel, 1829 'zeroLevelTol' => $zeroLevelTol 1830 ); 1831 } 1832 1833 =head3 fun_cmp() 1834 1835 Compares a function or a list of functions, using a named hash of options to set 1836 parameters. This can make for more readable code than using the function_cmp() 1837 style, but some people find one or the other easier to remember. 1838 1839 ANS( fun_cmp( answer or answer_array_ref, options_hash ) ); 1840 1841 1. a string containing the correct function, or a reference to an 1842 array of correct functions 1843 2. a hash containing the following items (all optional): 1844 var -- either the number of variables or a reference to an 1845 array of variable names (see below) 1846 limits -- reference to an array of arrays of limits (see below), or: 1847 mode -- 'std' (default) (function must match exactly), or: 1848 'antider' (function must match up to a constant) 1849 relTol -- (default) a relative tolerance (as a percentage), or: 1850 tol -- an absolute tolerance for error 1851 numPoints -- the number of points to evaluate the function at 1852 maxConstantOfIntegration -- maximum size of the constant of integration 1853 zeroLevel -- if the correct answer is this close to zero, then 1854 zeroLevelTol applies 1855 zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1856 params -- an array of "free" parameters which can be used to adapt 1857 -- the correct answer to the submitted answer. (e.g. ['c'] for 1858 -- a constant of integration in the answer x^3/3 + c. 1859 debug -- when set to 1 this provides extra information while checking the 1860 -- the answer. 1861 1862 Returns an answer evaluator, or (if given a reference to an array 1863 of answers), a list of answer evaluators 1864 1865 ANSWER: 1866 1867 The answer must be in the form of a string. The answer can contain 1868 functions, pi, e, and arithmetic operations. However, the correct answer 1869 string follows a slightly stricter syntax than student answers; specifically, 1870 there is no implicit multiplication. So the correct answer must be "3*x" rather 1871 than "3 x". Students can still enter "3 x". 1872 1873 VARIABLES: 1874 1875 The var parameter can contain either a number or a reference to an array of 1876 variable names. If it contains a number, the variables are named automatically 1877 as follows: 1 variable -- x 1878 2 variables -- x, y 1879 3 variables -- x, y, z 1880 4 or more -- x_1, x_2, x_3, etc. 1881 If the var parameter contains a reference to an array of variable names, then 1882 the number of variables is determined by the number of items in the array. A 1883 reference to an array is created with brackets, e.g. "var => ['r', 's', 't']". 1884 If only one variable is being used, you can write either "var => ['t']" for 1885 consistency or "var => 't'" as a shortcut. The default is one variable, x. 1886 1887 LIMITS: 1888 1889 Limits are specified with the limits parameter. You may NOT use llimit/ulimit. 1890 If you specify limits for one variable, you must specify them for all variables. 1891 The limit parameter must be a reference to an array of arrays of the form 1892 [lower_limit. upper_limit], each array corresponding to the lower and upper 1893 endpoints of the (half-open) domain of one variable. For example, 1894 "vars => 2, limits => [[0,2], [-3,8]]" would cause x to be evaluated in [0,2) and 1895 y to be evaluated in [-3,8). If only one variable is being used, you can write 1896 either "limits => [[0,3]]" for consistency or "limits => [0,3]" as a shortcut. 1897 1898 EXAMPLES: 1899 1900 fun_cmp( "3*x" ) -- standard compare, variable is x 1901 fun_cmp( ["3*x", "4*x+3", "3*x**2"] ) -- standard compare, defaults used for all three functions 1902 fun_cmp( "3*t", var => 't' ) -- standard compare, variable is t 1903 fun_cmp( "5*x*y*z", var => 3 ) -- x, y and z are the variables 1904 fun_cmp( "5*x", mode => 'antider' ) -- student answer must match up to constant (i.e., 5x+C) 1905 fun_cmp( ["3*x*y", "4*x*y"], limits => [[0,2], [5,7]] ) -- x evaluated in [0,2) 1906 y evaluated in [5,7) 1907 1908 =cut 1909 1910 sub fun_cmp { 1911 my $correctAnswer = shift @_; 1912 my %opt = @_; 1913 1914 assign_option_aliases( \%opt, 1915 'vars' => 'var', # set the standard option 'var' to the one specified as vars 1916 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain 1917 'reltol' => 'relTol', 1918 'param' => 'params', 1919 ); 1920 1921 set_default_options( \%opt, 1922 'var' => $functVarDefault, 1923 'params' => [], 1924 'limits' => [[$functLLimitDefault, $functULimitDefault]], 1925 'mode' => 'std', 1926 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative', 1927 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined 1928 'relTol' => $functRelPercentTolDefault, 1929 'numPoints' => $functNumOfPoints, 1930 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 1931 'zeroLevel' => $functZeroLevelDefault, 1932 'zeroLevelTol' => $functZeroLevelTolDefault, 1933 'debug' => 0, 1934 ); 1935 1936 1937 1938 # allow var => 'x' as an abbreviation for var => ['x'] 1939 my %out_options = %opt; 1940 unless ( ref($out_options{var}) eq 'ARRAY' ) { 1941 $out_options{var} = [$out_options{var}]; 1942 } 1943 # allow params => 'c' as an abbreviation for params => ['c'] 1944 unless ( ref($out_options{params}) eq 'ARRAY' ) { 1945 $out_options{params} = [$out_options{params}]; 1946 } 1947 my ($tolType, $tol); 1948 if ($out_options{tolType} eq 'absolute') { 1949 $tolType = 'absolute'; 1950 $tol = $out_options{'tol'}; 1951 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} ); 1952 } else { 1953 $tolType = 'relative'; 1954 $tol = $out_options{'relTol'}; 1955 delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 1956 } 1957 1958 my @output_list = (); 1959 # thread over lists 1960 my @ans_list = (); 1961 1962 if ( ref($correctAnswer) eq 'ARRAY' ) { 1963 @ans_list = @{$correctAnswer}; 1964 } 1965 else { 1966 push( @ans_list, $correctAnswer ); 1967 } 1968 1969 # produce answer evaluators 1970 foreach my $ans (@ans_list) { 1971 push(@output_list, 1972 FUNCTION_CMP( 'correctEqn' => $ans, 1973 'var' => $out_options{'var'}, 1974 'limits' => $out_options{'limits'}, 1975 'tolerance' => $tol, 1976 'tolType' => $tolType, 1977 'numPoints' => $out_options{'numPoints'}, 1978 'mode' => $out_options{'mode'}, 1979 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'}, 1980 'zeroLevel' => $out_options{'zeroLevel'}, 1981 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1982 'params' => $out_options{'params'}, 1983 'debug' => $out_options{'debug'}, 1984 ), 1985 ); 1986 } 1987 1988 return @output_list; 1989 } 1990 1991 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1992 ## NOTE: PG_answer_eval is used instead of PG_restricted_eval in order to insure that the answer 1993 ## evaluated within the context of the package the problem was originally defined in. 1994 ## Includes multivariable modifications contributed by Professor William K. Ziemer 1995 ## 1996 ## IN: a hash consisting of the following keys (error checking to be added later?) 1997 ## correctEqn -- the correct equation as a string 1998 ## var -- the variable name as a string, 1999 ## or a reference to an array of variables 2000 ## limits -- reference to an array of arrays of type [lower,upper] 2001 ## tolerance -- the allowable margin of error 2002 ## tolType -- 'relative' or 'absolute' 2003 ## numPoints -- the number of points to evaluate the function at 2004 ## mode -- 'std' or 'antider' 2005 ## maxConstantOfIntegration -- maximum size of the constant of integration 2006 ## zeroLevel -- if the correct answer is this close to zero, 2007 ## then zeroLevelTol applies 2008 ## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 2009 2010 2011 sub FUNCTION_CMP { 2012 my %func_params = @_; 2013 2014 my $correctEqn = $func_params{'correctEqn'}; 2015 my $var = $func_params{'var'}; 2016 my $ra_limits = $func_params{'limits'}; 2017 my $tol = $func_params{'tolerance'}; 2018 my $tolType = $func_params{'tolType'}; 2019 my $numPoints = $func_params{'numPoints'}; 2020 my $mode = $func_params{'mode'}; 2021 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 2022 my $zeroLevel = $func_params{'zeroLevel'}; 2023 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 2024 2025 2026 # Check that everything is defined: 2027 $func_params{debug} = 0 unless defined($func_params{debug}); 2028 $mode = 'std' unless defined($mode); 2029 my @VARS = get_var_array( $var ); 2030 my @limits = get_limits_array( $ra_limits ); 2031 my @PARAMS = (); 2032 @PARAMS = @{$func_params{'params'}} if defined($func_params{'params'}); 2033 2034 if ($mode eq 'antider' ) { 2035 # doctor the equation to allow addition of a constant 2036 my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters. 2037 # There is the possibility of conflict here. 2038 # 'Q' seemed less dangerous than 'C'. 2039 $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM"; 2040 push(@PARAMS, $CONSTANT_PARAM); 2041 } 2042 my $dim_of_param_space = @PARAMS; # dimension of equivalence space 2043 2044 if( $tolType eq 'relative' ) { 2045 $tol = $functRelPercentTolDefault unless defined $tol; 2046 $tol *= .01; 2047 } 2048 else { 2049 $tol = $functAbsTolDefault unless defined $tol; 2050 } 2051 2052 #loop ensures that number of limits matches number of variables 2053 for( my $i = 0; $i < scalar(@VARS); $i++ ) { 2054 $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0]; 2055 $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1]; 2056 } 2057 $numPoints = $functNumOfPoints unless defined $numPoints; 2058 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 2059 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 2060 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 2061 2062 $func_params{'var'} = $var; 2063 $func_params{'limits'} = \@limits; 2064 $func_params{'tolerance'} = $tol; 2065 $func_params{'tolType'} = $tolType; 2066 $func_params{'numPoints'} = $numPoints; 2067 $func_params{'mode'} = $mode; 2068 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 2069 $func_params{'zeroLevel'} = $zeroLevel; 2070 $func_params{'zeroLevelTol'} = $zeroLevelTol; 2071 2072 ######################################################## 2073 # End of cleanup of calling parameters 2074 ######################################################## 2075 my $i; #for use with loops 2076 my $PGanswerMessage = ""; 2077 my $originalCorrEqn = $correctEqn; 2078 2079 #prepare the correct answer and check it's syntax 2080 my $rh_correct_ans = new AnswerHash; 2081 $rh_correct_ans->input($correctEqn); 2082 $rh_correct_ans = check_syntax($rh_correct_ans); 2083 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2084 $rh_correct_ans->clear_error(); 2085 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ], 2086 store_in =>'rf_correct_ans', 2087 debug => $func_params{debug}); 2088 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans}; 2089 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2090 2091 #create the evaluation points 2092 my $random_for_answers = new PGrandom($main::PG_original_problemSeed); 2093 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator 2094 my (@evaluation_points); 2095 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) { 2096 my (@vars,$iteration_limit); 2097 for( my $i = 0; $i < @VARS; $i++ ) { 2098 my $iteration_limit = 10; 2099 while ( 0 < --$iteration_limit ) { # make sure that the endpoints of the interval are not included 2100 $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM ); 2101 last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1]; 2102 } 2103 warn "Unable to properly choose evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )" 2104 if $iteration_limit == 0; 2105 }; 2106 2107 push(@evaluation_points,\@vars); 2108 } 2109 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points); 2110 2111 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters); 2112 #warn "coeff", join(" | ", @{$COEFFS}); 2113 2114 #construct the answer evaluator 2115 my $answer_evaluator = new AnswerEvaluator; 2116 $answer_evaluator->{debug} = $func_params{debug}; 2117 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn, 2118 rf_correct_ans => $rh_correct_ans->{rf_correct_ans}, 2119 evaluation_points => \@evaluation_points, 2120 ra_param_vars => \@PARAMS, 2121 ra_vars => \@VARS, 2122 type => 'function', 2123 ); 2124 2125 $answer_evaluator->install_pre_filter(\&check_syntax); 2126 $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. 2127 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS); 2128 $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params); 2129 $answer_evaluator->install_evaluator(\&is_zero_array, tol => $tol ); 2130 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); $rh_ans;} ); 2131 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 2132 if ($rh_ans->catch_error('EVAL') ) { 2133 $rh_ans->{ans_message} = $rh_ans->{error_message}; 2134 $rh_ans->clear_error('EVAL'); 2135 } 2136 $rh_ans; 2137 }); 2138 $answer_evaluator; 2139 } 2140 2141 =head4 Filters 2142 2143 =pod 2144 2145 is_array($rh_ans) 2146 returns: $rh_ans. Throws error "NOTARRAY" if this is not an array 2147 2148 =cut 2149 2150 sub is_array{ 2151 my $rh_ans = shift; 2152 # return if the result is an array 2153 return($rh_ans) if ref($rh_ans->{student_ans}) eq 'ARRAY' ; 2154 $rh_ans->throw_error("NOTARRAY","The answer is not an array"); 2155 $rh_ans; 2156 } 2157 2158 =pod 2159 2160 check_syntax( $rh_ans, %options) 2161 returns an answer hash. 2162 2163 latex2html preview code are installed in the answer hash. 2164 The input has been transformed, changing 7pi to 7*pi or 7x to 7*x. 2165 Syntax error messages may be generated and stored in student_ans 2166 Additional syntax error messages are stored in {ans_message} and duplicated in {error_message} 2167 2168 2169 =cut 2170 2171 sub check_syntax { 2172 my $rh_ans = shift; 2173 my %options = @_; 2174 unless ( defined( $rh_ans->{student_ans} ) ) { 2175 warn "Check_syntax requires an equation in the field {student_ans} or input"; 2176 $rh_ans->throw_error("1","{student_ans} field not defined"); 2177 return $rh_ans; 2178 } 2179 my $in = $rh_ans->{student_ans}; 2180 my $parser = new AlgParserWithImplicitExpand; 2181 my $ret = $parser -> parse($in); #for use with loops 2182 2183 if ( ref($ret) ) { ## parsed successfully 2184 $parser -> tostring(); 2185 $parser -> normalize(); 2186 $rh_ans->input( $parser -> tostring() ); 2187 $rh_ans->{preview_text_string} = $in; 2188 $rh_ans->{preview_latex_string} = $parser -> tolatex(); 2189 2190 } else { ## error in parsing 2191 2192 $rh_ans->{'student_ans'} = 'syntax error:'. $parser->{htmlerror}, 2193 $rh_ans->{'ans_message'} = $parser -> {error_msg}, 2194 $rh_ans->{'preview_text_string'} = '', 2195 $rh_ans->{'preview_latex_string'} = '', 2196 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg}); 2197 } 2198 2199 2200 2201 $rh_ans; 2202 2203 2204 } 2205 2206 =pod 2207 2208 std_num_filter($rh_ans, %options) 2209 returns $rh_ans 2210 2211 Replaces some constants using math_constants, then evaluates a perl expression. 2212 2213 2214 =cut 2215 2216 sub std_num_filter { 2217 my $rh_ans = shift; 2218 my %options = @_; 2219 my $in = $rh_ans->input(); 2220 $in = math_constants($in); 2221 $rh_ans->{type} = 'std_number'; 2222 my ($inVal,$PG_eval_errors,$PG_full_error_report); 2223 if ($in =~ /\S/) { 2224 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in); 2225 } else { 2226 $PG_eval_errors = ''; 2227 } 2228 2229 if ($PG_eval_errors) { ##error message from eval or above 2230 $rh_ans->{ans_message} = 'There is a syntax error in your answer'; 2231 $rh_ans->{student_ans} = clean_up_error_msg($PG_eval_errors); 2232 } else { 2233 $rh_ans->{student_ans} = $inVal; 2234 } 2235 $rh_ans; 2236 } 2237 2238 =pod 2239 2240 std_num_array_filter($rh_ans, %options) 2241 returns $rh_ans 2242 2243 Assumes the {student_ans} field is a numerical array, and applies BOTH check_syntax and std_num_filter 2244 to each element of the array. Does it's best to generate sensible error messages for syntax errors. 2245 A typical error message displayed in {studnet_ans} might be ( 56, error message, -4). 2246 2247 =cut 2248 2249 sub std_num_array_filter{ 2250 my $rh_ans= shift; 2251 my %options = @_; 2252 my @in = @{$rh_ans->{student_ans}}; 2253 my $temp_hash = new AnswerHash; 2254 my @out=(); 2255 my $PGanswerMessage = ''; 2256 foreach my $item (@in) { # evaluate each number in the vector 2257 $temp_hash->input($item); 2258 $temp_hash = check_syntax($temp_hash); 2259 if (defined($temp_hash->{error_flag}) and $temp_hash->{error_flag} eq 'SYNTAX') { 2260 $PGanswerMessage .= $temp_hash->{ans_message}; 2261 $temp_hash->{ans_message} = undef; 2262 } else { 2263 #continue processing 2264 $temp_hash = std_num_filter($temp_hash); 2265 if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) { 2266 $PGanswerMessage .= $temp_hash->{ans_message}; 2267 $temp_hash->{ans_message} = undef; 2268 } 2269 } 2270 push(@out, $temp_hash->input()); 2271 2272 } 2273 if ($PGanswerMessage) { 2274 $rh_ans->input( "( " . join(", ", @out ) . " )" ); 2275 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.'); 2276 } else { 2277 $rh_ans->input( [@out] ); 2278 } 2279 $rh_ans; 2280 } 2281 2282 2283 2284 sub function_from_string2 { 2285 my $rh_ans = shift; 2286 my %options = @_; 2287 my $eqn = $rh_ans->{student_ans}; 2288 set_default_options( \%options, 2289 'store_in' => 'rf_student_ans', 2290 'ra_vars' => [qw( x y )], 2291 'debug' => 0, 2292 ); 2293 my @VARS = @{ $options{ 'ra_vars'}}; 2294 warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1; 2295 my $originalEqn = $eqn; 2296 $eqn = &math_constants($eqn); 2297 for( my $i = 0; $i < @VARS; $i++ ) { 2298 $eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g; 2299 } 2300 warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n", 2301 pretty_print(\%options) 2302 if defined($options{debug}) and $options{debug} ==1; 2303 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q! 2304 sub { 2305 my @VARS = @_; 2306 my $input_str = ''; 2307 for( my $i=0; $i<@VARS; $i++ ) { 2308 $input_str .= "\$VARS[$i] = $VARS[$i]; "; 2309 } 2310 my $PGanswerMessage; 2311 $input_str .= '! . $eqn . q!'; # need the single quotes to keep the contents of $eqn from being 2312 # evaluated when it is assigned to $input_str; 2313 my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated 2314 2315 if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) { 2316 $PGanswerMessage = clean_up_error_msg($PG_eval_errors); 2317 # This message seemed too verbose, but it does give extra information, we'll see if it is needed. 2318 # "<br> There was an error in evaluating your function <br> 2319 # !. $originalEqn . q! <br> 2320 # at ( " . join(', ', @VARS) . " ) <br> 2321 # $PG_eval_errors 2322 # "; # this message appears in the answer section which is not process by Latex2HTML so it must 2323 # # be in HTML. That is why $BR is NOT used. 2324 2325 } 2326 (wantarray) ? ($out, $PGanswerMessage): $out; # PGanswerMessage may be undefined. 2327 }; 2328 !); 2329 2330 if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) { 2331 $PG_eval_errors = clean_up_error_msg($PG_eval_errors); 2332 2333 my $PGanswerMessage = "There was an error in converting the expression 2334 $main::BR $originalEqn $main::BR into a function. 2335 $main::BR $PG_eval_errors."; 2336 $rh_ans->{rf_student_ans} = $function_sub; 2337 $rh_ans->{ans_message} = $PGanswerMessage; 2338 $rh_ans->{error_message} = $PGanswerMessage; 2339 $rh_ans->{error_flag} = 1; 2340 # we couldn't compile the equation, we'll return an error message. 2341 } else { 2342 # if (defined($options{store_in} )) { 2343 # $rh_ans ->{$options{store_in}} = $function_sub; 2344 # } else { 2345 # $rh_ans->{rf_student_ans} = $function_sub; 2346 # } 2347 $rh_ans ->{$options{store_in}} = $function_sub; 2348 2349 } 2350 2351 $rh_ans; 2352 } 2353 2354 2355 sub is_zero_array{ 2356 my $rh_ans = shift; 2357 my %options = @_; 2358 my $array = $rh_ans -> {ra_differences}; 2359 my $num = @$array; 2360 my $i; 2361 my $max = 0; my $mm; 2362 for ($i=0; $i< $num; $i++) { 2363 $mm = $array->[$i] ; 2364 if (not is_a_number($mm) ) { 2365 $max = $mm; # break out if one of the elements is not a number 2366 last; 2367 } 2368 $max = abs($mm) if abs($mm) > $max; 2369 } 2370 if (not is_a_number($max)) { 2371 $rh_ans->{score} = 0; 2372 my $error = "WeBWorK was unable evaluate your function. Please check that your 2373 expression doesn't take roots of negative numbers, or divide by zero."; 2374 $rh_ans->throw_error('EVAL',$error); 2375 } else { 2376 my $tol = $options{tol} if defined($options{tol}); 2377 #$tol = 0.01*$options{reltol} if defined($options{reltol}); 2378 $tol = .000001 unless defined($tol); 2379 2380 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0; 2381 } 2382 $rh_ans; 2383 } 2384 =pod 2385 2386 best_approx_parameters($rh_ans,%options); 2387 {rf_student_ans} # reference to the test answer 2388 {rf_correct_ans} # reference to the comparison answer 2389 {evaluation_points}, # an array of row vectors indicating the points 2390 # to evaluate when comparing the functions 2391 %options # debug => 1 gives more error answers 2392 # param_vars => [''] additional parameters used to adapt to function 2393 ) 2394 returns $rh_ans; 2395 The parameters for the comparison function which best approximates the test_function are stored 2396 in the field {ra_parameters}. 2397 2398 The last $dim_of_parms_space variables are assumed to be parameters, and it is also 2399 assumed that the function \&comparison_fun 2400 depends linearly on these variables. This function finds the values for these parameters which minimizes the 2401 Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified 2402 by the array reference \@rows_of_test_points. This is assumed to be an array of arrays, with the inner arrays 2403 determining a test point. 2404 2405 The comparison function should have $dim_of_params_space more input variables than the test function. 2406 2407 =cut 2408 2409 2410 2411 2412 2413 # =pod 2414 # 2415 # Used internally: 2416 # 2417 # &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function 2418 # $ra_variables # an array of the active input variables to the functions 2419 # $dim_of_params_space # indicates the number of parameters upon which the 2420 # # the comparison function depends linearly. These are assumed to 2421 # # be the last group of inputs to the comparison function. 2422 # 2423 # %options # $options{debug} gives more error messages 2424 # 2425 # # A typical function might look like 2426 # # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter 2427 # # space of dimension 2 and a variable space of dimension 3. 2428 # ) 2429 # # returns a list of coefficients 2430 # 2431 # =cut 2432 2433 2434 sub best_approx_parameters{ 2435 my $rh_ans = shift; 2436 my %options = @_; 2437 my $errors = undef; 2438 # This subroutine for the determining the coefficents of the parameters at a given point 2439 # is pretty specialized, so it is included here as a sub-subroutine. 2440 my $determine_param_coeffs = sub { 2441 my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_; 2442 my @zero_params=(); 2443 for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); } 2444 my @vars = @$ra_variables; 2445 my @coeff = (); 2446 my @inputs = (@vars,@zero_params); 2447 my ($f0, $f1, $err); 2448 ($f0, $err) = &{$rf_fun}(@inputs); 2449 if (defined($err) ) { 2450 $errors .= "$err "; 2451 } else { 2452 for (my $i=@vars;$i<@inputs;$i++) { 2453 $inputs[$i]=1; # set one parameter to 1; 2454 my($f1,$err) = &$rf_fun(@inputs); 2455 if (defined($err) ) { 2456 $errors .= " $err "; 2457 } else { 2458 push(@coeff, $f1-$f0); 2459 } 2460 $inputs[$i]=0; # set it back 2461 } 2462 } 2463 (\@coeff, $errors); 2464 }; 2465 my $rf_fun = $rh_ans->{rf_student_ans}; 2466 my $rf_correct_fun = $rh_ans->{rf_correct_ans}; 2467 my $ra_vars_matrix = $rh_ans->{evaluation_points}; 2468 my $dim_of_param_space = @{$options{param_vars}}; 2469 # Short cut. Bail if there are no param_vars 2470 unless ($dim_of_param_space >0) { 2471 $rh_ans ->{ra_parameters} = []; 2472 return $rh_ans; 2473 } 2474 # inputs are row arrays in this case. 2475 my @zero_params=(); 2476 2477 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); } 2478 my @rows_of_vars = @$ra_vars_matrix; 2479 warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug}; 2480 my $rows = @rows_of_vars; 2481 my $matrix =new Matrix($rows,$dim_of_param_space); 2482 my $rhs_vec = new Matrix($rows, 1); 2483 my $row_num = 1; 2484 my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars); 2485 my $number_of_data_points = $dim_of_param_space +2; 2486 while (@rows_of_vars and $row_num <= $number_of_data_points) { 2487 2488 # get one set of data points from the test function; 2489 @vars = @{ shift(@rows_of_vars) }; 2490 ($val2, $err1) = &{$rf_fun}(@vars); 2491 $errors .= " $err1 " if defined($err1); 2492 @inputs = (@vars,@zero_params); 2493 ($val1, $err2) = &{$rf_correct_fun}(@inputs); 2494 $errors .= " $err2 " if defined($err2); 2495 2496 unless (defined($err1) or defined($err2) ) { 2497 $rhs_vec->assign($row_num,1, $val2-$val1 ); 2498 2499 # warn "rhs data val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug}; 2500 # warn "vars ", join(" | ", @vars) if $options{debug}; 2501 2502 ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options); 2503 if (defined($err1) ) { 2504 $errors .= " $err1 "; 2505 } else { 2506 my @coeff = @$ra_coeff; 2507 my $col_num=1; 2508 while(@coeff) { 2509 $matrix->assign($row_num,$col_num, shift(@coeff) ); 2510 $col_num++; 2511 } 2512 } 2513 2514 } 2515 $row_num++; 2516 last if $errors; # break if there are any errors. 2517 # This cuts down on the size of error messages. 2518 # However it impossible to check for equivalence at 95% of points 2519 # which might be useful for functions that are not defined at some points. 2520 } 2521 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug}; 2522 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug}; 2523 2524 # we have Matrix * parameter = data_vec + perpendicular vector 2525 # where the matrix has column vectors defining the span of the parameter space 2526 # multiply both sides by Matrix_transpose and solve for the parameters 2527 # This is exactly what the method proj_coeff method does. 2528 my @array; 2529 if (defined($errors) ) { 2530 @array = (); # new Matrix($dim_of_param_space,1); 2531 } else { 2532 @array = $matrix->proj_coeff($rhs_vec)->list(); 2533 } 2534 # check size (hack) 2535 my $max = 0; 2536 foreach my $val (@array ) { 2537 $max = abs($val) if $max < abs($val); 2538 if (not is_a_number($val) ) { 2539 $max = "NaN: $val"; 2540 last; 2541 } 2542 } 2543 if ($max =~/NaN/) { 2544 $errors .= "WeBWorK was unable evaluate your function. Please check that your 2545 expression doesn't take roots of negative numbers, or divide by zero."; 2546 } elsif ($max > $options{maxConstantOfIntegration} ) { 2547 $errors .= "At least one of the adapting parameters 2548 (perhaps the constant of integration) is too large: $max, 2549 ( the maximum allowed is $options{maxConstantOfIntegration} )"; 2550 } 2551 2552 $rh_ans->{ra_parameters} = \@array; 2553 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 2554 $rh_ans; 2555 } 2556 2557 =pod 2558 2559 calculate_difference_vector( $ans_hash, %options); 2560 2561 {rf_student_ans}, # a reference to the test function 2562 {rf_correct_ans}, # a reference to the correct answer function 2563 {evaluation_points}, # an array of row vectors indicating the points 2564 # to evaluate when comparing the functions 2565 {ra_parameters} # these are the (optional) additional inputs to 2566 # the comparison function which adapt it properly 2567 # to the problem at hand. 2568 2569 %options # mode => 'rel' specifies that each element in the 2570 # difference matrix is divided by the correct answer. 2571 # unless the correct answer is nearly 0. 2572 ) 2573 2574 =cut 2575 2576 2577 sub calculate_difference_vector { 2578 my $rh_ans = shift; 2579 my %options = @_; 2580 # initialize 2581 my $rf_fun = $rh_ans -> {rf_student_ans}; 2582 my $rf_correct_fun = $rh_ans -> {rf_correct_ans}; 2583 my $ra_parameters = $rh_ans ->{ra_parameters}; 2584 my @evaluation_points = @{$rh_ans->{evaluation_points} }; 2585 my @parameters = (); 2586 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY'; 2587 my $errors = undef; 2588 my @zero_params=(); 2589 for(my $i=1;$i<=@{$ra_parameters};$i++){push(@zero_params,0); } 2590 my @differences = (); 2591 my @student_values; 2592 my @correct_values; 2593 my @tol_values; 2594 my ($diff,$tol_val); 2595 # calculate the vector of differences between the test function and the comparison function. 2596 while (@evaluation_points) { 2597 my ($err1, $err2,$err3); 2598 my @vars = @{ shift(@evaluation_points) }; 2599 my @inputs = (@vars, @parameters); 2600 my ($inVal, $correctVal); 2601 ($inVal, $err1) = &{$rf_fun}(@vars); 2602 $errors .= " $err1 " if defined($err1); 2603 $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err1); 2604 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs); 2605 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2); 2606 $errors .= " Error detected evaluating correct answer at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2); 2607 ($tol_val,$err3)= &$rf_correct_fun(@vars, @zero_params); 2608 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3); 2609 $errors .= " Error detected evaluating correct answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3); 2610 unless (defined($err1) or defined($err2) or defined($err3) ) { 2611 $diff = ( $inVal - ($correctVal -$tol_val ) ) - $tol_val; #prevents entering too high a number? 2612 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 2613 2614 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 2615 #warn "diff = $diff"; 2616 2617 $diff = ( $inVal - ($correctVal-$tol_val ) )/abs($tol_val) -1 if abs($tol_val) > $options{zeroLevel}; 2618 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel}; 2619 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal"; 2620 } 2621 } 2622 last if $errors; # break if there are any errors. 2623 # This cuts down on the size of error messages. 2624 # However it impossible to check for equivalence at 95% of points 2625 # which might be useful for functions that are not defined at some points. 2626 push(@student_values,$inVal); 2627 push(@correct_values,( $inVal - ($correctVal-$tol_val ) )); 2628 push(@differences, $diff); 2629 push(@tol_values,$tol_val); 2630 } 2631 $rh_ans ->{ra_differences} = \@differences; 2632 $rh_ans ->{ra_student_values} = \@student_values; 2633 $rh_ans ->{ra_adjusted_student_values} = \@correct_values; 2634 $rh_ans->{ra_tol_values}=\@tol_values; 2635 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 2636 $rh_ans; 2637 } 2638 2639 2640 ########################################################################## 2641 ########################################################################## 2642 ## String answer evaluators 2643 2644 =head2 String Answer Evaluators 2645 2646 String answer evaluators compare a student string to the correct string. 2647 Different filters can be applied to allow various degrees of variation. 2648 Both the student and correct answers are subject to the same filters, to 2649 ensure that there are no unexpected matches or rejections. 2650 2651 String Filters 2652 2653 remove_whitespace -- Removes all whitespace from the string. 2654 It applies the following substitution 2655 to the string: 2656 $filteredAnswer =~ s/\s+//g; 2657 2658 compress_whitespace -- Removes leading and trailing whitespace, and 2659 replaces all other blocks of whitespace by a 2660 single space. Applies the following substitutions: 2661 $filteredAnswer =~ s/^\s*//; 2662 $filteredAnswer =~ s/\s*$//; 2663 $filteredAnswer =~ s/\s+/ /g; 2664 2665 trim_whitespace -- Removes leading and trailing whitespace. 2666 Applies the following substitutions: 2667 $filteredAnswer =~ s/^\s*//; 2668 $filteredAnswer =~ s/\s*$//; 2669 2670 ignore_case -- Ignores the case of the string. More accurately, 2671 it converts the string to uppercase (by convention). 2672 Applies the following function: 2673 $filteredAnswer = uc $filteredAnswer; 2674 2675 ignore_order -- Ignores the order of the letters in the string. 2676 This is used for problems of the form "Choose all 2677 that apply." Specifically, it removes all 2678 whitespace and lexically sorts the letters in 2679 ascending alphabetical order. Applies the following 2680 functions: 2681 $filteredAnswer = join( "", lex_sort( 2682 split( /\s*/, $filteredAnswer ) ) ); 2683 2684 =cut 2685 2686 ################################ 2687 ## STRING ANSWER FILTERS 2688 2689 ## IN: --the string to be filtered 2690 ## --a list of the filters to use 2691 ## 2692 ## OUT: --the modified string 2693 ## 2694 ## Use this subroutine instead of the 2695 ## individual filters below it 2696 sub str_filters { 2697 my $stringToFilter = shift @_; 2698 my @filters_to_use = @_; 2699 my %known_filters = ( 'remove_whitespace' => undef, 2700 'compress_whitespace' => undef, 2701 'trim_whitespace' => undef, 2702 'ignore_case' => undef, 2703 'ignore_order' => undef 2704 ); 2705 2706 #test for unknown filters 2707 my $filter; 2708 foreach $filter (@filters_to_use) { 2709 die "Unknown string filter $filter (try checking the parameters to str_cmp() )" 2710 unless exists $known_filters{$filter}; 2711 } 2712 2713 if( grep( /remove_whitespace/i, @filters_to_use ) ) { 2714 $stringToFilter = remove_whitespace( $stringToFilter ); 2715 } 2716 if( grep( /compress_whitespace/i, @filters_to_use ) ) { 2717 $stringToFilter = compress_whitespace( $stringToFilter ); 2718 } 2719 if( grep( /trim_whitespace/i, @filters_to_use ) ) { 2720 $stringToFilter = trim_whitespace( $stringToFilter ); 2721 } 2722 if( grep( /ignore_case/i, @filters_to_use ) ) { 2723 $stringToFilter = ignore_case( $stringToFilter ); 2724 } 2725 if( grep( /ignore_order/i, @filters_to_use ) ) { 2726 $stringToFilter = ignore_order( $stringToFilter ); 2727 } 2728 2729 return $stringToFilter; 2730 } 2731 2732 sub remove_whitespace { 2733 my $filteredAnswer = shift; 2734 2735 $filteredAnswer =~ s/\s+//g; # remove all whitespace 2736 2737 return $filteredAnswer; 2738 } 2739 2740 sub compress_whitespace { 2741 my $filteredAnswer = shift; 2742 2743 $filteredAnswer =~ s/^\s*//; # remove initial whitespace 2744 $filteredAnswer =~ s/\s*$//; # remove trailing whitespace 2745 $filteredAnswer =~ s/\s+/ /g; # replace spaces by single space 2746 2747 return $filteredAnswer; 2748 } 2749 2750 sub trim_whitespace { 2751 my $filteredAnswer = shift; 2752 2753 $filteredAnswer =~ s/^\s*//; # remove initial whitespace 2754 $filteredAnswer =~ s/\s*$//; # remove trailing whitespace 2755 2756 return $filteredAnswer; 2757 } 2758 2759 sub ignore_case { 2760 my $filteredAnswer = shift; 2761 2762 $filteredAnswer = uc $filteredAnswer; 2763 2764 return $filteredAnswer; 2765 } 2766 2767 sub ignore_order { 2768 my $filteredAnswer = shift; 2769 2770 $filteredAnswer = join( "", lex_sort( split( /\s*/, $filteredAnswer ) ) ); 2771 2772 return $filteredAnswer; 2773 } 2774 ################################ 2775 ## END STRING ANSWER FILTERS 2776 2777 =head3 "mode"_str_cmp functions 2778 2779 The functions of the the form "mode"_str_cmp() use different functions to 2780 specify which filters to apply. They take no options except the correct 2781 string. There are also versions which accept a list of strings. 2782 2783 std_str_cmp( $correctString ) 2784 std_str_cmp_list( @correctStringList ) 2785 Filters: compress_whitespace, ignore_case 2786 2787 std_cs_str_cmp( $correctString ) 2788 std_cs_str_cmp_list( @correctStringList ) 2789 Filters: compress_whitespace 2790 2791 strict_str_cmp( $correctString ) 2792 strict_str_cmp_list( @correctStringList ) 2793 Filters: trim_whitespace 2794 2795 unordered_str_cmp( $correctString ) 2796 unordered_str_cmp_list( @correctStringList ) 2797 Filters: ignore_order, ignore_case 2798 2799 unordered_cs_str_cmp( $correctString ) 2800 unordered_cs_str_cmp_list( @correctStringList ) 2801 Filters: ignore_order 2802 2803 ordered_str_cmp( $correctString ) 2804 ordered_str_cmp_list( @correctStringList ) 2805 Filters: remove_whitespace, ignore_case 2806 2807 ordered_cs_str_cmp( $correctString ) 2808 ordered_cs_str_cmp_list( @correctStringList ) 2809 Filters: remove_whitespace 2810 2811 Examples 2812 2813 ANS( std_str_cmp( "W. Mozart" ) ) -- Accepts "W. Mozart", "W. MOZarT", 2814 and so forth. Case insensitive. All internal spaces treated 2815 as single spaces. 2816 ANS( std_cs_str_cmp( "Mozart" ) ) -- Rejects "mozart". Same as 2817 std_str_cmp() but case sensitive. 2818 ANS( strict_str_cmp( "W. Mozart" ) ) -- Accepts only the exact string. 2819 ANS( unordered_str_cmp( "ABC" ) ) -- Accepts "a c B", "CBA" and so forth. 2820 Unordered, case insensitive, spaces ignored. 2821 ANS( unordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc". Same as 2822 unordered_str_cmp() but case sensitive. 2823 ANS( ordered_str_cmp( "ABC" ) ) -- Accepts "a b C", "A B C" and so forth. 2824 Ordered, case insensitive, spaces ignored. 2825 ANS( ordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc", accepts "A BC" and 2826 so forth. Same as ordered_str_cmp() but case sensitive. 2827 2828 =cut 2829 2830 sub std_str_cmp { # compare strings 2831 my $correctAnswer = shift @_; 2832 my @filters = ( 'compress_whitespace', 'ignore_case' ); 2833 my $type = 'std_str_cmp'; 2834 STR_CMP( 'correctAnswer' => $correctAnswer, 2835 'filters' => \@filters, 2836 'type' => $type 2837 ); 2838 } 2839 2840 sub std_str_cmp_list { # alias for std_str_cmp 2841 my @answerList = @_; 2842 my @output; 2843 while (@answerList) { 2844 push( @output, std_str_cmp(shift @answerList) ); 2845 } 2846 @output; 2847 } 2848 2849 sub std_cs_str_cmp { # compare strings case sensitive 2850 my $correctAnswer = shift @_; 2851 my @filters = ( 'compress_whitespace' ); 2852 my $type = 'std_cs_str_cmp'; 2853 STR_CMP( 'correctAnswer' => $correctAnswer, 2854 'filters' => \@filters, 2855 'type' => $type 2856 ); 2857 } 2858 2859 sub std_cs_str_cmp_list { # alias for std_cs_str_cmp 2860 my @answerList = @_; 2861 my @output; 2862 while (@answerList) { 2863 push( @output, std_cs_str_cmp(shift @answerList) ); 2864 } 2865 @output; 2866 } 2867 2868 sub strict_str_cmp { # strict string compare 2869 my $correctAnswer = shift @_; 2870 my @filters = ( 'trim_whitespace' ); 2871 my $type = 'strict_str_cmp'; 2872 STR_CMP( 'correctAnswer' => $correctAnswer, 2873 'filters' => \@filters, 2874 'type' => $type 2875 ); 2876 } 2877 2878 sub strict_str_cmp_list { # alias for strict_str_cmp 2879 my @answerList = @_; 2880 my @output; 2881 while (@answerList) { 2882 push( @output, strict_str_cmp(shift @answerList) ); 2883 } 2884 @output; 2885 } 2886 2887 sub unordered_str_cmp { # unordered, case insensitive, spaces ignored 2888 my $correctAnswer = shift @_; 2889 my @filters = ( 'ignore_order', 'ignore_case' ); 2890 my $type = 'unordered_str_cmp'; 2891 STR_CMP( 'correctAnswer' => $correctAnswer, 2892 'filters' => \@filters, 2893 'type' => $type 2894 ); 2895 } 2896 2897 sub unordered_str_cmp_list { # alias for unordered_str_cmp 2898 my @answerList = @_; 2899 my @output; 2900 while (@answerList) { 2901 push( @output, unordered_str_cmp(shift @answerList) ); 2902 } 2903 @output; 2904 } 2905 2906 sub unordered_cs_str_cmp { # unordered, case sensitive, spaces ignored 2907 my $correctAnswer = shift @_; 2908 my @filters = ( 'ignore_order' ); 2909 my $type = 'unordered_cs_str_cmp'; 2910 STR_CMP( 'correctAnswer' => $correctAnswer, 2911 'filters' => \@filters, 2912 'type' => $type 2913 ); 2914 } 2915 2916 sub unordered_cs_str_cmp_list { # alias for unordered_cs_str_cmp 2917 my @answerList = @_; 2918 my @output; 2919 while (@answerList) { 2920 push( @output, unordered_cs_str_cmp(shift @answerList) ); 2921 } 2922 @output; 2923 } 2924 2925 sub ordered_str_cmp { # ordered, case insensitive, spaces ignored 2926 my $correctAnswer = shift @_; 2927 my @filters = ( 'remove_whitespace', 'ignore_case' ); 2928 my $type = 'ordered_str_cmp'; 2929 STR_CMP( 'correctAnswer' => $correctAnswer, 2930 'filters' => \@filters, 2931 'type' => $type 2932 ); 2933 } 2934 2935 sub ordered_str_cmp_list { # alias for ordered_str_cmp 2936 my @answerList = @_; 2937 my @output; 2938 while (@answerList) { 2939 push( @output, ordered_str_cmp(shift @answerList) ); 2940 } 2941 @output; 2942 2943 } 2944 2945 sub ordered_cs_str_cmp { # ordered, case sensitive, spaces ignored 2946 my $correctAnswer = shift @_; 2947 my @filters = ( 'remove_whitespace' ); 2948 my $type = 'ordered_cs_str_cmp'; 2949 STR_CMP( 'correctAnswer' => $correctAnswer, 2950 'filters' => \@filters, 2951 'type' => $type 2952 ); 2953 } 2954 2955 sub ordered_cs_str_cmp_list { # alias for ordered_cs_str_cmp 2956 my @answerList = @_; 2957 my @output; 2958 while (@answerList) { 2959 push( @output, ordered_cs_str_cmp(shift @answerList) ); 2960 } 2961 @output; 2962 } 2963 2964 =head3 str_cmp() 2965 2966 Compares a string or a list of strings, using a named hash of options to set 2967 parameters. This can make for more readable code than using the "mode"_str_cmp() 2968 style, but some people find one or the other easier to remember. 2969 2970 ANS( str_cmp( answer or answer_array_ref, options_hash ) ); 2971 2972 1. the correct answer or a reference to an array of answers 2973 2. either a list of filters, or: 2974 a hash consisting of 2975 filters - a reference to an array of filters 2976 2977 Returns an answer evaluator, or (if given a reference to an array of answers), 2978 a list of answer evaluators 2979 2980 FILTERS: 2981 2982 remove_whitespace -- removes all whitespace 2983 compress_whitespace -- removes whitespace from the beginning and end of the string, 2984 and treats one or more whitespace characters in a row as a 2985 single space (true by default) 2986 trim_whitespace -- removes whitespace from the beginning and end of the string 2987 ignore_case -- ignores the case of the letters (true by default) 2988 ignore_order -- ignores the order in which letters are entered 2989 2990 EXAMPLES: 2991 2992 str_cmp( "Hello" ) -- matches "Hello", " hello" (same as std_str_cmp() ) 2993 str_cmp( ["Hello", "Goodbye"] ) -- same as std_str_cmp_list() 2994 str_cmp( " hello ", trim_whitespace ) -- matches "hello", " hello " 2995 str_cmp( "ABC", filters => 'ignore_order' ) -- matches "ACB", "A B C", but not "abc" 2996 str_cmp( "D E F", remove_whitespace, ignore_case ) -- matches "def" and "d e f" but not "fed" 2997 2998 =cut 2999 3000 sub str_cmp { 3001 my $correctAnswer = shift @_; 3002 $correctAnswer = '' unless defined($correctAnswer); 3003 my @options = @_; 3004 my $ra_filters; 3005 3006 # error-checking for filters occurs in the filters() subroutine 3007 if( not defined( $options[0] ) ) { # used with no filters as alias for std_str_cmp() 3008 @options = ( 'compress_whitespace', 'ignore_case' ); 3009 } 3010 3011 if( $options[0] eq 'filters' ) { # using filters => [f1, f2, ...] notation 3012 $ra_filters = $options[1]; 3013 } 3014 else { # using a list of filters 3015 $ra_filters = \@options; 3016 } 3017 3018 # thread over lists 3019 my @ans_list = (); 3020 3021 if ( ref($correctAnswer) eq 'ARRAY' ) { 3022 @ans_list = @{$correctAnswer}; 3023 } 3024 else { 3025 push( @ans_list, $correctAnswer ); 3026 } 3027 3028 # final_answer; 3029 my @output_list = (); 3030 3031 foreach my $ans (@ans_list) { 3032 push(@output_list, STR_CMP( 'correctAnswer' => $ans, 3033 'filters' => $ra_filters, 3034 'type' => 'str_cmp' 3035 ) 3036 ); 3037 } 3038 3039 return @output_list; 3040 } 3041 3042 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 3043 ## 3044 ## IN: a hashtable with the following entries (error-checking to be added later?): 3045 ## correctAnswer -- the correct answer, before filtering 3046 ## filters -- reference to an array containing the filters to be applied 3047 ## type -- a string containing the type of answer evaluator in use 3048 ## OUT: a reference to an answer evaluator subroutine 3049 3050 sub STR_CMP { 3051 my %str_params = @_; 3052 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} ); 3053 my $answer_evaluator = sub { 3054 my $in = shift @_; 3055 $in = '' unless defined $in; 3056 my $original_student_ans = $in; 3057 $in = str_filters( $in, @{$str_params{'filters'}} ); 3058 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0; 3059 my $ans_hash = new AnswerHash( 'score' => $correctQ, 3060 'correct_ans' => $str_params{'correctAnswer'}, 3061 'student_ans' => $in, 3062 'ans_message' => '', 3063 'type' => $str_params{'type'}, 3064 'preview_text_string' => $in, 3065 'preview_latex_string' => $in, 3066 'original_student_ans' => $original_student_ans 3067 ); 3068 return $ans_hash; 3069 }; 3070 return $answer_evaluator; 3071 } 3072 3073 ########################################################################## 3074 ########################################################################## 3075 ## Miscellaneous answer evaluators 3076 3077 =head2 Miscellaneous Answer Evaluators (Checkboxes and Radio Buttons) 3078 3079 These evaluators do not fit any of the other categories. 3080 3081 checkbox_cmp( $correctAnswer ) 3082 3083 $correctAnswer -- a string containing the names of the correct boxes, 3084 e.g. "ACD". Note that this means that individual 3085 checkbox names can only be one character. Internally, 3086 this is largely the same as unordered_cs_str_cmp(). 3087 3088 radio_cmp( $correctAnswer ) 3089 3090 $correctAnswer -- a string containing the name of the correct radio 3091 button, e.g. "Choice1". This is case sensitive and 3092 whitespace sensitive, so the correct answer must match 3093 the name of the radio button exactly. 3094 3095 =cut 3096 3097 # added 6/14/2000 by David Etlinger 3098 # because of the conversion of the answer 3099 # string to an array, I thought it better not 3100 # to force STR_CMP() to work with this 3101 sub checkbox_cmp { 3102 my $correctAnswer = shift @_; 3103 $correctAnswer = str_filters( $correctAnswer, 'ignore_order' ); 3104 3105 my $answer_evaluator = sub { 3106 my $in = shift @_; 3107 $in = '' unless defined $in; #in case no boxes checked 3108 3109 my @temp = split( "\0", $in ); #convert "\0"-delimited string to array... 3110 $in = join( "", @temp ); #and then to a single no-delimiter string 3111 3112 my $original_student_ans = $in; #well, almost original 3113 $in = str_filters( $in, 'ignore_order' ); 3114 3115 my $correctQ = ($in eq $correctAnswer) ? 1: 0; 3116 3117 my $ans_hash = new AnswerHash( 3118 'score' => $correctQ, 3119 'correct_ans' => $correctAnswer, 3120 'student_ans' => $in, 3121 'ans_message' => "", 3122 'type' => "checkbox_cmp", 3123 'preview_text_string' => $in, 3124 'original_student_ans' => $original_student_ans 3125 ); 3126 3127 return $ans_hash; 3128 3129 }; 3130 3131 return $answer_evaluator; 3132 } 3133 3134 #added 6/28/2000 by David Etlinger 3135 #exactly the same as strict_str_cmp, 3136 #but more intuitive to the user 3137 sub radio_cmp { 3138 strict_str_cmp( @_ ); 3139 } 3140 3141 3142 3143 ########################################################################## 3144 ########################################################################## 3145 ## Text and e-mail routines 3146 3147 3148 sub store_ans_at { 3149 my $answerStringRef = shift; 3150 my %options = @_; 3151 my $ans_eval= ''; 3152 if ( ref($answerStringRef) eq 'SCALAR' ) { 3153 $ans_eval= sub { 3154 my $text = shift; 3155 $text = '' unless defined($text); 3156 $$answerStringRef = $$answerStringRef . $text; 3157 my $ans_hash = new AnswerHash( 3158 'score' => 1, 3159 'correct_ans' => '', 3160 'student_ans' => $text, 3161 'ans_message' => '', 3162 'type' => 'store_ans_at', 3163 'original_student_ans' => $text, 3164 'preview_text_string' => '' 3165 3166 ); 3167 3168 return $ans_hash; 3169 }; 3170 } 3171 else { 3172 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"; 3173 } 3174 3175 return $ans_eval; 3176 } 3177 3178 3179 #### subroutines used in producing a questionnaire 3180 #### these are at least good models for other answers of this type 3181 3182 my $QUESTIONNAIRE_ANSWERS=''; # stores the answers until it is time to send them 3183 # this must be initialized before the answer evaluators are run 3184 # but that happens long after all of the text in the problem is 3185 # evaluated. 3186 # this is a utility script for cleaning up the answer output for display in 3187 #the answers. 3188 3189 3190 sub DUMMY_ANSWER { 3191 my $num = shift; 3192 qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">} 3193 } 3194 3195 sub escapeHTML { 3196 my $string = shift; 3197 $string =~ s/\n/$BR/ge; 3198 $string; 3199 } 3200 3201 # these next two subroutines show how to modify the "store_and_at()" answer 3202 # evaluator to add extra information before storing the info 3203 # They provide a good model for how to tweak answer evaluators in special cases. 3204 sub anstext { 3205 my $num = shift; 3206 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3207 my $ans_eval = sub { 3208 my $text = shift; 3209 $text = '' unless defined($text); 3210 my $new_text = "\n$main::psvnNumber-Problem-$main::probNum-Question-$num:\n $text "; # modify entered text 3211 my $out = &$ans_eval_template($new_text); # standard evaluator 3212 #warn "$QUESTIONNAIRE_ANSWERS"; 3213 $out->{student_ans} = escapeHTML($text); # restore original entered text 3214 $out->{correct_ans} = "Question $num answered"; 3215 $out->{original_student_ans} = escapeHTML($text); 3216 $out; 3217 }; 3218 $ans_eval; 3219 } 3220 3221 sub ansradio { 3222 my $num = shift; 3223 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3224 my $ans_eval = sub { 3225 my $text = shift; 3226 $text = '' unless defined($text); 3227 my $new_text = "\n$main::psvnNumber-Problem-$main::probNum-RADIO-$num:\n $text "; # modify entered text 3228 my $out = $ans_eval_template->($new_text); # standard evaluator 3229 $out->{student_ans} =escapeHTML($text); # restore original entered text 3230 $out->{original_student_ans} = escapeHTML($text); 3231 $out; 3232 }; 3233 3234 3235 $ans_eval; 3236 } 3237 3238 # This is another example of how to modify an answer evaluator to obtain 3239 # the desired behavior in a special case. Here the object is to have 3240 # have the last answer trigger the send_mail_to subroutine which mails 3241 # all of the answers to the designated address. 3242 # (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.) 3243 3244 sub mail_answers_to { #accepts the last answer and mails off the result 3245 my $user_address = shift; 3246 my $ans_eval = sub { 3247 3248 # then mail out all of the answers, including this last one. 3249 3250 send_mail_to( $user_address, 3251 'subject' => "$main::courseName WeBWorK questionnaire", 3252 'body' => $QUESTIONNAIRE_ANSWERS, 3253 'ALLOW_MAIL_TO' => $main::ALLOW_MAIL_TO 3254 ); 3255 3256 my $ans_hash = new AnswerHash( 'score' => 1, 3257 'correct_ans' => '', 3258 'student_ans' => 'Answer recorded', 3259 'ans_message' => '', 3260 'type' => 'send_mail_to', 3261 ); 3262 3263 return $ans_hash; 3264 }; 3265 3266 return $ans_eval; 3267 } 3268 sub mail_answers_to2 { #accepts the last answer and mails off the result 3269 my $user_address = shift; 3270 my $subject = shift; 3271 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject; 3272 3273 3274 send_mail_to($user_address, 3275 'subject' => $subject, 3276 'body' => $QUESTIONNAIRE_ANSWERS, 3277 'ALLOW_MAIL_TO' => $main::ALLOW_MAIL_TO 3278 ); 3279 3280 3281 } 3282 3283 3284 3285 ########################################################################## 3286 ########################################################################## 3287 ## Problem Grader Subroutines 3288 3289 3290 ##################################### 3291 # This is a model for plug-in problem graders 3292 ##################################### 3293 sub install_problem_grader { 3294 my $rf_problem_grader = shift; 3295 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $rf_problem_grader; 3296 } 3297 3298 #this is called std only for compatability purposes; 3299 #almost everyone uses avg_problem_grader 3300 sub std_problem_grader{ 3301 my $rh_evaluated_answers = shift; 3302 my $rh_problem_state = shift; 3303 my %form_options = @_; 3304 my %evaluated_answers = %{$rh_evaluated_answers}; 3305 # The hash $rh_evaluated_answers typically contains: 3306 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 3307 3308 # By default the old problem state is simply passed back out again. 3309 my %problem_state = %$rh_problem_state; 3310 3311 3312 # %form_options might include 3313 # The user login name 3314 # The permission level of the user 3315 # The studentLogin name for this psvn. 3316 # Whether the form is asking for a refresh or is submitting a new answer. 3317 3318 # initial setup of the answer 3319 my %problem_result = ( score => 0, 3320 errors => '', 3321 type => 'std_problem_grader', 3322 msg => '', 3323 ); 3324 # Checks 3325 3326 my $ansCount = keys %evaluated_answers; # get the number of answers 3327 unless ($ansCount > 0 ) { 3328 $problem_result{msg} = "This problem did not ask any questions."; 3329 return(\%problem_result,\%problem_state); 3330 } 3331 3332 if ($ansCount > 1 ) { 3333 $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ; 3334 } 3335 3336 unless ($form_options{answers_submitted} == 1) { 3337 return(\%problem_result,\%problem_state); 3338 } 3339 3340 my $allAnswersCorrectQ=1; 3341 foreach my $ans_name (keys %evaluated_answers) { 3342 # I'm not sure if this check is really useful. 3343 if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) { 3344 $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} ); 3345 } 3346 else { 3347 die "Error at file ",__FILE__,"line ", __LINE__,": Answer |$ans_name| is not a hash reference\n". 3348 $evaluated_answers{$ans_name} . 3349 "This probably means that the answer evaluator for this answer\n" . 3350 "is not working correctly."; 3351 $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}"; 3352 } 3353 } 3354 # report the results 3355 $problem_result{score} = $allAnswersCorrectQ; 3356 3357 # I don't like to put in this bit of code. 3358 # It makes it hard to construct error free problem graders 3359 # I would prefer to know that the problem score was numeric. 3360 unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 3361 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 3362 } 3363 # 3364 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 3365 $problem_state{recorded_score} = 1; 3366 } 3367 else { 3368 $problem_state{recorded_score} = 0; 3369 } 3370 3371 $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1; 3372 $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0; 3373 (\%problem_result, \%problem_state); 3374 } 3375 3376 #the only difference between the two versions 3377 #is at the end of the subroutine, where std_problem_grader2 3378 #records the attempt only if there have been no syntax errors, 3379 #whereas std_problem_grader records it regardless 3380 sub std_problem_grader2{ 3381 my $rh_evaluated_answers = shift; 3382 my $rh_problem_state = shift; 3383 my %form_options = @_; 3384 my %evaluated_answers = %{$rh_evaluated_answers}; 3385 # The hash $rh_evaluated_answers typically contains: 3386 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 3387 3388 # By default the old problem state is simply passed back out again. 3389 my %problem_state = %$rh_problem_state; 3390 3391 3392 # %form_options might include 3393 # The user login name 3394 # The permission level of the user 3395 # The studentLogin name for this psvn. 3396 # Whether the form is asking for a refresh or is submitting a new answer. 3397 3398 # initial setup of the answer 3399 my %problem_result = ( score => 0, 3400 errors => '', 3401 type => 'std_problem_grader', 3402 msg => '', 3403 ); 3404 3405 # syntax errors are not counted. 3406 my $record_problem_attempt = 1; 3407 # Checks 3408 3409 my $ansCount = keys %evaluated_answers; # get the number of answers 3410 unless ($ansCount > 0 ) { 3411 $problem_result{msg} = "This problem did not ask any questions."; 3412 return(\%problem_result,\%problem_state); 3413 } 3414 3415 if ($ansCount > 1 ) { 3416 $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ; 3417 } 3418 3419 unless ($form_options{answers_submitted} == 1) { 3420 return(\%problem_result,\%problem_state); 3421 } 3422 3423 my $allAnswersCorrectQ=1; 3424 foreach my $ans_name (keys %evaluated_answers) { 3425 # I'm not sure if this check is really useful. 3426 if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) { 3427 $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} ); 3428 } 3429 else { 3430 die "Error at file ",__FILE__,"line ", __LINE__,": Answer |$ans_name| is not a hash reference\n". 3431 $evaluated_answers{$ans_name} . 3432 "This probably means that the answer evaluator for this answer\n" . 3433 "is not working correctly."; 3434 $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}"; 3435 } 3436 } 3437 # report the results 3438 $problem_result{score} = $allAnswersCorrectQ; 3439 3440 # I don't like to put in this bit of code. 3441 # It makes it hard to construct error free problem graders 3442 # I would prefer to know that the problem score was numeric. 3443 unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 3444 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 3445 } 3446 # 3447 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 3448 $problem_state{recorded_score} = 1; 3449 } 3450 else { 3451 $problem_state{recorded_score} = 0; 3452 } 3453 # record attempt only if there have been no syntax errors. 3454 3455 if ($record_problem_attempt == 1) { 3456 $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1; 3457 $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0; 3458 } 3459 else { 3460 $problem_result{show_partial_correct_answers} = 0 ; # prevent partial correct answers from being shown for syntax errors. 3461 3462 } 3463 3464 (\%problem_result, \%problem_state); 3465 } 3466 3467 3468 sub avg_problem_grader{ 3469 my $rh_evaluated_answers = shift; 3470 my $rh_problem_state = shift; 3471 my %form_options = @_; 3472 my %evaluated_answers = %{$rh_evaluated_answers}; 3473 # The hash $rh_evaluated_answers typically contains: 3474 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 3475 3476 # By default the old problem state is simply passed back out again. 3477 my %problem_state = %$rh_problem_state; 3478 3479 3480 # %form_options might include 3481 # The user login name 3482 # The permission level of the user 3483 # The studentLogin name for this psvn. 3484 # Whether the form is asking for a refresh or is submitting a new answer. 3485 3486 # initial setup of the answer 3487 my $total=0; 3488 my %problem_result = ( score => 0, 3489 errors => '', 3490 type => 'avg_problem_grader', 3491 msg => '', 3492 ); 3493 my $count = keys %evaluated_answers; 3494 $problem_result{msg} = 'You can earn partial credit on this problem.' if $count >1; 3495 # Return unless answers have been submitted 3496 unless ($form_options{answers_submitted} == 1) { 3497 return(\%problem_result,\%problem_state); 3498 } 3499 3500 # Answers have been submitted -- process them. 3501 foreach my $ans_name (keys %evaluated_answers) { 3502 # I'm not sure if this check is really useful. 3503 if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) { 3504 $total += $evaluated_answers{$ans_name}->{score}; 3505 } 3506 else { 3507 die "Error: Answer |$ans_name| is not a hash reference\n". 3508 $evaluated_answers{$ans_name} . 3509 "This probably means that the answer evaluator for this answer\n" . 3510 "is not working correctly."; 3511 $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}"; 3512 } 3513 } 3514 # Calculate score rounded to three places to avoid roundoff problems 3515 $problem_result{score} = $total/$count if $count; 3516 # increase recorded score if the current score is greater. 3517 $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score}; 3518 3519 3520 $problem_state{num_of_correct_ans}++ if $total == $count; 3521 $problem_state{num_of_incorrect_ans}++ if $total < $count ; 3522 warn "Error in grading this problem the total $total is larger than $count" if $total > $count; 3523 (\%problem_result, \%problem_state); 3524 3525 } 3526 3527 3528 3529 ########################################################################### 3530 ### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT. 3531 3532 3533 ## Internal routine that converts variables into the standard array format 3534 ## 3535 ## IN: one of the following: 3536 ## an undefined value (i.e., no variable was specified) 3537 ## a reference to an array of variable names -- [var1, var2] 3538 ## a number (the number of variables desired) -- 3 3539 ## one or more variable names -- (var1, var2) 3540 ## OUT: an array of variable names 3541 sub get_var_array { 3542 my $in = shift @_; 3543 my @out; 3544 3545 if( not defined($in) ) { #if nothing defined, build default array and return 3546 @out = ( $functVarDefault ); 3547 return @out; 3548 } 3549 elsif( ref( $in ) eq 'ARRAY' ) { #if given an array ref, dereference and return 3550 return @{$in}; 3551 } 3552 elsif( $in =~ /^\d+/ ) { #if given a number, set up the array and return 3553 if( $in == 1 ) { 3554 $out[0] = 'x'; 3555 } 3556 elsif( $in == 2 ) { 3557 $out[0] = 'x'; 3558 $out[1] = 'y'; 3559 } 3560 elsif( $in == 3 ) { 3561 $out[0] = 'x'; 3562 $out[1] = 'y'; 3563 $out[2] = 'z'; 3564 } 3565 else { #default to the x_1, x_2, ... convention 3566 my ($i, $tag); 3567 for( $i=0; $i < $in; $i++ ) { 3568 ## akp the above seems to be off by one 1/4/00 3569 $tag = $i + 1; ## akp 1/4/00 3570 $out[$i] = "${functVarDefault}_" . $tag; ## akp 1/4/00 3571 } 3572 } 3573 3574 return @out; 3575 } 3576 else { #if given one or more names, return as an array 3577 unshift( @_, $in ); 3578 3579 return @_; 3580 } 3581 } 3582 3583 ## Internal routine that converts limits into the standard array of arrays format 3584 ## Some of the cases are probably unneccessary, but better safe than sorry 3585 ## 3586 ## IN: one of the following: 3587 ## an undefined value (i.e., no limits were specified) 3588 ## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]] 3589 ## a reference to an array of limits -- [llim, ulim] 3590 ## an array of array references -- ([llim,ulim], [llim,ulim]) 3591 ## an array of limits -- (llim,ulim) 3592 ## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim]) 3593 3594 sub get_limits_array { 3595 my $in = shift @_; 3596 my @out; 3597 3598 if( not defined($in) ) { #if nothing defined, build default array and return 3599 @out = ( [$functLLimitDefault, $functULimitDefault] ); 3600 return @out; 3601 } 3602 elsif( ref($in) eq 'ARRAY' ) { #$in is either ref to array, or ref to array of refs 3603 my @deref = @{$in}; 3604 3605 if( ref( $in->[0] ) eq 'ARRAY' ) { #$in is a ref to an array of array refs 3606 return @deref; 3607 } 3608 else { #$in was just a ref to an array of numbers 3609 @out = ( $in ); 3610 return @out; 3611 } 3612 } 3613 else { #$in was an array of references or numbers 3614 unshift( @_, $in ); 3615 3616 if( ref($_[0]) eq 'ARRAY' ) { #$in was an array of references, so just return it 3617 return @_; 3618 } 3619 else { #$in was an array of numbers 3620 @out = ( \@_ ); 3621 return @out; 3622 } 3623 } 3624 } 3625 3626 sub check_option_list { 3627 my $size = scalar(@_); 3628 if( ( $size % 2 ) != 0 ) { 3629 warn "ERROR in answer evaluator generator:\n" . 3630 "Usage: <CODE>str_cmp([\$ans1, \$ans2],%options)</CODE> 3631 or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR> 3632 A list of inputs must be inclosed in square brackets <CODE>[\$ans1, \$ans2]</CODE>"; 3633 } 3634 } 3635 3636 # simple subroutine to display an error message when 3637 # function compares are called with invalid parameters 3638 sub function_invalid_params { 3639 my $correctEqn = shift @_; 3640 my $error_response = sub { 3641 my $PGanswerMessage = "Tell your professor that there is an error with the parameters " . 3642 "to the function answer evaluator"; 3643 return ( 0, $correctEqn, "", $PGanswerMessage ); 3644 }; 3645 3646 return $error_response; 3647 } 3648 3649 3650 ######################################################################### 3651 # Filters for answer evaluators 3652 ######################################################################### 3653 3654 3655 sub is_a_number { 3656 my ($num,%options) = @_; 3657 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 3658 my ($rh_ans); 3659 if ($process_ans_hash) { 3660 $rh_ans = $num; 3661 $num = $rh_ans->{student_ans}; 3662 } 3663 3664 my $is_a_number = 0; 3665 return $is_a_number unless defined($num); 3666 $num =~ s/^\s*//; ## remove initial spaces 3667 $num =~ s/\s*$//; ## remove trailing spaces 3668 3669 ## the following is copied from the online perl manual 3670 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ 3671 $is_a_number = 1; 3672 } 3673 3674 if ($process_ans_hash) { 3675 if ($is_a_number == 1 ) { 3676 $rh_ans->{student_ans}=$num; 3677 return $rh_ans; 3678 } else { 3679 $rh_ans->{student_ans} = "Incorrect number format: You must enter a number, e.g. -6, 5.3, or 6.12E-3"; 3680 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3'); 3681 return $rh_ans; 3682 } 3683 } else { 3684 return $is_a_number; 3685 } 3686 } 3687 3688 sub is_a_fraction { 3689 my ($num,%options) = @_; 3690 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 3691 my ($rh_ans); 3692 if ($process_ans_hash) { 3693 $rh_ans = $num; 3694 $num = $rh_ans->{student_ans}; 3695 } 3696 3697 my $is_a_fraction = 0; 3698 return $is_a_fraction unless defined($num); 3699 $num =~ s/^\s*//; ## remove initial spaces 3700 $num =~ s/\s*$//; ## remove trailing spaces 3701 3702 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) { 3703 $is_a_fraction = 1; 3704 } 3705 3706 if ($process_ans_hash) { 3707 if ($is_a_fraction == 1 ) { 3708 $rh_ans->{student_ans}=$num; 3709 return $rh_ans; 3710 } else { 3711 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13"; 3712 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3'); 3713 return $rh_ans; 3714 } 3715 3716 } else { 3717 return $is_a_fraction; 3718 } 3719 } 3720 3721 3722 sub is_an_arithmetic_expression { 3723 my ($num,%options) = @_; 3724 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 3725 my ($rh_ans); 3726 if ($process_ans_hash) { 3727 $rh_ans = $num; 3728 $num = $rh_ans->{student_ans}; 3729 } 3730 3731 my $is_an_arithmetic_expression = 0; 3732 return $is_an_arithmetic_expression unless defined($num); 3733 $num =~ s/^\s*//; ## remove initial spaces 3734 $num =~ s/\s*$//; ## remove trailing spaces 3735 3736 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) { 3737 $is_an_arithmetic_expression = 1; 3738 } 3739 3740 if ($process_ans_hash) { 3741 if ($is_an_arithmetic_expression == 1 ) { 3742 $rh_ans->{student_ans}=$num; 3743 return $rh_ans; 3744 } else { 3745 3746 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2"; 3747 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2'); 3748 return $rh_ans; 3749 } 3750 3751 } else { 3752 return $is_an_arithmetic_expression; 3753 } 3754 } 3755 3756 #replaces pi, e, and ^ with their Perl equivalents 3757 sub math_constants { 3758 my($in,%options) = @_; 3759 my $rh_ans; 3760 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ; 3761 if ($process_ans_hash) { 3762 $rh_ans = $in; 3763 $in = $rh_ans->{student_ans}; 3764 } 3765 3766 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 3767 $in =~s/\be\b/(exp(1))/ge; 3768 $in =~s/\^/**/g; 3769 3770 if ($process_ans_hash) { 3771 $rh_ans->{student_ans}=$in; 3772 return $rh_ans; 3773 } else { 3774 return $in; 3775 } 3776 } 3777 3778 sub clean_up_error_msg { 3779 my $msg = $_[0]; 3780 $msg =~ s/^\[[^\]]*\][^:]*://; 3781 $msg =~ s/Unquoted string//g; 3782 $msg =~ s/may\s+clash.*/does not make sense here/; 3783 $msg =~ s/\sat.*line [\d]*//g; 3784 $msg = 'error: '. $msg; 3785 3786 return $msg; 3787 } 3788 3789 #formats the student and correct answer as specified 3790 #format must be of a form suitable for sprintf (e.g. '%0.5g'), 3791 #with the exception that a '#' at the end of the string 3792 #will cause trailing zeros in the decimal part to be removed 3793 sub prfmt { 3794 my($number,$format) = @_; # attention, the order of format and number are reversed 3795 my $out; 3796 if ($format) { 3797 warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>" 3798 unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/; 3799 3800 if( $format =~ s/#\s*$// ) { # remove trailing zeros in the decimal 3801 $out = sprintf( $format, $number ); 3802 $out =~ s/(\.\d*?)0+$/$1/; 3803 $out =~ s/\.$//; # in case all decimal digits were zero, remove the decimal 3804 } 3805 else { 3806 $out = sprintf( $format, $number ); 3807 } 3808 3809 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 3810 } 3811 else { 3812 $out = $number; 3813 } 3814 3815 return $out; 3816 } 3817 3818 =head4 3819 3820 pretty_print() 3821 3822 3823 =cut 3824 3825 sub pretty_print { 3826 my $r_input = shift; 3827 my $out = ''; 3828 if ( not ref($r_input) ) { 3829 $out = $r_input; # not a reference 3830 } elsif ("$r_input" =~/hash/i) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput). 3831 local($^W) = 0; 3832 $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; 3833 foreach my $key (lex_sort( keys %$r_input )) { 3834 $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}) . "</td></tr>"; 3835 } 3836 $out .="</table>"; 3837 } elsif (ref($r_input) eq 'ARRAY' ) { 3838 my @array = @$r_input; 3839 $out .= "( " ; 3840 while (@array) { 3841 $out .= pretty_print(shift @array) . " , "; 3842 } 3843 $out .= " )"; 3844 } elsif (ref($r_input) eq 'CODE') { 3845 $out = "$r_input"; 3846 } else { 3847 $out = $r_input; 3848 } 3849 $out; 3850 } 3851 3852 # Use this to set default options 3853 sub set_default_options { 3854 my $rh_options = shift; 3855 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 3856 my %default_options = @_; 3857 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) { 3858 foreach my $key1 (keys %$rh_options) { 3859 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1}); 3860 } 3861 } 3862 foreach my $key (keys %default_options) { 3863 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) { 3864 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define 3865 # this key unless tol is explicitly defined. 3866 } 3867 } 3868 } 3869 # Use this to assign aliases for the standard options 3870 sub assign_option_aliases { 3871 my $rh_options = shift; 3872 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 3873 my @option_aliases = @_; 3874 while (@option_aliases) { 3875 my $alias = shift @option_aliases; 3876 my $option_key = shift @option_aliases; 3877 3878 if (defined($rh_options->{$alias} )) { # if the alias appears in the option list 3879 if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined, 3880 $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value 3881 # the FIRST alias for a given option takes precedence 3882 # (after the option itself) 3883 } else { 3884 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n", 3885 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias}, 3886 " was ignored."; 3887 } 3888 3889 } 3890 delete($rh_options->{$alias}); # remove the alias from the initial list 3891 } 3892 3893 } 3894 3895 3896 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |