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