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