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