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