Parent Directory
| 
Revision Log
Added Davide Cervone's methods for evaluating formulas module 2pi Used in complex variables in particular.
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 # Hack to fix up exponential notation in correct answer 1045 # (e.g., perl will pass .0000001 as 1e-07). 1046 # 1047 $correctAnswer = uc($correctAnswer) 1048 if $correctAnswer =~ m/e/ && Value::isNumber($correctAnswer); 1049 1050 # 1051 # Get an apppropriate context based on the mode 1052 # 1053 my $context; 1054 for ($mode) { 1055 /^strict$/i and do { 1056 $context = Parser::Context->getCopy($user_context,"LimitedNumeric"); 1057 last; 1058 }; 1059 /^arith$/i and do { 1060 $context = Parser::Context->getCopy($user_context,"LegacyNumeric"); 1061 $context->functions->disable('All'); 1062 last; 1063 }; 1064 /^frac$/i and do { 1065 $context = Parser::Context->getCopy($user_context,"LimitedNumeric-Fraction"); 1066 last; 1067 }; 1068 1069 # default 1070 $context = Parser::Context->getCopy($user_context,"LegacyNumeric"); 1071 } 1072 $context->{format}{number} = $num_params{'format'}; 1073 $context->strings->clear; 1074 # FIXME: should clear variables as well? Copy them from the current context? 1075 1076 # 1077 # Add the strings to the context 1078 # 1079 if ($num_params{strings}) { 1080 foreach my $string (@{$num_params{strings}}) { 1081 my %tex = ($string =~ m/^(-?)inf(inity)?$/i)? (TeX => "$1\\infty"): (); 1082 %tex = (TeX => "-\\infty") if uc($string) eq "MINF"; 1083 $context->strings->add(uc($string) => {%tex}) 1084 unless $context->strings->get(uc($string)); 1085 } 1086 } 1087 1088 # 1089 # Set the tolerances 1090 # 1091 if ($num_params{tolType} eq 'absolute') { 1092 $context->flags->set( 1093 tolerance => $num_params{tolerance}, 1094 tolType => 'absolute', 1095 ); 1096 } else { 1097 $context->flags->set( 1098 tolerance => .01*$num_params{tolerance}, 1099 tolType => 'relative', 1100 ); 1101 } 1102 $context->flags->set( 1103 zeroLevel => $num_params{zeroLevel}, 1104 zeroLevelTol => $num_params{zeroLevelTol}, 1105 ); 1106 1107 # 1108 # Get the proper Parser object for the professor's answer 1109 # using the initialized context 1110 # 1111 my $oldContext = &$Context(); &$Context($context); my $r; 1112 if ($num_params{units}) { 1113 $r = new Parser::Legacy::NumberWithUnits($correctAnswer); 1114 $options{rh_correct_units} = $num_params{units}; 1115 } else { 1116 $r = Value::Formula->new($correctAnswer); 1117 die "The professor's answer can't be a formula" unless $r->isConstant; 1118 $r = $r->eval; $r = new Value::Real($r) unless Value::class($r) eq 'String'; 1119 $r->{correct_ans} = $correctAnswer; 1120 if ($mode eq 'phase_pi') { 1121 my $pi = 4*atan2(1,1); 1122 while ($r > $pi/2) {$r -= $pi} 1123 while ($r < -$pi/2) {$r += $pi} 1124 } 1125 } 1126 # 1127 # Get the answer checker from the parser object 1128 # 1129 my $cmp = $r->cmp(%options); 1130 $cmp->install_pre_filter(sub { 1131 my $rh_ans = shift; 1132 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; 1133 $rh_ans->{original_correct_ans} = $rh_ans->{correct_ans}; 1134 return $rh_ans; 1135 }); 1136 $cmp->install_post_filter(sub { 1137 my $rh_ans = shift; 1138 $rh_ans->{student_ans} = $rh_ans->{student_value}->string 1139 if ref($rh_ans->{student_value}); 1140 return $rh_ans; 1141 }); 1142 &$Context($oldContext); 1143 1144 return $cmp; 1145 } 1146 1147 # 1148 # The original version, for backward compatibility 1149 # (can be removed when the Parser-based version is more fully tested.) 1150 # 1151 sub ORIGINAL_NUM_CMP { # low level numeric compare 1152 my %num_params = @_; 1153 1154 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug ); 1155 foreach my $key (@keys) { 1156 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key}); 1157 } 1158 1159 my $correctAnswer = $num_params{'correctAnswer'}; 1160 my $format = $num_params{'format'}; 1161 my $mode = $num_params{'mode'}; 1162 1163 if( $num_params{tolType} eq 'relative' ) { 1164 $num_params{'tolerance'} = .01*$num_params{'tolerance'}; 1165 } 1166 1167 my $formattedCorrectAnswer; 1168 my $correct_units; 1169 my $correct_num_answer; 1170 my %correct_units; 1171 my $corrAnswerIsString = 0; 1172 1173 1174 if (defined($num_params{units}) && $num_params{units}) { 1175 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' ); 1176 # units are in form stuff space units where units contains no spaces. 1177 1178 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/; 1179 %correct_units = Units::evaluate_units($correct_units); 1180 if ( defined( $correct_units{'ERROR'} ) ) { 1181 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" . 1182 "$correct_units{'ERROR'}\n"); 1183 } 1184 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1185 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1186 1187 } elsif (defined($num_params{strings}) && $num_params{strings}) { 1188 my $legalString = ''; 1189 my @legalStrings = @{$num_params{strings}}; 1190 $correct_num_answer = $correctAnswer; 1191 $formattedCorrectAnswer = $correctAnswer; 1192 foreach $legalString (@legalStrings) { 1193 if ( uc($correctAnswer) eq uc($legalString) ) { 1194 $corrAnswerIsString = 1; 1195 1196 last; 1197 } 1198 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 1199 } else { 1200 $correct_num_answer = $correctAnswer; 1201 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} ); 1202 } 1203 1204 $correct_num_answer = math_constants($correct_num_answer); 1205 1206 my $PGanswerMessage = ''; 1207 1208 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report); 1209 1210 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) { 1211 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer); 1212 } else { # case of a string answer 1213 $PG_eval_errors = ' '; 1214 $correctVal = $correctAnswer; 1215 } 1216 1217 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) { 1218 ##error message from eval or above 1219 warn "Error in 'correct' answer: $PG_eval_errors<br> 1220 The answer $correctAnswer evaluates to $correctVal, 1221 which cannot be interpreted as a number. "; 1222 1223 } 1224 ######################################################################### 1225 1226 #construct the answer evaluator 1227 my $answer_evaluator = new AnswerEvaluator; 1228 $answer_evaluator->{debug} = $num_params{debug}; 1229 $answer_evaluator->ans_hash( 1230 correct_ans => $correctVal, 1231 type => "${mode}_number", 1232 tolerance => $num_params{tolerance}, 1233 tolType => $num_params{tolType}, 1234 units => $correct_units, 1235 original_correct_ans => $formattedCorrectAnswer, 1236 rh_correct_units => \%correct_units, 1237 answerIsString => $corrAnswerIsString, 1238 ); 1239 my ($in, $formattedSubmittedAnswer); 1240 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift; 1241 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;} 1242 ); 1243 1244 1245 1246 if (defined($num_params{units}) && $num_params{units}) { 1247 $answer_evaluator->install_pre_filter(\&check_units); 1248 } 1249 if (defined($num_params{strings}) && $num_params{strings}) { 1250 $answer_evaluator->install_pre_filter(\&check_strings, %num_params); 1251 } 1252 1253 ## FIXME? - this pre filter was moved before check_units to allow 1254 ## for latex preview of answers with no units. 1255 ## seems to work but may have unintended side effects elsewhere. 1256 1257 ## Actually it caused trouble with the check strings package so it has been moved back 1258 # We'll try some other method -- perhaps add code to fix_answer for display 1259 $answer_evaluator->install_pre_filter(\&check_syntax); 1260 1261 $answer_evaluator->install_pre_filter(\&math_constants); 1262 1263 if ($mode eq 'std') { 1264 # do nothing 1265 } elsif ($mode eq 'strict') { 1266 $answer_evaluator->install_pre_filter(\&is_a_number); 1267 } elsif ($mode eq 'arith') { 1268 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression); 1269 } elsif ($mode eq 'frac') { 1270 $answer_evaluator->install_pre_filter(\&is_a_fraction); 1271 1272 } elsif ($mode eq 'phase_pi') { 1273 $answer_evaluator->install_pre_filter(\&phase_pi); 1274 1275 } else { 1276 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.'; 1277 $formattedSubmittedAnswer = $in; 1278 } 1279 1280 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string. 1281 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params); 1282 } 1283 1284 1285 ############################################################################### 1286 # We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's 1287 # can be displayed in the answer message. This may still cause a few anomolies when strings are used 1288 # 1289 ############################################################################### 1290 1291 $answer_evaluator->install_post_filter(\&fix_answers_for_display); 1292 1293 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 1294 return $rh_ans unless $rh_ans->catch_error('EVAL'); 1295 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message}; 1296 $rh_ans->clear_error('EVAL'); } ); 1297 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } ); 1298 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } ); 1299 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } ); 1300 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } ); 1301 $answer_evaluator; 1302 } 1303 1304 1305 1306 ########################################################################## 1307 ########################################################################## 1308 ## Function answer evaluators 1309 1310 =head2 Function Answer Evaluators 1311 1312 Function answer evaluators take in a function, compare it numerically to a 1313 correct function, and return a score. They can require an exactly equivalent 1314 function, or one that is equal up to a constant. They can accept or reject an 1315 answer based on specified tolerances for numerical deviation. 1316 1317 Function Comparison Options 1318 1319 correctEqn -- The correct equation, specified as a string. It may include 1320 all basic arithmetic operations, as well as elementary 1321 functions. Variable usage is described below. 1322 1323 Variables -- The independent variable(s). When comparing the correct 1324 equation to the student equation, each variable will be 1325 replaced by a certain number of numerical values. If 1326 the student equation agrees numerically with the correct 1327 equation, they are considered equal. Note that all 1328 comparison is numeric; it is possible (although highly 1329 unlikely and never a practical concern) for two unequal 1330 functions to yield the same numerical results. 1331 1332 Limits -- The limits of evaluation for the independent variables. 1333 Each variable is evaluated only in the half-open interval 1334 [lower_limit, upper_limit). This is useful if the function 1335 has a singularity or is not defined in a certain range. 1336 For example, the function "sqrt(-1-x)" could be evaluated 1337 in [-2,-1). 1338 1339 Tolerance -- Tolerance in function comparisons works exactly as in 1340 numerical comparisons; see the numerical comparison 1341 documentation for a complete description. Note that the 1342 tolerance does applies to the function as a whole, not 1343 each point individually. 1344 1345 Number of -- Specifies how many points to evaluate each variable at. This 1346 Points is typically 3, but can be set higher if it is felt that 1347 there is a strong possibility of "false positives." 1348 1349 Maximum -- Sets the maximum size of the constant of integration. For 1350 Constant of technical reasons concerning floating point arithmetic, if 1351 Integration the additive constant, i.e., the constant of integration, is 1352 greater (in absolute value) than maxConstantOfIntegration 1353 AND is greater than maxConstantOfIntegration times the 1354 correct value, WeBWorK will give an error message saying 1355 that it can not handle such a large constant of integration. 1356 This is to prevent e.g. cos(x) + 1E20 or even 1E20 as being 1357 accepted as a correct antiderivatives of sin(x) since 1358 floating point arithmetic cannot tell the difference 1359 between cos(x) + 1E20, 1E20, and -cos(x) + 1E20. 1360 1361 Technical note: if you examine the code for the function routines, you will see 1362 that most subroutines are simply doing some basic error-checking and then 1363 passing the parameters on to the low-level FUNCTION_CMP(). Because this routine 1364 is set up to handle multivariable functions, with single-variable functions as 1365 a special case, it is possible to pass multivariable parameters to single- 1366 variable functions. This usage is strongly discouraged as unnecessarily 1367 confusing. Avoid it. 1368 1369 Default Values (As of 7/24/2000) (Option -- Variable Name -- Value) 1370 1371 Variable -- $functVarDefault -- 'x' 1372 Relative Tolerance -- $functRelPercentTolDefault -- .1 1373 Absolute Tolerance -- $functAbsTolDefault -- .001 1374 Lower Limit -- $functLLimitDefault -- .0000001 1375 Upper Limit -- $functULimitDefault -- 1 1376 Number of Points -- $functNumOfPoints -- 3 1377 Zero Level -- $functZeroLevelDefault -- 1E-14 1378 Zero Level Tolerance -- $functZeroLevelTolDefault -- 1E-12 1379 Maximum Constant -- $functMaxConstantOfIntegration -- 1E8 1380 of Integration 1381 1382 =cut 1383 1384 1385 1386 =head3 fun_cmp() 1387 1388 Compares a function or a list of functions, using a named hash of options to set 1389 parameters. This can make for more readable code than using the function_cmp() 1390 style, but some people find one or the other easier to remember. 1391 1392 ANS( fun_cmp( answer or answer_array_ref, options_hash ) ); 1393 1394 1. a string containing the correct function, or a reference to an 1395 array of correct functions 1396 2. a hash containing the following items (all optional): 1397 var -- either the number of variables or a reference to an 1398 array of variable names (see below) 1399 limits -- reference to an array of arrays of limits (see below), or: 1400 mode -- 'std' (default) (function must match exactly), or: 1401 'antider' (function must match up to a constant) 1402 relTol -- (default) a relative tolerance (as a percentage), or: 1403 tol -- an absolute tolerance for error 1404 numPoints -- the number of points to evaluate the function at 1405 maxConstantOfIntegration -- maximum size of the constant of integration 1406 zeroLevel -- if the correct answer is this close to zero, then 1407 zeroLevelTol applies 1408 zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1409 test_points -- a list of points to use in checking the function, or a list of lists when there is more than one variable. 1410 params an array of "free" parameters which can be used to adapt 1411 the correct answer to the submitted answer. (e.g. ['c'] for 1412 a constant of integration in the answer x^3/3 + c. 1413 debug -- when set to 1 this provides extra information while checking the 1414 the answer. 1415 1416 Returns an answer evaluator, or (if given a reference to an array 1417 of answers), a list of answer evaluators 1418 1419 ANSWER: 1420 1421 The answer must be in the form of a string. The answer can contain 1422 functions, pi, e, and arithmetic operations. However, the correct answer 1423 string follows a slightly stricter syntax than student answers; specifically, 1424 there is no implicit multiplication. So the correct answer must be "3*x" rather 1425 than "3 x". Students can still enter "3 x". 1426 1427 VARIABLES: 1428 1429 The var parameter can contain either a number or a reference to an array of 1430 variable names. If it contains a number, the variables are named automatically 1431 as follows: 1 variable -- x 1432 2 variables -- x, y 1433 3 variables -- x, y, z 1434 4 or more -- x_1, x_2, x_3, etc. 1435 If the var parameter contains a reference to an array of variable names, then 1436 the number of variables is determined by the number of items in the array. A 1437 reference to an array is created with brackets, e.g. "var => ['r', 's', 't']". 1438 If only one variable is being used, you can write either "var => ['t']" for 1439 consistency or "var => 't'" as a shortcut. The default is one variable, x. 1440 1441 LIMITS: 1442 1443 Limits are specified with the limits parameter. You may NOT use llimit/ulimit. 1444 If you specify limits for one variable, you must specify them for all variables. 1445 The limit parameter must be a reference to an array of arrays of the form 1446 [lower_limit. upper_limit], each array corresponding to the lower and upper 1447 endpoints of the (half-open) domain of one variable. For example, 1448 "vars => 2, limits => [[0,2], [-3,8]]" would cause x to be evaluated in [0,2) and 1449 y to be evaluated in [-3,8). If only one variable is being used, you can write 1450 either "limits => [[0,3]]" for consistency or "limits => [0,3]" as a shortcut. 1451 1452 TEST POINTS: 1453 1454 In some cases, the problem writer may want to specify the points 1455 used to check a particular function. For example, if you want to 1456 use only integer values, they can be specified. With one variable, 1457 you can specify "test_points => [1,4,5,6]" or "test_points => [[1,4,5,6]]". 1458 With more variables, specify the list for the first variable, then the 1459 second, and so on: "vars=>['x','y'], test_points => [[1,4,5],[7,14,29]]". 1460 1461 If the problem writer wants random values which need to meet some special 1462 restrictions (such as being integers), they can be generated in the problem: 1463 "test_points=>[random(1,50), random(1,50), random(1,50), random(1,50)]". 1464 1465 Note that test_points should not be used for function checks which involve 1466 parameters (either explicitly given by "params", or as antiderivatives). 1467 1468 EXAMPLES: 1469 1470 fun_cmp( "3*x" ) -- standard compare, variable is x 1471 fun_cmp( ["3*x", "4*x+3", "3*x**2"] ) -- standard compare, defaults used for all three functions 1472 fun_cmp( "3*t", var => 't' ) -- standard compare, variable is t 1473 fun_cmp( "5*x*y*z", var => 3 ) -- x, y and z are the variables 1474 fun_cmp( "5*x", mode => 'antider' ) -- student answer must match up to constant (i.e., 5x+C) 1475 fun_cmp( ["3*x*y", "4*x*y"], limits => [[0,2], [5,7]] ) -- x evaluated in [0,2) 1476 y evaluated in [5,7) 1477 1478 =cut 1479 1480 sub fun_cmp { 1481 my $correctAnswer = shift @_; 1482 my %opt = @_; 1483 1484 assign_option_aliases( \%opt, 1485 'vars' => 'var', # set the standard option 'var' to the one specified as vars 1486 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain 1487 'reltol' => 'relTol', 1488 'param' => 'params', 1489 ); 1490 1491 set_default_options( \%opt, 1492 'var' => $functVarDefault, 1493 'params' => [], 1494 'limits' => [[$functLLimitDefault, $functULimitDefault]], 1495 'test_points' => undef, 1496 'mode' => 'std', 1497 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative', 1498 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined 1499 'relTol' => $functRelPercentTolDefault, 1500 'numPoints' => $functNumOfPoints, 1501 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 1502 'zeroLevel' => $functZeroLevelDefault, 1503 'zeroLevelTol' => $functZeroLevelTolDefault, 1504 'debug' => 0, 1505 'diagnostics' => undef, 1506 ); 1507 1508 # allow var => 'x' as an abbreviation for var => ['x'] 1509 my %out_options = %opt; 1510 unless ( ref($out_options{var}) eq 'ARRAY' || $out_options{var} =~ m/^\d+$/) { 1511 $out_options{var} = [$out_options{var}]; 1512 } 1513 # allow params => 'c' as an abbreviation for params => ['c'] 1514 unless ( ref($out_options{params}) eq 'ARRAY' ) { 1515 $out_options{params} = [$out_options{params}]; 1516 } 1517 my ($tolType, $tol); 1518 if ($out_options{tolType} eq 'absolute') { 1519 $tolType = 'absolute'; 1520 $tol = $out_options{'tol'}; 1521 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} ); 1522 } else { 1523 $tolType = 'relative'; 1524 $tol = $out_options{'relTol'}; 1525 delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 1526 } 1527 1528 my @output_list = (); 1529 # thread over lists 1530 my @ans_list = (); 1531 1532 if ( ref($correctAnswer) eq 'ARRAY' ) { 1533 @ans_list = @{$correctAnswer}; 1534 } 1535 else { 1536 push( @ans_list, $correctAnswer ); 1537 } 1538 1539 # produce answer evaluators 1540 foreach my $ans (@ans_list) { 1541 push(@output_list, 1542 FUNCTION_CMP( 1543 'correctEqn' => $ans, 1544 'var' => $out_options{'var'}, 1545 'limits' => $out_options{'limits'}, 1546 'tolerance' => $tol, 1547 'tolType' => $tolType, 1548 'numPoints' => $out_options{'numPoints'}, 1549 'test_points' => $out_options{'test_points'}, 1550 'mode' => $out_options{'mode'}, 1551 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'}, 1552 'zeroLevel' => $out_options{'zeroLevel'}, 1553 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1554 'params' => $out_options{'params'}, 1555 'debug' => $out_options{'debug'}, 1556 'diagnostics' => $out_options{'diagnostics'} , 1557 ), 1558 ); 1559 } 1560 1561 return (wantarray) ? @output_list : $output_list[0]; 1562 } 1563 1564 =head3 Single-variable Function Comparisons 1565 1566 There are four single-variable function answer evaluators: "normal," absolute 1567 tolerance, antiderivative, and antiderivative with absolute tolerance. All 1568 parameters (other than the correct equation) are optional. 1569 1570 function_cmp( $correctEqn ) OR 1571 function_cmp( $correctEqn, $var ) OR 1572 function_cmp( $correctEqn, $var, $llimit, $ulimit ) OR 1573 function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol ) OR 1574 function_cmp( $correctEqn, $var, $llimit, $ulimit, 1575 $relPercentTol, $numPoints ) OR 1576 function_cmp( $correctEqn, $var, $llimit, $ulimit, 1577 $relPercentTol, $numPoints, $zeroLevel ) OR 1578 function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol, $numPoints, 1579 $zeroLevel,$zeroLevelTol ) 1580 1581 $correctEqn -- the correct equation, as a string 1582 $var -- the string representing the variable (optional) 1583 $llimit -- the lower limit of the interval to evaluate the 1584 variable in (optional) 1585 $ulimit -- the upper limit of the interval to evaluate the 1586 variable in (optional) 1587 $relPercentTol -- the error tolerance as a percentage (optional) 1588 $numPoints -- the number of points at which to evaluate the 1589 variable (optional) 1590 $zeroLevel -- if the correct answer is this close to zero, then 1591 zeroLevelTol applies (optional) 1592 $zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1593 1594 function_cmp() uses standard comparison and relative tolerance. It takes a 1595 string representing a single-variable function and compares the student 1596 answer to that function numerically. 1597 1598 function_cmp_up_to_constant( $correctEqn ) OR 1599 function_cmp_up_to_constant( $correctEqn, $var ) OR 1600 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit ) OR 1601 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1602 $relpercentTol ) OR 1603 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1604 $relpercentTol, $numOfPoints ) OR 1605 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1606 $relpercentTol, $numOfPoints, 1607 $maxConstantOfIntegration ) OR 1608 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1609 $relpercentTol, $numOfPoints, 1610 $maxConstantOfIntegration, $zeroLevel) OR 1611 function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit, 1612 $relpercentTol, $numOfPoints, 1613 $maxConstantOfIntegration, 1614 $zeroLevel, $zeroLevelTol ) 1615 1616 $maxConstantOfIntegration -- the maximum size of the constant of 1617 integration 1618 1619 function_cmp_up_to_constant() uses antiderivative compare and relative 1620 tolerance. All options work exactly like function_cmp(), except of course 1621 $maxConstantOfIntegration. It will accept as correct any function which 1622 differs from $correctEqn by at most a constant; that is, if 1623 $studentEqn = $correctEqn + C 1624 the answer is correct. 1625 1626 function_cmp_abs( $correctFunction ) OR 1627 function_cmp_abs( $correctFunction, $var ) OR 1628 function_cmp_abs( $correctFunction, $var, $llimit, $ulimit ) OR 1629 function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol ) OR 1630 function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol, 1631 $numOfPoints ) 1632 1633 $absTol -- the tolerance as an absolute value 1634 1635 function_cmp_abs() uses standard compare and absolute tolerance. All 1636 other options work exactly as for function_cmp(). 1637 1638 function_cmp_up_to_constant_abs( $correctFunction ) OR 1639 function_cmp_up_to_constant_abs( $correctFunction, $var ) OR 1640 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit ) OR 1641 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit, 1642 $absTol ) OR 1643 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit, 1644 $absTol, $numOfPoints ) OR 1645 function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit, 1646 $absTol, $numOfPoints, 1647 $maxConstantOfIntegration ) 1648 1649 function_cmp_up_to_constant_abs() uses antiderivative compare 1650 and absolute tolerance. All other options work exactly as with 1651 function_cmp_up_to_constant(). 1652 1653 Examples: 1654 1655 ANS( function_cmp( "cos(x)" ) ) -- Accepts cos(x), sin(x+pi/2), 1656 sin(x)^2 + cos(x) + cos(x)^2 -1, etc. This assumes 1657 $functVarDefault has been set to "x". 1658 ANS( function_cmp( $answer, "t" ) ) -- Assuming $answer is "cos(t)", 1659 accepts cos(t), etc. 1660 ANS( function_cmp_up_to_constant( "cos(x)" ) ) -- Accepts any 1661 antiderivative of sin(x), e.g. cos(x) + 5. 1662 ANS( function_cmp_up_to_constant( "cos(z)", "z" ) ) -- Accepts any 1663 antiderivative of sin(z), e.g. sin(z+pi/2) + 5. 1664 1665 =cut 1666 1667 sub adaptive_function_cmp { 1668 my $correctEqn = shift; 1669 my %options = @_; 1670 set_default_options( \%options, 1671 'vars' => [qw( x y )], 1672 'params' => [], 1673 'limits' => [ [0,1], [0,1]], 1674 'reltol' => $functRelPercentTolDefault, 1675 'numPoints' => $functNumOfPoints, 1676 'zeroLevel' => $functZeroLevelDefault, 1677 'zeroLevelTol' => $functZeroLevelTolDefault, 1678 'debug' => 0, 1679 'diagnostics' => undef, 1680 ); 1681 1682 my $var_ref = $options{'vars'}; 1683 my $ra_params = $options{ 'params'}; 1684 my $limit_ref = $options{'limits'}; 1685 my $relPercentTol= $options{'reltol'}; 1686 my $numPoints = $options{'numPoints'}; 1687 my $zeroLevel = $options{'zeroLevel'}; 1688 my $zeroLevelTol = $options{'zeroLevelTol'}; 1689 1690 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1691 'var' => $var_ref, 1692 'limits' => $limit_ref, 1693 'tolerance' => $relPercentTol, 1694 'tolType' => 'relative', 1695 'numPoints' => $numPoints, 1696 'mode' => 'std', 1697 'maxConstantOfIntegration' => 10**100, 1698 'zeroLevel' => $zeroLevel, 1699 'zeroLevelTol' => $zeroLevelTol, 1700 'scale_norm' => 1, 1701 'params' => $ra_params, 1702 'debug' => $options{debug} , 1703 'diagnostics' => $options{diagnostics} , 1704 ); 1705 } 1706 1707 sub function_cmp { 1708 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_; 1709 1710 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) { 1711 function_invalid_params( $correctEqn ); 1712 } 1713 else { 1714 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1715 'var' => $var, 1716 'limits' => [$llimit, $ulimit], 1717 'tolerance' => $relPercentTol, 1718 'tolType' => 'relative', 1719 'numPoints' => $numPoints, 1720 'mode' => 'std', 1721 'maxConstantOfIntegration' => 0, 1722 'zeroLevel' => $zeroLevel, 1723 'zeroLevelTol' => $zeroLevelTol 1724 ); 1725 } 1726 } 1727 1728 sub function_cmp_up_to_constant { ## for antiderivative problems 1729 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_; 1730 1731 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) { 1732 function_invalid_params( $correctEqn ); 1733 } 1734 else { 1735 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1736 'var' => $var, 1737 'limits' => [$llimit, $ulimit], 1738 'tolerance' => $relPercentTol, 1739 'tolType' => 'relative', 1740 'numPoints' => $numPoints, 1741 'mode' => 'antider', 1742 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1743 'zeroLevel' => $zeroLevel, 1744 'zeroLevelTol' => $zeroLevelTol 1745 ); 1746 } 1747 } 1748 1749 sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance 1750 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_; 1751 1752 if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) { 1753 function_invalid_params( $correctEqn ); 1754 } 1755 else { 1756 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1757 'var' => $var, 1758 'limits' => [$llimit, $ulimit], 1759 'tolerance' => $absTol, 1760 'tolType' => 'absolute', 1761 'numPoints' => $numPoints, 1762 'mode' => 'std', 1763 'maxConstantOfIntegration' => 0, 1764 'zeroLevel' => 0, 1765 'zeroLevelTol' => 0 1766 ); 1767 } 1768 } 1769 1770 1771 sub function_cmp_up_to_constant_abs { ## for antiderivative problems 1772 ## similar to function_cmp_up_to_constant 1773 ## but uses absolute tolerance 1774 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_; 1775 1776 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) { 1777 function_invalid_params( $correctEqn ); 1778 } 1779 1780 else { 1781 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1782 'var' => $var, 1783 'limits' => [$llimit, $ulimit], 1784 'tolerance' => $absTol, 1785 'tolType' => 'absolute', 1786 'numPoints' => $numPoints, 1787 'mode' => 'antider', 1788 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1789 'zeroLevel' => 0, 1790 'zeroLevelTol' => 0 1791 ); 1792 } 1793 } 1794 1795 ## The following answer evaluator for comparing multivarable functions was 1796 ## contributed by Professor William K. Ziemer 1797 ## (Note: most of the multivariable functionality provided by Professor Ziemer 1798 ## has now been integrated into fun_cmp and FUNCTION_CMP) 1799 ############################ 1800 # W.K. Ziemer, Sep. 1999 1801 # Math Dept. CSULB 1802 # email: wziemer@csulb.edu 1803 ############################ 1804 1805 =head3 multivar_function_cmp 1806 1807 NOTE: this function is maintained for compatibility. fun_cmp() is 1808 slightly preferred. 1809 1810 usage: 1811 1812 multivar_function_cmp( $answer, $var_reference, options) 1813 $answer -- string, represents function of several variables 1814 $var_reference -- number (of variables), or list reference (e.g. ["var1","var2"] ) 1815 options: 1816 $limit_reference -- reference to list of lists (e.g. [[1,2],[3,4]]) 1817 $relPercentTol -- relative percent tolerance in answer 1818 $numPoints -- number of points to sample in for each variable 1819 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1820 $zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1821 1822 =cut 1823 1824 sub multivar_function_cmp { 1825 my ($correctEqn,$var_ref,$limit_ref,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_; 1826 1827 if ( (scalar(@_) > 7) or (scalar(@_) < 2) ) { 1828 function_invalid_params( $correctEqn ); 1829 } 1830 1831 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1832 'var' => $var_ref, 1833 'limits' => $limit_ref, 1834 'tolerance' => $relPercentTol, 1835 'tolType' => 'relative', 1836 'numPoints' => $numPoints, 1837 'mode' => 'std', 1838 'maxConstantOfIntegration' => 0, 1839 'zeroLevel' => $zeroLevel, 1840 'zeroLevelTol' => $zeroLevelTol 1841 ); 1842 } 1843 1844 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1845 ## NOTE: PG_answer_eval is used instead of PG_restricted_eval in order to insure that the answer 1846 ## evaluated within the context of the package the problem was originally defined in. 1847 ## Includes multivariable modifications contributed by Professor William K. Ziemer 1848 ## 1849 ## IN: a hash consisting of the following keys (error checking to be added later?) 1850 ## correctEqn -- the correct equation as a string 1851 ## var -- the variable name as a string, 1852 ## or a reference to an array of variables 1853 ## limits -- reference to an array of arrays of type [lower,upper] 1854 ## tolerance -- the allowable margin of error 1855 ## tolType -- 'relative' or 'absolute' 1856 ## numPoints -- the number of points to evaluate the function at 1857 ## mode -- 'std' or 'antider' 1858 ## maxConstantOfIntegration -- maximum size of the constant of integration 1859 ## zeroLevel -- if the correct answer is this close to zero, 1860 ## then zeroLevelTol applies 1861 ## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1862 ## test_points -- user supplied points to use for testing the 1863 ## function, either array of arrays, or optionally 1864 ## reference to single array (for one variable) 1865 1866 1867 sub FUNCTION_CMP { 1868 return ORIGINAL_FUNCTION_CMP(@_) 1869 if main::PG_restricted_eval(q!$main::useOldAnswerMacros!); 1870 1871 my %func_params = @_; 1872 1873 my $correctEqn = $func_params{'correctEqn'}; 1874 my $var = $func_params{'var'}; 1875 my $ra_limits = $func_params{'limits'}; 1876 my $tol = $func_params{'tolerance'}; 1877 my $tolType = $func_params{'tolType'}; 1878 my $numPoints = $func_params{'numPoints'}; 1879 my $mode = $func_params{'mode'}; 1880 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 1881 my $zeroLevel = $func_params{'zeroLevel'}; 1882 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 1883 my $testPoints = $func_params{'test_points'}; 1884 1885 # 1886 # Check that everything is defined: 1887 # 1888 $func_params{debug} = 0 unless defined $func_params{debug}; 1889 $mode = 'std' unless defined $mode; 1890 my @VARS = get_var_array($var); 1891 my @limits = get_limits_array($ra_limits); 1892 my @PARAMS = @{$func_params{'params'} || []}; 1893 1894 if ($tolType eq 'relative') { 1895 $tol = $functRelPercentTolDefault unless defined $tol; 1896 $tol *= .01; 1897 } else { 1898 $tol = $functAbsTolDefault unless defined $tol; 1899 } 1900 1901 # 1902 # Ensure that the number of limits matches number of variables 1903 # 1904 foreach my $i (0..scalar(@VARS)-1) { 1905 $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0]; 1906 $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1]; 1907 } 1908 1909 # 1910 # Check that the test points are array references with the right number of coordinates 1911 # 1912 if ($testPoints) { 1913 my $n = scalar(@VARS); my $s = ($n != 1)? "s": ""; 1914 foreach my $p (@{$testPoints}) { 1915 $p = [$p] unless ref($p) eq 'ARRAY'; 1916 warn "Test point (".join(',',@{$p}).") should have $n coordiante$s" 1917 unless scalar(@{$p}) == $n; 1918 } 1919 } 1920 1921 # 1922 # Reorder variables, limits, and test_points if the variables are not in alphabetical order 1923 # 1924 if (scalar(@VARS) > 1 && join('',@VARS) ne join('',lex_sort(@VARS))) { 1925 my %order; foreach my $i (0..$#VARS) {$order{$VARS[$i]} = $i} 1926 @VARS = lex_sort(@VARS); 1927 @limits = map {$limits[$order{$_}]} @VARS; 1928 if ($testPoints) {foreach my $p (@{$testPoints}) {$p = [map {$p->[$order{$_}]} @VARS]}} 1929 } 1930 1931 $numPoints = $functNumOfPoints unless defined $numPoints; 1932 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 1933 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 1934 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 1935 1936 $func_params{'var'} = \@VARS; 1937 $func_params{'params'} = \@PARAMS; 1938 $func_params{'limits'} = \@limits; 1939 $func_params{'tolerance'} = $tol; 1940 $func_params{'tolType'} = $tolType; 1941 $func_params{'numPoints'} = $numPoints; 1942 $func_params{'mode'} = $mode; 1943 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 1944 $func_params{'zeroLevel'} = $zeroLevel; 1945 $func_params{'zeroLevelTol'} = $zeroLevelTol; 1946 1947 ######################################################## 1948 # End of cleanup of calling parameters 1949 ######################################################## 1950 1951 my %options = ( 1952 debug => $func_params{'debug'}, 1953 diagnostics => $func_params{'diagnostics'}, 1954 ); 1955 1956 # 1957 # Initialize the context for the formula 1958 # 1959 my $context = Parser::Context->getCopy($user_context,"LegacyNumeric"); 1960 $context->flags->set( 1961 tolerance => $func_params{'tolerance'}, 1962 tolType => $func_params{'tolType'}, 1963 zeroLevel => $func_params{'zeroLevel'}, 1964 zeroLevelTol => $func_params{'zeroLevelTol'}, 1965 num_points => $func_params{'numPoints'}, 1966 ); 1967 if ($func_params{'mode'} eq 'antider') { 1968 $context->flags->set(max_adapt => $func_params{'maxConstantOfIntegration'}); 1969 $options{upToConstant} = 1; 1970 } 1971 1972 # 1973 # Add the variables and parameters to the context 1974 # 1975 my %variables; my $x; 1976 foreach $x (@{$func_params{'var'}}) { 1977 if (length($x) > 1) { 1978 $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} = 1979 $x . '|' . $context->{_variables}->{pattern}; 1980 $context->update; 1981 } 1982 $variables{$x} = 'Real'; 1983 } 1984 foreach $x (@{$func_params{'params'}}) {$variables{$x} = 'Parameter'} 1985 $context->variables->are(%variables); 1986 1987 # 1988 # Create the Formula object and get its answer checker 1989 # 1990 my $oldContext = &$Context(); &$Context($context); 1991 my $f = new Value::Formula($correctEqn); 1992 $f->{limits} = $func_params{'limits'}; 1993 $f->{test_points} = $func_params{'test_points'}; 1994 $f->{correct_ans} = $correctEqn; 1995 my $cmp = $f->cmp(%options); 1996 &$Context($oldContext); 1997 1998 # 1999 # Get previous answer from hidden field of form 2000 # 2001 $cmp->install_pre_filter( 2002 sub { 2003 my $rh_ans = shift; 2004 $rh_ans->{_filter_name} = "fetch_previous_answer"; 2005 my $prev_ans_label = "previous_".$rh_ans->{ans_label}; 2006 $rh_ans->{prev_ans} = 2007 (defined $inputs_ref->{$prev_ans_label} and 2008 $inputs_ref->{$prev_ans_label} =~/\S/) ? $inputs_ref->{$prev_ans_label} : undef; 2009 $rh_ans; 2010 } 2011 ); 2012 2013 # 2014 # Parse the previous answer, if any 2015 # 2016 $cmp->install_evaluator( 2017 sub { 2018 my $rh_ans = shift; 2019 $rh_ans->{_filter_name} = "parse_previous_answer"; 2020 return $rh_ans unless defined $rh_ans->{prev_ans}; 2021 my $oldContext = &$Context(); 2022 &$Context($rh_ans->{correct_value}{context}); 2023 $rh_ans->{prev_formula} = Parser::Formula($rh_ans->{prev_ans}); 2024 &$Context($oldContext); 2025 $rh_ans; 2026 } 2027 ); 2028 2029 # 2030 # Check if previous answer equals this current one 2031 # 2032 $cmp->install_evaluator( 2033 sub { 2034 my $rh_ans = shift; 2035 $rh_ans->{_filter_name} = "compare_to_previous_answer"; 2036 return $rh_ans unless defined($rh_ans->{prev_formula}) && defined($rh_ans->{student_formula}); 2037 $rh_ans->{prev_equals_current} = 2038 Value::cmp_compare($rh_ans->{student_formula},$rh_ans->{prev_formula},{}); 2039 $rh_ans; 2040 } 2041 ); 2042 2043 # 2044 # Show a message when the answer is equivalent to the previous answer. 2045 # 2046 # We want to show the message when we're not in preview mode AND the 2047 # answers are equivalent AND the answers are not identical. We DON'T CARE 2048 # whether the answers are correct or not, because that leaks information in 2049 # multipart questions when $showPartialCorrectAnswers is off. 2050 # 2051 $cmp->install_post_filter( 2052 sub { 2053 my $rh_ans = shift; 2054 $rh_ans->{_filter_name} = "produce_equivalence_message"; 2055 2056 return $rh_ans unless !$rh_ans->{isPreview} # not preview mode 2057 and $rh_ans->{prev_equals_current} # equivalent 2058 and $rh_ans->{prev_ans} ne $rh_ans->{original_student_ans}; # not identical 2059 2060 $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted."; 2061 $rh_ans; 2062 } 2063 ); 2064 2065 return $cmp; 2066 } 2067 2068 # 2069 # The original version, for backward compatibility 2070 # (can be removed when the Parser-based version is more fully tested.) 2071 # 2072 sub ORIGINAL_FUNCTION_CMP { 2073 my %func_params = @_; 2074 2075 my $correctEqn = $func_params{'correctEqn'}; 2076 my $var = $func_params{'var'}; 2077 my $ra_limits = $func_params{'limits'}; 2078 my $tol = $func_params{'tolerance'}; 2079 my $tolType = $func_params{'tolType'}; 2080 my $numPoints = $func_params{'numPoints'}; 2081 my $mode = $func_params{'mode'}; 2082 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 2083 my $zeroLevel = $func_params{'zeroLevel'}; 2084 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 2085 my $ra_test_points = $func_params{'test_points'}; 2086 2087 # Check that everything is defined: 2088 $func_params{debug} = 0 unless defined $func_params{debug}; 2089 $mode = 'std' unless defined $mode; 2090 my @VARS = get_var_array($var); 2091 my @limits = get_limits_array($ra_limits); 2092 my @PARAMS = (); 2093 @PARAMS = @{$func_params{'params'}} if defined $func_params{'params'}; 2094 2095 my @evaluation_points; 2096 if(defined $ra_test_points) { 2097 # see if this is the standard format 2098 if(ref $ra_test_points->[0] eq 'ARRAY') { 2099 $numPoints = scalar @{$ra_test_points->[0]}; 2100 # now a little sanity check 2101 my $j; 2102 for $j (@{$ra_test_points}) { 2103 warn "Test points do not give the same number of values for each variable" 2104 unless(scalar(@{$j}) == $numPoints); 2105 } 2106 warn "Test points do not match the number of variables" 2107 unless scalar @{$ra_test_points} == scalar @VARS; 2108 } else { # we are got the one-variable format 2109 $ra_test_points = [$ra_test_points]; 2110 $numPoints = scalar $ra_test_points->[0]; 2111 } 2112 # The input format for test points is the transpose of what is used 2113 # internally below, so take care of that now. 2114 my ($j1, $j2); 2115 for ($j1 = 0; $j1 < scalar @{$ra_test_points}; $j1++) { 2116 for ($j2 = 0; $j2 < scalar @{$ra_test_points->[$j1]}; $j2++) { 2117 $evaluation_points[$j2][$j1] = $ra_test_points->[$j1][$j2]; 2118 } 2119 } 2120 } # end of handling of user supplied evaluation points 2121 2122 if ($mode eq 'antider') { 2123 # doctor the equation to allow addition of a constant 2124 my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters. 2125 # There is the possibility of conflict here. 2126 # 'Q' seemed less dangerous than 'C'. 2127 $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM"; 2128 push @PARAMS, $CONSTANT_PARAM; 2129 } 2130 my $dim_of_param_space = @PARAMS; # dimension of equivalence space 2131 2132 if($tolType eq 'relative') { 2133 $tol = $functRelPercentTolDefault unless defined $tol; 2134 $tol *= .01; 2135 } else { 2136 $tol = $functAbsTolDefault unless defined $tol; 2137 } 2138 2139 #loop ensures that number of limits matches number of variables 2140 for(my $i = 0; $i < scalar @VARS; $i++) { 2141 $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0]; 2142 $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1]; 2143 } 2144 $numPoints = $functNumOfPoints unless defined $numPoints; 2145 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 2146 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 2147 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 2148 2149 $func_params{'var'} = $var; 2150 $func_params{'limits'} = \@limits; 2151 $func_params{'tolerance'} = $tol; 2152 $func_params{'tolType'} = $tolType; 2153 $func_params{'numPoints'} = $numPoints; 2154 $func_params{'mode'} = $mode; 2155 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 2156 $func_params{'zeroLevel'} = $zeroLevel; 2157 $func_params{'zeroLevelTol'} = $zeroLevelTol; 2158 2159 ######################################################## 2160 # End of cleanup of calling parameters 2161 ######################################################## 2162 2163 my $i; # for use with loops 2164 my $PGanswerMessage = ""; 2165 my $originalCorrEqn = $correctEqn; 2166 2167 ###################################################################### 2168 # prepare the correct answer and check its syntax 2169 ###################################################################### 2170 2171 my $rh_correct_ans = new AnswerHash; 2172 $rh_correct_ans->input($correctEqn); 2173 $rh_correct_ans = check_syntax($rh_correct_ans); 2174 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2175 $rh_correct_ans->clear_error(); 2176 $rh_correct_ans = function_from_string2($rh_correct_ans, 2177 ra_vars => [ @VARS, @PARAMS ], 2178 stdout => 'rf_correct_ans', 2179 debug => $func_params{debug} 2180 ); 2181 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans}; 2182 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2183 2184 ###################################################################### 2185 # define the points at which the functions are to be evaluated 2186 ###################################################################### 2187 2188 if(not defined $ra_test_points) { 2189 #create the evaluation points 2190 my $random_for_answers = new PGrandom($main::PG_original_problemSeed); 2191 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator 2192 for(my $count = 0; $count < @PARAMS+1+$numPoints; $count++) { 2193 my (@vars,$iteration_limit); 2194 for(my $i = 0; $i < @VARS; $i++) { 2195 my $iteration_limit = 10; 2196 while (0 < --$iteration_limit) { # make sure that the endpoints of the interval are not included 2197 $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM); 2198 last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1]; 2199 } 2200 warn "Unable to properly choose evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )" 2201 if $iteration_limit == 0; 2202 } 2203 2204 push @evaluation_points, \@vars; 2205 } 2206 } 2207 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points); 2208 2209 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters); 2210 #warn "coeff", join(" | ", @{$COEFFS}); 2211 2212 #construct the answer evaluator 2213 my $answer_evaluator = new AnswerEvaluator; 2214 $answer_evaluator->{debug} = $func_params{debug}; 2215 $answer_evaluator->ans_hash( 2216 correct_ans => $originalCorrEqn, 2217 rf_correct_ans => $rh_correct_ans->{rf_correct_ans}, 2218 evaluation_points => \@evaluation_points, 2219 ra_param_vars => \@PARAMS, 2220 ra_vars => \@VARS, 2221 type => 'function', 2222 score => 0, 2223 ); 2224 2225 ######################################################### 2226 # Prepare the previous answer for evaluation, discard errors 2227 ######################################################### 2228 2229 $answer_evaluator->install_pre_filter( 2230 sub { 2231 my $rh_ans = shift; 2232 $rh_ans->{_filter_name} = "fetch_previous_answer"; 2233 my $prev_ans_label = "previous_".$rh_ans->{ans_label}; 2234 $rh_ans->{prev_ans} = (defined $inputs_ref->{$prev_ans_label} and $inputs_ref->{$prev_ans_label} =~/\S/) 2235 ? $inputs_ref->{$prev_ans_label} 2236 : undef; 2237 $rh_ans; 2238 } 2239 ); 2240 2241 $answer_evaluator->install_pre_filter( 2242 sub { 2243 my $rh_ans = shift; 2244 return $rh_ans unless defined $rh_ans->{prev_ans}; 2245 check_syntax($rh_ans, 2246 stdin => 'prev_ans', 2247 stdout => 'prev_ans', 2248 error_msg_flag => 0 2249 ); 2250 $rh_ans->{_filter_name} = "check_syntax_of_previous_answer"; 2251 $rh_ans; 2252 } 2253 ); 2254 2255 $answer_evaluator->install_pre_filter( 2256 sub { 2257 my $rh_ans = shift; 2258 return $rh_ans unless defined $rh_ans->{prev_ans}; 2259 function_from_string2($rh_ans, 2260 stdin => 'prev_ans', 2261 stdout => 'rf_prev_ans', 2262 ra_vars => \@VARS, 2263 debug => $func_params{debug} 2264 ); 2265 $rh_ans->{_filter_name} = "compile_previous_answer"; 2266 $rh_ans; 2267 } 2268 ); 2269 2270 ######################################################### 2271 # Prepare the current answer for evaluation 2272 ######################################################### 2273 2274 $answer_evaluator->install_pre_filter(\&check_syntax); 2275 $answer_evaluator->install_pre_filter(\&function_from_string2, 2276 ra_vars => \@VARS, 2277 debug => $func_params{debug} 2278 ); # @VARS has been guaranteed to be an array, $var might be a single string. 2279 2280 ######################################################### 2281 # Compare the previous and current answer. Discard errors 2282 ######################################################### 2283 2284 $answer_evaluator->install_evaluator( 2285 sub { 2286 my $rh_ans = shift; 2287 return $rh_ans unless defined $rh_ans->{rf_prev_ans}; 2288 calculate_difference_vector($rh_ans, 2289 %func_params, 2290 stdin1 => 'rf_student_ans', 2291 stdin2 => 'rf_prev_ans', 2292 stdout => 'ra_diff_with_prev_ans', 2293 error_msg_flag => 0, 2294 ); 2295 $rh_ans->{_filter_name} = "calculate_difference_vector_of_previous_answer"; 2296 $rh_ans; 2297 } 2298 ); 2299 2300 $answer_evaluator->install_evaluator( 2301 sub { 2302 my $rh_ans = shift; 2303 return $rh_ans unless defined $rh_ans->{ra_diff_with_prev_ans}; 2304 ## 2305 ## DPVC -- only give the message if the answer is specified differently 2306 ## 2307 return $rh_ans if $rh_ans->{prev_ans} eq $rh_ans->{student_ans}; 2308 ## 2309 ## /DPVC 2310 ## 2311 is_zero_array($rh_ans, 2312 stdin => 'ra_diff_with_prev_ans', 2313 stdout => 'ans_equals_prev_ans' 2314 ); 2315 } 2316 ); 2317 2318 ######################################################### 2319 # Calculate values for approximation parameters and 2320 # compare the current answer with the correct answer. Keep errors this time. 2321 ######################################################### 2322 2323 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS); 2324 $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params); 2325 $answer_evaluator->install_evaluator(\&is_zero_array, tolerance => $tol ); 2326 2327 $answer_evaluator->install_post_filter( 2328 sub { 2329 my $rh_ans = shift; 2330 $rh_ans->clear_error('SYNTAX'); 2331 $rh_ans; 2332 } 2333 ); 2334 2335 $answer_evaluator->install_post_filter( 2336 sub { 2337 my $rh_ans = shift; 2338 if ($rh_ans->catch_error('EVAL')) { 2339 $rh_ans->{ans_message} = $rh_ans->{error_message}; 2340 $rh_ans->clear_error('EVAL'); 2341 } 2342 $rh_ans; 2343 } 2344 ); 2345 2346 # 2347 # Show a message when the answer is equivalent to the previous answer. 2348 # 2349 # We want to show the message when we're not in preview mode AND the 2350 # answers are equivalent AND the answers are not identical. We DON'T CARE 2351 # whether the answers are correct or not, because that leaks information in 2352 # multipart questions when $showPartialCorrectAnswers is off. 2353 # 2354 $answer_evaluator->install_post_filter( 2355 sub { 2356 my $rh_ans = shift; 2357 2358 my $isPreview = $inputs_ref->{previewAnswers} || ($inputs_ref->{action} =~ m/^Preview/); 2359 return $rh_ans unless !$isPreview # not preview mode 2360 and $rh_ans->{ans_equals_prev_ans} # equivalent 2361 and $rh_ans->{prev_ans} ne $rh_ans->{original_student_ans}; # not identical 2362 2363 $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted."; 2364 return $rh_ans; 2365 } 2366 ); 2367 2368 $answer_evaluator; 2369 } 2370 2371 2372 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 2373 ## 2374 ## IN: a hash containing the following items (error-checking to be added later?): 2375 ## correctAnswer -- the correct answer 2376 ## tolerance -- the allowable margin of error 2377 ## tolType -- 'relative' or 'absolute' 2378 ## format -- the display format of the answer 2379 ## mode -- one of 'std', 'strict', 'arith', or 'frac'; 2380 ## determines allowable formats for the input 2381 ## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 2382 ## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 2383 2384 2385 ########################################################################## 2386 ########################################################################## 2387 ## String answer evaluators 2388 2389 =head2 String Answer Evaluators 2390 2391 String answer evaluators compare a student string to the correct string. 2392 Different filters can be applied to allow various degrees of variation. 2393 Both the student and correct answers are subject to the same filters, to 2394 ensure that there are no unexpected matches or rejections. 2395 2396 String Filters 2397 2398 remove_whitespace -- Removes all whitespace from the string. 2399 It applies the following substitution 2400 to the string: 2401 $filteredAnswer =~ s/\s+//g; 2402 2403 compress_whitespace -- Removes leading and trailing whitespace, and 2404 replaces all other blocks of whitespace by a 2405 single space. Applies the following substitutions: 2406 $filteredAnswer =~ s/^\s*//; 2407 $filteredAnswer =~ s/\s*$//; 2408 $filteredAnswer =~ s/\s+/ /g; 2409 2410 trim_whitespace -- Removes leading and trailing whitespace. 2411 Applies the following substitutions: 2412 $filteredAnswer =~ s/^\s*//; 2413 $filteredAnswer =~ s/\s*$//; 2414 2415 ignore_case -- Ignores the case of the string. More accurately, 2416 it converts the string to uppercase (by convention). 2417 Applies the following function: 2418 $filteredAnswer = uc $filteredAnswer; 2419 2420 ignore_order -- Ignores the order of the letters in the string. 2421 This is used for problems of the form "Choose all 2422 that apply." Specifically, it removes all 2423 whitespace and lexically sorts the letters in 2424 ascending alphabetical order. Applies the following 2425 functions: 2426 $filteredAnswer = join( "", lex_sort( 2427 split( /\s*/, $filteredAnswer ) ) ); 2428 2429 =cut 2430 2431 ################################ 2432 ## STRING ANSWER FILTERS 2433 2434 ## IN: --the string to be filtered 2435 ## --a list of the filters to use 2436 ## 2437 ## OUT: --the modified string 2438 ## 2439 ## Use this subroutine instead of the 2440 ## individual filters below it 2441 2442 sub str_filters { 2443 my $stringToFilter = shift @_; 2444 # filters now take an answer hash, so encapsulate the string 2445 # in the answer hash. 2446 my $rh_ans = new AnswerHash; 2447 $rh_ans->{student_ans} = $stringToFilter; 2448 $rh_ans->{correct_ans}=''; 2449 my @filters_to_use = @_; 2450 my %known_filters = ( 2451 'remove_whitespace' => \&remove_whitespace, 2452 'compress_whitespace' => \&compress_whitespace, 2453 'trim_whitespace' => \&trim_whitespace, 2454 'ignore_case' => \&ignore_case, 2455 'ignore_order' => \&ignore_order, 2456 ); 2457 2458 #test for unknown filters 2459 foreach my $filter ( @filters_to_use ) { 2460 #check that filter is known 2461 die "Unknown string filter $filter (try checking the parameters to str_cmp() )" 2462 unless exists $known_filters{$filter}; 2463 $rh_ans = $known_filters{$filter}($rh_ans); # apply filter. 2464 } 2465 # foreach $filter (@filters_to_use) { 2466 # die "Unknown string filter $filter (try checking the parameters to str_cmp() )" 2467 # unless exists $known_filters{$filter}; 2468 # } 2469 # 2470 # if( grep( /remove_whitespace/i, @filters_to_use ) ) { 2471 # $rh_ans = remove_whitespace( $rh_ans ); 2472 # } 2473 # if( grep( /compress_whitespace/i, @filters_to_use ) ) { 2474 # $rh_ans = compress_whitespace( $rh_ans ); 2475 # } 2476 # if( grep( /trim_whitespace/i, @filters_to_use ) ) { 2477 # $rh_ans = trim_whitespace( $rh_ans ); 2478 # } 2479 # if( grep( /ignore_case/i, @filters_to_use ) ) { 2480 # $rh_ans = ignore_case( $rh_ans ); 2481 # } 2482 # if( grep( /ignore_order/i, @filters_to_use ) ) { 2483 # $rh_ans = ignore_order( $rh_ans ); 2484 # } 2485 2486 return $rh_ans->{student_ans}; 2487 } 2488 sub remove_whitespace { 2489 my $rh_ans = shift; 2490 die "expected an answer hash" unless ref($rh_ans)=~/HASH/i; 2491 $rh_ans->{_filter_name} = 'remove_whitespace'; 2492 $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace 2493 $rh_ans->{correct_ans} =~ s/\s+//g; # remove all whitespace 2494 return $rh_ans; 2495 } 2496 2497 sub compress_whitespace { 2498 my $rh_ans = shift; 2499 die "expected an answer hash" unless ref($rh_ans)=~/HASH/i; 2500 $rh_ans->{_filter_name} = 'compress_whitespace'; 2501 $rh_ans->{student_ans} =~ s/^\s*//; # remove initial whitespace 2502 $rh_ans->{student_ans} =~ s/\s*$//; # remove trailing whitespace 2503 $rh_ans->{student_ans} =~ s/\s+/ /g; # replace spaces by single space 2504 $rh_ans->{correct_ans} =~ s/^\s*//; # remove initial whitespace 2505 $rh_ans->{correct_ans} =~ s/\s*$//; # remove trailing whitespace 2506 $rh_ans->{correct_ans} =~ s/\s+/ /g; # replace spaces by single space 2507 2508 return $rh_ans; 2509 } 2510 2511 sub trim_whitespace { 2512 my $rh_ans = shift; 2513 die "expected an answer hash" unless ref($rh_ans)=~/HASH/i; 2514 $rh_ans->{_filter_name} = 'trim_whitespace'; 2515 $rh_ans->{student_ans} =~ s/^\s*//; # remove initial whitespace 2516 $rh_ans->{student_ans} =~ s/\s*$//; # remove trailing whitespace 2517 $rh_ans->{correct_ans} =~ s/^\s*//; # remove initial whitespace 2518 $rh_ans->{correct_ans} =~ s/\s*$//; # remove trailing whitespace 2519 2520 return $rh_ans; 2521 } 2522 2523 sub ignore_case { 2524 my $rh_ans = shift; 2525 die "expected an answer hash" unless ref($rh_ans)=~/HASH/i; 2526 $rh_ans->{_filter_name} = 'ignore_case'; 2527 $rh_ans->{student_ans} =~ tr/a-z/A-Z/; 2528 $rh_ans->{correct_ans} =~ tr/a-z/A-Z/; 2529 return $rh_ans; 2530 } 2531 2532 sub ignore_order { 2533 my $rh_ans = shift; 2534 die "expected an answer hash" unless ref($rh_ans)=~/HASH/i; 2535 $rh_ans->{_filter_name} = 'ignore_order'; 2536 $rh_ans->{student_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{student_ans} ) ) ); 2537 $rh_ans->{correct_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{correct_ans} ) ) ); 2538 2539 return $rh_ans; 2540 } 2541 # sub remove_whitespace { 2542 # my $filteredAnswer = shift; 2543 # 2544 # $filteredAnswer =~ s/\s+//g; # remove all whitespace 2545 # 2546 # return $filteredAnswer; 2547 # } 2548 # 2549 # sub compress_whitespace { 2550 # my $filteredAnswer = shift; 2551 # 2552 # $filteredAnswer =~ s/^\s*//; # remove initial whitespace 2553 # $filteredAnswer =~ s/\s*$//; # remove trailing whitespace 2554 # $filteredAnswer =~ s/\s+/ /g; # replace spaces by single space 2555 # 2556 # return $filteredAnswer; 2557 # } 2558 # 2559 # sub trim_whitespace { 2560 # my $filteredAnswer = shift; 2561 # 2562 # $filteredAnswer =~ s/^\s*//; # remove initial whitespace 2563 # $filteredAnswer =~ s/\s*$//; # remove trailing whitespace 2564 # 2565 # return $filteredAnswer; 2566 # } 2567 # 2568 # sub ignore_case { 2569 # my $filteredAnswer = shift; 2570 # #warn "filtered answer is ", $filteredAnswer; 2571 # #$filteredAnswer = uc $filteredAnswer; # this didn't work on webwork xmlrpc, but does elsewhere ???? 2572 # $filteredAnswer =~ tr/a-z/A-Z/; 2573 # 2574 # return $filteredAnswer; 2575 # } 2576 # 2577 # sub ignore_order { 2578 # my $filteredAnswer = shift; 2579 # 2580 # $filteredAnswer = join( "", lex_sort( split( /\s*/, $filteredAnswer ) ) ); 2581 # 2582 # return $filteredAnswer; 2583 # } 2584 ################################ 2585 ## END STRING ANSWER FILTERS 2586 2587 2588 =head3 str_cmp() 2589 2590 Compares a string or a list of strings, using a named hash of options to set 2591 parameters. This can make for more readable code than using the "mode"_str_cmp() 2592 style, but some people find one or the other easier to remember. 2593 2594 ANS( str_cmp( answer or answer_array_ref, options_hash ) ); 2595 2596 1. the correct answer or a reference to an array of answers 2597 2. either a list of filters, or: 2598 a hash consisting of 2599 filters - a reference to an array of filters 2600 2601 Returns an answer evaluator, or (if given a reference to an array of answers), 2602 a list of answer evaluators 2603 2604 FILTERS: 2605 2606 remove_whitespace -- removes all whitespace 2607 compress_whitespace -- removes whitespace from the beginning and end of the string, 2608 and treats one or more whitespace characters in a row as a 2609 single space (true by default) 2610 trim_whitespace -- removes whitespace from the beginning and end of the string 2611 ignore_case -- ignores the case of the letters (true by default) 2612 ignore_order -- ignores the order in which letters are entered 2613 2614 EXAMPLES: 2615 2616 str_cmp( "Hello" ) -- matches "Hello", " hello" (same as std_str_cmp() ) 2617 str_cmp( ["Hello", "Goodbye"] ) -- same as std_str_cmp_list() 2618 str_cmp( " hello ", trim_whitespace ) -- matches "hello", " hello " 2619 str_cmp( "ABC", filters => 'ignore_order' ) -- matches "ACB", "A B C", but not "abc" 2620 str_cmp( "D E F", remove_whitespace, ignore_case ) -- matches "def" and "d e f" but not "fed" 2621 2622 2623 =cut 2624 2625 sub str_cmp { 2626 my $correctAnswer = shift @_; 2627 $correctAnswer = '' unless defined($correctAnswer); 2628 my @options = @_; 2629 my %options = (); 2630 # backward compatibility 2631 if (grep /filters|debug|filter/, @options) { # see whether we have hash keys in the input. 2632 %options = @options; 2633 } elsif (@options) { # all options are names of filters. 2634 $options{filters} = [@options]; 2635 } 2636 my $ra_filters; 2637 assign_option_aliases( \%options, 2638 'filter' => 'filters', 2639 ); 2640 set_default_options( \%options, 2641 'filters' => [qw(trim_whitespace compress_whitespace ignore_case)], 2642 'debug' => 0, 2643 'type' => 'str_cmp', 2644 ); 2645 $options{filters} = (ref($options{filters}))?$options{filters}:[$options{filters}]; 2646 # make sure this is a reference to an array. 2647 # error-checking for filters occurs in the filters() subroutine 2648 # if( not defined( $options[0] ) ) { # used with no filters as alias for std_str_cmp() 2649 # @options = ( 'compress_whitespace', 'ignore_case' ); 2650 # } 2651 # 2652 # if( $options[0] eq 'filters' ) { # using filters => [f1, f2, ...] notation 2653 # $ra_filters = $options[1]; 2654 # } 2655 # else { # using a list of filters 2656 # $ra_filters = \@options; 2657 # } 2658 2659 # thread over lists 2660 my @ans_list = (); 2661 2662 if ( ref($correctAnswer) eq 'ARRAY' ) { 2663 @ans_list = @{$correctAnswer}; 2664 } 2665 else { 2666 push( @ans_list, $correctAnswer ); 2667 } 2668 2669 # final_answer; 2670 my @output_list = (); 2671 2672 foreach my $ans (@ans_list) { 2673 push(@output_list, STR_CMP( 2674 'correct_ans' => $ans, 2675 'filters' => $options{filters}, 2676 'type' => $options{type}, 2677 'debug' => $options{debug}, 2678 ) 2679 ); 2680 } 2681 2682 return (wantarray) ? @output_list : $output_list[0] ; 2683 } 2684 2685 =head3 "mode"_str_cmp functions 2686 2687 The functions of the the form "mode"_str_cmp() use different functions to 2688 specify which filters to apply. They take no options except the correct 2689 string. There are also versions which accept a list of strings. 2690 2691 std_str_cmp( $correctString ) 2692 std_str_cmp_list( @correctStringList ) 2693 Filters: compress_whitespace, ignore_case 2694 2695 std_cs_str_cmp( $correctString ) 2696 std_cs_str_cmp_list( @correctStringList ) 2697 Filters: compress_whitespace 2698 2699 strict_str_cmp( $correctString ) 2700 strict_str_cmp_list( @correctStringList ) 2701 Filters: trim_whitespace 2702 2703 unordered_str_cmp( $correctString ) 2704 unordered_str_cmp_list( @correctStringList ) 2705 Filters: ignore_order, ignore_case 2706 2707 unordered_cs_str_cmp( $correctString ) 2708 unordered_cs_str_cmp_list( @correctStringList ) 2709 Filters: ignore_order 2710 2711 ordered_str_cmp( $correctString ) 2712 ordered_str_cmp_list( @correctStringList ) 2713 Filters: remove_whitespace, ignore_case 2714 2715 ordered_cs_str_cmp( $correctString ) 2716 ordered_cs_str_cmp_list( @correctStringList ) 2717 Filters: remove_whitespace 2718 2719 Examples 2720 2721 ANS( std_str_cmp( "W. Mozart" ) ) -- Accepts "W. Mozart", "W. MOZarT", 2722 and so forth. Case insensitive. All internal spaces treated 2723 as single spaces. 2724 ANS( std_cs_str_cmp( "Mozart" ) ) -- Rejects "mozart". Same as 2725 std_str_cmp() but case sensitive. 2726 ANS( strict_str_cmp( "W. Mozart" ) ) -- Accepts only the exact string. 2727 ANS( unordered_str_cmp( "ABC" ) ) -- Accepts "a c B", "CBA" and so forth. 2728 Unordered, case insensitive, spaces ignored. 2729 ANS( unordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc". Same as 2730 unordered_str_cmp() but case sensitive. 2731 ANS( ordered_str_cmp( "ABC" ) ) -- Accepts "a b C", "A B C" and so forth. 2732 Ordered, case insensitive, spaces ignored. 2733 ANS( ordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc", accepts "A BC" and 2734 so forth. Same as ordered_str_cmp() but case sensitive. 2735 2736 =cut 2737 2738 sub std_str_cmp { # compare strings 2739 my $correctAnswer = shift @_; 2740 my @filters = ( 'compress_whitespace', 'ignore_case' ); 2741 my $type = 'std_str_cmp'; 2742 STR_CMP('correct_ans' => $correctAnswer, 2743 'filters' => \@filters, 2744 'type' => $type 2745 ); 2746 } 2747 2748 sub std_str_cmp_list { # alias for std_str_cmp 2749 my @answerList = @_; 2750 my @output; 2751 while (@answerList) { 2752 push( @output, std_str_cmp(shift @answerList) ); 2753 } 2754 @output; 2755 } 2756 2757 sub std_cs_str_cmp { # compare strings case sensitive 2758 my $correctAnswer = shift @_; 2759 my @filters = ( 'compress_whitespace' ); 2760 my $type = 'std_cs_str_cmp'; 2761 STR_CMP( 'correct_ans' => $correctAnswer, 2762 'filters' => \@filters, 2763 'type' => $type 2764 ); 2765 } 2766 2767 sub std_cs_str_cmp_list { # alias for std_cs_str_cmp 2768 my @answerList = @_; 2769 my @output; 2770 while (@answerList) { 2771 push( @output, std_cs_str_cmp(shift @answerList) ); 2772 } 2773 @output; 2774 } 2775 2776 sub strict_str_cmp { # strict string compare 2777 my $correctAnswer = shift @_; 2778 my @filters = ( 'trim_whitespace' ); 2779 my $type = 'strict_str_cmp'; 2780 STR_CMP( 'correct_ans' => $correctAnswer, 2781 'filters' => \@filters, 2782 'type' => $type 2783 ); 2784 } 2785 2786 sub strict_str_cmp_list { # alias for strict_str_cmp 2787 my @answerList = @_; 2788 my @output; 2789 while (@answerList) { 2790 push( @output, strict_str_cmp(shift @answerList) ); 2791 } 2792 @output; 2793 } 2794 2795 sub unordered_str_cmp { # unordered, case insensitive, spaces ignored 2796 my $correctAnswer = shift @_; 2797 my @filters = ( 'ignore_order', 'ignore_case' ); 2798 my $type = 'unordered_str_cmp'; 2799 STR_CMP( 'correct_ans' => $correctAnswer, 2800 'filters' => \@filters, 2801 'type' => $type 2802 ); 2803 } 2804 2805 sub unordered_str_cmp_list { # alias for unordered_str_cmp 2806 my @answerList = @_; 2807 my @output; 2808 while (@answerList) { 2809 push( @output, unordered_str_cmp(shift @answerList) ); 2810 } 2811 @output; 2812 } 2813 2814 sub unordered_cs_str_cmp { # unordered, case sensitive, spaces ignored 2815 my $correctAnswer = shift @_; 2816 my @filters = ( 'ignore_order' ); 2817 my $type = 'unordered_cs_str_cmp'; 2818 STR_CMP( 'correct_ans' => $correctAnswer, 2819 'filters' => \@filters, 2820 'type' => $type 2821 ); 2822 } 2823 2824 sub unordered_cs_str_cmp_list { # alias for unordered_cs_str_cmp 2825 my @answerList = @_; 2826 my @output; 2827 while (@answerList) { 2828 push( @output, unordered_cs_str_cmp(shift @answerList) ); 2829 } 2830 @output; 2831 } 2832 2833 sub ordered_str_cmp { # ordered, case insensitive, spaces ignored 2834 my $correctAnswer = shift @_; 2835 my @filters = ( 'remove_whitespace', 'ignore_case' ); 2836 my $type = 'ordered_str_cmp'; 2837 STR_CMP( 'correct_ans' => $correctAnswer, 2838 'filters' => \@filters, 2839 'type' => $type 2840 ); 2841 } 2842 2843 sub ordered_str_cmp_list { # alias for ordered_str_cmp 2844 my @answerList = @_; 2845 my @output; 2846 while (@answerList) { 2847 push( @output, ordered_str_cmp(shift @answerList) ); 2848 } 2849 @output; 2850 } 2851 2852 sub ordered_cs_str_cmp { # ordered, case sensitive, spaces ignored 2853 my $correctAnswer = shift @_; 2854 my @filters = ( 'remove_whitespace' ); 2855 my $type = 'ordered_cs_str_cmp'; 2856 STR_CMP( 'correct_ans' => $correctAnswer, 2857 'filters' => \@filters, 2858 'type' => $type 2859 ); 2860 } 2861 2862 sub ordered_cs_str_cmp_list { # alias for ordered_cs_str_cmp 2863 my @answerList = @_; 2864 my @output; 2865 while (@answerList) { 2866 push( @output, ordered_cs_str_cmp(shift @answerList) ); 2867 } 2868 @output; 2869 } 2870 2871 2872 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 2873 ## 2874 ## IN: a hashtable with the following entries (error-checking to be added later?): 2875 ## correctAnswer -- the correct answer, before filtering 2876 ## filters -- reference to an array containing the filters to be applied 2877 ## type -- a string containing the type of answer evaluator in use 2878 ## OUT: a reference to an answer evaluator subroutine 2879 sub STR_CMP { 2880 my %str_params = @_; 2881 #my $correctAnswer = str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} ); 2882 my $answer_evaluator = new AnswerEvaluator; 2883 $answer_evaluator->{debug} = $str_params{debug}; 2884 $answer_evaluator->ans_hash( 2885 correct_ans => "$str_params{correct_ans}", 2886 type => $str_params{type}||'str_cmp', 2887 score => 0, 2888 2889 ); 2890 # Remove blank prefilter if the correct answer is blank 2891 $answer_evaluator->install_pre_filter('erase') if $answer_evaluator->{correct_ans} eq ''; 2892 2893 my %known_filters = ( 2894 'remove_whitespace' => \&remove_whitespace, 2895 'compress_whitespace' => \&compress_whitespace, 2896 'trim_whitespace' => \&trim_whitespace, 2897 'ignore_case' => \&ignore_case, 2898 'ignore_order' => \&ignore_order, 2899 ); 2900 2901 foreach my $filter ( @{$str_params{filters}} ) { 2902 #check that filter is known 2903 die "Unknown string filter |$filter|. Known filters are ". 2904 join(" ", keys %known_filters) . 2905 "(try checking the parameters to str_cmp() )" 2906 unless exists $known_filters{$filter}; 2907 # install related pre_filter 2908 $answer_evaluator->install_pre_filter( $known_filters{$filter} ); 2909 } 2910 $answer_evaluator->install_evaluator(sub { 2911 my $rh_ans = shift; 2912 $rh_ans->{_filter_name} = "Evaluator: Compare string answers with eq"; 2913 $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans})?1:0 ; 2914 $rh_ans; 2915 }); 2916 $answer_evaluator->install_post_filter(sub { 2917 my $rh_hash = shift; 2918 $rh_hash->{_filter_name} = "clean up preview strings"; 2919 $rh_hash->{'preview_text_string'} = $rh_hash->{student_ans}; 2920 $rh_hash->{'preview_latex_string'} = "\\text{ ".$rh_hash->{student_ans}." }"; 2921 $rh_hash; 2922 }); 2923 return $answer_evaluator; 2924 } 2925 2926 # sub STR_CMP_old { 2927 # my %str_params = @_; 2928 # $str_params{'correct_ans'} = str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} ); 2929 # my $answer_evaluator = sub { 2930 # my $in = shift @_; 2931 # $in = '' unless defined $in; 2932 # my $original_student_ans = $in; 2933 # $in = str_filters( $in, @{$str_params{'filters'}} ); 2934 # my $correctQ = ( $in eq $str_params{'correct_ans'} ) ? 1: 0; 2935 # my $ans_hash = new AnswerHash( 'score' => $correctQ, 2936 # 'correct_ans' => $str_params{'correctAnswer'}, 2937 # 'student_ans' => $in, 2938 # 'ans_message' => '', 2939 # 'type' => $str_params{'type'}, 2940 # 'preview_text_string' => $in, 2941 # 'preview_latex_string' => $in, 2942 # 'original_student_ans' => $original_student_ans 2943 # ); 2944 # return $ans_hash; 2945 # }; 2946 # return $answer_evaluator; 2947 # } 2948 2949 ########################################################################## 2950 ########################################################################## 2951 ## Miscellaneous answer evaluators 2952 2953 =head2 Miscellaneous Answer Evaluators (Checkboxes and Radio Buttons) 2954 2955 These evaluators do not fit any of the other categories. 2956 2957 checkbox_cmp( $correctAnswer ) 2958 2959 $correctAnswer -- a string containing the names of the correct boxes, 2960 e.g. "ACD". Note that this means that individual 2961 checkbox names can only be one character. Internally, 2962 this is largely the same as unordered_cs_str_cmp(). 2963 2964 radio_cmp( $correctAnswer ) 2965 2966 $correctAnswer -- a string containing the name of the correct radio 2967 button, e.g. "Choice1". This is case sensitive and 2968 whitespace sensitive, so the correct answer must match 2969 the name of the radio button exactly. 2970 2971 =cut 2972 2973 # added 6/14/2000 by David Etlinger 2974 # because of the conversion of the answer 2975 # string to an array, I thought it better not 2976 # to force STR_CMP() to work with this 2977 2978 #added 2/26/2003 by Mike Gage 2979 # handled the case where multiple answers are passed as an array reference 2980 # rather than as a \0 delimited string. 2981 sub checkbox_cmp { 2982 my $correctAnswer = shift @_; 2983 my %options = @_; 2984 assign_option_aliases( \%options, 2985 ); 2986 set_default_options( \%options, 2987 'debug' => 0, 2988 'type' => 'checkbox_cmp', 2989 ); 2990 my $answer_evaluator = new AnswerEvaluator( 2991 correct_ans => $correctAnswer, 2992 type => $options{type}, 2993 ); 2994 # pass along debug requests 2995 $answer_evaluator->{debug} = $options{debug}; 2996 2997 # join student answer array into a single string if necessary 2998 $answer_evaluator->install_pre_filter(sub { 2999 my $rh_ans = shift; 3000 $rh_ans->{_filter_name} = 'convert student_ans to string'; 3001 $rh_ans->{student_ans} = join("", @{$rh_ans->{student_ans}}) 3002 if ref($rh_ans->{student_ans}) =~/ARRAY/i; 3003 $rh_ans; 3004 }); 3005 # ignore order of check boxes 3006 $answer_evaluator->install_pre_filter(\&ignore_order); 3007 # compare as strings 3008 $answer_evaluator->install_evaluator(sub { 3009 my $rh_ans = shift; 3010 $rh_ans->{_filter_name} = 'compare strings generated by checked boxes'; 3011 $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans}) ? 1 : 0; 3012 $rh_ans; 3013 }); 3014 # fix up preview displays 3015 $answer_evaluator->install_post_filter( sub { 3016 my $rh_ans = shift; 3017 $rh_ans->{_filter_name} = 'adjust preview strings'; 3018 $rh_ans->{type} = $options{type}; 3019 $rh_ans->{preview_text_string} = '\\text{'.$rh_ans->{student_ans}.'}', 3020 $rh_ans->{preview_latex_string} = '\\text{'.$rh_ans->{student_ans}.'}', 3021 $rh_ans; 3022 3023 3024 }); 3025 3026 # my $answer_evaluator = sub { 3027 # my $in = shift @_; 3028 # $in = '' unless defined $in; #in case no boxes checked 3029 # # multiple answers could come in two forms 3030 # # either a \0 delimited string or 3031 # # an array reference. We handle both. 3032 # if (ref($in) eq 'ARRAY') { 3033 # $in = join("",@{$in}); # convert array to single no-delimiter string 3034 # } else { 3035 # my @temp = split( "\0", $in ); #convert "\0"-delimited string to array... 3036 # $in = join( "", @temp ); #and then to a single no-delimiter string 3037 # } 3038 # my $original_student_ans = $in; #well, almost original 3039 # $in = str_filters( $in, 'ignore_order' ); 3040 # 3041 # my $correctQ = ($in eq $correctAnswer) ? 1: 0; 3042 # 3043 # my $ans_hash = new AnswerHash( 3044 # 'score' => $correctQ, 3045 # 'correct_ans' => "$correctAnswer", 3046 # 'student_ans' => $in, 3047 # 'ans_message' => "", 3048 # 'type' => "checkbox_cmp", 3049 # 'preview_text_string' => $in, 3050 # 'preview_latex_string' => $in, 3051 # 'original_student_ans' => $original_student_ans 3052 # ); 3053 # return $ans_hash; 3054 # 3055 # }; 3056 return $answer_evaluator; 3057 } 3058 # sub checkbox_cmp { 3059 # my $correctAnswer = shift @_; 3060 # $correctAnswer = str_filters( $correctAnswer, 'ignore_order' ); 3061 # 3062 # my $answer_evaluator = sub { 3063 # my $in = shift @_; 3064 # $in = '' unless defined $in; #in case no boxes checked 3065 # # multiple answers could come in two forms 3066 # # either a \0 delimited string or 3067 # # an array reference. We handle both. 3068 # if (ref($in) eq 'ARRAY') { 3069 # $in = join("",@{$in}); # convert array to single no-delimiter string 3070 # } else { 3071 # my @temp = split( "\0", $in ); #convert "\0"-delimited string to array... 3072 # $in = join( "", @temp ); #and then to a single no-delimiter string 3073 # } 3074 # my $original_student_ans = $in; #well, almost original 3075 # $in = str_filters( $in, 'ignore_order' ); 3076 # 3077 # my $correctQ = ($in eq $correctAnswer) ? 1: 0; 3078 # 3079 # my $ans_hash = new AnswerHash( 3080 # 'score' => $correctQ, 3081 # 'correct_ans' => "$correctAnswer", 3082 # 'student_ans' => $in, 3083 # 'ans_message' => "", 3084 # 'type' => "checkbox_cmp", 3085 # 'preview_text_string' => $in, 3086 # 'preview_latex_string' => $in, 3087 # 'original_student_ans' => $original_student_ans 3088 # ); 3089 # return $ans_hash; 3090 # 3091 # }; 3092 # return $answer_evaluator; 3093 # } 3094 3095 #added 6/28/2000 by David Etlinger 3096 #exactly the same as strict_str_cmp, 3097 #but more intuitive to the user 3098 3099 # check that answer is really a string and not an array 3100 # also use ordinary string compare 3101 sub radio_cmp { 3102 #strict_str_cmp( @_ ); 3103 my $response = shift; # there should be only one item. 3104 warn "Multiple choices -- this should not happen with radio buttons. Have 3105 you used checkboxes perhaps?" if ref($response); #triggered if an ARRAY is passed 3106 str_cmp($response); 3107 } 3108 3109 ########################################################################## 3110 ########################################################################## 3111 ## Text and e-mail routines 3112 3113 sub store_ans_at { 3114 my $answerStringRef = shift; 3115 my %options = @_; 3116 my $ans_eval= ''; 3117 if ( ref($answerStringRef) eq 'SCALAR' ) { 3118 $ans_eval= sub { 3119 my $text = shift; 3120 $text = '' unless defined($text); 3121 $$answerStringRef = $$answerStringRef . $text; 3122 my $ans_hash = new AnswerHash( 3123 'score' => 1, 3124 'correct_ans' => '', 3125 'student_ans' => $text, 3126 'ans_message' => '', 3127 'type' => 'store_ans_at', 3128 'original_student_ans' => $text, 3129 'preview_text_string' => '' 3130 ); 3131 3132 return $ans_hash; 3133 }; 3134 } 3135 else { 3136 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"; 3137 } 3138 3139 return $ans_eval; 3140 } 3141 3142 #### subroutines used in producing a questionnaire 3143 #### these are at least good models for other answers of this type 3144 3145 # my $QUESTIONNAIRE_ANSWERS=''; # stores the answers until it is time to send them 3146 # this must be initialized before the answer evaluators are run 3147 # but that happens long after all of the text in the problem is 3148 # evaluated. 3149 # this is a utility script for cleaning up the answer output for display in 3150 #the answers. 3151 3152 sub DUMMY_ANSWER { 3153 my $num = shift; 3154 qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">} 3155 } 3156 3157 sub escapeHTML { 3158 my $string = shift; 3159 $string =~ s/\n/$BR/ge; 3160 $string; 3161 } 3162 3163 # these next three subroutines show how to modify the "store_ans_at()" answer 3164 # evaluator to add extra information before storing the info 3165 # They provide a good model for how to tweak answer evaluators in special cases. 3166 3167 sub anstext { 3168 my $num = shift; 3169 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3170 my $psvnNumber = PG_restricted_eval(q!$main::psvnNumber!); 3171 my $probNum = PG_restricted_eval(q!$main::probNum!); 3172 my $courseName = PG_restricted_eval(q!$main::courseName!); 3173 my $setNumber = PG_restricted_eval(q!$main::setNumber!); 3174 3175 my $ans_eval = sub { 3176 my $text = shift; 3177 $text = '' unless defined($text); 3178 my $new_text = "\n${setNumber}_${courseName}_$psvnNumber-Problem-$probNum-Question-$num:\n $text "; # modify entered text 3179 my $out = &$ans_eval_template($new_text); # standard evaluator 3180 #warn "$QUESTIONNAIRE_ANSWERS"; 3181 $out->{student_ans} = escapeHTML($text); # restore original entered text 3182 $out->{correct_ans} = "Question $num answered"; 3183 $out->{original_student_ans} = escapeHTML($text); 3184 $out; 3185 }; 3186 $ans_eval; 3187 } 3188 3189 3190 sub ansradio { 3191 my $num = shift; 3192 my $psvnNumber = PG_restricted_eval(q!$main::psvnNumber!); 3193 my $probNum = PG_restricted_eval(q!$main::probNum!); 3194 3195 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3196 my $ans_eval = sub { 3197 my $text = shift; 3198 $text = '' unless defined($text); 3199 my $new_text = "\n$psvnNumber-Problem-$probNum-RADIO-$num:\n $text "; # modify entered text 3200 my $out = $ans_eval_template->($new_text); # standard evaluator 3201 $out->{student_ans} =escapeHTML($text); # restore original entered text 3202 $out->{original_student_ans} = escapeHTML($text); 3203 $out; 3204 }; 3205 3206 $ans_eval; 3207 } 3208 3209 sub anstext_non_anonymous { 3210 ## this emails identifying information 3211 my $num = shift; 3212 my $psvnNumber = PG_restricted_eval(q!$main::psvnNumber!); 3213 my $probNum = PG_restricted_eval(q!$main::probNum!); 3214 my $studentLogin = PG_restricted_eval(q!$main::studentLogin!); 3215 my $studentID = PG_restricted_eval(q!$main::studentID!); 3216 my $studentName = PG_restricted_eval(q!$main::studentName!); 3217 3218 3219 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3220 my $ans_eval = sub { 3221 my $text = shift; 3222 $text = '' unless defined($text); 3223 my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n$studentLogin $main::studentID $studentName\n$text "; # modify entered text 3224 my $out = &$ans_eval_template($new_text); # standard evaluator 3225 #warn "$QUESTIONNAIRE_ANSWERS"; 3226 $out->{student_ans} = escapeHTML($text); # restore original entered text 3227 $out->{correct_ans} = "Question $num answered"; 3228 $out->{original_student_ans} = escapeHTML($text); 3229 $out; 3230 }; 3231 $ans_eval; 3232 } 3233 3234 3235 # This is another example of how to modify an answer evaluator to obtain 3236 # the desired behavior in a special case. Here the object is to have 3237 # have the last answer trigger the send_mail_to subroutine which mails 3238 # all of the answers to the designated address. 3239 # (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.) 3240 3241 # Fix me?? why is the body hard wired to the string QUESTIONNAIRE_ANSWERS? 3242 3243 sub mail_answers_to { #accepts the last answer and mails off the result 3244 my $user_address = shift; 3245 my $ans_eval = sub { 3246 3247 # then mail out all of the answers, including this last one. 3248 3249 # this is the old mechanism for sending mail (via IO.pl) 3250 #send_mail_to( $user_address, 3251 # 'subject' => "$main::courseName WeBWorK questionnaire", 3252 # 'body' => $QUESTIONNAIRE_ANSWERS, 3253 # 'ALLOW_MAIL_TO' => $rh_envir->{ALLOW_MAIL_TO} 3254 #); 3255 3256 # DelayedMailer is the new method (for now) 3257 $rh_envir->{mailer}->add_message( 3258 to => $user_address, 3259 subject => "$main::courseName WeBWorK questionnaire", 3260 msg => $QUESTIONNAIRE_ANSWERS, 3261 ); 3262 3263 my $ans_hash = new AnswerHash( 'score' => 1, 3264 'correct_ans' => '', 3265 'student_ans' => 'Answer recorded', 3266 'ans_message' => '', 3267 'type' => 'send_mail_to', 3268 ); 3269 3270 return $ans_hash; 3271 }; 3272 3273 return $ans_eval; 3274 } 3275 3276 sub save_answer_to_file { #accepts the last answer and mails off the result 3277 my $fileID = shift; 3278 my $ans_eval = new AnswerEvaluator; 3279 $ans_eval->install_evaluator( 3280 sub { 3281 my $rh_ans = shift; 3282 3283 unless ( defined( $rh_ans->{student_ans} ) ) { 3284 $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined"); 3285 return $rh_ans; 3286 } 3287 3288 my $error; 3289 my $string = ''; 3290 $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!. 3291 $rh_ans->{student_ans}. qq!\n\n============================\n\n!; 3292 3293 if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) { 3294 $rh_ans->throw_error("save_answers_to_file","Error: $error"); 3295 } else { 3296 $rh_ans->{'student_ans'} = 'Answer saved'; 3297 $rh_ans->{'score'} = 1; 3298 } 3299 $rh_ans; 3300 } 3301 ); 3302 3303 return $ans_eval; 3304 } 3305 3306 #sub mail_answers_to2 { #accepts the last answer and mails off the result 3307 # my $user_address = shift; 3308 # my $subject = shift; 3309 # my $ra_allow_mail_to = shift; 3310 # $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject; 3311 # send_mail_to($user_address, 3312 # 'subject' => $subject, 3313 # 'body' => $QUESTIONNAIRE_ANSWERS, 3314 # 'ALLOW_MAIL_TO' => $rh_envir->{ALLOW_MAIL_TO}, 3315 # ); 3316 #} 3317 sub save_questionnaire_answers_to { 3318 my $fileName =shift; 3319 SaveFile::printAnswerFile($fileName,[$QUESTIONNAIRE_ANSWERS]); 3320 } 3321 sub mail_answers_to2 { 3322 my ($to, $subject, $ra_allow_mail_to) = @_; 3323 3324 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject; 3325 warn "The third argument (ra_allow_mail_to) to mail_answers_to2() is ignored. The list of allowed addresses is fixed." 3326 if defined $ra_allow_mail_to; 3327 3328 $rh_envir->{mailer}->add_message( 3329 to => $to, 3330 subject => $subject, 3331 msg => $QUESTIONNAIRE_ANSWERS, 3332 ); 3333 3334 #my $mailer = $rh_envir->{mailer}; 3335 # 3336 #my $open_result = $mailer->Open({to => $to, subject => $subject}); 3337 #if (not ref $open_result) { 3338 # die "An error occured while opening the mailer: ", 3339 # $mailer->error_msg, " (", $mailer->error, ")"; 3340 #} 3341 # 3342 #my $sendenc_result = $mailer->SendEnc($QUESTIONNAIRE_ANSWERS); 3343 #if (not ref $sendenc_result) { 3344 # die "An error occured while sending the message body: ", 3345 # $mailer->error_msg, " (", $mailer->error, ")"; 3346 #} 3347 # 3348 #my $close_result = $mailer->Close; 3349 #if (not ref $open_result) { 3350 # die "An error occured while closing the mailer: ", 3351 # $mailer->error_msg, " (", $mailer->error, ")"; 3352 #} 3353 3354 return; 3355 } 3356 3357 ########################################################################## 3358 ########################################################################## 3359 3360 3361 ########################################################################### 3362 ### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT. 3363 3364 ## Internal routine that converts variables into the standard array format 3365 ## 3366 ## IN: one of the following: 3367 ## an undefined value (i.e., no variable was specified) 3368 ## a reference to an array of variable names -- [var1, var2] 3369 ## a number (the number of variables desired) -- 3 3370 ## one or more variable names -- (var1, var2) 3371 ## OUT: an array of variable names 3372 3373 sub get_var_array { 3374 my $in = shift @_; 3375 my @out; 3376 3377 if( not defined($in) ) { #if nothing defined, build default array and return 3378 @out = ( $functVarDefault ); 3379 return @out; 3380 } 3381 elsif( ref( $in ) eq 'ARRAY' ) { #if given an array ref, dereference and return 3382 return @{$in}; 3383 } 3384 elsif( $in =~ /^\d+/ ) { #if given a number, set up the array and return 3385 if( $in == 1 ) { 3386 $out[0] = 'x'; 3387 } 3388 elsif( $in == 2 ) { 3389 $out[0] = 'x'; 3390 $out[1] = 'y'; 3391 } 3392 elsif( $in == 3 ) { 3393 $out[0] = 'x'; 3394 $out[1] = 'y'; 3395 $out[2] = 'z'; 3396 } 3397 else { #default to the x_1, x_2, ... convention 3398 my ($i, $tag); 3399 for($i = 0; $i < $in; $i++) {$out[$i] = "${functVarDefault}_".($i+1)} 3400 } 3401 return @out; 3402 } 3403 else { #if given one or more names, return as an array 3404 unshift( @_, $in ); 3405 return @_; 3406 } 3407 } 3408 3409 ## Internal routine that converts limits into the standard array of arrays format 3410 ## Some of the cases are probably unneccessary, but better safe than sorry 3411 ## 3412 ## IN: one of the following: 3413 ## an undefined value (i.e., no limits were specified) 3414 ## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]] 3415 ## a reference to an array of limits -- [llim, ulim] 3416 ## an array of array references -- ([llim,ulim], [llim,ulim]) 3417 ## an array of limits -- (llim,ulim) 3418 ## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim]) 3419 3420 sub get_limits_array { 3421 my $in = shift @_; 3422 my @out; 3423 3424 if( not defined($in) ) { #if nothing defined, build default array and return 3425 @out = ( [$functLLimitDefault, $functULimitDefault] ); 3426 return @out; 3427 } 3428 elsif( ref($in) eq 'ARRAY' ) { #$in is either ref to array, or ref to array of refs 3429 my @deref = @{$in}; 3430 3431 if( ref( $in->[0] ) eq 'ARRAY' ) { #$in is a ref to an array of array refs 3432 return @deref; 3433 } 3434 else { #$in was just a ref to an array of numbers 3435 @out = ( $in ); 3436 return @out; 3437 } 3438 } 3439 else { #$in was an array of references or numbers 3440 unshift( @_, $in ); 3441 3442 if( ref($_[0]) eq 'ARRAY' ) { #$in was an array of references, so just return it 3443 return @_; 3444 } 3445 else { #$in was an array of numbers 3446 @out = ( \@_ ); 3447 return @out; 3448 } 3449 } 3450 } 3451 3452 #sub check_option_list { 3453 # my $size = scalar(@_); 3454 # if( ( $size % 2 ) != 0 ) { 3455 # warn "ERROR in answer evaluator generator:\n" . 3456 # "Usage: <CODE>str_cmp([\$ans1, \$ans2],%options)</CODE> 3457 # or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR> 3458 # A list of inputs must be inclosed in square brackets <CODE>[\$ans1, \$ans2]</CODE>"; 3459 # } 3460 #} 3461 3462 # simple subroutine to display an error message when 3463 # function compares are called with invalid parameters 3464 sub function_invalid_params { 3465 my $correctEqn = shift @_; 3466 my $error_response = sub { 3467 my $PGanswerMessage = "Tell your professor that there is an error with the parameters " . 3468 "to the function answer evaluator"; 3469 return ( 0, $correctEqn, "", $PGanswerMessage ); 3470 }; 3471 return $error_response; 3472 } 3473 3474 sub clean_up_error_msg { 3475 my $msg = $_[0]; 3476 $msg =~ s/^\[[^\]]*\][^:]*://; 3477 $msg =~ s/Unquoted string//g; 3478 $msg =~ s/may\s+clash.*/does not make sense here/; 3479 $msg =~ s/\sat.*line [\d]*//g; 3480 $msg = 'Error: '. $msg; 3481 3482 return $msg; 3483 } 3484 3485 #formats the student and correct answer as specified 3486 #format must be of a form suitable for sprintf (e.g. '%0.5g'), 3487 #with the exception that a '#' at the end of the string 3488 #will cause trailing zeros in the decimal part to be removed 3489 sub prfmt { 3490 my($number,$format) = @_; # attention, the order of format and number are reversed 3491 my $out; 3492 if ($format) { 3493 warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>" 3494 unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/; 3495 3496 if( $format =~ s/#\s*$// ) { # remove trailing zeros in the decimal 3497 $out = sprintf( $format, $number ); 3498 $out =~ s/(\.\d*?)0+$/$1/; 3499 $out =~ s/\.$//; # in case all decimal digits were zero, remove the decimal 3500 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 3501 } elsif (is_a_number($number) ){ 3502 $out = sprintf( $format, $number ); 3503 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 3504 } else { # number is probably a string representing an arithmetic expression 3505 $out = $number; 3506 } 3507 3508 } else { 3509 if (is_a_number($number)) {# only use capital E's for exponents. Little e is for 2.71828... 3510 $out = $number; 3511 $out =~ s/e/E/g; 3512 } else { # number is probably a string representing an arithmetic expression 3513 $out = $number; 3514 } 3515 } 3516 return $out; 3517 } 3518 ######################################################################### 3519 # Filters for answer evaluators 3520 ######################################################################### 3521 3522 =head2 Filters 3523 3524 =pod 3525 3526 A filter is a short subroutine with the following structure. It accepts an 3527 AnswerHash, followed by a hash of options. It returns an AnswerHash 3528 3529 $ans_hash = filter($ans_hash, %options); 3530 3531 See the AnswerHash.pm file for a list of entries which can be expected to be found 3532 in an AnswerHash, such as 'student_ans', 'score' and so forth. Other entries 3533 may be present for specialized answer evaluators. 3534 3535 The hope is that a well designed set of filters can easily be combined to form 3536 a new answer_evaluator and that this method will produce answer evaluators which are 3537 are more robust than the method of copying existing answer evaluators and modifying them. 3538 3539 Here is an outline of how a filter is constructed: 3540 3541 sub filter{ 3542 my $rh_ans = shift; 3543 my %options = @_; 3544 assign_option_aliases(\%options, 3545 'alias1' => 'option5' 3546 'alias2' => 'option7' 3547 ); 3548 set_default_options(\%options, 3549 '_filter_name' => 'filter', 3550 'option5' => .0001, 3551 'option7' => 'ascii', 3552 'allow_unknown_options => 0, 3553 } 3554 .... body code of filter ....... 3555 if ($error) { 3556 $rh_ans->throw_error("FILTER_ERROR", "Something went wrong"); 3557 # see AnswerHash.pm for details on using the throw_error method. 3558 3559 $rh_ans; #reference to an AnswerHash object is returned. 3560 } 3561 3562 =cut 3563 3564 =head4 compare_numbers 3565 3566 3567 =cut 3568 3569 3570 sub compare_numbers { 3571 my ($rh_ans, %options) = @_; 3572 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans}); 3573 if ($PG_eval_errors) { 3574 $rh_ans->throw_error('EVAL','There is a syntax error in your answer'); 3575 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors); 3576 # return $rh_ans; 3577 } else { 3578 $rh_ans->{student_ans} = prfmt($inVal,$options{format}); 3579 } 3580 3581 my $permitted_error; 3582 3583 if ($rh_ans->{tolType} eq 'absolute') { 3584 $permitted_error = $rh_ans->{tolerance}; 3585 } 3586 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) { 3587 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero 3588 } 3589 else { 3590 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}); 3591 } 3592 3593 my $is_a_number = is_a_number($inVal); 3594 $rh_ans->{score} = 1 if ( ($is_a_number) and 3595 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) ); 3596 if (not $is_a_number) { 3597 $rh_ans->{error_message} = "$rh_ans->{error_message}". 'Your answer does not evaluate to a number '; 3598 } 3599 3600 $rh_ans; 3601 } 3602 3603 =head4 std_num_filter 3604 3605 std_num_filter($rh_ans, %options) 3606 returns $rh_ans 3607 3608 Replaces some constants using math_constants, then evaluates a perl expression. 3609 3610 3611 =cut 3612 3613 sub std_num_filter { 3614 my $rh_ans = shift; 3615 my %options = @_; 3616 my $in = $rh_ans->input(); 3617 $in = math_constants($in); 3618 $rh_ans->{type} = 'std_number'; 3619 my ($inVal,$PG_eval_errors,$PG_full_error_report); 3620 if ($in =~ /\S/) { 3621 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in); 3622 } else { 3623 $PG_eval_errors = ''; 3624 } 3625 3626 if ($PG_eval_errors) { ##error message from eval or above 3627 $rh_ans->{ans_message} = 'There is a syntax error in your answer'; 3628 $rh_ans->{student_ans} = 3629 clean_up_error_msg($PG_eval_errors); 3630 } else { 3631 $rh_ans->{student_ans} = $inVal; 3632 } 3633 $rh_ans; 3634 } 3635 3636 =head4 std_num_array_filter 3637 3638 std_num_array_filter($rh_ans, %options) 3639 returns $rh_ans 3640 3641 Assumes the {student_ans} field is a numerical array, and applies BOTH check_syntax and std_num_filter 3642 to each element of the array. Does it's best to generate sensible error messages for syntax errors. 3643 A typical error message displayed in {studnet_ans} might be ( 56, error message, -4). 3644 3645 =cut 3646 3647 sub std_num_array_filter { 3648 my $rh_ans= shift; 3649 my %options = @_; 3650 set_default_options( \%options, 3651 '_filter_name' => 'std_num_array_filter', 3652 ); 3653 my @in = @{$rh_ans->{student_ans}}; 3654 my $temp_hash = new AnswerHash; 3655 my @out=(); 3656 my $PGanswerMessage = ''; 3657 foreach my $item (@in) { # evaluate each number in the vector 3658 $temp_hash->input($item); 3659 $temp_hash = check_syntax($temp_hash); 3660 if (defined($temp_hash->{error_flag}) and $temp_hash->{error_flag} eq 'SYNTAX') { 3661 $PGanswerMessage .= $temp_hash->{ans_message}; 3662 $temp_hash->{ans_message} = undef; 3663 } else { 3664 #continue processing 3665 $temp_hash = std_num_filter($temp_hash); 3666 if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) { 3667 $PGanswerMessage .= $temp_hash->{ans_message}; 3668 $temp_hash->{ans_message} = undef; 3669 } 3670 } 3671 push(@out, $temp_hash->input()); 3672 3673 } 3674 if ($PGanswerMessage) { 3675 $rh_ans->input( "( " . join(", ", @out ) . " )" ); 3676 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.'); 3677 } else { 3678 $rh_ans->input( [@out] ); 3679 } 3680 $rh_ans; 3681 } 3682 3683 =head4 function_from_string2 3684 3685 3686 3687 =cut 3688 3689 sub function_from_string2 { 3690 my $rh_ans = shift; 3691 my %options = @_; 3692 assign_option_aliases(\%options, 3693 'vars' => 'ra_vars', 3694 'var' => 'ra_vars', 3695 'store_in' => 'stdout', 3696 ); 3697 set_default_options( \%options, 3698 'stdin' => 'student_ans', 3699 'stdout' => 'rf_student_ans', 3700 'ra_vars' => [qw( x y )], 3701 'debug' => 0, 3702 '_filter_name' => 'function_from_string2', 3703 ); 3704 # initialize 3705 $rh_ans->{_filter_name} = $options{_filter_name}; 3706 3707 my $eqn = $rh_ans->{ $options{stdin} }; 3708 my @VARS = @{ $options{ 'ra_vars'} }; 3709 #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1; 3710 my $originalEqn = $eqn; 3711 $eqn = &math_constants($eqn); 3712 for( my $i = 0; $i < @VARS; $i++ ) { 3713 # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1 3714 my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"'); 3715 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g; 3716 $eqn =~ s/\b$temp\b/\$VARS[$i]/g; 3717 3718 } 3719 #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n", 3720 # pretty_print(\%options) 3721 # if defined($options{debug}) and $options{debug} ==1; 3722 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q! 3723 sub { 3724 my @VARS = @_; 3725 my $input_str = ''; 3726 for( my $i=0; $i<@VARS; $i++ ) { 3727 $input_str .= "\$VARS[$i] = $VARS[$i]; "; 3728 } 3729 my $PGanswerMessage; 3730 $input_str .= '! . $eqn . q!'; # need the single quotes to keep the contents of $eqn from being 3731 # evaluated when it is assigned to $input_str; 3732 my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated 3733 3734 if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) { 3735 $PGanswerMessage = clean_up_error_msg($PG_eval_errors); 3736 # This message seemed too verbose, but it does give extra information, we'll see if it is needed. 3737 # "<br> There was an error in evaluating your function <br> 3738 # !. $originalEqn . q! <br> 3739 # at ( " . join(', ', @VARS) . " ) <br> 3740 # $PG_eval_errors 3741 # "; # this message appears in the answer section which is not process by Latex2HTML so it must 3742 # # be in HTML. That is why $BR is NOT used. 3743 3744 } 3745 (wantarray) ? ($out, $PGanswerMessage): $out; # PGanswerMessage may be undefined. 3746 }; 3747 !); 3748 3749 if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) { 3750 $PG_eval_errors = clean_up_error_msg($PG_eval_errors); 3751 3752 my $PGanswerMessage = "There was an error in converting the expression 3753 $BR $originalEqn $BR into a function. 3754 $BR $PG_eval_errors."; 3755 $rh_ans->{rf_student_ans} = $function_sub; 3756 $rh_ans->{ans_message} = $PGanswerMessage; 3757 $rh_ans->{error_message} = $PGanswerMessage; 3758 $rh_ans->{error_flag} = 1; 3759 # we couldn't compile the equation, we'll return an error message. 3760 } else { 3761 # if (defined($options{stdout} )) { 3762 # $rh_ans ->{$options{stdout}} = $function_sub; 3763 # } else { 3764 # $rh_ans->{rf_student_ans} = $function_sub; 3765 # } 3766 $rh_ans ->{$options{stdout}} = $function_sub; 3767 } 3768 3769 $rh_ans; 3770 } 3771 3772 =head4 is_zero_array 3773 3774 3775 =cut 3776 3777 3778 sub is_zero_array { 3779 my $rh_ans = shift; 3780 my %options = @_; 3781 set_default_options( \%options, 3782 '_filter_name' => 'is_zero_array', 3783 'tolerance' => 0.000001, 3784 'stdin' => 'ra_differences', 3785 'stdout' => 'score', 3786 ); 3787 #intialize 3788 $rh_ans->{_filter_name} = $options{_filter_name}; 3789 3790 my $array = $rh_ans -> {$options{stdin}}; # default ra_differences 3791 my $num = @$array; 3792 my $i; 3793 my $max = 0; my $mm; 3794 for ($i=0; $i< $num; $i++) { 3795 $mm = $array->[$i] ; 3796 if (not is_a_number($mm) ) { 3797 $max = $mm; # break out if one of the elements is not a number 3798 last; 3799 } 3800 $max = abs($mm) if abs($mm) > $max; 3801 } 3802 if (not is_a_number($max)) { 3803 $rh_ans->{score} = 0; 3804 my $error = "WeBWorK was unable evaluate your function. Please check that your 3805 expression doesn't take roots of negative numbers, or divide by zero."; 3806 $rh_ans->throw_error('EVAL',$error); 3807 } else { 3808 $rh_ans->{$options{stdout}} = ($max < $options{tolerance} ) ? 1: 0; # set 'score' to 1 if the array is close to 0; 3809 } 3810 $rh_ans; 3811 } 3812 3813 =head4 best_approx_parameters 3814 3815 best_approx_parameters($rh_ans,%options); #requires the following fields in $rh_ans 3816 {rf_student_ans} # reference to the test answer 3817 {rf_correct_ans} # reference to the comparison answer 3818 {evaluation_points}, # an array of row vectors indicating the points 3819 # to evaluate when comparing the functions 3820 3821 %options # debug => 1 gives more error answers 3822 # param_vars => [''] additional parameters used to adapt to function 3823 ) 3824 3825 3826 The parameters for the comparison function which best approximates the test_function are stored 3827 in the field {ra_parameters}. 3828 3829 3830 The last $dim_of_parms_space variables are assumed to be parameters, and it is also 3831 assumed that the function \&comparison_fun 3832 depends linearly on these variables. This function finds the values for these parameters which minimizes the 3833 Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified 3834 by the array reference \@rows_of_test_points. This is assumed to be an array of arrays, with the inner arrays 3835 determining a test point. 3836 3837 The comparison function should have $dim_of_params_space more input variables than the test function. 3838 3839 3840 3841 3842 3843 =cut 3844 3845 # Used internally: 3846 # 3847 # &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function 3848 # $ra_variables # an array of the active input variables to the functions 3849 # $dim_of_params_space # indicates the number of parameters upon which the 3850 # # the comparison function depends linearly. These are assumed to 3851 # # be the last group of inputs to the comparison function. 3852 # 3853 # %options # $options{debug} gives more error messages 3854 # 3855 # # A typical function might look like 3856 # # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter 3857 # # space of dimension 2 and a variable space of dimension 3. 3858 # ) 3859 # # returns a list of coefficients 3860 3861 sub best_approx_parameters { 3862 my $rh_ans = shift; 3863 my %options = @_; 3864 set_default_options(\%options, 3865 '_filter_name' => 'best_approx_paramters', 3866 'allow_unknown_options' => 1, 3867 ); 3868 my $errors = undef; 3869 # This subroutine for the determining the coefficents of the parameters at a given point 3870 # is pretty specialized, so it is included here as a sub-subroutine. 3871 my $determine_param_coeffs = sub { 3872 my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_; 3873 my @zero_params=(); 3874 for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); } 3875 my @vars = @$ra_variables; 3876 my @coeff = (); 3877 my @inputs = (@vars,@zero_params); 3878 my ($f0, $f1, $err); 3879 ($f0, $err) = &{$rf_fun}(@inputs); 3880 if (defined($err) ) { 3881 $errors .= "$err "; 3882 } else { 3883 for (my $i=@vars;$i<@inputs;$i++) { 3884 $inputs[$i]=1; # set one parameter to 1; 3885 my($f1,$err) = &$rf_fun(@inputs); 3886 if (defined($err) ) { 3887 $errors .= " $err "; 3888 } else { 3889 push(@coeff, $f1-$f0); 3890 } 3891 $inputs[$i]=0; # set it back 3892 } 3893 } 3894 (\@coeff, $errors); 3895 }; 3896 my $rf_fun = $rh_ans->{rf_student_ans}; 3897 my $rf_correct_fun = $rh_ans->{rf_correct_ans}; 3898 my $ra_vars_matrix = $rh_ans->{evaluation_points}; 3899 my $dim_of_param_space = @{$options{param_vars}}; 3900 # Short cut. Bail if there are no param_vars 3901 unless ($dim_of_param_space >0) { 3902 $rh_ans ->{ra_parameters} = []; 3903 return $rh_ans; 3904 } 3905 # inputs are row arrays in this case. 3906 my @zero_params=(); 3907 3908 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); } 3909 my @rows_of_vars = @$ra_vars_matrix; 3910 warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug}; 3911 my $rows = @rows_of_vars; 3912 my $matrix =new Matrix($rows,$dim_of_param_space); 3913 my $rhs_vec = new Matrix($rows, 1); 3914 my $row_num = 1; 3915 my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars); 3916 my $number_of_data_points = $dim_of_param_space +2; 3917 while (@rows_of_vars and $row_num <= $number_of_data_points) { 3918 # get one set of data points from the test function; 3919 @vars = @{ shift(@rows_of_vars) }; 3920 ($val2, $err1) = &{$rf_fun}(@vars); 3921 $errors .= " $err1 " if defined($err1); 3922 @inputs = (@vars,@zero_params); 3923 ($val1, $err2) = &{$rf_correct_fun}(@inputs); 3924 $errors .= " $err2 " if defined($err2); 3925 3926 unless (defined($err1) or defined($err2) ) { 3927 $rhs_vec->assign($row_num,1, $val2-$val1 ); 3928 3929 # warn "rhs data val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug}; 3930 # warn "vars ", join(" | ", @vars) if $options{debug}; 3931 3932 ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options); 3933 if (defined($err1) ) { 3934 $errors .= " $err1 "; 3935 } else { 3936 my @coeff = @$ra_coeff; 3937 my $col_num=1; 3938 while(@coeff) { 3939 $matrix->assign($row_num,$col_num, shift(@coeff) ); 3940 $col_num++; 3941 } 3942 } 3943 } 3944 $row_num++; 3945 last if $errors; # break if there are any errors. 3946 # This cuts down on the size of error messages. 3947 # However it impossible to check for equivalence at 95% of points 3948 # which might be useful for functions that are not defined at some points. 3949 } 3950 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug}; 3951 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug}; 3952 3953 # we have Matrix * parameter = data_vec + perpendicular vector 3954 # where the matrix has column vectors defining the span of the parameter space 3955 # multiply both sides by Matrix_transpose and solve for the parameters 3956 # This is exactly what the method proj_coeff method does. 3957 my @array; 3958 if (defined($errors) ) { 3959 @array = (); # new Matrix($dim_of_param_space,1); 3960 } else { 3961 @array = $matrix->proj_coeff($rhs_vec)->list(); 3962 } 3963 # check size (hack) 3964 my $max = 0; 3965 foreach my $val (@array ) { 3966 $max = abs($val) if $max < abs($val); 3967 if (not is_a_number($val) ) { 3968 $max = "NaN: $val"; 3969 last; 3970 } 3971 } 3972 if ($max =~/NaN/) { 3973 $errors .= "WeBWorK was unable evaluate your function. Please check that your 3974 expression doesn't take roots of negative numbers, or divide by zero."; 3975 } elsif ($max > $options{maxConstantOfIntegration} ) { 3976 $errors .= "At least one of the adapting parameters 3977 (perhaps the constant of integration) is too large: $max, 3978 ( the maximum allowed is $options{maxConstantOfIntegration} )"; 3979 } 3980 3981 $rh_ans->{ra_parameters} = \@array; 3982 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 3983 $rh_ans; 3984 } 3985 3986 =head4 calculate_difference_vector 3987 3988 calculate_difference_vector( $ans_hash, %options); 3989 3990 {rf_student_ans}, # a reference to the test function 3991 {rf_correct_ans}, # a reference to the correct answer function 3992 {evaluation_points}, # an array of row vectors indicating the points 3993 # to evaluate when comparing the functions 3994 {ra_parameters} # these are the (optional) additional inputs to 3995 # the comparison function which adapt it properly 3996 # to the problem at hand. 3997 3998 %options # mode => 'rel' specifies that each element in the 3999 # difference matrix is divided by the correct answer. 4000 # unless the correct answer is nearly 0. 4001 ) 4002 4003 =cut 4004 4005 sub calculate_difference_vector { 4006 my $rh_ans = shift; 4007 my %options = @_; 4008 assign_option_aliases( \%options, 4009 ); 4010 set_default_options( \%options, 4011 allow_unknown_options => 1, 4012 stdin1 => 'rf_student_ans', 4013 stdin2 => 'rf_correct_ans', 4014 stdout => 'ra_differences', 4015 debug => 0, 4016 tolType => 'absolute', 4017 error_msg_flag => 1, 4018 ); 4019 # initialize 4020 $rh_ans->{_filter_name} = 'calculate_difference_vector'; 4021 my $rf_fun = $rh_ans -> {$options{stdin1}}; # rf_student_ans by default 4022 my $rf_correct_fun = $rh_ans -> {$options{stdin2}}; # rf_correct_ans by default 4023 my $ra_parameters = $rh_ans -> {ra_parameters}; 4024 my @evaluation_points = @{$rh_ans->{evaluation_points} }; 4025 my @parameters = (); 4026 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY'; 4027 my $errors = undef; 4028 my @zero_params = (); 4029 for (my $i=1;$i<=@{$ra_parameters};$i++) { 4030 push(@zero_params,0); 4031 } 4032 my @differences = (); 4033 my @student_values; 4034 my @adjusted_student_values; 4035 my @instructorVals; 4036 my ($diff,$instructorVal); 4037 # calculate the vector of differences between the test function and the comparison function. 4038 while (@evaluation_points) { 4039 my ($err1, $err2,$err3); 4040 my @vars = @{ shift(@evaluation_points) }; 4041 my @inputs = (@vars, @parameters); 4042 my ($inVal, $correctVal); 4043 ($inVal, $err1) = &{$rf_fun}(@vars); 4044 $errors .= " $err1 " if defined($err1); 4045 $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if defined($options{debug}) and $options{debug}==1 and defined($err1); 4046 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs); 4047 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2); 4048 $errors .= " Error detected evaluating correct adapted answer at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2); 4049 ($instructorVal,$err3)= &$rf_correct_fun(@vars, @zero_params); 4050 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3); 4051 $errors .= " Error detected evaluating instructor answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3); 4052 unless (defined($err1) or defined($err2) or defined($err3) ) { 4053 $diff = ( $inVal - ($correctVal -$instructorVal ) ) - $instructorVal; #prevents entering too high a number? 4054 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 4055 if ( $options{tolType} eq 'relative' ) { #relative tolerance 4056 #warn "diff = $diff"; 4057 #$diff = ( $inVal - ($correctVal-$instructorVal ) )/abs($instructorVal) -1 if abs($instructorVal) > $options{zeroLevel}; 4058 $diff = ( $inVal - ($correctVal-$instructorVal ) )/$instructorVal -1 if abs($instructorVal) > $options{zeroLevel}; 4059 # DPVC -- adjust so that a check for tolerance will 4060 # do a zeroLevelTol check 4061 ## $diff *= $options{tolerance}/$options{zeroLevelTol} unless abs($instructorVal) > $options{zeroLevel}; 4062 # /DPVC 4063 #$diff = ( $inVal - ($correctVal-$instructorVal- $instructorVal ) )/abs($instructorVal) if abs($instructorVal) > $options{zeroLevel}; 4064 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal"; 4065 } 4066 } 4067 last if $errors; # break if there are any errors. 4068 # This cuts down on the size of error messages. 4069 # However it impossible to check for equivalence at 95% of points 4070 # which might be useful for functions that are not defined at some points. 4071 push(@student_values,$inVal); 4072 push(@adjusted_student_values,( $inVal - ($correctVal -$instructorVal) ) ); 4073 push(@differences, $diff); 4074 push(@instructorVals,$instructorVal); 4075 } 4076 if (( not defined($errors) ) or $errors eq '' or $options{error_msg_flag} ) { 4077 $rh_ans ->{$options{stdout}} = \@differences; 4078 $rh_ans ->{ra_student_values} = \@student_values; 4079 $rh_ans ->{ra_adjusted_student_values} = \@adjusted_student_values; 4080 $rh_ans->{ra_instructor_values}=\@instructorVals; 4081 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 4082 } else { 4083 4084 } # no output if error_msg_flag is set to 0. 4085 4086 $rh_ans; 4087 } 4088 4089 =head4 fix_answer_for_display 4090 4091 =cut 4092 4093 sub fix_answers_for_display { 4094 my ($rh_ans, %options) = @_; 4095 if ( $rh_ans->{answerIsString} ==1) { 4096 $rh_ans = evaluatesToNumber ($rh_ans, %options); 4097 } 4098 if (defined ($rh_ans->{student_units})) { 4099 $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units}; 4100 4101 } 4102 if ( $rh_ans->catch_error('UNITS') ) { # create preview latex string for expressions even if the units are incorrect 4103 my $rh_temp = new AnswerHash; 4104 $rh_temp->{student_ans} = $rh_ans->{student_ans}; 4105 $rh_temp = check_syntax($rh_temp); 4106 $rh_ans->{preview_latex_string} = $rh_temp->{preview_latex_string}; 4107 } 4108 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans}; 4109 4110 $rh_ans; 4111 } 4112 4113 =head4 evaluatesToNumber 4114 4115 =cut 4116 4117 sub evaluatesToNumber { 4118 my ($rh_ans, %options) = @_; 4119 if (is_a_numeric_expression($rh_ans->{student_ans})) { 4120 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans}); 4121 if ($PG_eval_errors) { # this if statement should never be run 4122 # change nothing 4123 } else { 4124 # change this 4125 $rh_ans->{student_ans} = prfmt($inVal,$options{format}); 4126 } 4127 } 4128 $rh_ans; 4129 } 4130 4131 =head4 is_numeric_expression 4132 4133 =cut 4134 4135 sub is_a_numeric_expression { 4136 my $testString = shift; 4137 my $is_a_numeric_expression = 0; 4138 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString); 4139 if ($PG_eval_errors) { 4140 $is_a_numeric_expression = 0; 4141 } else { 4142 $is_a_numeric_expression = 1; 4143 } 4144 $is_a_numeric_expression; 4145 } 4146 4147 =head4 is_a_number 4148 4149 =cut 4150 4151 sub is_a_number { 4152 my ($num,%options) = @_; 4153 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 4154 my ($rh_ans); 4155 if ($process_ans_hash) { 4156 $rh_ans = $num; 4157 $num = $rh_ans->{student_ans}; 4158 } 4159 4160 my $is_a_number = 0; 4161 return $is_a_number unless defined($num); 4162 $num =~ s/^\s*//; ## remove initial spaces 4163 $num =~ s/\s*$//; ## remove trailing spaces 4164 4165 ## the following is copied from the online perl manual 4166 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ 4167 $is_a_number = 1; 4168 } 4169 4170 if ($process_ans_hash) { 4171 if ($is_a_number == 1 ) { 4172 $rh_ans->{student_ans}=$num; 4173 return $rh_ans; 4174 } else { 4175 $rh_ans->{student_ans} = "Incorrect number format: You must enter a number, e.g. -6, 5.3, or 6.12E-3"; 4176 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3'); 4177 return $rh_ans; 4178 } 4179 } else { 4180 return $is_a_number; 4181 } 4182 } 4183 4184 =head4 is_a_fraction 4185 4186 =cut 4187 4188 sub is_a_fraction { 4189 my ($num,%options) = @_; 4190 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 4191 my ($rh_ans); 4192 if ($process_ans_hash) { 4193 $rh_ans = $num; 4194 $num = $rh_ans->{student_ans}; 4195 } 4196 4197 my $is_a_fraction = 0; 4198 return $is_a_fraction unless defined($num); 4199 $num =~ s/^\s*//; ## remove initial spaces 4200 $num =~ s/\s*$//; ## remove trailing spaces 4201 4202 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) { 4203 $is_a_fraction = 1; 4204 } 4205 4206 if ($process_ans_hash) { 4207 if ($is_a_fraction == 1 ) { 4208 $rh_ans->{student_ans}=$num; 4209 return $rh_ans; 4210 } else { 4211 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13"; 4212 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3'); 4213 return $rh_ans; 4214 } 4215 4216 } else { 4217 return $is_a_fraction; 4218 } 4219 } 4220 4221 =head4 phase_pi 4222 I often discovered that the answers I was getting, when using the arctan function would be off by phases of 4223 pi, which for the tangent function, were equivalent values. This method allows for this. 4224 =cut 4225 4226 sub phase_pi { 4227 my ($num,%options) = @_; 4228 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 4229 my ($rh_ans); 4230 if ($process_ans_hash) { 4231 $rh_ans = $num; 4232 $num = $rh_ans->{correct_ans}; 4233 } 4234 while( ($rh_ans->{correct_ans}) > 3.14159265358979/2 ){ 4235 $rh_ans->{correct_ans} -= 3.14159265358979; 4236 } 4237 while( ($rh_ans->{correct_ans}) <= -3.14159265358979/2 ){ 4238 $rh_ans->{correct_ans} += 3.14159265358979; 4239 } 4240 $rh_ans; 4241 } 4242 4243 =head4 is_an_arithemetic_expression 4244 4245 =cut 4246 4247 sub is_an_arithmetic_expression { 4248 my ($num,%options) = @_; 4249 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 4250 my ($rh_ans); 4251 if ($process_ans_hash) { 4252 $rh_ans = $num; 4253 $num = $rh_ans->{student_ans}; 4254 } 4255 4256 my $is_an_arithmetic_expression = 0; 4257 return $is_an_arithmetic_expression unless defined($num); 4258 $num =~ s/^\s*//; ## remove initial spaces 4259 $num =~ s/\s*$//; ## remove trailing spaces 4260 4261 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) { 4262 $is_an_arithmetic_expression = 1; 4263 } 4264 4265 if ($process_ans_hash) { 4266 if ($is_an_arithmetic_expression == 1 ) { 4267 $rh_ans->{student_ans}=$num; 4268 return $rh_ans; 4269 } else { 4270 4271 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2"; 4272 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2'); 4273 return $rh_ans; 4274 } 4275 4276 } else { 4277 return $is_an_arithmetic_expression; 4278 } 4279 } 4280 4281 # 4282 4283 =head4 math_constants 4284 4285 replaces pi, e, and ^ with their Perl equivalents 4286 if useBaseTenLog is non-zero, convert log to logten 4287 4288 =cut 4289 4290 sub math_constants { 4291 my($in,%options) = @_; 4292 my $rh_ans; 4293 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ; 4294 if ($process_ans_hash) { 4295 $rh_ans = $in; 4296 $in = $rh_ans->{student_ans}; 4297 } 4298 # The code fragment above allows this filter to be used when the input is simply a string 4299 # as well as when the input is an AnswerHash, and options. 4300 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 4301 $in =~s/\be\b/(exp(1))/ge; 4302 $in =~s/\^/**/g; 4303 if($useBaseTenLog) { 4304 $in =~ s/\blog\b/logten/g; 4305 } 4306 4307 if ($process_ans_hash) { 4308 $rh_ans->{student_ans}=$in; 4309 return $rh_ans; 4310 } else { 4311 return $in; 4312 } 4313 } 4314 4315 4316 4317 =head4 is_array 4318 4319 is_array($rh_ans) 4320 returns: $rh_ans. Throws error "NOTARRAY" if this is not an array 4321 4322 =cut 4323 4324 sub is_array { 4325 my $rh_ans = shift; 4326 # return if the result is an array 4327 return($rh_ans) if ref($rh_ans->{student_ans}) eq 'ARRAY' ; 4328 $rh_ans->throw_error("NOTARRAY","The answer is not an array"); 4329 $rh_ans; 4330 } 4331 4332 =head4 check_syntax 4333 4334 check_syntax( $rh_ans, %options) 4335 returns an answer hash. 4336 4337 latex2html preview code are installed in the answer hash. 4338 The input has been transformed, changing 7pi to 7*pi or 7x to 7*x. 4339 Syntax error messages may be generated and stored in student_ans 4340 Additional syntax error messages are stored in {ans_message} and duplicated in {error_message} 4341 4342 4343 =cut 4344 4345 sub check_syntax { 4346 my $rh_ans = shift; 4347 my %options = @_; 4348 assign_option_aliases(\%options, 4349 ); 4350 set_default_options( \%options, 4351 'stdin' => 'student_ans', 4352 'stdout' => 'student_ans', 4353 'ra_vars' => [qw( x y )], 4354 'debug' => 0, 4355 '_filter_name' => 'check_syntax', 4356 error_msg_flag => 1, 4357 ); 4358 #initialize 4359 $rh_ans->{_filter_name} = $options{_filter_name}; 4360 unless ( defined( $rh_ans->{$options{stdin}} ) ) { 4361 warn "Check_syntax requires an equation in the field '$options{stdin}' or input"; 4362 $rh_ans->throw_error("1","'$options{stdin}' field not defined"); 4363 return $rh_ans; 4364 } 4365 my $in = $rh_ans->{$options{stdin}}; 4366 my $parser = new AlgParserWithImplicitExpand; 4367 my $ret = $parser -> parse($in); #for use with loops 4368 4369 if ( ref($ret) ) { ## parsed successfully 4370 # $parser -> tostring(); # FIXME? was this needed for some reason????? 4371 $parser -> normalize(); 4372 $rh_ans -> {$options{stdout}} = $parser -> tostring(); 4373 $rh_ans -> {preview_text_string} = $in; 4374 $rh_ans -> {preview_latex_string} = $parser -> tolatex(); 4375 4376 } elsif ($options{error_msg_flag} ) { ## error in parsing 4377 4378 $rh_ans->{$options{stdout}} = 'syntax error:'. $parser->{htmlerror}, 4379 $rh_ans->{'ans_message'} = $parser -> {error_msg}, 4380 $rh_ans->{'preview_text_string'} = '', 4381 $rh_ans->{'preview_latex_string'} = '', 4382 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg}); 4383 } # no output is produced if there is an error and the error_msg_flag is set to zero 4384 $rh_ans; 4385 4386 } 4387 4388 =head4 check_strings 4389 4390 check_strings ($rh_ans, %options) 4391 returns $rh_ans 4392 4393 =cut 4394 4395 sub check_strings { 4396 my ($rh_ans, %options) = @_; 4397 4398 # if the student's answer is a number, simply return the answer hash (unchanged). 4399 4400 # we allow constructions like -INF to be treated as a string. Thus we ignore an initial 4401 # - in deciding whether the student's answer is a number or string 4402 4403 my $temp_ans = $rh_ans->{student_ans}; 4404 $temp_ans =~ s/^\s*\-//; # remove an initial - 4405 4406 if ( $temp_ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) { 4407 # if ( $rh_ans->{answerIsString} == 1) { 4408 # #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number 4409 # } 4410 return $rh_ans; 4411 } 4412 # the student's answer is recognized as a string 4413 my $ans = $rh_ans->{student_ans}; 4414 4415 # OVERVIEW of reminder of function: 4416 # if answer is correct, return correct. (adjust score to 1) 4417 # if answer is incorect: 4418 # 1) determine if the answer is sensible. if it is, return incorrect. 4419 # 2) if the answer is not sensible (and incorrect), then return an error message indicating so. 4420 # no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators) 4421 # last: 'STRING' post_filter will clear the error (avoiding pink screen.) 4422 4423 my $sensibleAnswer = 0; 4424 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces. 4425 my ($ans_eval) = str_cmp($rh_ans->{correct_ans}); 4426 my $temp_ans_hash = $ans_eval->evaluate($ans); 4427 $rh_ans->{test} = $temp_ans_hash; 4428 4429 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer. 4430 $rh_ans->{score} = 1; 4431 $sensibleAnswer = 1; 4432 } else { # students answer does not match the correct answer. 4433 my $legalString = ''; # find out if string makes sense 4434 my @legalStrings = @{$options{strings}}; 4435 foreach $legalString (@legalStrings) { 4436 if ( uc($ans) eq uc($legalString) ) { 4437 $sensibleAnswer = 1; 4438 last; 4439 } 4440 } 4441 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 4442 $rh_ans->throw_error('EVAL', "Your answer is not a recognized answer") unless ($sensibleAnswer); 4443 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer); 4444 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) ); 4445 } 4446 4447 $rh_ans->{student_ans} = $ans; 4448 4449 if ($sensibleAnswer) { 4450 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string."); 4451 } 4452 4453 $rh_ans->{'preview_text_string'} = $ans, 4454 $rh_ans->{'preview_latex_string'} = $ans, 4455 4456 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}"); 4457 $rh_ans; 4458 } 4459 4460 =head4 check_units 4461 4462 check_strings ($rh_ans, %options) 4463 returns $rh_ans 4464 4465 4466 =cut 4467 4468 sub check_units { 4469 my ($rh_ans, %options) = @_; 4470 my %correct_units = %{$rh_ans-> {rh_correct_units}}; 4471 my $ans = $rh_ans->{student_ans}; 4472 # $ans = '' unless defined ($ans); 4473 $ans = str_filters ($ans, 'trim_whitespace'); 4474 my $original_student_ans = $ans; 4475 $rh_ans->{original_student_ans} = $original_student_ans; 4476 4477 # it surprises me that the match below works since the first .* is greedy. 4478 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/; 4479 4480 unless ( defined($num_answer) && $units ) { 4481 # there is an error reading the input 4482 if ( $ans =~ /\S/ ) { # the answer is not blank 4483 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " . 4484 "as a number or an arithmetic expression followed by a unit specification. " . 4485 "Your answer must contain units." ); 4486 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " . 4487 "as a number or an arithmetic expression followed by a unit specification. " . 4488 "Your answer must contain units." ); 4489 } 4490 return $rh_ans; 4491 } 4492 4493 # we have been able to parse the answer into a numerical part and a unit part 4494 4495 # $num_answer = $1; #$1 and $2 from the regular expression above 4496 # $units = $2; 4497 4498 my %units = Units::evaluate_units($units); 4499 if ( defined( $units{'ERROR'} ) ) { 4500 # handle error condition 4501 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'}); 4502 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" ); 4503 $rh_ans -> throw_error('UNITS', "$units{'ERROR'}"); 4504 return $rh_ans; 4505 } 4506 4507 my $units_match = 1; 4508 my $fund_unit; 4509 foreach $fund_unit (keys %correct_units) { 4510 next if $fund_unit eq 'factor'; 4511 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit}; 4512 } 4513 4514 if ( $units_match ) { 4515 # units are ok. Evaluate the numerical part of the answer 4516 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if 4517 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor. 4518 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'}); 4519 $rh_ans->{student_units} = $units; 4520 $rh_ans->{student_ans} = $num_answer; 4521 4522 } else { 4523 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' ); 4524 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' ); 4525 } 4526 4527 return $rh_ans; 4528 } 4529 4530 4531 4532 =head2 Filter utilities 4533 4534 These two subroutines can be used in filters to set default options. They 4535 help make filters perform in uniform, predictable ways, and also make it 4536 easy to recognize from the code which options a given filter expects. 4537 4538 4539 =head4 assign_option_aliases 4540 4541 Use this to assign aliases for the standard options. It must come before set_default_options 4542 within the subroutine. 4543 4544 assign_option_aliases(\%options, 4545 'alias1' => 'option5' 4546 'alias2' => 'option7' 4547 ); 4548 4549 4550 If the subroutine is called with an option " alias1 => 23 " it will behave as if it had been 4551 called with the option " option5 => 23 " 4552 4553 =cut 4554 4555 4556 4557 sub assign_option_aliases { 4558 my $rh_options = shift; 4559 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 4560 my @option_aliases = @_; 4561 while (@option_aliases) { 4562 my $alias = shift @option_aliases; 4563 my $option_key = shift @option_aliases; 4564 4565 if (defined($rh_options->{$alias} )) { # if the alias appears in the option list 4566 if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined, 4567 $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value 4568 # the FIRST alias for a given option takes precedence 4569 # (after the option itself) 4570 } else { 4571 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n", 4572 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias}, 4573 " was ignored."; 4574 } 4575 } 4576 delete($rh_options->{$alias}); # remove the alias from the initial list 4577 } 4578 4579 } 4580 4581 =head4 set_default_options 4582 4583 set_default_options(\%options, 4584 '_filter_name' => 'filter', 4585 'option5' => .0001, 4586 'option7' => 'ascii', 4587 'allow_unknown_options => 0, 4588 } 4589 4590 Note that the first entry is a reference to the options with which the filter was called. 4591 4592 The option5 is set to .0001 unless the option is explicitly set when the subroutine is called. 4593 4594 The B<'_filter_name'> option should always be set, although there is no error if it is missing. 4595 It is used mainly for debugging answer evaluators and allows 4596 you to keep track of which filter is currently processing the answer. 4597 4598 If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the 4599 set_default_options list an error will be signaled and a warning message will be printed out. This provides 4600 error checking against misspelling an option and is generally what is desired for most filters. 4601 4602 Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance, 4603 but only uses a subset of the options 4604 provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled. 4605 4606 =cut 4607 4608 sub set_default_options { 4609 my $rh_options = shift; 4610 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 4611 my %default_options = @_; 4612 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) { 4613 foreach my $key1 (keys %$rh_options) { 4614 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1}); 4615 } 4616 } 4617 foreach my $key (keys %default_options) { 4618 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) { 4619 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define 4620 # this key unless tol is explicitly defined. 4621 } 4622 } 4623 } 4624 4625 =head2 Problem Grader Subroutines 4626 4627 =cut 4628 4629 ## Problem Grader Subroutines 4630 4631 ##################################### 4632 # This is a model for plug-in problem graders 4633 ##################################### 4634 sub install_problem_grader { 4635 my $rf_problem_grader = shift; 4636 my $rh_flags = PG_restricted_eval(q!\\%main::PG_FLAGS!); 4637 $rh_flags->{PROBLEM_GRADER_TO_USE} = $rf_problem_grader; 4638 } 4639 4640 =head4 std_problem_grader 4641 4642 This is an all-or-nothing grader. A student must get all parts of the problem write 4643 before receiving credit. You should make sure to use this grader on multiple choice 4644 and true-false questions, otherwise students will be able to deduce how many 4645 answers are correct by the grade reported by webwork. 4646 4647 4648 install_problem_grader(~~&std_problem_grader); 4649 4650 =cut 4651 4652 sub std_problem_grader { 4653 my $rh_evaluated_answers = shift; 4654 my $rh_problem_state = shift; 4655 my %form_options = @_; 4656 my %evaluated_answers = %{$rh_evaluated_answers}; 4657 # The hash $rh_evaluated_answers typically contains: 4658 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 4659 4660 # By default the old problem state is simply passed back out again. 4661 my %problem_state = %$rh_problem_state; 4662 4663 # %form_options might include 4664 # The user login name 4665 # The permission level of the user 4666 # The studentLogin name for this psvn. 4667 # Whether the form is asking for a refresh or is submitting a new answer. 4668 4669 # initial setup of the answer 4670 my %problem_result = ( score => 0, 4671 errors => '', 4672 type => 'std_problem_grader', 4673 msg => '', 4674 ); 4675 # Checks 4676 4677 my $ansCount = keys %evaluated_answers; # get the number of answers 4678 4679 unless ($ansCount > 0 ) { 4680 4681 $problem_result{msg} = "This problem did not ask any questions."; 4682 return(\%problem_result,\%problem_state); 4683 } 4684 4685 if ($ansCount > 1 ) { 4686 $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ; 4687 } 4688 4689 unless ($form_options{answers_submitted} == 1) { 4690 return(\%problem_result,\%problem_state); 4691 } 4692 4693 my $allAnswersCorrectQ=1; 4694 foreach my $ans_name (keys %evaluated_answers) { 4695 # I'm not sure if this check is really useful. 4696 if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) { 4697 $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} ); 4698 } 4699 else { 4700 die "Error at file ",__FILE__,"line ", __LINE__,": Answer |$ans_name| is not a hash reference\n". 4701 $evaluated_answers{$ans_name} . 4702 "This probably means that the answer evaluator for this answer\n" . 4703 "is not working correctly."; 4704 $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}"; 4705 } 4706 } 4707 # report the results 4708 $problem_result{score} = $allAnswersCorrectQ; 4709 4710 # I don't like to put in this bit of code. 4711 # It makes it hard to construct error free problem graders 4712 # I would prefer to know that the problem score was numeric. 4713 unless (defined($problem_state{recorded_score}) and $problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 4714 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 4715 } 4716 # 4717 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 4718 $problem_state{recorded_score} = 1; 4719 } 4720 else { 4721 $problem_state{recorded_score} = 0; 4722 } 4723 4724 $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1; 4725 $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0; 4726 4727 $problem_state{state_summary_msg} = ''; # an HTML formatted message printed at the bottom of the problem page 4728 4729 (\%problem_result, \%problem_state); 4730 } 4731 4732 =head4 std_problem_grader2 4733 4734 This is an all-or-nothing grader. A student must get all parts of the problem write 4735 before receiving credit. You should make sure to use this grader on multiple choice 4736 and true-false questions, otherwise students will be able to deduce how many 4737 answers are correct by the grade reported by webwork. 4738 4739 4740 install_problem_grader(~~&std_problem_grader2); 4741 4742 The only difference between the two versions 4743 is at the end of the subroutine, where std_problem_grader2 4744 records the attempt only if there have been no syntax errors, 4745 whereas std_problem_grader records it regardless. 4746 4747 =cut 4748 4749 4750 4751 sub std_problem_grader2 { 4752 my $rh_evaluated_answers = shift; 4753 my $rh_problem_state = shift; 4754 my %form_options = @_; 4755 my %evaluated_answers = %{$rh_evaluated_answers}; 4756 # The hash $rh_evaluated_answers typically contains: 4757 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 4758 4759 # By default the old problem state is simply passed back out again. 4760 my %problem_state = %$rh_problem_state; 4761 4762 # %form_options might include 4763 # The user login name 4764 # The permission level of the user 4765 # The studentLogin name for this psvn. 4766 # Whether the form is asking for a refresh or is submitting a new answer. 4767 4768 # initial setup of the answer 4769 my %problem_result = ( score => 0, 4770 errors => '', 4771 type => 'std_problem_grader', 4772 msg => '', 4773 ); 4774 4775 # syntax errors are not counted. 4776 my $record_problem_attempt = 1; 4777 # Checks 4778 4779 my $ansCount = keys %evaluated_answers; # get the number of answers 4780 unless ($ansCount > 0 ) { 4781 $problem_result{msg} = "This problem did not ask any questions."; 4782 return(\%problem_result,\%problem_state); 4783 } 4784 4785 if ($ansCount > 1 ) { 4786 $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ; 4787 } 4788 4789 unless ($form_options{answers_submitted} == 1) { 4790 return(\%problem_result,\%problem_state); 4791 } 4792 4793 my $allAnswersCorrectQ=1; 4794 foreach my $ans_name (keys %evaluated_answers) { 4795 # I'm not sure if this check is really useful. 4796 if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) { 4797 $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} ); 4798 } 4799 else { 4800 die "Error at file ",__FILE__,"line ", __LINE__,": Answer |$ans_name| is not a hash reference\n". 4801 $evaluated_answers{$ans_name} . 4802 "This probably means that the answer evaluator for this answer\n" . 4803 "is not working correctly."; 4804 $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}"; 4805 } 4806 } 4807 # report the results 4808 $problem_result{score} = $allAnswersCorrectQ; 4809 4810 # I don't like to put in this bit of code. 4811 # It makes it hard to construct error free problem graders 4812 # I would prefer to know that the problem score was numeric. 4813 unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 4814 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 4815 } 4816 # 4817 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 4818 $problem_state{recorded_score} = 1; 4819 } 4820 else { 4821 $problem_state{recorded_score} = 0; 4822 } 4823 # record attempt only if there have been no syntax errors. 4824 4825 if ($record_problem_attempt == 1) { 4826 $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1; 4827 $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0; 4828 $problem_state{state_summary_msg} = ''; # an HTML formatted message printed at the bottom of the problem page 4829 4830 } 4831 else { 4832 $problem_result{show_partial_correct_answers} = 0 ; # prevent partial correct answers from being shown for syntax errors. 4833 } 4834 (\%problem_result, \%problem_state); 4835 } 4836 4837 =head4 avg_problem_grader 4838 4839 This grader gives a grade depending on how many questions from the problem are correct. (The highest 4840 grade is the one that is kept. One can never lower the recorded grade on a problem by repeating it.) 4841 Many professors (and almost all students :-) ) prefer this grader. 4842 4843 4844 install_problem_grader(~~&avg_problem_grader); 4845 4846 =cut 4847 4848 4849 sub avg_problem_grader { 4850 my $rh_evaluated_answers = shift; 4851 my $rh_problem_state = shift; 4852 my %form_options = @_; 4853 my %evaluated_answers = %{$rh_evaluated_answers}; 4854 # The hash $rh_evaluated_answers typically contains: 4855 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 4856 4857 # By default the old problem state is simply passed back out again. 4858 my %problem_state = %$rh_problem_state; 4859 4860 4861 # %form_options might include 4862 # The user login name 4863 # The permission level of the user 4864 # The studentLogin name for this psvn. 4865 # Whether the form is asking for a refresh or is submitting a new answer. 4866 4867 # initial setup of the answer 4868 my $total=0; 4869 my %problem_result = ( score => 0, 4870 errors => '', 4871 type => 'avg_problem_grader', 4872 msg => '', 4873 ); 4874 my $count = keys %evaluated_answers; 4875 $problem_result{msg} = 'You can earn partial credit on this problem.' if $count >1; 4876 # Return unless answers have been submitted 4877 unless ($form_options{answers_submitted} == 1) { 4878 return(\%problem_result,\%problem_state); 4879 } 4880 4881 # Answers have been submitted -- process them. 4882 foreach my $ans_name (keys %evaluated_answers) { 4883 # I'm not sure if this check is really useful. 4884 if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) { 4885 $total += $evaluated_answers{$ans_name}->{score}; 4886 } 4887 else { 4888 die "Error: Answer |$ans_name| is not a hash reference\n". 4889 $evaluated_answers{$ans_name} . 4890 "This probably means that the answer evaluator for this answer\n" . 4891 "is not working correctly."; 4892 $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}"; 4893 } 4894 } 4895 # Calculate score rounded to three places to avoid roundoff problems 4896 $problem_result{score} = $total/$count if $count; 4897 # increase recorded score if the current score is greater. 4898 $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score}; 4899 4900 4901 $problem_state{num_of_correct_ans}++ if $total == $count; 4902 $problem_state{num_of_incorrect_ans}++ if $total < $count ; 4903 4904 $problem_state{state_summary_msg} = ''; # an HTML formatted message printed at the bottom of the problem page 4905 4906 warn "Error in grading this problem the total $total is larger than $count" if $total > $count; 4907 (\%problem_result, \%problem_state); 4908 } 4909 4910 =head2 Utility subroutines 4911 4912 =head4 pretty_print 4913 4914 Usage: warn pretty_print( $rh_hash_input) 4915 TEXT(pretty_print($ans_hash)); 4916 TEXT(~~%envir); 4917 4918 This can be very useful for printing out messages about objects while debugging 4919 4920 =cut 4921 4922 sub pretty_print { 4923 my $r_input = shift; 4924 my $out = ''; 4925 if ( not ref($r_input) ) { 4926 $out = $r_input; # not a reference 4927 $out =~ s/</</g; # protect for HTML output 4928 } elsif ("$r_input" =~/hash/i) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput). 4929 local($^W) = 0; 4930 $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; 4931 foreach my $key (lex_sort( keys %$r_input )) { 4932 $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}) . "</td></tr>"; 4933 } 4934 $out .="</table>"; 4935 } elsif (ref($r_input) eq 'ARRAY' ) { 4936 my @array = @$r_input; 4937 $out .= "( " ; 4938 while (@array) { 4939 $out .= pretty_print(shift @array) . " , "; 4940 } 4941 $out .= " )"; 4942 } elsif (ref($r_input) eq 'CODE') { 4943 $out = "$r_input"; 4944 } else { 4945 $out = $r_input; 4946 $out =~ s/</</g; # protect for HTML output 4947 } 4948 $out; 4949 } 4950 4951 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |