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