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