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