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