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