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