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