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