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