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