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