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