[system] / trunk / pg / macros / PGanswermacros.pl Repository:
ViewVC logotype

Diff of /trunk/pg/macros/PGanswermacros.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1071 Revision 1080
1#!/usr/local/bin/webwork-perl 1
2 2
3# This file is PGanswermacros.pl 3# This file is PGanswermacros.pl
4# This includes the subroutines for the ANS macros, that 4# This includes the subroutines for the ANS macros, that
5# is, macros allowing a more flexible answer checking 5# is, macros allowing a more flexible answer checking
6#################################################################### 6####################################################################
15 15
16=head1 SYNPOSIS 16=head1 SYNPOSIS
17 17
18 Number Answer Evaluators: 18 Number Answer Evaluators:
19 num_cmp() -- uses an input hash to determine parameters 19 num_cmp() -- uses an input hash to determine parameters
20 20
21 std_num_cmp(), std_num_cmp_list(), std_num_cmp_abs, std_num_cmp_abs_list() 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() 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() 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() 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 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 26 std_num_str_cmp() -- also accepts a set of strings as possible answers
27 27
28 Function Answer Evaluators: 28 Function Answer Evaluators:
29 fun_cmp() -- uses an input hash to determine parameters 29 fun_cmp() -- uses an input hash to determine parameters
30 30
31 function_cmp(), function_cmp_abs() 31 function_cmp(), function_cmp_abs()
32 function_cmp_up_to_constant(), function_cmp_up_to_constant_abs() 32 function_cmp_up_to_constant(), function_cmp_up_to_constant_abs()
33 multivar_function_cmp() 33 multivar_function_cmp()
34 34
35 String Answer Evaluators: 35 String Answer Evaluators:
36 str_cmp() -- uses an input hash to determine parameters 36 str_cmp() -- uses an input hash to determine parameters
37 37
38 std_str_cmp(), std_str_cmp_list(), std_cs_str_cmp(), std_cs_str_cmp_list() 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() 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() 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() 41 unordered_str_cmp(), unordered_str_cmp_list(), unordered_cs_str_cmp(), unordered_cs_str_cmp_list()
42 42
113 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. 113 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
114} 114}
115 115
116 116
117my ($BR , # convenient localizations. 117my ($BR , # convenient localizations.
118 $PAR , 118 $PAR ,
119 $numRelPercentTolDefault , 119 $numRelPercentTolDefault ,
120 $numZeroLevelDefault , 120 $numZeroLevelDefault ,
121 $numZeroLevelTolDefault , 121 $numZeroLevelTolDefault ,
122 $numAbsTolDefault , 122 $numAbsTolDefault ,
123 $numFormatDefault , 123 $numFormatDefault ,
124 $functRelPercentTolDefault , 124 $functRelPercentTolDefault ,
125 $functZeroLevelDefault , 125 $functZeroLevelDefault ,
126 $functZeroLevelTolDefault , 126 $functZeroLevelTolDefault ,
127 $functAbsTolDefault , 127 $functAbsTolDefault ,
128 $functNumOfPoints , 128 $functNumOfPoints ,
129 $functVarDefault , 129 $functVarDefault ,
130 $functLLimitDefault , 130 $functLLimitDefault ,
131 $functULimitDefault , 131 $functULimitDefault ,
132 $functMaxConstantOfIntegration , 132 $functMaxConstantOfIntegration ,
133 $CA 133 $CA
134); 134);
135 135
136 136
137 137
138 138
139sub _PGanswermacros_init { 139sub _PGanswermacros_init {
140 140
141 $BR = $main::BR; # convenient localizations. 141 $BR = $main::BR; # convenient localizations.
142 $PAR = $main::PAR; 142 $PAR = $main::PAR;
143 143
144 # import defaults 144 # import defaults
145 # these are now imported from the %envir variable 145 # these are now imported from the %envir variable
146 $numRelPercentTolDefault = $main::numRelPercentTolDefault; 146 $numRelPercentTolDefault = $main::numRelPercentTolDefault;
147 $numZeroLevelDefault = $main::numZeroLevelDefault; 147 $numZeroLevelDefault = $main::numZeroLevelDefault;
148 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault; 148 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault;
155 $functNumOfPoints = $main::functNumOfPoints; 155 $functNumOfPoints = $main::functNumOfPoints;
156 $functVarDefault = $main::functVarDefault; 156 $functVarDefault = $main::functVarDefault;
157 $functLLimitDefault = $main::functLLimitDefault; 157 $functLLimitDefault = $main::functLLimitDefault;
158 $functULimitDefault = $main::functULimitDefault; 158 $functULimitDefault = $main::functULimitDefault;
159 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration; 159 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration;
160 160
161 161
162 162
163} 163}
164 164
165########################################################################## 165##########################################################################
166########################################################################## 166##########################################################################
167## Number answer evaluators 167## Number answer evaluators
291 291
292ANS( num_cmp( answer or answer_array_ref, options_hash ) ); 292ANS( num_cmp( answer or answer_array_ref, options_hash ) );
293 293
294 1. the correct answer, or a reference to an array of correct answers 294 1. the correct answer, or a reference to an array of correct answers
295 2. a hash with the following keys (all optional): 295 2. a hash with the following keys (all optional):
296 mode -- 'std' (default) (allows any expression evaluating to 296 mode -- 'std' (default) (allows any expression evaluating to
297 a number) 297 a number)
298 'strict' (only numbers are allowed) 298 'strict' (only numbers are allowed)
299 'frac' (fractions are allowed) 299 'frac' (fractions are allowed)
300 'arith' (arithmetic expressions allowed) 300 'arith' (arithmetic expressions allowed)
301 format -- '%0.5f#' (default); defines formatting for the 301 format -- '%0.5f#' (default); defines formatting for the
302 correct answer 302 correct answer
303 tol -- an absolute tolerance, or 303 tol -- an absolute tolerance, or
304 relTol -- a relative tolerance 304 relTol -- a relative tolerance
305 units -- the units to use for the answer(s) 305 units -- the units to use for the answer(s)
306 strings -- a reference to an array of strings which are valid 306 strings -- a reference to an array of strings which are valid
307 answers (works like std_num_str_cmp() ) 307 answers (works like std_num_str_cmp() )
308 zeroLevel -- if the correct answer is this close to zero, 308 zeroLevel -- if the correct answer is this close to zero,
309 then zeroLevelTol applies 309 then zeroLevelTol applies
310 zeroLevelTol -- absolute tolerance to allow when answer is close 310 zeroLevelTol -- absolute tolerance to allow when answer is close
311 to zero 311 to zero
312 312
313 debug -- if set to 1, provides verbose listing of 313 debug -- if set to 1, provides verbose listing of
314 hash entries throughout fliters. 314 hash entries throughout fliters.
315 315
316 Returns an answer evaluator, or (if given a reference to an array of 316 Returns an answer evaluator, or (if given a reference to an array of
317 answers), a list of answer evaluators. Note that a reference to an array of 317 answers), a list of answer evaluators. Note that a reference to an array of
320 320
321EXAMPLES: 321EXAMPLES:
322 322
323 num_cmp( 5 ) -- correct answer is 5, using defaults 323 num_cmp( 5 ) -- correct answer is 5, using defaults
324 for all options 324 for all options
325 num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7, 325 num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7,
326 using defaults for all options 326 using defaults for all options
327 num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict 327 num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict
328 num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6, 328 num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6,
329 both with 5% relative tolerance 329 both with 5% relative tolerance
330 num_cmp( 6, strings => ["Inf", "Minf", "NaN"] ) 330 num_cmp( 6, strings => ["Inf", "Minf", "NaN"] )
331 -- correct answer is 6, "Inf", "Minf", 331 -- correct answer is 6, "Inf", "Minf",
332 and "NaN" recognized as valid, but 332 and "NaN" recognized as valid, but
333 incorrect answers. 333 incorrect answers.
334 num_cmp( "-INF", strings => ["INF", "-INF"] ) 334 num_cmp( "-INF", strings => ["INF", "-INF"] )
335 -- correct answer is "-INF", "INF" and 335 -- correct answer is "-INF", "INF" and
347 347
348######################################################################### 348#########################################################################
349# Retain this first check for backword compatibility. Allows input of the form 349# Retain this first check for backword compatibility. Allows input of the form
350# num_cmp($ans, 1, '%0.5f') but warns against it 350# num_cmp($ans, 1, '%0.5f') but warns against it
351######################################################################### 351#########################################################################
352 my %known_options = ( 352 my %known_options = (
353 'mode' => 'std', 353 'mode' => 'std',
354 'format' => $numFormatDefault, 354 'format' => $numFormatDefault,
355 'tol' => $numAbsTolDefault, 355 'tol' => $numAbsTolDefault,
356 'relTol' => $numRelPercentTolDefault, 356 'relTol' => $numRelPercentTolDefault,
357 'units' => undef, 357 'units' => undef,
362 'tolerance' => 1, 362 'tolerance' => 1,
363 'reltol' => undef, #alternate spelling 363 'reltol' => undef, #alternate spelling
364 'unit' => undef, #alternate spelling 364 'unit' => undef, #alternate spelling
365 'debug' => 0 365 'debug' => 0
366 ); 366 );
367 367
368 my @output_list; 368 my @output_list;
369 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt; 369 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
370 370
371 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 || 371 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
372 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) { 372 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
373 # unless the first parameter is a list of arrays 373 # unless the first parameter is a list of arrays
374 # or the second parameter is a known option or 374 # or the second parameter is a known option or
375 # no options were used, 375 # no options were used,
376 # use the old num_cmp which does not use options, but has inputs 376 # use the old num_cmp which does not use options, but has inputs
377 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol 377 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol
378 warn "This method of using num_cmp() is deprecated. Please rewrite this" . 378 warn "This method of using num_cmp() is deprecated. Please rewrite this" .
379 " problem using the options style of parameter passing (or" . 379 " problem using the options style of parameter passing (or" .
380 " check that your first option is spelled correctly)."; 380 " check that your first option is spelled correctly).";
381 381
382 %out_options = ( 'relTol' => $relPercentTol, 382 %out_options = ( 'relTol' => $relPercentTol,
383 'format' => $format, 383 'format' => $format,
384 'zeroLevel' => $zeroLevel, 384 'zeroLevel' => $zeroLevel,
385 'zeroLevelTol' => $zeroLevelTol, 385 'zeroLevelTol' => $zeroLevelTol,
386 'mode' => 'std' 386 'mode' => 'std'
387 ); 387 );
388 } 388 }
389 389
390######################################################################### 390#########################################################################
391# Now handle the options assuming they are entered in the form 391# Now handle the options assuming they are entered in the form
392# num_cmp($ans, relTol=>1, format=>'%0.5f') 392# num_cmp($ans, relTol=>1, format=>'%0.5f')
393######################################################################### 393#########################################################################
394 %out_options = @opt; 394 %out_options = @opt;
395 assign_option_aliases( \%out_options, 395 assign_option_aliases( \%out_options,
396 'reltol' => 'relTol', 396 'reltol' => 'relTol',
415 # can't use both units and strings 415 # can't use both units and strings
416 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) { 416 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
417 warn "Can't use both 'units' and 'strings' in the same problem " . 417 warn "Can't use both 'units' and 'strings' in the same problem " .
418 "(check your parameters to num_cmp() )"; 418 "(check your parameters to num_cmp() )";
419 } 419 }
420 420
421 # absolute tolType and relTol are incompatible. So are relative tolType and tol 421 # absolute tolType and relTol are incompatible. So are relative tolType and tol
422 if( defined( $out_options{'relTol'} ) && $out_options{'tolType'} eq 'absolute' ) { 422 if( defined( $out_options{'relTol'} ) && $out_options{'tolType'} eq 'absolute' ) {
423 warn "The 'tolType' 'absolute' is not compatible with 'relTol' " . 423 warn "The 'tolType' 'absolute' is not compatible with 'relTol' " .
424 "(check your parameters to num_cmp() )"; 424 "(check your parameters to num_cmp() )";
425 } 425 }
426 if( defined( $out_options{'tol'} ) && $out_options{'tolType'} eq 'relative' ) { 426 if( defined( $out_options{'tol'} ) && $out_options{'tolType'} eq 'relative' ) {
427 warn "The 'tolType' 'relative' is not compatible with 'tol' " . 427 warn "The 'tolType' 'relative' is not compatible with 'tol' " .
428 "(check your parameters to num_cmp() )"; 428 "(check your parameters to num_cmp() )";
429 } 429 }
430 430
431 431
432 # Handle legacy options 432 # Handle legacy options
433 if ($out_options{tolType} eq 'absolute') { 433 if ($out_options{tolType} eq 'absolute') {
434 $out_options{'tolerance'}=$out_options{'tol'} if defined($out_options{'tol'}); 434 $out_options{'tolerance'}=$out_options{'tol'} if defined($out_options{'tol'});
435 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} ); 435 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
436 } else { 436 } else {
437 $out_options{'tolerance'}=$out_options{'relTol'} if defined($out_options{'relTol'}); 437 $out_options{'tolerance'}=$out_options{'relTol'} if defined($out_options{'relTol'});
438 # delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 438 # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
439 } 439 }
440 # end legacy options 440 # end legacy options
441 441
442 # thread over lists 442 # thread over lists
443 my @ans_list = (); 443 my @ans_list = ();
444 444
445 if ( ref($correctAnswer) eq 'ARRAY' ) { 445 if ( ref($correctAnswer) eq 'ARRAY' ) {
446 @ans_list = @{$correctAnswer}; 446 @ans_list = @{$correctAnswer};
450 450
451 # produce answer evaluators 451 # produce answer evaluators
452 foreach my $ans (@ans_list) { 452 foreach my $ans (@ans_list) {
453 if( defined( $out_options{'units'} ) ) { 453 if( defined( $out_options{'units'} ) ) {
454 $ans = "$ans $out_options{'units'}"; 454 $ans = "$ans $out_options{'units'}";
455 455
456 push( @output_list, NUM_CMP( 'correctAnswer' => $ans, 456 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
457 'tolerance' => $out_options{'tolerance'}, 457 'tolerance' => $out_options{'tolerance'},
458 'tolType' => $out_options{'tolType'}, 458 'tolType' => $out_options{'tolType'},
459 'format' => $out_options{'format'}, 459 'format' => $out_options{'format'},
460 'mode' => $out_options{'mode'}, 460 'mode' => $out_options{'mode'},
461 'zeroLevel' => $out_options{'zeroLevel'}, 461 'zeroLevel' => $out_options{'zeroLevel'},
462 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 462 'zeroLevelTol' => $out_options{'zeroLevelTol'},
463 'debug' => $out_options{'debug'}, 463 'debug' => $out_options{'debug'},
464 'units' => $out_options{'units'}, 464 'units' => $out_options{'units'},
465 ) 465 )
466 ); 466 );
467 } elsif( defined( $out_options{'strings'} ) ) { 467 } elsif( defined( $out_options{'strings'} ) ) {
468 468
469 469
470 push( @output_list, NUM_CMP( 'correctAnswer' => $ans, 470 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
471 'tolerance' => $out_options{tolerance}, 471 'tolerance' => $out_options{tolerance},
472 'tolType' => $out_options{tolType}, 472 'tolType' => $out_options{tolType},
473 'format' => $out_options{'format'}, 473 'format' => $out_options{'format'},
474 'mode' => $out_options{'mode'}, 474 'mode' => $out_options{'mode'},
476 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 476 'zeroLevelTol' => $out_options{'zeroLevelTol'},
477 'debug' => $out_options{'debug'}, 477 'debug' => $out_options{'debug'},
478 'strings' => $out_options{'strings'}, 478 'strings' => $out_options{'strings'},
479 ) 479 )
480 ); 480 );
481 } else { 481 } else {
482 push(@output_list, 482 push(@output_list,
483 NUM_CMP( 'correctAnswer' => $ans, 483 NUM_CMP( 'correctAnswer' => $ans,
484 'tolerance' => $out_options{tolerance}, 484 'tolerance' => $out_options{tolerance},
485 'tolType' => $out_options{tolType}, 485 'tolType' => $out_options{tolType},
486 'format' => $out_options{'format'}, 486 'format' => $out_options{'format'},
490 'debug' => $out_options{'debug'}, 490 'debug' => $out_options{'debug'},
491 ), 491 ),
492 ); 492 );
493 } 493 }
494 } 494 }
495 495
496 return (wantarray) ? @output_list : $output_list[0]; 496 return (wantarray) ? @output_list : $output_list[0];
497} 497}
498 498
499#legacy code for compatability purposes 499#legacy code for compatability purposes
500sub num_rel_cmp { # compare numbers 500sub num_rel_cmp { # compare numbers
586 my %options = ( 'relTol' => $relPercentTol, 586 my %options = ( 'relTol' => $relPercentTol,
587 'format' => $format, 587 'format' => $format,
588 'zeroLevel' => $zeroLevel, 588 'zeroLevel' => $zeroLevel,
589 'zeroLevelTol' => $zeroLevelTol 589 'zeroLevelTol' => $zeroLevelTol
590 ); 590 );
591 591
592 set_default_options( \%options, 592 set_default_options( \%options,
593 'tolType' => 'relative', 593 'tolType' => 'relative',
594 'tolerance' => $numRelPercentTolDefault, 594 'tolerance' => $numRelPercentTolDefault,
595 'mode' => 'std', 595 'mode' => 'std',
596 'format' => $numFormatDefault, 596 'format' => $numFormatDefault,
597 'relTol' => $numRelPercentTolDefault, 597 'relTol' => $numRelPercentTolDefault,
598 'zeroLevel' => $numZeroLevelDefault, 598 'zeroLevel' => $numZeroLevelDefault,
599 'zeroLevelTol' => $numZeroLevelTolDefault, 599 'zeroLevelTol' => $numZeroLevelTolDefault,
600 'debug' => 0, 600 'debug' => 0,
601 ); 601 );
602 602
603 num_cmp([$correctAnswer], %options); 603 num_cmp([$correctAnswer], %options);
604} 604}
605 605
606## Similar to std_num_cmp but accepts a list of numbers in the form 606## Similar to std_num_cmp but accepts a list of numbers in the form
607## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...) 607## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
633sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance 633sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
634 my ( $correctAnswer, $absTol, $format) = @_; 634 my ( $correctAnswer, $absTol, $format) = @_;
635 my %options = ( 'tolerance' => $absTol, 635 my %options = ( 'tolerance' => $absTol,
636 'format' => $format 636 'format' => $format
637 ); 637 );
638 638
639 set_default_options (\%options, 639 set_default_options (\%options,
640 'tolType' => 'absolute', 640 'tolType' => 'absolute',
641 'tolerance' => $absTol, 641 'tolerance' => $absTol,
642 'mode' => 'std', 642 'mode' => 'std',
643 'format' => $numFormatDefault, 643 'format' => $numFormatDefault,
672} 672}
673 673
674sub frac_num_cmp { # only allow fractions and numbers as submitted answer 674sub frac_num_cmp { # only allow fractions and numbers as submitted answer
675 675
676 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 676 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
677 677
678 my %options = ( 'relTol' => $relPercentTol, 678 my %options = ( 'relTol' => $relPercentTol,
679 'format' => $format, 679 'format' => $format,
680 'zeroLevel' => $zeroLevel, 680 'zeroLevel' => $zeroLevel,
681 'zeroLevelTol' => $zeroLevelTol 681 'zeroLevelTol' => $zeroLevelTol
682 ); 682 );
696} 696}
697 697
698## See std_num_cmp_list for usage 698## See std_num_cmp_list for usage
699sub frac_num_cmp_list { 699sub frac_num_cmp_list {
700 my ( $relPercentTol, $format, @answerList ) = @_; 700 my ( $relPercentTol, $format, @answerList ) = @_;
701 701
702 my %options = ( 'relTol' => $relPercentTol, 702 my %options = ( 'relTol' => $relPercentTol,
703 'format' => $format 703 'format' => $format
704 ); 704 );
705 705
706 set_default_options( \%options, 706 set_default_options( \%options,
707 'tolType' => 'relative', 707 'tolType' => 'relative',
708 'tolerance' => $relPercentTol, 708 'tolerance' => $relPercentTol,
709 'mode' => 'frac', 709 'mode' => 'frac',
710 'format' => $numFormatDefault, 710 'format' => $numFormatDefault,
711 'zeroLevel' => $numZeroLevelDefault, 711 'zeroLevel' => $numZeroLevelDefault,
712 'zeroLevelTol' => $numZeroLevelTolDefault, 712 'zeroLevelTol' => $numZeroLevelTolDefault,
713 'relTol' => $numRelPercentTolDefault, 713 'relTol' => $numRelPercentTolDefault,
714 'debug' => 0, 714 'debug' => 0,
715 ); 715 );
716 716
717 num_cmp(\@answerList, %options); 717 num_cmp(\@answerList, %options);
718} 718}
719 719
720sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance 720sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
721 my ( $correctAnswer, $absTol, $format ) = @_; 721 my ( $correctAnswer, $absTol, $format ) = @_;
722 722
723 my %options = ( 'tolerance' => $absTol, 723 my %options = ( 'tolerance' => $absTol,
724 'format' => $format 724 'format' => $format
725 ); 725 );
726 726
727 set_default_options (\%options, 727 set_default_options (\%options,
728 'tolType' => 'absolute', 728 'tolType' => 'absolute',
729 'tolerance' => $absTol, 729 'tolerance' => $absTol,
730 'mode' => 'frac', 730 'mode' => 'frac',
731 'format' => $numFormatDefault, 731 'format' => $numFormatDefault,
734 'debug' => 0, 734 'debug' => 0,
735 ); 735 );
736 736
737 num_cmp([$correctAnswer], %options); 737 num_cmp([$correctAnswer], %options);
738} 738}
739 739
740## See std_num_cmp_list for usage 740## See std_num_cmp_list for usage
741 741
742sub frac_num_cmp_abs_list { 742sub frac_num_cmp_abs_list {
743 my ( $absTol, $format, @answerList ) = @_; 743 my ( $absTol, $format, @answerList ) = @_;
744 744
745 my %options = ( 'tolerance' => $absTol, 745 my %options = ( 'tolerance' => $absTol,
746 'format' => $format 746 'format' => $format
747 ); 747 );
748 748
749 set_default_options (\%options, 749 set_default_options (\%options,
750 'tolType' => 'absolute', 750 'tolType' => 'absolute',
751 'tolerance' => $absTol, 751 'tolerance' => $absTol,
752 'mode' => 'frac', 752 'mode' => 'frac',
753 'format' => $numFormatDefault, 753 'format' => $numFormatDefault,
754 'zeroLevel' => 0, 754 'zeroLevel' => 0,
755 'zeroLevelTol' => 0, 755 'zeroLevelTol' => 0,
756 'debug' => 0, 756 'debug' => 0,
757 ); 757 );
758 758
759 num_cmp(\@answerList, %options); 759 num_cmp(\@answerList, %options);
760} 760}
761 761
762 762
763sub arith_num_cmp { # only allow arithmetic expressions as submitted answer 763sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
764 764
765 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 765 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
766 766
767 my %options = ( 'relTol' => $relPercentTol, 767 my %options = ( 'relTol' => $relPercentTol,
768 'format' => $format, 768 'format' => $format,
769 'zeroLevel' => $zeroLevel, 769 'zeroLevel' => $zeroLevel,
770 'zeroLevelTol' => $zeroLevelTol 770 'zeroLevelTol' => $zeroLevelTol
771 ); 771 );
772 772
773 set_default_options( \%options, 773 set_default_options( \%options,
774 'tolType' => 'relative', 774 'tolType' => 'relative',
775 'tolerance' => $relPercentTol, 775 'tolerance' => $relPercentTol,
776 'mode' => 'arith', 776 'mode' => 'arith',
777 'format' => $numFormatDefault, 777 'format' => $numFormatDefault,
800 'zeroLevel' => $numZeroLevelDefault, 800 'zeroLevel' => $numZeroLevelDefault,
801 'zeroLevelTol' => $numZeroLevelTolDefault, 801 'zeroLevelTol' => $numZeroLevelTolDefault,
802 'relTol' => $numRelPercentTolDefault, 802 'relTol' => $numRelPercentTolDefault,
803 'debug' => 0, 803 'debug' => 0,
804 ); 804 );
805 805
806 num_cmp(\@answerList, %options); 806 num_cmp(\@answerList, %options);
807} 807}
808 808
809sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance 809sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
810 my ( $correctAnswer, $absTol, $format ) = @_; 810 my ( $correctAnswer, $absTol, $format ) = @_;
811 811
812 my %options = ( 'tolerance' => $absTol, 812 my %options = ( 'tolerance' => $absTol,
813 'format' => $format 813 'format' => $format
814 ); 814 );
815 815
816 set_default_options (\%options, 816 set_default_options (\%options,
817 'tolType' => 'absolute', 817 'tolType' => 'absolute',
818 'tolerance' => $absTol, 818 'tolerance' => $absTol,
819 'mode' => 'arith', 819 'mode' => 'arith',
820 'format' => $numFormatDefault, 820 'format' => $numFormatDefault,
821 'zeroLevel' => 0, 821 'zeroLevel' => 0,
822 'zeroLevelTol' => 0, 822 'zeroLevelTol' => 0,
823 'debug' => 0, 823 'debug' => 0,
824 ); 824 );
825 825
826 num_cmp([$correctAnswer], %options); 826 num_cmp([$correctAnswer], %options);
827} 827}
828 828
829## See std_num_cmp_list for usage 829## See std_num_cmp_list for usage
830sub arith_num_cmp_abs_list { 830sub arith_num_cmp_abs_list {
831 my ( $absTol, $format, @answerList ) = @_; 831 my ( $absTol, $format, @answerList ) = @_;
832 832
833 my %options = ( 'tolerance' => $absTol, 833 my %options = ( 'tolerance' => $absTol,
834 'format' => $format 834 'format' => $format
835 ); 835 );
836 836
837 set_default_options (\%options, 837 set_default_options (\%options,
838 'tolType' => 'absolute', 838 'tolType' => 'absolute',
839 'tolerance' => $absTol, 839 'tolerance' => $absTol,
840 'mode' => 'arith', 840 'mode' => 'arith',
841 'format' => $numFormatDefault, 841 'format' => $numFormatDefault,
842 'zeroLevel' => 0, 842 'zeroLevel' => 0,
843 'zeroLevelTol' => 0, 843 'zeroLevelTol' => 0,
844 'debug' => 0, 844 'debug' => 0,
845 ); 845 );
846 846
847 num_cmp(\@answerList, %options); 847 num_cmp(\@answerList, %options);
848} 848}
849 849
850sub strict_num_cmp { # only allow numbers as submitted answer 850sub strict_num_cmp { # only allow numbers as submitted answer
851 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 851 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
852 852
853 my %options = ( 'relTol' => $relPercentTol, 853 my %options = ( 'relTol' => $relPercentTol,
854 'format' => $format, 854 'format' => $format,
855 'zeroLevel' => $zeroLevel, 855 'zeroLevel' => $zeroLevel,
856 'zeroLevelTol' => $zeroLevelTol 856 'zeroLevelTol' => $zeroLevelTol
857 ); 857 );
858 858
859 set_default_options( \%options, 859 set_default_options( \%options,
860 'tolType' => 'relative', 860 'tolType' => 'relative',
861 'tolerance' => $relPercentTol, 861 'tolerance' => $relPercentTol,
862 'mode' => 'strict', 862 'mode' => 'strict',
863 'format' => $numFormatDefault, 863 'format' => $numFormatDefault,
871} 871}
872 872
873## See std_num_cmp_list for usage 873## See std_num_cmp_list for usage
874sub strict_num_cmp_list { # compare numbers 874sub strict_num_cmp_list { # compare numbers
875 my ( $relPercentTol, $format, @answerList ) = @_; 875 my ( $relPercentTol, $format, @answerList ) = @_;
876 876
877 my %options = ( 'relTol' => $relPercentTol, 877 my %options = ( 'relTol' => $relPercentTol,
878 'format' => $format, 878 'format' => $format,
879 ); 879 );
880 880
881 set_default_options( \%options, 881 set_default_options( \%options,
882 'tolType' => 'relative', 882 'tolType' => 'relative',
883 'tolerance' => $relPercentTol, 883 'tolerance' => $relPercentTol,
884 'mode' => 'strict', 884 'mode' => 'strict',
885 'format' => $numFormatDefault, 885 'format' => $numFormatDefault,
886 'zeroLevel' => $numZeroLevelDefault, 886 'zeroLevel' => $numZeroLevelDefault,
887 'zeroLevelTol' => $numZeroLevelTolDefault, 887 'zeroLevelTol' => $numZeroLevelTolDefault,
888 'relTol' => $numRelPercentTolDefault, 888 'relTol' => $numRelPercentTolDefault,
889 'debug' => 0, 889 'debug' => 0,
890 ); 890 );
891 891
892 num_cmp(\@answerList, %options); 892 num_cmp(\@answerList, %options);
893} 893}
894 894
895 895
896sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance 896sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
932 ); 932 );
933 933
934 num_cmp(\@answerList, %options); 934 num_cmp(\@answerList, %options);
935} 935}
936 936
937## sub numerical_compare_with_units 937## sub numerical_compare_with_units
938## Compares a number with units 938## Compares a number with units
939## Deprecated; use num_cmp() 939## Deprecated; use num_cmp()
940## 940##
941## IN: a string which includes the numerical answer and the units 941## IN: a string which includes the numerical answer and the units
942## a hash with the following keys (all optional): 942## a hash with the following keys (all optional):
957 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' ); 957 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
958 958
959 # it surprises me that the match below works since the first .* is greedy. 959 # it surprises me that the match below works since the first .* is greedy.
960 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/; 960 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
961 $options{units} = $correct_units; 961 $options{units} = $correct_units;
962 962
963 num_cmp($correct_num_answer, %options); 963 num_cmp($correct_num_answer, %options);
964} 964}
965 965
966 966
967=head3 std_num_str_cmp() 967=head3 std_num_str_cmp()
968 968
969NOTE: This function is maintained for compatibility. num_cmp() with the 969NOTE: This function is maintained for compatibility. num_cmp() with the
970 'strings' parameter is slightly preferred. 970 'strings' parameter is slightly preferred.
971 971
972std_num_str_cmp() is used when the correct answer could be either a number or a 972std_num_str_cmp() is used when the correct answer could be either a number or a
973string. For example, if you wanted the student to evaluate a function at number 973string. For example, if you wanted the student to evaluate a function at number
1000=cut 1000=cut
1001 1001
1002sub std_num_str_cmp { 1002sub std_num_str_cmp {
1003 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 1003 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
1004 # warn ('This method is depreciated. Use num_cmp instead.'); 1004 # warn ('This method is depreciated. Use num_cmp instead.');
1005 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format, 1005 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
1006 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol); 1006 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
1007} 1007}
1008 1008
1009sub NUM_CMP { # low level numeric compare 1009sub NUM_CMP { # low level numeric compare
1010 my %num_params = @_; 1010 my %num_params = @_;
1011 1011
1012 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug ); 1012 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1013 foreach my $key (@keys) { 1013 foreach my $key (@keys) {
1014 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key}); 1014 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1015 } 1015 }
1016 1016
1017 my $correctAnswer = $num_params{'correctAnswer'}; 1017 my $correctAnswer = $num_params{'correctAnswer'};
1018 my $format = $num_params{'format'}; 1018 my $format = $num_params{'format'};
1019 my $mode = $num_params{'mode'}; 1019 my $mode = $num_params{'mode'};
1020 1020
1021 if( $num_params{tolType} eq 'relative' ) { 1021 if( $num_params{tolType} eq 'relative' ) {
1022 $num_params{'tolerance'} = .01*$num_params{'tolerance'}; 1022 $num_params{'tolerance'} = .01*$num_params{'tolerance'};
1023 } 1023 }
1024 1024
1025 my $formattedCorrectAnswer; 1025 my $formattedCorrectAnswer;
1026 my $correct_units; 1026 my $correct_units;
1027 my $correct_num_answer; 1027 my $correct_num_answer;
1028 my %correct_units; 1028 my %correct_units;
1029 my $corrAnswerIsString = 0; 1029 my $corrAnswerIsString = 0;
1030 1030
1031 1031
1032 if (defined($num_params{units}) && $num_params{units}) { 1032 if (defined($num_params{units}) && $num_params{units}) {
1033 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' ); 1033 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1034 # units are in form stuff space units where units contains no spaces. 1034 # units are in form stuff space units where units contains no spaces.
1035 1035
1036 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/; 1036 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
1037 %correct_units = Units::evaluate_units($correct_units); 1037 %correct_units = Units::evaluate_units($correct_units);
1038 if ( defined( $correct_units{'ERROR'} ) ) { 1038 if ( defined( $correct_units{'ERROR'} ) ) {
1039 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" . 1039 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1040 "$correct_units{'ERROR'}\n"); 1040 "$correct_units{'ERROR'}\n");
1041 } 1041 }
1042 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1042 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1043 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1043 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1044 1044
1045 } elsif (defined($num_params{strings}) && $num_params{strings}) { 1045 } elsif (defined($num_params{strings}) && $num_params{strings}) {
1046 my $legalString = ''; 1046 my $legalString = '';
1047 my @legalStrings = @{$num_params{strings}}; 1047 my @legalStrings = @{$num_params{strings}};
1048 $correct_num_answer = $correctAnswer; 1048 $correct_num_answer = $correctAnswer;
1049 $formattedCorrectAnswer = $correctAnswer; 1049 $formattedCorrectAnswer = $correctAnswer;
1050 foreach $legalString (@legalStrings) { 1050 foreach $legalString (@legalStrings) {
1051 if ( uc($correctAnswer) eq uc($legalString) ) { 1051 if ( uc($correctAnswer) eq uc($legalString) ) {
1052 $corrAnswerIsString = 1; 1052 $corrAnswerIsString = 1;
1053 1053
1054 last; 1054 last;
1055 } 1055 }
1056 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 1056 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1057 } else { 1057 } else {
1058 $correct_num_answer = $correctAnswer; 1058 $correct_num_answer = $correctAnswer;
1059 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} ); 1059 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1060 } 1060 }
1061 1061
1062 $correct_num_answer = math_constants($correct_num_answer); 1062 $correct_num_answer = math_constants($correct_num_answer);
1063 1063
1064 my $PGanswerMessage = ''; 1064 my $PGanswerMessage = '';
1065 1065
1066 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report); 1066 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1067 1067
1068 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) { 1068 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1069 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer); 1069 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1070 } else { # case of a string answer 1070 } else { # case of a string answer
1071 $PG_eval_errors = ' '; 1071 $PG_eval_errors = ' ';
1072 $correctVal = $correctAnswer; 1072 $correctVal = $correctAnswer;
1073 } 1073 }
1074 1074
1075 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) { 1075 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1076 ##error message from eval or above 1076 ##error message from eval or above
1077 warn "Error in 'correct' answer: $PG_eval_errors<br> 1077 warn "Error in 'correct' answer: $PG_eval_errors<br>
1078 The answer $correctAnswer evaluates to $correctVal, 1078 The answer $correctAnswer evaluates to $correctVal,
1079 which cannot be interpreted as a number. "; 1079 which cannot be interpreted as a number. ";
1080 1080
1081 } 1081 }
1082 ######################################################################### 1082 #########################################################################
1083 1083
1084 #construct the answer evaluator 1084 #construct the answer evaluator
1085 my $answer_evaluator = new AnswerEvaluator; 1085 my $answer_evaluator = new AnswerEvaluator;
1086 $answer_evaluator->{debug} = $num_params{debug}; 1086 $answer_evaluator->{debug} = $num_params{debug};
1087 $answer_evaluator->ans_hash( 1087 $answer_evaluator->ans_hash(
1088 correct_ans => $correctVal, 1088 correct_ans => $correctVal,
1089 type => "${mode}_number", 1089 type => "${mode}_number",
1090 tolerance => $num_params{tolerance}, 1090 tolerance => $num_params{tolerance},
1091 tolType => $num_params{tolType}, 1091 tolType => $num_params{tolType},
1092 units => $correct_units, 1092 units => $correct_units,
1093 original_correct_ans => $formattedCorrectAnswer, 1093 original_correct_ans => $formattedCorrectAnswer,
1094 rh_correct_units => \%correct_units, 1094 rh_correct_units => \%correct_units,
1095 answerIsString => $corrAnswerIsString, 1095 answerIsString => $corrAnswerIsString,
1096 ); 1096 );
1097 my ($in, $formattedSubmittedAnswer); 1097 my ($in, $formattedSubmittedAnswer);
1098 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift; 1098 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1099 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;} 1099 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1100 ); 1100 );
1101 if (defined($num_params{units}) && $num_params{units}) { 1101 if (defined($num_params{units}) && $num_params{units}) {
1102 $answer_evaluator->install_pre_filter(\&check_units); 1102 $answer_evaluator->install_pre_filter(\&check_units);
1103 } 1103 }
1104 if (defined($num_params{strings}) && $num_params{strings}) { 1104 if (defined($num_params{strings}) && $num_params{strings}) {
1105 $answer_evaluator->install_pre_filter(\&check_strings, %num_params); 1105 $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
1106 } 1106 }
1107 1107
1108 $answer_evaluator->install_pre_filter(\&check_syntax); 1108 $answer_evaluator->install_pre_filter(\&check_syntax);
1109 1109
1110 $answer_evaluator->install_pre_filter(\&math_constants); 1110 $answer_evaluator->install_pre_filter(\&math_constants);
1111 1111
1112 if ($mode eq 'std') { 1112 if ($mode eq 'std') {
1113 # do nothing 1113 # do nothing
1114 } elsif ($mode eq 'strict') { 1114 } elsif ($mode eq 'strict') {
1115 $answer_evaluator->install_pre_filter(\&is_a_number); 1115 $answer_evaluator->install_pre_filter(\&is_a_number);
1116 } elsif ($mode eq 'arith') { 1116 } elsif ($mode eq 'arith') {
1117 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression); 1117 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
1118 } elsif ($mode eq 'frac') { 1118 } elsif ($mode eq 'frac') {
1119 $answer_evaluator->install_pre_filter(\&is_a_fraction); 1119 $answer_evaluator->install_pre_filter(\&is_a_fraction);
1120 1120
1121 } elsif ($mode eq 'phase_pi') { 1121 } elsif ($mode eq 'phase_pi') {
1122 $answer_evaluator->install_pre_filter(\&phase_pi); 1122 $answer_evaluator->install_pre_filter(\&phase_pi);
1123 1123
1124 } else { 1124 } else {
1125 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.'; 1125 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1126 $formattedSubmittedAnswer = $in; 1126 $formattedSubmittedAnswer = $in;
1127 } 1127 }
1128 1128
1129 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string. 1129 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
1130 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params); 1130 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1131 } 1131 }
1132 1132
1133 1133
1134############################################################################### 1134###############################################################################
1135# We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's 1135# We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
1136# can be displayed in the answer message. This may still cause a few anomolies when strings are used 1136# can be displayed in the answer message. This may still cause a few anomolies when strings are used
1137# 1137#
1138############################################################################### 1138###############################################################################
1139 1139
1140 $answer_evaluator->install_post_filter(\&fix_answers_for_display); 1140 $answer_evaluator->install_post_filter(\&fix_answers_for_display);
1141 1141
1142 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 1142 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1143 return $rh_ans unless $rh_ans->catch_error('EVAL'); 1143 return $rh_ans unless $rh_ans->catch_error('EVAL');
1144 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message}; 1144 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1145 $rh_ans->clear_error('EVAL'); } ); 1145 $rh_ans->clear_error('EVAL'); } );
1146 $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('SYNTAX'); } );
1147 $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('UNITS'); } );
1253 numPoints -- the number of points to evaluate the function at 1253 numPoints -- the number of points to evaluate the function at
1254 maxConstantOfIntegration -- maximum size of the constant of integration 1254 maxConstantOfIntegration -- maximum size of the constant of integration
1255 zeroLevel -- if the correct answer is this close to zero, then 1255 zeroLevel -- if the correct answer is this close to zero, then
1256 zeroLevelTol applies 1256 zeroLevelTol applies
1257 zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1257 zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1258 params an array of "free" parameters which can be used to adapt 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 1259 the correct answer to the submitted answer. (e.g. ['c'] for
1260 a constant of integration in the answer x^3/3 + c. 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 1261 debug -- when set to 1 this provides extra information while checking the
1262 the answer. 1262 the answer.
1263 1263
1264 Returns an answer evaluator, or (if given a reference to an array 1264 Returns an answer evaluator, or (if given a reference to an array
1265 of answers), a list of answer evaluators 1265 of answers), a list of answer evaluators
1266 1266
1267ANSWER: 1267ANSWER:
1268 1268
1269 The answer must be in the form of a string. The answer can contain 1269 The answer must be in the form of a string. The answer can contain
1310=cut 1310=cut
1311 1311
1312sub fun_cmp { 1312sub fun_cmp {
1313 my $correctAnswer = shift @_; 1313 my $correctAnswer = shift @_;
1314 my %opt = @_; 1314 my %opt = @_;
1315 1315
1316 assign_option_aliases( \%opt, 1316 assign_option_aliases( \%opt,
1317 'vars' => 'var', # set the standard option 'var' to the one specified as vars 1317 'vars' => 'var', # set the standard option 'var' to the one specified as vars
1318 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain 1318 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain
1319 'reltol' => 'relTol', 1319 'reltol' => 'relTol',
1320 'param' => 'params', 1320 'param' => 'params',
1321 ); 1321 );
1322 1322
1323 set_default_options( \%opt, 1323 set_default_options( \%opt,
1324 'var' => $functVarDefault, 1324 'var' => $functVarDefault,
1325 'params' => [], 1325 'params' => [],
1326 'limits' => [[$functLLimitDefault, $functULimitDefault]], 1326 'limits' => [[$functLLimitDefault, $functULimitDefault]],
1327 'mode' => 'std', 1327 'mode' => 'std',
1332 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 1332 'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
1333 'zeroLevel' => $functZeroLevelDefault, 1333 'zeroLevel' => $functZeroLevelDefault,
1334 'zeroLevelTol' => $functZeroLevelTolDefault, 1334 'zeroLevelTol' => $functZeroLevelTolDefault,
1335 'debug' => 0, 1335 'debug' => 0,
1336 ); 1336 );
1337 1337
1338 # allow var => 'x' as an abbreviation for var => ['x'] 1338 # allow var => 'x' as an abbreviation for var => ['x']
1339 my %out_options = %opt; 1339 my %out_options = %opt;
1340 unless ( ref($out_options{var}) eq 'ARRAY' ) { 1340 unless ( ref($out_options{var}) eq 'ARRAY' ) {
1341 $out_options{var} = [$out_options{var}]; 1341 $out_options{var} = [$out_options{var}];
1342 } 1342 }
1343 # allow params => 'c' as an abbreviation for params => ['c'] 1343 # allow params => 'c' as an abbreviation for params => ['c']
1344 unless ( ref($out_options{params}) eq 'ARRAY' ) { 1344 unless ( ref($out_options{params}) eq 'ARRAY' ) {
1345 $out_options{params} = [$out_options{params}]; 1345 $out_options{params} = [$out_options{params}];
1346 } 1346 }
1347 my ($tolType, $tol); 1347 my ($tolType, $tol);
1348 if ($out_options{tolType} eq 'absolute') { 1348 if ($out_options{tolType} eq 'absolute') {
1349 $tolType = 'absolute'; 1349 $tolType = 'absolute';
1350 $tol = $out_options{'tol'}; 1350 $tol = $out_options{'tol'};
1352 } else { 1352 } else {
1353 $tolType = 'relative'; 1353 $tolType = 'relative';
1354 $tol = $out_options{'relTol'}; 1354 $tol = $out_options{'relTol'};
1355 delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 1355 delete($out_options{'tol'}) if exists( $out_options{'tol'} );
1356 } 1356 }
1357 1357
1358 my @output_list = (); 1358 my @output_list = ();
1359 # thread over lists 1359 # thread over lists
1360 my @ans_list = (); 1360 my @ans_list = ();
1361 1361
1362 if ( ref($correctAnswer) eq 'ARRAY' ) { 1362 if ( ref($correctAnswer) eq 'ARRAY' ) {
1367 } 1367 }
1368 1368
1369 # produce answer evaluators 1369 # produce answer evaluators
1370 foreach my $ans (@ans_list) { 1370 foreach my $ans (@ans_list) {
1371 push(@output_list, 1371 push(@output_list,
1372 FUNCTION_CMP( 1372 FUNCTION_CMP(
1373 'correctEqn' => $ans, 1373 'correctEqn' => $ans,
1374 'var' => $out_options{'var'}, 1374 'var' => $out_options{'var'},
1375 'limits' => $out_options{'limits'}, 1375 'limits' => $out_options{'limits'},
1376 'tolerance' => $tol, 1376 'tolerance' => $tol,
1377 'tolType' => $tolType, 1377 'tolType' => $tolType,
1511 my $limit_ref = $options{'limits'}; 1511 my $limit_ref = $options{'limits'};
1512 my $relPercentTol= $options{'reltol'}; 1512 my $relPercentTol= $options{'reltol'};
1513 my $numPoints = $options{'numPoints'}; 1513 my $numPoints = $options{'numPoints'};
1514 my $zeroLevel = $options{'zeroLevel'}; 1514 my $zeroLevel = $options{'zeroLevel'};
1515 my $zeroLevelTol = $options{'zeroLevelTol'}; 1515 my $zeroLevelTol = $options{'zeroLevelTol'};
1516 1516
1517 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1517 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1518 'var' => $var_ref, 1518 'var' => $var_ref,
1519 'limits' => $limit_ref, 1519 'limits' => $limit_ref,
1520 'tolerance' => $relPercentTol, 1520 'tolerance' => $relPercentTol,
1521 'tolType' => 'relative', 1521 'tolType' => 'relative',
1698 my $numPoints = $func_params{'numPoints'}; 1698 my $numPoints = $func_params{'numPoints'};
1699 my $mode = $func_params{'mode'}; 1699 my $mode = $func_params{'mode'};
1700 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 1700 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
1701 my $zeroLevel = $func_params{'zeroLevel'}; 1701 my $zeroLevel = $func_params{'zeroLevel'};
1702 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 1702 my $zeroLevelTol = $func_params{'zeroLevelTol'};
1703 1703
1704 1704
1705 # Check that everything is defined: 1705 # Check that everything is defined:
1706 $func_params{debug} = 0 unless defined($func_params{debug}); 1706 $func_params{debug} = 0 unless defined($func_params{debug});
1707 $mode = 'std' unless defined($mode); 1707 $mode = 'std' unless defined($mode);
1708 my @VARS = get_var_array( $var ); 1708 my @VARS = get_var_array( $var );
1709 my @limits = get_limits_array( $ra_limits ); 1709 my @limits = get_limits_array( $ra_limits );
1710 my @PARAMS = (); 1710 my @PARAMS = ();
1711 @PARAMS = @{$func_params{'params'}} if defined($func_params{'params'}); 1711 @PARAMS = @{$func_params{'params'}} if defined($func_params{'params'});
1712 1712
1713 if ($mode eq 'antider' ) { 1713 if ($mode eq 'antider' ) {
1714 # doctor the equation to allow addition of a constant 1714 # doctor the equation to allow addition of a constant
1715 my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters. 1715 my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters.
1716 # There is the possibility of conflict here. 1716 # There is the possibility of conflict here.
1717 # 'Q' seemed less dangerous than 'C'. 1717 # 'Q' seemed less dangerous than 'C'.
1718 $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM"; 1718 $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM";
1719 push(@PARAMS, $CONSTANT_PARAM); 1719 push(@PARAMS, $CONSTANT_PARAM);
1720 } 1720 }
1721 my $dim_of_param_space = @PARAMS; # dimension of equivalence space 1721 my $dim_of_param_space = @PARAMS; # dimension of equivalence space
1735 } 1735 }
1736 $numPoints = $functNumOfPoints unless defined $numPoints; 1736 $numPoints = $functNumOfPoints unless defined $numPoints;
1737 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 1737 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
1738 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 1738 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
1739 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 1739 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
1740 1740
1741 $func_params{'var'} = $var; 1741 $func_params{'var'} = $var;
1742 $func_params{'limits'} = \@limits; 1742 $func_params{'limits'} = \@limits;
1743 $func_params{'tolerance'} = $tol; 1743 $func_params{'tolerance'} = $tol;
1744 $func_params{'tolType'} = $tolType; 1744 $func_params{'tolType'} = $tolType;
1745 $func_params{'numPoints'} = $numPoints; 1745 $func_params{'numPoints'} = $numPoints;
1746 $func_params{'mode'} = $mode; 1746 $func_params{'mode'} = $mode;
1747 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 1747 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
1748 $func_params{'zeroLevel'} = $zeroLevel; 1748 $func_params{'zeroLevel'} = $zeroLevel;
1749 $func_params{'zeroLevelTol'} = $zeroLevelTol; 1749 $func_params{'zeroLevelTol'} = $zeroLevelTol;
1750 1750
1751######################################################## 1751########################################################
1752# End of cleanup of calling parameters 1752# End of cleanup of calling parameters
1753######################################################## 1753########################################################
1754 my $i; #for use with loops 1754 my $i; #for use with loops
1755 my $PGanswerMessage = ""; 1755 my $PGanswerMessage = "";
1756 my $originalCorrEqn = $correctEqn; 1756 my $originalCorrEqn = $correctEqn;
1757 1757
1758#prepare the correct answer and check it's syntax 1758#prepare the correct answer and check it's syntax
1759 my $rh_correct_ans = new AnswerHash; 1759 my $rh_correct_ans = new AnswerHash;
1760 $rh_correct_ans->input($correctEqn); 1760 $rh_correct_ans->input($correctEqn);
1761 $rh_correct_ans = check_syntax($rh_correct_ans); 1761 $rh_correct_ans = check_syntax($rh_correct_ans);
1762 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 1762 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1763 $rh_correct_ans->clear_error(); 1763 $rh_correct_ans->clear_error();
1764 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ], 1764 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ],
1765 store_in =>'rf_correct_ans', 1765 store_in =>'rf_correct_ans',
1766 debug => $func_params{debug}); 1766 debug => $func_params{debug});
1767 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans}; 1767 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
1768 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 1768 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1769 1769
1770#create the evaluation points 1770#create the evaluation points
1771 my $random_for_answers = new PGrandom($main::PG_original_problemSeed); 1771 my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
1772 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator 1772 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
1773 my (@evaluation_points); 1773 my (@evaluation_points);
1774 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) { 1774 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) {
1777 my $iteration_limit = 10; 1777 my $iteration_limit = 10;
1778 while ( 0 < --$iteration_limit ) { # make sure that the endpoints of the interval are not included 1778 while ( 0 < --$iteration_limit ) { # make sure that the endpoints of the interval are not included
1779 $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM ); 1779 $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM );
1780 last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1]; 1780 last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1];
1781 } 1781 }
1782 warn "Unable to properly choose evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )" 1782 warn "Unable to properly choose evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )"
1783 if $iteration_limit == 0; 1783 if $iteration_limit == 0;
1784 }; 1784 };
1785 1785
1786 push(@evaluation_points,\@vars); 1786 push(@evaluation_points,\@vars);
1787 } 1787 }
1788 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points); 1788 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
1789 1789
1790 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters); 1790 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
1791 #warn "coeff", join(" | ", @{$COEFFS}); 1791 #warn "coeff", join(" | ", @{$COEFFS});
1792 1792
1793#construct the answer evaluator 1793#construct the answer evaluator
1794 my $answer_evaluator = new AnswerEvaluator; 1794 my $answer_evaluator = new AnswerEvaluator;
1795 $answer_evaluator->{debug} = $func_params{debug}; 1795 $answer_evaluator->{debug} = $func_params{debug};
1796 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn, 1796 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn,
1797 rf_correct_ans => $rh_correct_ans->{rf_correct_ans}, 1797 rf_correct_ans => $rh_correct_ans->{rf_correct_ans},
1798 evaluation_points => \@evaluation_points, 1798 evaluation_points => \@evaluation_points,
1799 ra_param_vars => \@PARAMS, 1799 ra_param_vars => \@PARAMS,
1800 ra_vars => \@VARS, 1800 ra_vars => \@VARS,
1801 type => 'function', 1801 type => 'function',
1802 ); 1802 );
1803 1803
1804 $answer_evaluator->install_pre_filter(\&check_syntax); 1804 $answer_evaluator->install_pre_filter(\&check_syntax);
1805 $answer_evaluator->install_pre_filter(\&function_from_string2, ra_vars => \@VARS,debug=>$func_params{debug},); # @VARS has been guaranteed to be an array, $var might be a single string. 1805 $answer_evaluator->install_pre_filter(\&function_from_string2, ra_vars => \@VARS,debug=>$func_params{debug},); # @VARS has been guaranteed to be an array, $var might be a single string.
1806 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS); 1806 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS);
1807 $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params); 1807 $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params);
1808 $answer_evaluator->install_evaluator(\&is_zero_array, tolerance => $tol ); 1808 $answer_evaluator->install_evaluator(\&is_zero_array, tolerance => $tol );
1809 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); $rh_ans;} ); 1809 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); $rh_ans;} );
1810 $answer_evaluator->install_post_filter( 1810 $answer_evaluator->install_post_filter(
1811 sub {my $rh_ans = shift; 1811 sub {my $rh_ans = shift;
1812 if ($rh_ans->catch_error('EVAL') ) { 1812 if ($rh_ans->catch_error('EVAL') ) {
1813 $rh_ans->{ans_message} = $rh_ans->{error_message}; 1813 $rh_ans->{ans_message} = $rh_ans->{error_message};
1814 $rh_ans->clear_error('EVAL'); 1814 $rh_ans->clear_error('EVAL');
1815 } 1815 }
1816 $rh_ans; 1816 $rh_ans;
2492 my $fileID = shift; 2492 my $fileID = shift;
2493 my $ans_eval = new AnswerEvaluator; 2493 my $ans_eval = new AnswerEvaluator;
2494 $ans_eval->install_evaluator( 2494 $ans_eval->install_evaluator(
2495 sub { 2495 sub {
2496 my $rh_ans = shift; 2496 my $rh_ans = shift;
2497 2497
2498 unless ( defined( $rh_ans->{student_ans} ) ) { 2498 unless ( defined( $rh_ans->{student_ans} ) ) {
2499 $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined"); 2499 $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined");
2500 return $rh_ans; 2500 return $rh_ans;
2501 } 2501 }
2502 2502
2503 my $error; 2503 my $error;
2504 my $string = ''; 2504 my $string = '';
2505 $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!. 2505 $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!.
2506 $rh_ans->{student_ans}. qq!\n\n============================\n\n!; 2506 $rh_ans->{student_ans}. qq!\n\n============================\n\n!;
2507 2507
2508 if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) { 2508 if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) {
2509 $rh_ans->throw_error("save_answers_to_file","Error: $error"); 2509 $rh_ans->throw_error("save_answers_to_file","Error: $error");
2510 } else { 2510 } else {
2511 $rh_ans->{'student_ans'} = 'Answer saved'; 2511 $rh_ans->{'student_ans'} = 'Answer saved';
2512 $rh_ans->{'score'} = 1; 2512 $rh_ans->{'score'} = 1;
2513 } 2513 }
2514 $rh_ans; 2514 $rh_ans;
2515 } 2515 }
2516 ); 2516 );
2517 2517
2682 $out = sprintf( $format, $number ); 2682 $out = sprintf( $format, $number );
2683 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 2683 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
2684 } else { # number is probably a string representing an arithmetic expression 2684 } else { # number is probably a string representing an arithmetic expression
2685 $out = $number; 2685 $out = $number;
2686 } 2686 }
2687 2687
2688 } else { 2688 } else {
2689 if (is_a_number($number)) {# only use capital E's for exponents. Little e is for 2.71828... 2689 if (is_a_number($number)) {# only use capital E's for exponents. Little e is for 2.71828...
2690 $out = $number; 2690 $out = $number;
2691 $out =~ s/e/E/g; 2691 $out =~ s/e/E/g;
2692 } else { # number is probably a string representing an arithmetic expression 2692 } else { # number is probably a string representing an arithmetic expression
2693 $out = $number; 2693 $out = $number;
2694 } 2694 }
2695 } 2695 }
2696 return $out; 2696 return $out;
2697} 2697}
2698######################################################################### 2698#########################################################################
2699# Filters for answer evaluators 2699# Filters for answer evaluators
2711See the AnswerHash.pm file for a list of entries which can be expected to be found 2711See the AnswerHash.pm file for a list of entries which can be expected to be found
2712in an AnswerHash, such as 'student_ans', 'score' and so forth. Other entries 2712in an AnswerHash, such as 'student_ans', 'score' and so forth. Other entries
2713may be present for specialized answer evaluators. 2713may be present for specialized answer evaluators.
2714 2714
2715The hope is that a well designed set of filters can easily be combined to form 2715The hope is that a well designed set of filters can easily be combined to form
2716a new answer_evaluator and that this method will produce answer evaluators which are 2716a new answer_evaluator and that this method will produce answer evaluators which are
2717are more robust than the method of copying existing answer evaluators and modifying them. 2717are more robust than the method of copying existing answer evaluators and modifying them.
2718 2718
2719Here is an outline of how a filter is constructed: 2719Here is an outline of how a filter is constructed:
2720 2720
2721 sub filter{ 2721 sub filter{
2731 'option7' => 'ascii', 2731 'option7' => 'ascii',
2732 'allow_unknown_options => 0, 2732 'allow_unknown_options => 0,
2733 } 2733 }
2734 .... body code of filter ....... 2734 .... body code of filter .......
2735 if ($error) { 2735 if ($error) {
2736 $rh_ans->throw_error("FILTER_ERROR", "Something went wrong"); 2736 $rh_ans->throw_error("FILTER_ERROR", "Something went wrong");
2737 # see AnswerHash.pm for details on using the throw_error method. 2737 # see AnswerHash.pm for details on using the throw_error method.
2738 2738
2739 $rh_ans; #reference to an AnswerHash object is returned. 2739 $rh_ans; #reference to an AnswerHash object is returned.
2740 } 2740 }
2741 2741
2742=cut 2742=cut
2743 2743
2755 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors); 2755 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
2756 # return $rh_ans; 2756 # return $rh_ans;
2757 } else { 2757 } else {
2758 $rh_ans->{student_ans} = prfmt($inVal,$options{format}); 2758 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
2759 } 2759 }
2760 2760
2761 my $permitted_error; 2761 my $permitted_error;
2762 2762
2763 if ($rh_ans->{tolType} eq 'absolute') { 2763 if ($rh_ans->{tolType} eq 'absolute') {
2764 $permitted_error = $rh_ans->{tolerance}; 2764 $permitted_error = $rh_ans->{tolerance};
2765 } 2765 }
2766 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) { 2766 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
2767 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero 2767 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
2768 } 2768 }
2769 else { 2769 else {
2770 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}); 2770 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
2771 } 2771 }
2772 2772
2773 my $is_a_number = is_a_number($inVal); 2773 my $is_a_number = is_a_number($inVal);
2774 $rh_ans->{score} = 1 if ( ($is_a_number) and 2774 $rh_ans->{score} = 1 if ( ($is_a_number) and
2775 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) ); 2775 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
2776 if (not $is_a_number) { 2776 if (not $is_a_number) {
2777 $rh_ans->{error_message} = "$rh_ans->{error_message}". 'Your answer does not evaluate to a number '; 2777 $rh_ans->{error_message} = "$rh_ans->{error_message}". 'Your answer does not evaluate to a number ';
2778 } 2778 }
2779 2779
2780 $rh_ans; 2780 $rh_ans;
2781} 2781}
2782 2782
2783=head4 std_num_filter 2783=head4 std_num_filter
2784 2784
2797 $in = math_constants($in); 2797 $in = math_constants($in);
2798 $rh_ans->{type} = 'std_number'; 2798 $rh_ans->{type} = 'std_number';
2799 my ($inVal,$PG_eval_errors,$PG_full_error_report); 2799 my ($inVal,$PG_eval_errors,$PG_full_error_report);
2800 if ($in =~ /\S/) { 2800 if ($in =~ /\S/) {
2801 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in); 2801 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
2802 } else { 2802 } else {
2803 $PG_eval_errors = ''; 2803 $PG_eval_errors = '';
2804 } 2804 }
2805 2805
2806 if ($PG_eval_errors) { ##error message from eval or above 2806 if ($PG_eval_errors) { ##error message from eval or above
2807 $rh_ans->{ans_message} = 'There is a syntax error in your answer'; 2807 $rh_ans->{ans_message} = 'There is a syntax error in your answer';
2808 $rh_ans->{student_ans} = clean_up_error_msg($PG_eval_errors); 2808 $rh_ans->{student_ans} = clean_up_error_msg($PG_eval_errors);
2809 } else { 2809 } else {
2810 $rh_ans->{student_ans} = $inVal; 2810 $rh_ans->{student_ans} = $inVal;
2811 } 2811 }
2814 2814
2815=head std_num_array_filter 2815=head std_num_array_filter
2816 2816
2817 std_num_array_filter($rh_ans, %options) 2817 std_num_array_filter($rh_ans, %options)
2818 returns $rh_ans 2818 returns $rh_ans
2819 2819
2820Assumes the {student_ans} field is a numerical array, and applies BOTH check_syntax and std_num_filter 2820Assumes the {student_ans} field is a numerical array, and applies BOTH check_syntax and std_num_filter
2821to each element of the array. Does it's best to generate sensible error messages for syntax errors. 2821to each element of the array. Does it's best to generate sensible error messages for syntax errors.
2822A typical error message displayed in {studnet_ans} might be ( 56, error message, -4). 2822A typical error message displayed in {studnet_ans} might be ( 56, error message, -4).
2823 2823
2824=cut 2824=cut
2825 2825
2826sub std_num_array_filter { 2826sub std_num_array_filter {
2827 my $rh_ans= shift; 2827 my $rh_ans= shift;
2828 my %options = @_; 2828 my %options = @_;
2829 set_default_options( \%options, 2829 set_default_options( \%options,
2830 '_filter_name' => 'std_num_array_filter', 2830 '_filter_name' => 'std_num_array_filter',
2831 ); 2831 );
2832 my @in = @{$rh_ans->{student_ans}}; 2832 my @in = @{$rh_ans->{student_ans}};
2833 my $temp_hash = new AnswerHash; 2833 my $temp_hash = new AnswerHash;
2834 my @out=(); 2834 my @out=();
2835 my $PGanswerMessage = ''; 2835 my $PGanswerMessage = '';
2843 #continue processing 2843 #continue processing
2844 $temp_hash = std_num_filter($temp_hash); 2844 $temp_hash = std_num_filter($temp_hash);
2845 if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) { 2845 if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) {
2846 $PGanswerMessage .= $temp_hash->{ans_message}; 2846 $PGanswerMessage .= $temp_hash->{ans_message};
2847 $temp_hash->{ans_message} = undef; 2847 $temp_hash->{ans_message} = undef;
2848 } 2848 }
2849 } 2849 }
2850 push(@out, $temp_hash->input()); 2850 push(@out, $temp_hash->input());
2851 2851
2852 } 2852 }
2853 if ($PGanswerMessage) { 2853 if ($PGanswerMessage) {
2854 $rh_ans->input( "( " . join(", ", @out ) . " )" ); 2854 $rh_ans->input( "( " . join(", ", @out ) . " )" );
2855 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.'); 2855 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
2856 } else { 2856 } else {
2875 ); 2875 );
2876 set_default_options( \%options, 2876 set_default_options( \%options,
2877 'store_in' => 'rf_student_ans', 2877 'store_in' => 'rf_student_ans',
2878 'ra_vars' => [qw( x y )], 2878 'ra_vars' => [qw( x y )],
2879 'debug' => 0, 2879 'debug' => 0,
2880 '_filter_name' => 'function_from_string2', 2880 '_filter_name' => 'function_from_string2',
2881 ); 2881 );
2882 $rh_ans->{_filter_name} = $options{_filter_name}; 2882 $rh_ans->{_filter_name} = $options{_filter_name};
2883 my @VARS = @{ $options{ 'ra_vars'}}; 2883 my @VARS = @{ $options{ 'ra_vars'}};
2884 #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1; 2884 #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
2885 my $originalEqn = $eqn; 2885 my $originalEqn = $eqn;
2890 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g; 2890 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
2891 $eqn =~ s/\b$temp\b/\$VARS[$i]/g; 2891 $eqn =~ s/\b$temp\b/\$VARS[$i]/g;
2892 2892
2893 } 2893 }
2894 #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n", 2894 #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
2895 # pretty_print(\%options) 2895 # pretty_print(\%options)
2896 # if defined($options{debug}) and $options{debug} ==1; 2896 # if defined($options{debug}) and $options{debug} ==1;
2897 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q! 2897 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q!
2898 sub { 2898 sub {
2899 my @VARS = @_; 2899 my @VARS = @_;
2900 my $input_str = ''; 2900 my $input_str = '';
2901 for( my $i=0; $i<@VARS; $i++ ) { 2901 for( my $i=0; $i<@VARS; $i++ ) {
2902 $input_str .= "\$VARS[$i] = $VARS[$i]; "; 2902 $input_str .= "\$VARS[$i] = $VARS[$i]; ";
2903 } 2903 }
2904 my $PGanswerMessage; 2904 my $PGanswerMessage;
2905 $input_str .= '! . $eqn . q!'; # need the single quotes to keep the contents of $eqn from being 2905 $input_str .= '! . $eqn . q!'; # need the single quotes to keep the contents of $eqn from being
2906 # evaluated when it is assigned to $input_str; 2906 # evaluated when it is assigned to $input_str;
2907 my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated 2907 my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated
2908 2908
2909 if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) { 2909 if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) {
2910 $PGanswerMessage = clean_up_error_msg($PG_eval_errors); 2910 $PGanswerMessage = clean_up_error_msg($PG_eval_errors);
2911# This message seemed too verbose, but it does give extra information, we'll see if it is needed. 2911# This message seemed too verbose, but it does give extra information, we'll see if it is needed.
2912# "<br> There was an error in evaluating your function <br> 2912# "<br> There was an error in evaluating your function <br>
2913# !. $originalEqn . q! <br> 2913# !. $originalEqn . q! <br>
2914# at ( " . join(', ', @VARS) . " ) <br> 2914# at ( " . join(', ', @VARS) . " ) <br>
2915# $PG_eval_errors 2915# $PG_eval_errors
2916# "; # this message appears in the answer section which is not process by Latex2HTML so it must 2916# "; # this message appears in the answer section which is not process by Latex2HTML so it must
2917# # be in HTML. That is why $BR is NOT used. 2917# # be in HTML. That is why $BR is NOT used.
2918 2918
2919 } 2919 }
2920 (wantarray) ? ($out, $PGanswerMessage): $out; # PGanswerMessage may be undefined. 2920 (wantarray) ? ($out, $PGanswerMessage): $out; # PGanswerMessage may be undefined.
2921 }; 2921 };
2922 !); 2922 !);
2923 2923
2924 if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) { 2924 if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) {
2925 $PG_eval_errors = clean_up_error_msg($PG_eval_errors); 2925 $PG_eval_errors = clean_up_error_msg($PG_eval_errors);
2926 2926
2927 my $PGanswerMessage = "There was an error in converting the expression 2927 my $PGanswerMessage = "There was an error in converting the expression
2928 $main::BR $originalEqn $main::BR into a function. 2928 $main::BR $originalEqn $main::BR into a function.
2929 $main::BR $PG_eval_errors."; 2929 $main::BR $PG_eval_errors.";
2930 $rh_ans->{rf_student_ans} = $function_sub; 2930 $rh_ans->{rf_student_ans} = $function_sub;
2931 $rh_ans->{ans_message} = $PGanswerMessage; 2931 $rh_ans->{ans_message} = $PGanswerMessage;
2932 $rh_ans->{error_message} = $PGanswerMessage; 2932 $rh_ans->{error_message} = $PGanswerMessage;
2938# } else { 2938# } else {
2939# $rh_ans->{rf_student_ans} = $function_sub; 2939# $rh_ans->{rf_student_ans} = $function_sub;
2940# } 2940# }
2941 $rh_ans ->{$options{store_in}} = $function_sub; 2941 $rh_ans ->{$options{store_in}} = $function_sub;
2942 } 2942 }
2943 2943
2944 $rh_ans; 2944 $rh_ans;
2945} 2945}
2946 2946
2947=head4 is_zero_array 2947=head4 is_zero_array
2948 2948
2949 2949
2952 2952
2953sub is_zero_array { 2953sub is_zero_array {
2954 my $rh_ans = shift; 2954 my $rh_ans = shift;
2955 my %options = @_; 2955 my %options = @_;
2956 set_default_options( \%options, 2956 set_default_options( \%options,
2957 '_filter_name' => 'is_zero_array', 2957 '_filter_name' => 'is_zero_array',
2958 'tolerance' => 0.000001, 2958 'tolerance' => 0.000001,
2959 ); 2959 );
2960 my $array = $rh_ans -> {ra_differences}; 2960 my $array = $rh_ans -> {ra_differences};
2961 my $num = @$array; 2961 my $num = @$array;
2962 my $i; 2962 my $i;
2963 my $max = 0; my $mm; 2963 my $max = 0; my $mm;
2969 } 2969 }
2970 $max = abs($mm) if abs($mm) > $max; 2970 $max = abs($mm) if abs($mm) > $max;
2971 } 2971 }
2972 if (not is_a_number($max)) { 2972 if (not is_a_number($max)) {
2973 $rh_ans->{score} = 0; 2973 $rh_ans->{score} = 0;
2974 my $error = "WeBWorK was unable evaluate your function. Please check that your 2974 my $error = "WeBWorK was unable evaluate your function. Please check that your
2975 expression doesn't take roots of negative numbers, or divide by zero."; 2975 expression doesn't take roots of negative numbers, or divide by zero.";
2976 $rh_ans->throw_error('EVAL',$error); 2976 $rh_ans->throw_error('EVAL',$error);
2977 } else { 2977 } else {
2978 $rh_ans->{score} = ($max < $options{tolerance} ) ? 1: 0; # 1 if the array is close to 0; 2978 $rh_ans->{score} = ($max < $options{tolerance} ) ? 1: 0; # 1 if the array is close to 0;
2979 } 2979 }
2982 2982
2983=head4 best_approx_parameters 2983=head4 best_approx_parameters
2984 2984
2985 best_approx_parameters($rh_ans,%options); #requires the following fields in $rh_ans 2985 best_approx_parameters($rh_ans,%options); #requires the following fields in $rh_ans
2986 {rf_student_ans} # reference to the test answer 2986 {rf_student_ans} # reference to the test answer
2987 {rf_correct_ans} # reference to the comparison answer 2987 {rf_correct_ans} # reference to the comparison answer
2988 {evaluation_points}, # an array of row vectors indicating the points 2988 {evaluation_points}, # an array of row vectors indicating the points
2989 # to evaluate when comparing the functions 2989 # to evaluate when comparing the functions
2990 2990
2991 %options # debug => 1 gives more error answers 2991 %options # debug => 1 gives more error answers
2992 # param_vars => [''] additional parameters used to adapt to function 2992 # param_vars => [''] additional parameters used to adapt to function
2993 ) 2993 )
2994 2994
2995 2995
2996The parameters for the comparison function which best approximates the test_function are stored 2996The parameters for the comparison function which best approximates the test_function are stored
2997in the field {ra_parameters}. 2997in the field {ra_parameters}.
2998 2998
2999 2999
3000The last $dim_of_parms_space variables are assumed to be parameters, and it is also 3000The last $dim_of_parms_space variables are assumed to be parameters, and it is also
3001assumed that the function \&comparison_fun 3001assumed that the function \&comparison_fun
3002depends linearly on these variables. This function finds the values for these parameters which minimizes the 3002depends linearly on these variables. This function finds the values for these parameters which minimizes the
3003Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified 3003Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified
3004by the array reference \@rows_of_test_points. This is assumed to be an array of arrays, with the inner arrays 3004by the array reference \@rows_of_test_points. This is assumed to be an array of arrays, with the inner arrays
3005determining a test point. 3005determining a test point.
3006 3006
3007The comparison function should have $dim_of_params_space more input variables than the test function. 3007The comparison function should have $dim_of_params_space more input variables than the test function.
3008 3008
3009 3009
3010 3010
3011 3011
3012 3012
3013=cut 3013=cut
3014 3014
3015# Used internally: 3015# Used internally:
3016# 3016#
3017# &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function 3017# &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function
3018# $ra_variables # an array of the active input variables to the functions 3018# $ra_variables # an array of the active input variables to the functions
3019# $dim_of_params_space # indicates the number of parameters upon which the 3019# $dim_of_params_space # indicates the number of parameters upon which the
3020# # the comparison function depends linearly. These are assumed to 3020# # the comparison function depends linearly. These are assumed to
3021# # be the last group of inputs to the comparison function. 3021# # be the last group of inputs to the comparison function.
3022# 3022#
3023# %options # $options{debug} gives more error messages 3023# %options # $options{debug} gives more error messages
3024# 3024#
3025# # A typical function might look like 3025# # A typical function might look like
3026# # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter 3026# # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter
3027# # space of dimension 2 and a variable space of dimension 3. 3027# # space of dimension 2 and a variable space of dimension 3.
3028# ) 3028# )
3029# # returns a list of coefficients 3029# # returns a list of coefficients
3030 3030
3031sub best_approx_parameters { 3031sub best_approx_parameters {
3032 my $rh_ans = shift; 3032 my $rh_ans = shift;
3033 my %options = @_; 3033 my %options = @_;
3034 set_default_options(\%options, 3034 set_default_options(\%options,
3035 '_filter_name' => 'best_approx_paramters', 3035 '_filter_name' => 'best_approx_paramters',
3072 $rh_ans ->{ra_parameters} = []; 3072 $rh_ans ->{ra_parameters} = [];
3073 return $rh_ans; 3073 return $rh_ans;
3074 } 3074 }
3075 # inputs are row arrays in this case. 3075 # inputs are row arrays in this case.
3076 my @zero_params=(); 3076 my @zero_params=();
3077 3077
3078 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); } 3078 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); }
3079 my @rows_of_vars = @$ra_vars_matrix; 3079 my @rows_of_vars = @$ra_vars_matrix;
3080 warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug}; 3080 warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug};
3081 my $rows = @rows_of_vars; 3081 my $rows = @rows_of_vars;
3082 my $matrix =new Matrix($rows,$dim_of_param_space); 3082 my $matrix =new Matrix($rows,$dim_of_param_space);
3084 my $row_num = 1; 3084 my $row_num = 1;
3085 my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars); 3085 my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars);
3086 my $number_of_data_points = $dim_of_param_space +2; 3086 my $number_of_data_points = $dim_of_param_space +2;
3087 while (@rows_of_vars and $row_num <= $number_of_data_points) { 3087 while (@rows_of_vars and $row_num <= $number_of_data_points) {
3088 # get one set of data points from the test function; 3088 # get one set of data points from the test function;
3089 @vars = @{ shift(@rows_of_vars) }; 3089 @vars = @{ shift(@rows_of_vars) };
3090 ($val2, $err1) = &{$rf_fun}(@vars); 3090 ($val2, $err1) = &{$rf_fun}(@vars);
3091 $errors .= " $err1 " if defined($err1); 3091 $errors .= " $err1 " if defined($err1);
3092 @inputs = (@vars,@zero_params); 3092 @inputs = (@vars,@zero_params);
3093 ($val1, $err2) = &{$rf_correct_fun}(@inputs); 3093 ($val1, $err2) = &{$rf_correct_fun}(@inputs);
3094 $errors .= " $err2 " if defined($err2); 3094 $errors .= " $err2 " if defined($err2);
3095 3095
3096 unless (defined($err1) or defined($err2) ) { 3096 unless (defined($err1) or defined($err2) ) {
3097 $rhs_vec->assign($row_num,1, $val2-$val1 ); 3097 $rhs_vec->assign($row_num,1, $val2-$val1 );
3098 3098
3099 # warn "rhs data val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug}; 3099 # warn "rhs data val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug};
3100 # warn "vars ", join(" | ", @vars) if $options{debug}; 3100 # warn "vars ", join(" | ", @vars) if $options{debug};
3101 3101
3102 ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options); 3102 ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options);
3103 if (defined($err1) ) { 3103 if (defined($err1) ) {
3104 $errors .= " $err1 "; 3104 $errors .= " $err1 ";
3105 } else { 3105 } else {
3106 my @coeff = @$ra_coeff; 3106 my @coeff = @$ra_coeff;
3110 $col_num++; 3110 $col_num++;
3111 } 3111 }
3112 } 3112 }
3113 } 3113 }
3114 $row_num++; 3114 $row_num++;
3115 last if $errors; # break if there are any errors. 3115 last if $errors; # break if there are any errors.
3116 # This cuts down on the size of error messages. 3116 # This cuts down on the size of error messages.
3117 # However it impossible to check for equivalence at 95% of points 3117 # However it impossible to check for equivalence at 95% of points
3118 # which might be useful for functions that are not defined at some points. 3118 # which might be useful for functions that are not defined at some points.
3119 } 3119 }
3120 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug}; 3120 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug};
3121 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug}; 3121 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug};
3122 3122
3123 # we have Matrix * parameter = data_vec + perpendicular vector 3123 # we have Matrix * parameter = data_vec + perpendicular vector
3124 # where the matrix has column vectors defining the span of the parameter space 3124 # where the matrix has column vectors defining the span of the parameter space
3125 # multiply both sides by Matrix_transpose and solve for the parameters 3125 # multiply both sides by Matrix_transpose and solve for the parameters
3126 # This is exactly what the method proj_coeff method does. 3126 # This is exactly what the method proj_coeff method does.
3127 my @array; 3127 my @array;
3138 $max = "NaN: $val"; 3138 $max = "NaN: $val";
3139 last; 3139 last;
3140 } 3140 }
3141 } 3141 }
3142 if ($max =~/NaN/) { 3142 if ($max =~/NaN/) {
3143 $errors .= "WeBWorK was unable evaluate your function. Please check that your 3143 $errors .= "WeBWorK was unable evaluate your function. Please check that your
3144 expression doesn't take roots of negative numbers, or divide by zero."; 3144 expression doesn't take roots of negative numbers, or divide by zero.";
3145 } elsif ($max > $options{maxConstantOfIntegration} ) { 3145 } elsif ($max > $options{maxConstantOfIntegration} ) {
3146 $errors .= "At least one of the adapting parameters 3146 $errors .= "At least one of the adapting parameters
3147 (perhaps the constant of integration) is too large: $max, 3147 (perhaps the constant of integration) is too large: $max,
3148 ( the maximum allowed is $options{maxConstantOfIntegration} )"; 3148 ( the maximum allowed is $options{maxConstantOfIntegration} )";
3149 } 3149 }
3150 3150
3151 $rh_ans->{ra_parameters} = \@array; 3151 $rh_ans->{ra_parameters} = \@array;
3152 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 3152 $rh_ans->throw_error('EVAL', $errors) if defined($errors);
3153 $rh_ans; 3153 $rh_ans;
3154} 3154}
3155 3155
3156=head4 calculate_difference_vector 3156=head4 calculate_difference_vector
3157 3157
3158 calculate_difference_vector( $ans_hash, %options); 3158 calculate_difference_vector( $ans_hash, %options);
3159 3159
3160 {rf_student_ans}, # a reference to the test function 3160 {rf_student_ans}, # a reference to the test function
3161 {rf_correct_ans}, # a reference to the correct answer function 3161 {rf_correct_ans}, # a reference to the correct answer function
3162 {evaluation_points}, # an array of row vectors indicating the points 3162 {evaluation_points}, # an array of row vectors indicating the points
3163 # to evaluate when comparing the functions 3163 # to evaluate when comparing the functions
3164 {ra_parameters} # these are the (optional) additional inputs to 3164 {ra_parameters} # these are the (optional) additional inputs to
3165 # the comparison function which adapt it properly 3165 # the comparison function which adapt it properly
3166 # to the problem at hand. 3166 # to the problem at hand.
3167 3167
3168 %options # mode => 'rel' specifies that each element in the 3168 %options # mode => 'rel' specifies that each element in the
3169 # difference matrix is divided by the correct answer. 3169 # difference matrix is divided by the correct answer.
3170 # unless the correct answer is nearly 0. 3170 # unless the correct answer is nearly 0.
3171 ) 3171 )
3172 3172
3173=cut 3173=cut
3174 3174
3175sub calculate_difference_vector { 3175sub calculate_difference_vector {
3176 my $rh_ans = shift; 3176 my $rh_ans = shift;
3206 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3); 3206 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
3207 $errors .= " Error detected evaluating instructor answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3); 3207 $errors .= " Error detected evaluating instructor answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3);
3208 unless (defined($err1) or defined($err2) or defined($err3) ) { 3208 unless (defined($err1) or defined($err2) or defined($err3) ) {
3209 $diff = ( $inVal - ($correctVal -$instructorVal ) ) - $instructorVal; #prevents entering too high a number? 3209 $diff = ( $inVal - ($correctVal -$instructorVal ) ) - $instructorVal; #prevents entering too high a number?
3210 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 3210 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
3211 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 3211 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance
3212 #warn "diff = $diff"; 3212 #warn "diff = $diff";
3213 #$diff = ( $inVal - ($correctVal-$instructorVal ) )/abs($instructorVal) -1 if abs($instructorVal) > $options{zeroLevel}; 3213 #$diff = ( $inVal - ($correctVal-$instructorVal ) )/abs($instructorVal) -1 if abs($instructorVal) > $options{zeroLevel};
3214 $diff = ( $inVal - ($correctVal-$instructorVal ) )/$instructorVal -1 if abs($instructorVal) > $options{zeroLevel}; 3214 $diff = ( $inVal - ($correctVal-$instructorVal ) )/$instructorVal -1 if abs($instructorVal) > $options{zeroLevel};
3215 #$diff = ( $inVal - ($correctVal-$instructorVal- $instructorVal ) )/abs($instructorVal) if abs($instructorVal) > $options{zeroLevel}; 3215 #$diff = ( $inVal - ($correctVal-$instructorVal- $instructorVal ) )/abs($instructorVal) if abs($instructorVal) > $options{zeroLevel};
3216 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal"; 3216 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
3217 } 3217 }
3218 } 3218 }
3219 last if $errors; # break if there are any errors. 3219 last if $errors; # break if there are any errors.
3220 # This cuts down on the size of error messages. 3220 # This cuts down on the size of error messages.
3221 # However it impossible to check for equivalence at 95% of points 3221 # However it impossible to check for equivalence at 95% of points
3222 # which might be useful for functions that are not defined at some points. 3222 # which might be useful for functions that are not defined at some points.
3223 push(@student_values,$inVal); 3223 push(@student_values,$inVal);
3224 push(@adjusted_student_values,( $inVal - ($correctVal -$instructorVal) ) ); 3224 push(@adjusted_student_values,( $inVal - ($correctVal -$instructorVal) ) );
3225 push(@differences, $diff); 3225 push(@differences, $diff);
3226 push(@instructorVals,$instructorVal); 3226 push(@instructorVals,$instructorVal);
3227 } 3227 }
3228 $rh_ans ->{ra_differences} = \@differences; 3228 $rh_ans ->{ra_differences} = \@differences;
3229 $rh_ans ->{ra_student_values} = \@student_values; 3229 $rh_ans ->{ra_student_values} = \@student_values;
3230 $rh_ans ->{ra_adjusted_student_values} = \@adjusted_student_values; 3230 $rh_ans ->{ra_adjusted_student_values} = \@adjusted_student_values;
3231 $rh_ans->{ra_instructor_values}=\@instructorVals; 3231 $rh_ans->{ra_instructor_values}=\@instructorVals;
3244 } 3244 }
3245 if (defined ($rh_ans->{student_units})) { 3245 if (defined ($rh_ans->{student_units})) {
3246 $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units}; 3246 $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units};
3247 } 3247 }
3248 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans}; 3248 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
3249 3249
3250 $rh_ans; 3250 $rh_ans;
3251} 3251}
3252 3252
3253=head4 evaluatesToNumber 3253=head4 evaluatesToNumber
3254 3254
3294 my ($rh_ans); 3294 my ($rh_ans);
3295 if ($process_ans_hash) { 3295 if ($process_ans_hash) {
3296 $rh_ans = $num; 3296 $rh_ans = $num;
3297 $num = $rh_ans->{student_ans}; 3297 $num = $rh_ans->{student_ans};
3298 } 3298 }
3299 3299
3300 my $is_a_number = 0; 3300 my $is_a_number = 0;
3301 return $is_a_number unless defined($num); 3301 return $is_a_number unless defined($num);
3302 $num =~ s/^\s*//; ## remove initial spaces 3302 $num =~ s/^\s*//; ## remove initial spaces
3303 $num =~ s/\s*$//; ## remove trailing spaces 3303 $num =~ s/\s*$//; ## remove trailing spaces
3304 3304
3305 ## the following is copied from the online perl manual 3305 ## the following is copied from the online perl manual
3306 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ 3306 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
3307 $is_a_number = 1; 3307 $is_a_number = 1;
3308 } 3308 }
3309 3309
3310 if ($process_ans_hash) { 3310 if ($process_ans_hash) {
3311 if ($is_a_number == 1 ) { 3311 if ($is_a_number == 1 ) {
3312 $rh_ans->{student_ans}=$num; 3312 $rh_ans->{student_ans}=$num;
3313 return $rh_ans; 3313 return $rh_ans;
3314 } else { 3314 } else {
3331 my ($rh_ans); 3331 my ($rh_ans);
3332 if ($process_ans_hash) { 3332 if ($process_ans_hash) {
3333 $rh_ans = $num; 3333 $rh_ans = $num;
3334 $num = $rh_ans->{student_ans}; 3334 $num = $rh_ans->{student_ans};
3335 } 3335 }
3336 3336
3337 my $is_a_fraction = 0; 3337 my $is_a_fraction = 0;
3338 return $is_a_fraction unless defined($num); 3338 return $is_a_fraction unless defined($num);
3339 $num =~ s/^\s*//; ## remove initial spaces 3339 $num =~ s/^\s*//; ## remove initial spaces
3340 $num =~ s/\s*$//; ## remove trailing spaces 3340 $num =~ s/\s*$//; ## remove trailing spaces
3341 3341
3342 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) { 3342 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
3343 $is_a_fraction = 1; 3343 $is_a_fraction = 1;
3344 } 3344 }
3345 3345
3346 if ($process_ans_hash) { 3346 if ($process_ans_hash) {
3347 if ($is_a_fraction == 1 ) { 3347 if ($is_a_fraction == 1 ) {
3348 $rh_ans->{student_ans}=$num; 3348 $rh_ans->{student_ans}=$num;
3349 return $rh_ans; 3349 return $rh_ans;
3350 } else { 3350 } else {
3351 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13"; 3351 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
3352 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3'); 3352 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3353 return $rh_ans; 3353 return $rh_ans;
3354 } 3354 }
3355 3355
3356 } else { 3356 } else {
3357 return $is_a_fraction; 3357 return $is_a_fraction;
3358 } 3358 }
3359} 3359}
3360 3360
3390 my ($rh_ans); 3390 my ($rh_ans);
3391 if ($process_ans_hash) { 3391 if ($process_ans_hash) {
3392 $rh_ans = $num; 3392 $rh_ans = $num;
3393 $num = $rh_ans->{student_ans}; 3393 $num = $rh_ans->{student_ans};
3394 } 3394 }
3395 3395
3396 my $is_an_arithmetic_expression = 0; 3396 my $is_an_arithmetic_expression = 0;
3397 return $is_an_arithmetic_expression unless defined($num); 3397 return $is_an_arithmetic_expression unless defined($num);
3398 $num =~ s/^\s*//; ## remove initial spaces 3398 $num =~ s/^\s*//; ## remove initial spaces
3399 $num =~ s/\s*$//; ## remove trailing spaces 3399 $num =~ s/\s*$//; ## remove trailing spaces
3400 3400
3401 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) { 3401 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
3402 $is_an_arithmetic_expression = 1; 3402 $is_an_arithmetic_expression = 1;
3403 } 3403 }
3404 3404
3405 if ($process_ans_hash) { 3405 if ($process_ans_hash) {
3406 if ($is_an_arithmetic_expression == 1 ) { 3406 if ($is_an_arithmetic_expression == 1 ) {
3407 $rh_ans->{student_ans}=$num; 3407 $rh_ans->{student_ans}=$num;
3408 return $rh_ans; 3408 return $rh_ans;
3409 } else { 3409 } else {
3410 3410
3411 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2"; 3411 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
3412 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2'); 3412 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
3413 return $rh_ans; 3413 return $rh_ans;
3414 } 3414 }
3415 3415
3416 } else { 3416 } else {
3417 return $is_an_arithmetic_expression; 3417 return $is_an_arithmetic_expression;
3418 } 3418 }
3419} 3419}
3420 3420
3432 my $rh_ans; 3432 my $rh_ans;
3433 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ; 3433 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
3434 if ($process_ans_hash) { 3434 if ($process_ans_hash) {
3435 $rh_ans = $in; 3435 $rh_ans = $in;
3436 $in = $rh_ans->{student_ans}; 3436 $in = $rh_ans->{student_ans};
3437 } 3437 }
3438 # The code fragment above allows this filter to be used when the input is simply a string 3438 # The code fragment above allows this filter to be used when the input is simply a string
3439 # as well as when the input is an AnswerHash, and options. 3439 # as well as when the input is an AnswerHash, and options.
3440 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 3440 $in =~s/\bpi\b/(4*atan2(1,1))/ge;
3441 $in =~s/\be\b/(exp(1))/ge; 3441 $in =~s/\be\b/(exp(1))/ge;
3442 $in =~s/\^/**/g; 3442 $in =~s/\^/**/g;
3443 if($main::useBaseTenLog) { 3443 if($main::useBaseTenLog) {
3444 $in =~ s/\blog\b/logten/g; 3444 $in =~ s/\blog\b/logten/g;
3445 } 3445 }
3446 3446
3447 if ($process_ans_hash) { 3447 if ($process_ans_hash) {
3448 $rh_ans->{student_ans}=$in; 3448 $rh_ans->{student_ans}=$in;
3449 return $rh_ans; 3449 return $rh_ans;
3450 } else { 3450 } else {
3451 return $in; 3451 return $in;
3470} 3470}
3471 3471
3472=head4 check_syntax 3472=head4 check_syntax
3473 3473
3474 check_syntax( $rh_ans, %options) 3474 check_syntax( $rh_ans, %options)
3475 returns an answer hash. 3475 returns an answer hash.
3476 3476
3477latex2html preview code are installed in the answer hash. 3477latex2html preview code are installed in the answer hash.
3478The input has been transformed, changing 7pi to 7*pi or 7x to 7*x. 3478The input has been transformed, changing 7pi to 7*pi or 7x to 7*x.
3479Syntax error messages may be generated and stored in student_ans 3479Syntax error messages may be generated and stored in student_ans
3480Additional syntax error messages are stored in {ans_message} and duplicated in {error_message} 3480Additional syntax error messages are stored in {ans_message} and duplicated in {error_message}
3491 return $rh_ans; 3491 return $rh_ans;
3492 } 3492 }
3493 my $in = $rh_ans->{student_ans}; 3493 my $in = $rh_ans->{student_ans};
3494 my $parser = new AlgParserWithImplicitExpand; 3494 my $parser = new AlgParserWithImplicitExpand;
3495 my $ret = $parser -> parse($in); #for use with loops 3495 my $ret = $parser -> parse($in); #for use with loops
3496 3496
3497 if ( ref($ret) ) { ## parsed successfully 3497 if ( ref($ret) ) { ## parsed successfully
3498 $parser -> tostring(); 3498 $parser -> tostring();
3499 $parser -> normalize(); 3499 $parser -> normalize();
3500 $rh_ans->input( $parser -> tostring() ); 3500 $rh_ans->input( $parser -> tostring() );
3501 $rh_ans->{preview_text_string} = $in; 3501 $rh_ans->{preview_text_string} = $in;
3502 $rh_ans->{preview_latex_string} = $parser -> tolatex(); 3502 $rh_ans->{preview_latex_string} = $parser -> tolatex();
3503 3503
3504 } else { ## error in parsing 3504 } else { ## error in parsing
3505 3505
3506 $rh_ans->{'student_ans'} = 'syntax error:'. $parser->{htmlerror}, 3506 $rh_ans->{'student_ans'} = 'syntax error:'. $parser->{htmlerror},
3507 $rh_ans->{'ans_message'} = $parser -> {error_msg}, 3507 $rh_ans->{'ans_message'} = $parser -> {error_msg},
3508 $rh_ans->{'preview_text_string'} = '', 3508 $rh_ans->{'preview_text_string'} = '',
3509 $rh_ans->{'preview_latex_string'} = '', 3509 $rh_ans->{'preview_latex_string'} = '',
3510 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg}); 3510 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg});
3511 } 3511 }
3512$rh_ans; 3512$rh_ans;
3513 3513
3514} 3514}
3515 3515
3520 3520
3521=cut 3521=cut
3522 3522
3523sub check_strings { 3523sub check_strings {
3524 my ($rh_ans, %options) = @_; 3524 my ($rh_ans, %options) = @_;
3525 3525
3526 # if the student's answer is a number, simply return the answer hash (unchanged). 3526 # if the student's answer is a number, simply return the answer hash (unchanged).
3527 3527
3528 # we allow constructions like -INF to be treated as a string. Thus we ignore an initial 3528 # we allow constructions like -INF to be treated as a string. Thus we ignore an initial
3529 # - in deciding whether the student's answer is a number or string 3529 # - in deciding whether the student's answer is a number or string
3530 3530
3531 my $temp_ans = $rh_ans->{student_ans}; 3531 my $temp_ans = $rh_ans->{student_ans};
3532 $temp_ans =~ s/^\s*\-//; # remove an initial - 3532 $temp_ans =~ s/^\s*\-//; # remove an initial -
3533 3533
3534 if ( $temp_ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) { 3534 if ( $temp_ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
3535 # if ( $rh_ans->{answerIsString} == 1) { 3535 # if ( $rh_ans->{answerIsString} == 1) {
3536 # #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number 3536 # #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
3537 # } 3537 # }
3538 return $rh_ans; 3538 return $rh_ans;
3539 } 3539 }
3540 # the student's answer is recognized as a string 3540 # the student's answer is recognized as a string
3541 my $ans = $rh_ans->{student_ans}; 3541 my $ans = $rh_ans->{student_ans};
3542 3542
3543# OVERVIEW of reminder of function: 3543# OVERVIEW of reminder of function:
3544# if answer is correct, return correct. (adjust score to 1) 3544# if answer is correct, return correct. (adjust score to 1)
3545# if answer is incorect: 3545# if answer is incorect:
3546# 1) determine if the answer is sensible. if it is, return incorrect. 3546# 1) determine if the answer is sensible. if it is, return incorrect.
3547# 2) if the answer is not sensible (and incorrect), then return an error message indicating so. 3547# 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
3548# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators) 3548# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
3549# last: 'STRING' post_filter will clear the error (avoiding pink screen.) 3549# last: 'STRING' post_filter will clear the error (avoiding pink screen.)
3550 3550
3551 my $sensibleAnswer = 0; 3551 my $sensibleAnswer = 0;
3552 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces. 3552 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
3553 my ($ans_eval) = str_cmp($rh_ans->{correct_ans}); 3553 my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
3554 my $temp_ans_hash = &$ans_eval($ans); 3554 my $temp_ans_hash = &$ans_eval($ans);
3555 $rh_ans->{test} = $temp_ans_hash; 3555 $rh_ans->{test} = $temp_ans_hash;
3556 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer. 3556 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
3557 $rh_ans->{score} = 1; 3557 $rh_ans->{score} = 1;
3558 $sensibleAnswer = 1; 3558 $sensibleAnswer = 1;
3559 } else { # students answer does not match the correct answer. 3559 } else { # students answer does not match the correct answer.
3560 my $legalString = ''; # find out if string makes sense 3560 my $legalString = ''; # find out if string makes sense
3561 my @legalStrings = @{$options{strings}}; 3561 my @legalStrings = @{$options{strings}};
3562 foreach $legalString (@legalStrings) { 3562 foreach $legalString (@legalStrings) {
3592 my $ans = $rh_ans->{student_ans}; 3592 my $ans = $rh_ans->{student_ans};
3593 # $ans = '' unless defined ($ans); 3593 # $ans = '' unless defined ($ans);
3594 $ans = str_filters ($ans, 'trim_whitespace'); 3594 $ans = str_filters ($ans, 'trim_whitespace');
3595 my $original_student_ans = $ans; 3595 my $original_student_ans = $ans;
3596 $rh_ans->{original_student_ans} = $original_student_ans; 3596 $rh_ans->{original_student_ans} = $original_student_ans;
3597 3597
3598 # it surprises me that the match below works since the first .* is greedy. 3598 # it surprises me that the match below works since the first .* is greedy.
3599 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/; 3599 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
3600 3600
3601 unless ( defined($num_answer) && $units ) { 3601 unless ( defined($num_answer) && $units ) {
3602 # there is an error reading the input 3602 # there is an error reading the input
3603 if ( $ans =~ /\S/ ) { # the answer is not blank 3603 if ( $ans =~ /\S/ ) { # the answer is not blank
3604 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " . 3604 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
3605 "as a number or an arithmetic expression followed by a unit specification. " . 3605 "as a number or an arithmetic expression followed by a unit specification. " .
3629 my $fund_unit; 3629 my $fund_unit;
3630 foreach $fund_unit (keys %correct_units) { 3630 foreach $fund_unit (keys %correct_units) {
3631 next if $fund_unit eq 'factor'; 3631 next if $fund_unit eq 'factor';
3632 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit}; 3632 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
3633 } 3633 }
3634 3634
3635 if ( $units_match ) { 3635 if ( $units_match ) {
3636 # units are ok. Evaluate the numerical part of the answer 3636 # units are ok. Evaluate the numerical part of the answer
3637 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if 3637 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
3638 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor. 3638 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
3639 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'}); 3639 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
3642 3642
3643 } else { 3643 } else {
3644 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' ); 3644 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
3645 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' ); 3645 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
3646 } 3646 }
3647 3647
3648 return $rh_ans; 3648 return $rh_ans;
3649} 3649}
3650 3650
3651 3651
3652 3652
3680 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 3680 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
3681 my @option_aliases = @_; 3681 my @option_aliases = @_;
3682 while (@option_aliases) { 3682 while (@option_aliases) {
3683 my $alias = shift @option_aliases; 3683 my $alias = shift @option_aliases;
3684 my $option_key = shift @option_aliases; 3684 my $option_key = shift @option_aliases;
3685 3685
3686 if (defined($rh_options->{$alias} )) { # if the alias appears in the option list 3686 if (defined($rh_options->{$alias} )) { # if the alias appears in the option list
3687 if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined, 3687 if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined,
3688 $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value 3688 $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value
3689 # the FIRST alias for a given option takes precedence 3689 # the FIRST alias for a given option takes precedence
3690 # (after the option itself) 3690 # (after the option itself)
3691 } else { 3691 } else {
3692 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n", 3692 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
3693 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias}, 3693 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
3694 " was ignored."; 3694 " was ignored.";
3695 } 3695 }
3696 } 3696 }
3697 delete($rh_options->{$alias}); # remove the alias from the initial list 3697 delete($rh_options->{$alias}); # remove the alias from the initial list
3698 } 3698 }
3699 3699
3700} 3700}
3701 3701
3702=head4 set_default_options 3702=head4 set_default_options
3714 3714
3715The B<'_filter_name'> option should always be set, although there is no error if it is missing. 3715The B<'_filter_name'> option should always be set, although there is no error if it is missing.
3716It is used mainly for debugging answer evaluators and allows 3716It is used mainly for debugging answer evaluators and allows
3717you to keep track of which filter is currently processing the answer. 3717you to keep track of which filter is currently processing the answer.
3718 3718
3719If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the 3719If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
3720set_default_options list an error will be signaled and a warning message will be printed out. This provides 3720set_default_options list an error will be signaled and a warning message will be printed out. This provides
3721error checking against misspelling an option and is generally what is desired for most filters. 3721error checking against misspelling an option and is generally what is desired for most filters.
3722 3722
3723Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance, 3723Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
3724but only uses a subset of the options 3724but only uses a subset of the options
3725provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled. 3725provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
3726 3726
3727=cut 3727=cut
3728 3728
3729sub set_default_options { 3729sub set_default_options {
3730 my $rh_options = shift; 3730 my $rh_options = shift;
3761 3761
3762This is an all-or-nothing grader. A student must get all parts of the problem write 3762This is an all-or-nothing grader. A student must get all parts of the problem write
3763before receiving credit. You should make sure to use this grader on multiple choice 3763before receiving credit. You should make sure to use this grader on multiple choice
3764and true-false questions, otherwise students will be able to deduce how many 3764and true-false questions, otherwise students will be able to deduce how many
3765answers are correct by the grade reported by webwork. 3765answers are correct by the grade reported by webwork.
3766 3766
3767 3767
3768 install_problem_grader(~~&std_problem_grader); 3768 install_problem_grader(~~&std_problem_grader);
3769 3769
3770=cut 3770=cut
3771 3771
3772sub std_problem_grader { 3772sub std_problem_grader {
3793 msg => '', 3793 msg => '',
3794 ); 3794 );
3795 # Checks 3795 # Checks
3796 3796
3797 my $ansCount = keys %evaluated_answers; # get the number of answers 3797 my $ansCount = keys %evaluated_answers; # get the number of answers
3798 3798
3799 unless ($ansCount > 0 ) { 3799 unless ($ansCount > 0 ) {
3800 3800
3801 $problem_result{msg} = "This problem did not ask any questions."; 3801 $problem_result{msg} = "This problem did not ask any questions.";
3802 return(\%problem_result,\%problem_state); 3802 return(\%problem_result,\%problem_state);
3803 } 3803 }
3804 3804
3805 if ($ansCount > 1 ) { 3805 if ($ansCount > 1 ) {
3850 3850
3851This is an all-or-nothing grader. A student must get all parts of the problem write 3851This is an all-or-nothing grader. A student must get all parts of the problem write
3852before receiving credit. You should make sure to use this grader on multiple choice 3852before receiving credit. You should make sure to use this grader on multiple choice
3853and true-false questions, otherwise students will be able to deduce how many 3853and true-false questions, otherwise students will be able to deduce how many
3854answers are correct by the grade reported by webwork. 3854answers are correct by the grade reported by webwork.
3855 3855
3856 3856
3857 install_problem_grader(~~&std_problem_grader2); 3857 install_problem_grader(~~&std_problem_grader2);
3858 3858
3859The only difference between the two versions 3859The only difference between the two versions
3860is at the end of the subroutine, where std_problem_grader2 3860is at the end of the subroutine, where std_problem_grader2
3861records the attempt only if there have been no syntax errors, 3861records the attempt only if there have been no syntax errors,
3862whereas std_problem_grader records it regardless. 3862whereas std_problem_grader records it regardless.
3863 3863
3949 (\%problem_result, \%problem_state); 3949 (\%problem_result, \%problem_state);
3950} 3950}
3951 3951
3952=head4 avg_problem_grader 3952=head4 avg_problem_grader
3953 3953
3954This grader gives a grade depending on how many questions from the problem are correct. (The highest 3954This grader gives a grade depending on how many questions from the problem are correct. (The highest
3955grade is the one that is kept. One can never lower the recorded grade on a problem by repeating it.) 3955grade is the one that is kept. One can never lower the recorded grade on a problem by repeating it.)
3956Many professors (and almost all students :-) ) prefer this grader. 3956Many professors (and almost all students :-) ) prefer this grader.
3957 3957
3958 3958
3959 install_problem_grader(~~&avg_problem_grader); 3959 install_problem_grader(~~&avg_problem_grader);
3960 3960
3961=cut 3961=cut
3962 3962
3963 3963
3964sub avg_problem_grader { 3964sub avg_problem_grader {
3965 my $rh_evaluated_answers = shift; 3965 my $rh_evaluated_answers = shift;
3966 my $rh_problem_state = shift; 3966 my $rh_problem_state = shift;
3967 my %form_options = @_; 3967 my %form_options = @_;
3968 my %evaluated_answers = %{$rh_evaluated_answers}; 3968 my %evaluated_answers = %{$rh_evaluated_answers};
3969 # The hash $rh_evaluated_answers typically contains: 3969 # The hash $rh_evaluated_answers typically contains:
4022=head2 Utility subroutines 4022=head2 Utility subroutines
4023 4023
4024=head4 4024=head4
4025 4025
4026 warn pretty_print( $rh_hash_input) 4026 warn pretty_print( $rh_hash_input)
4027 4027
4028This can be very useful for printing out messages about objects while debugging 4028This can be very useful for printing out messages about objects while debugging
4029 4029
4030=cut 4030=cut
4031 4031
4032sub pretty_print { 4032sub pretty_print {
4045 my @array = @$r_input; 4045 my @array = @$r_input;
4046 $out .= "( " ; 4046 $out .= "( " ;
4047 while (@array) { 4047 while (@array) {
4048 $out .= pretty_print(shift @array) . " , "; 4048 $out .= pretty_print(shift @array) . " , ";
4049 } 4049 }
4050 $out .= " )"; 4050 $out .= " )";
4051 } elsif (ref($r_input) eq 'CODE') { 4051 } elsif (ref($r_input) eq 'CODE') {
4052 $out = "$r_input"; 4052 $out = "$r_input";
4053 } else { 4053 } else {
4054 $out = $r_input; 4054 $out = $r_input;
4055 } 4055 }

Legend:
Removed from v.1071  
changed lines
  Added in v.1080

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9