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