[system] / trunk / webwork / system / courseScripts / PGanswermacros.pl Repository:
ViewVC logotype

Diff of /trunk/webwork/system/courseScripts/PGanswermacros.pl

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

Revision 5 Revision 35
1#!/usr/local/bin/perl -w 1#!/usr/local/bin/webwork-perl
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####################################################################
7# Copyright @ 1995-2000 University of Rochester 7# Copyright @ 1995-2000 University of Rochester
8# All Rights Reserved 8# All Rights Reserved
9#################################################################### 9####################################################################
10#$Id$
10 11
11=head1 NAME 12=head1 NAME
12 13
13 PGanswermacros.pl -- located in the courseScripts directory 14 PGanswermacros.pl -- located in the courseScripts directory
14 15
… …
106=cut 107=cut
107 108
108BEGIN { 109BEGIN {
109 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. 110 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
110} 111}
111my ($BR , # convenient localizations. 112
112 $PAR , 113
113 $numRelPercentTolDefault , 114
114 $numZeroLevelDefault , 115sub _PGanswermacros_export {
115 $numZeroLevelTolDefault , 116 my @EXPORT = (
116 $numAbsTolDefault , 117 '&std_num_cmp', '&std_num_cmp_list', '&std_num_cmp_abs',
117 $numFormatDefault , 118 '&std_num_cmp_abs_list', '&frac_num_cmp', '&frac_num_cmp_list',
118 $functRelPercentTolDefault , 119 '&frac_num_cmp_abs', '&frac_num_cmp_abs_list', '&arith_num_cmp',
119 $functZeroLevelDefault , 120 '&arith_num_cmp_list', '&arith_num_cmp_abs', '&arith_num_cmp_abs_list',
120 $functZeroLevelTolDefault , 121 '&strict_num_cmp', '&strict_num_cmp_list', '&strict_num_cmp_abs',
121 $functAbsTolDefault , 122 '&strict_num_cmp_abs_list', '&numerical_compare_with_units',
122 $functNumOfPoints , 123 '&std_num_str_cmp', '&num_cmp', '&num_rel_cmp', '&NUM_CMP',
123 $functVarDefault , 124 '&NUM_CMP_LIST', '&adaptive_function_cmp', '&function_cmp',
124 $functLLimitDefault , 125 '&function_cmp_up_to_constant', '&function_cmp_abs',
125 $functULimitDefault , 126 '&function_cmp_up_to_constant_abs', '&multivar_function_cmp',
126 $functMaxConstantOfIntegration 127 '&fun_cmp', '&FUNCTION_CMP', '&is_array', '&check_syntax',
128 '&std_num_filter', '&std_num_array_filter', '&function_from_string2',
129 '&is_zero_array', '&best_approx_parameters',
130 '&calculate_difference_vector', '&str_filters', '&remove_whitespace',
131 '&compress_whitespace', '&trim_whitespace', '&ignore_case',
132 '&ignore_order', '&std_str_cmp', '&std_str_cmp_list', '&std_cs_str_cmp',
133 '&std_cs_str_cmp_list', '&strict_str_cmp', '&strict_str_cmp_list',
134 '&unordered_str_cmp', '&unordered_str_cmp_list',
135 '&unordered_cs_str_cmp', '&unordered_cs_str_cmp_list',
136 '&ordered_str_cmp', '&ordered_str_cmp_list', '&ordered_cs_str_cmp',
137 '&ordered_cs_str_cmp_list', '&str_cmp', '&STR_CMP', '&checkbox_cmp',
138 '&radio_cmp', '&store_ans_at', '&DUMMY_ANSWER', '&escapeHTML',
139 '&anstext', '&ansradio', '&mail_answers_to', '&mail_answers_to2',
140 '&install_problem_grader', '&std_problem_grader',
141 '&std_problem_grader2', '&avg_problem_grader', '&get_var_array',
142 '&get_limits_array', '&check_option_list', '&function_invalid_params',
143 '&is_a_number', '&is_a_fraction', '&is_an_arithmetic_expression',
144 '&math_constants', '&clean_up_error_msg', '&prfmt', '&pretty_print',
145 '&set_default_options', '&assign_option_aliases',
127); 146 );
147 @EXPORT;
148}
128 149
150my ($BR, $PAR,$numRelPercentTolDefault,$numZeroLevelDefault,$numZeroLevelTolDefault,
151 $numAbsTolDefault,$numFormatDefault,$functRelPercentTolDefault,$functZeroLevelDefault,
152 $functZeroLevelTolDefault,$functAbsTolDefault,$functNumOfPoints,$functVarDefault,
153 $functLLimitDefault, $functULimitDefault, $functMaxConstantOfIntegration,
154 );
155
129sub _PGanswermacros_init { 156sub _PGanswermacros_init {
130 157
131 $BR = $main::BR; # convenient localizations. 158 $BR = $main::BR; # convenient localizations.
132 $PAR = $main::PAR; 159 $PAR = $main::PAR;
133 160
134 # import defaults 161 # import defaults
135 # these are now imported from the %envir variable 162 # these are now imported from the %envir variable
136 $numRelPercentTolDefault = $main::numRelPercentTolDefault; 163 $numRelPercentTolDefault = PG_restricted_eval(q{$main::numRelPercentTolDefault});
137 $numZeroLevelDefault = $main::numZeroLevelDefault; 164 $numZeroLevelDefault = PG_restricted_eval(q{$main::numZeroLevelDefault});
138 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault; 165 $numZeroLevelTolDefault = PG_restricted_eval(q{$main::numZeroLevelTolDefault});
139 $numAbsTolDefault = $main::numAbsTolDefault; 166 $numAbsTolDefault = PG_restricted_eval(q{$main::numAbsTolDefault});
140 $numFormatDefault = $main::numFormatDefault; 167 $numFormatDefault = PG_restricted_eval(q{$main::numFormatDefault});
141 168
142 $functRelPercentTolDefault = $main::functRelPercentTolDefault; 169 $functRelPercentTolDefault = PG_restricted_eval(q{$main::functRelPercentTolDefault});
143 $functZeroLevelDefault = $main::functZeroLevelDefault; 170 $functZeroLevelDefault = PG_restricted_eval(q{$main::functZeroLevelDefault});
144 $functZeroLevelTolDefault = $main::functZeroLevelTolDefault; 171 $functZeroLevelTolDefault = PG_restricted_eval(q{$main::functZeroLevelTolDefault});
145 $functAbsTolDefault = $main::functAbsTolDefault; 172 $functAbsTolDefault = PG_restricted_eval(q{$main::functAbsTolDefault});
146 $functNumOfPoints = $main::functNumOfPoints; 173 $functNumOfPoints = PG_restricted_eval(q{$main::functNumOfPoints});
147 $functVarDefault = $main::functVarDefault; 174 $functVarDefault = PG_restricted_eval(q{$main::functVarDefault});
148 $functLLimitDefault = $main::functLLimitDefault; 175 $functLLimitDefault = PG_restricted_eval(q{$main::functLLimitDefault});
149 $functULimitDefault = $main::functULimitDefault; 176 $functULimitDefault = PG_restricted_eval(q{$main::functULimitDefault});
150 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration; 177 $functMaxConstantOfIntegration = PG_restricted_eval(q{$main::functMaxConstantOfIntegration});
151 178
179
180
152} 181}
153_PGanswermacros_init();
154 182
155########################################################################## 183##########################################################################
156########################################################################## 184##########################################################################
157## Number answer evaluators 185## Number answer evaluators
158 186
… …
349 The student answer can contain elementary functions, e.g. sin(.3+pi/2) 377 The student answer can contain elementary functions, e.g. sin(.3+pi/2)
350 378
351=cut 379=cut
352 380
353sub std_num_cmp { # compare numbers allowing use of elementary functions 381sub std_num_cmp { # compare numbers allowing use of elementary functions
354 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 382 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
355 383
356 NUM_CMP( 'correctAnswer' => $correctAnswer, 384 my %options = ( 'tolerance' => $relPercentTol,
357 'tolerance' => $relPercentTol,
358 'tolType' => 'relative',
359 'format' => $format, 385 'format' => $format,
386 'zeroLevel' => $zeroLevel,
387 'zeroLevelTol' => $zeroLevelTol
388 );
389
390 set_default_options( \%options,
391 'tolType' => 'relative',
392 'tolerance' => $numRelPercentTolDefault,
360 'mode' => 'std', 393 'mode' => 'std',
361 'zeroLevel' => $zeroLevel, 394 'format' => $numFormatDefault,
362 'zeroLevelTol' => $zeroLevelTol 395 'relTol' => $numRelPercentTolDefault,
396 'zeroLevel' => $numZeroLevelDefault,
397 'zeroLevelTol' => $numZeroLevelTolDefault,
398 'debug' => 0,
363 ); 399 );
400
401 num_cmp([$correctAnswer], %options);
364} 402}
365 403
366## Similar to std_num_cmp but accepts a list of numbers in the form 404## Similar to std_num_cmp but accepts a list of numbers in the form
367## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...) 405## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
368## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default 406## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
369## You must enter a format and tolerance 407## You must enter a format and tolerance
370sub std_num_cmp_list { 408sub std_num_cmp_list {
371 my ( $relPercentTol, $format, @answerList) = @_; 409 my ( $relPercentTol, $format, @answerList) = @_;
372 410
373 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 411 my %options = ( 'tolerance' => $relPercentTol,
374 'tolType' => 'relative', 412 'format' => $format,
375 'format' => $format,
376 'mode' => 'std',
377 'zeroLevel' => $numZeroLevelDefault,
378 'zeroLevelTol' => $numZeroLevelTolDefault,
379 'answerList' => \@answerList
380 ); 413 );
381}
382 414
415 set_default_options( \%options,
416 'tolType' => 'relative',
417 'tolerance' => $numRelPercentTolDefault,
418 'mode' => 'std',
419 'format' => $numFormatDefault,
420 'relTol' => $numRelPercentTolDefault,
421 'zeroLevel' => $numZeroLevelDefault,
422 'zeroLevelTol' => $numZeroLevelTolDefault,
423 'debug' => 0,
424 );
425
426 num_cmp(\@answerList, %options);
427
428}
429
383sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance 430sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
384 my ( $correctAnswer, $absTol, $format) = @_; 431 my ( $correctAnswer, $absTol, $format) = @_;
432 my %options = ( 'tolerance' => $absTol,
433 'format' => $format);
434
435 set_default_options (\%options,
436 'tolType' => 'absolute',
437 'tolerance' => $absTol,
438 'mode' => 'std',
439 'format' => $numFormatDefault,
440 'zeroLevel' => 0,
441 'zeroLevelTol' => 0,
442 'debug' => 0,
443 );
385 444
386 NUM_CMP( 'correctAnswer' => $correctAnswer, 445 num_cmp([$correctAnswer], %options);
387 'tolerance' => $absTol,
388 'tolType' => 'absolute',
389 'format' => $format,
390 'mode' => 'std',
391 'zeroLevel' => 0,
392 'zeroLevelTol' => 0
393 );
394} 446}
395 447
396## See std_num_cmp_list for usage 448## See std_num_cmp_list for usage
449
397sub std_num_cmp_abs_list { 450sub std_num_cmp_abs_list {
398 my ( $absTol, $format, @answerList ) = @_; 451 my ( $absTol, $format, @answerList ) = @_;
399 452
400 NUM_CMP_LIST( 'tolerance' => $absTol, 453 my %options = ( 'tolerance' => $absTol,
401 'tolType' => 'absolute', 454 'format' => $format,
402 'format' => $format,
403 'mode' => 'std',
404 'zeroLevel' => 0,
405 'zeroLevelTol' => 0,
406 'answerList' => \@answerList
407 ); 455 );
408}
409 456
457 set_default_options( \%options,
458 'tolType' => 'absolute',
459 'tolerance' => $absTol,
460 'mode' => 'std',
461 'format' => $numFormatDefault,
462 'zeroLevel' => 0,
463 'zeroLevelTol' => 0,
464 'debug' => 0,
465 );
466
467 num_cmp(\@answerList, %options);
468
469}
410 470
411sub frac_num_cmp { # only allow fractions and numbers as submitted answer 471sub frac_num_cmp { # only allow fractions and numbers as submitted answer
472
412 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 473 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
474
475 my %options = ( 'tolerance' => $relPercentTol,
476 'format' => $format,
477 'zeroLevel' => $zeroLevel,
478 'zeroLevelTol' => $zeroLevelTol
479 );
413 480
414 NUM_CMP( 'correctAnswer' => $correctAnswer, 481 set_default_options( \%options,
482 'tolType' => 'relative',
415 'tolerance' => $relPercentTol, 483 'tolerance' => $relPercentTol,
416 'tolType' => 'relative', 484 'mode' => 'frac',
417 'format' => $format, 485 'format' => $numFormatDefault,
418 'mode' => 'frac', 486 'zeroLevel' => $numZeroLevelDefault,
419 'zeroLevel' => $zeroLevel, 487 'zeroLevelTol' => $numZeroLevelTolDefault,
420 'zeroLevelTol' => $zeroLevelTol 488 'relTol' => $numRelPercentTolDefault,
489 'debug' => 0,
421 ); 490 );
491
492 num_cmp([$correctAnswer], %options);
422} 493}
423 494
424## See std_num_cmp_list for usage 495## See std_num_cmp_list for usage
425sub frac_num_cmp_list { 496sub frac_num_cmp_list {
426 my ( $relPercentTol, $format, @answerList ) = @_; 497 my ( $relPercentTol, $format, @answerList ) = @_;
427 498
428 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 499 my %options = ( 'tolerance' => $relPercentTol,
429 'tolType' => 'relative', 500 'format' => $format
430 'format' => $format, 501 );
431 'mode' => 'frac', 502
503 set_default_options( \%options,
504 'tolType' => 'relative',
505 'tolerance' => $relPercentTol,
506 'mode' => 'frac',
507 'format' => $numFormatDefault,
432 'zeroLevel' => $numZeroLevelDefault, 508 'zeroLevel' => $numZeroLevelDefault,
433 'zeroLevelTol' => $numZeroLevelTolDefault, 509 'zeroLevelTol' => $numZeroLevelTolDefault,
434 'answerList' => \@answerList 510 'relTol' => $numRelPercentTolDefault,
435 ); 511 'debug' => 0,
512 );
513
514 num_cmp(\@answerList, %options);
515
436} 516}
437 517
518
438sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance 519sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
439 my ( $correctAnswer, $absTol, $format ) = @_; 520 my ( $correctAnswer, $absTol, $format ) = @_;
440 521
441 NUM_CMP( 'correctAnswer' => $correctAnswer, 522 my %options = ( 'tolerance' => $absTol,
523 'format' => $format
524 );
525
526 set_default_options (\%options,
527 'tolType' => 'absolute',
442 'tolerance' => $absTol, 528 'tolerance' => $absTol,
443 'tolType' => 'absolute', 529 'mode' => 'frac',
444 'format' => $format, 530 'format' => $numFormatDefault,
445 'mode' => 'frac', 531 'zeroLevel' => 0,
446 'zeroLevel' => 0,
447 'zeroLevelTol' => 0 532 'zeroLevelTol' => 0,
448 ); 533 'debug' => 0,
449} 534 );
535 num_cmp([$correctAnswer], %options);
536
450 537
538}
539
451## See std_num_cmp_list for usage 540## See std_num_cmp_list for usage
452sub frac_num_cmp_abs_list { 541sub frac_num_cmp_abs_list {
453 my ( $absTol, $format, @answerList ) = @_; 542 my ( $absTol, $format, @answerList ) = @_;
454 543
455 NUM_CMP_LIST( 'tolerance' => $absTol, 544 my %options = ( 'tolerance' => $absTol,
456 'tolType' => 'absolute', 545 'format' => $format
457 'format' => $format, 546 );
458 'mode' => 'frac', 547
459 'zeroLevel' => 0, 548 set_default_options (\%options,
549 'tolType' => 'absolute',
550 'tolerance' => $absTol,
551 'mode' => 'frac',
552 'format' => $numFormatDefault,
553 'zeroLevel' => 0,
460 'zeroLevelTol' => 0, 554 'zeroLevelTol' => 0,
461 'answerList' => \@answerList 555 'debug' => 0,
462 ); 556 );
557
558 num_cmp(\@answerList, %options);
463} 559}
464 560
465 561
466sub arith_num_cmp { # only allow arithmetic expressions as submitted answer 562sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
563
467 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 564 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
468 565
469 NUM_CMP( 'correctAnswer' => $correctAnswer, 566 my %options = ( 'tolerance' => $relPercentTol,
470 'tolerance' => $relPercentTol, 567 'format' => $format,
471 'tolType' => 'relative', 568 'zeroLevel' => $zeroLevel,
472 'format' => $format,
473 'mode' => 'arith',
474 'zeroLevel' => $zeroLevel,
475 'zeroLevelTol' => $zeroLevelTol 569 'zeroLevelTol' => $zeroLevelTol
476 ); 570 );
571
572 set_default_options( \%options,
573 'tolType' => 'relative',
574 'tolerance' => $relPercentTol,
575 'mode' => 'arith',
576 'format' => $numFormatDefault,
577 'zeroLevel' => $numZeroLevelDefault,
578 'zeroLevelTol' => $numZeroLevelTolDefault,
579 'relTol' => $numRelPercentTolDefault,
580 'debug' => 0,
581 );
582
583 num_cmp([$correctAnswer], %options);
477} 584}
478 585
479## See std_num_cmp_list for usage 586## See std_num_cmp_list for usage
480sub arith_num_cmp_list { 587sub arith_num_cmp_list {
481 my ( $relPercentTol, $format, @answerList ) = @_; 588 my ( $relPercentTol, $format, @answerList ) = @_;
482 589
483 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 590 my %options = ( 'tolerance' => $relPercentTol,
484 'tolType' => 'relative', 591 'format' => $format,
485 'format' => $format, 592 );
486 'mode' => 'arith',
487 'zeroLevel' => $numZeroLevelDefault,
488 'zeroLevelTol' => $numZeroLevelTolDefault,
489 'answerList' => \@answerList
490 );
491}
492 593
594 set_default_options( \%options,
595 'tolType' => 'relative',
596 'tolerance' => $relPercentTol,
597 'mode' => 'arith',
598 'format' => $numFormatDefault,
599 'zeroLevel' => $numZeroLevelDefault,
600 'zeroLevelTol' => $numZeroLevelTolDefault,
601 'relTol' => $numRelPercentTolDefault,
602 'debug' => 0,
603 );
604 num_cmp(\@answerList, %options);
605}
606
493sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance 607sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
494 my ( $correctAnswer, $absTol, $format ) = @_; 608 my ( $correctAnswer, $absTol, $format ) = @_;
609
610 my %options = ( 'tolerance' => $absTol,
611 'format' => $format
612 );
613
614 set_default_options (\%options,
615 'tolType' => 'absolute',
616 'tolerance' => $absTol,
617 'mode' => 'arith',
618 'format' => $numFormatDefault,
619 'zeroLevel' => 0,
620 'zeroLevelTol' => 0,
621 'debug' => 0,
622 );
623 num_cmp([$correctAnswer], %options);
495 624
496 NUM_CMP( 'correctAnswer' => $correctAnswer, 625
497 'tolerance' => $absTol,
498 'tolType' => 'absolute',
499 'format' => $format,
500 'mode' => 'arith',
501 'zeroLevel' => 0,
502 'zeroLevelTol' => 0
503 );
504} 626}
505 627
506## See std_num_cmp_list for usage 628## See std_num_cmp_list for usage
507sub arith_num_cmp_abs_list { 629sub arith_num_cmp_abs_list {
508 my ( $absTol, $format, @answerList ) = @_; 630 my ( $absTol, $format, @answerList ) = @_;
509 631
510 NUM_CMP_LIST( 'tolerance' => $absTol, 632 my %options = ( 'tolerance' => $absTol,
511 'tolType' => 'absolute', 633 'format' => $format
512 'format' => $format, 634 );
513 'mode' => 'arith', 635
514 'zeroLevel' => 0, 636 set_default_options (\%options,
515 'zeroLevelTol' => 0, 637 'tolType' => 'absolute',
516 'answerList' => \@answerList 638 'tolerance' => $absTol,
517 ); 639 'mode' => 'arith',
640 'format' => $numFormatDefault,
641 'zeroLevel' => 0,
642 'zeroLevelTol' => 0,
643 'debug' => 0,
644 );
645 num_cmp(\@answerList, %options);
646
518} 647}
519 648
520sub strict_num_cmp { # only allow numbers as submitted answer 649sub strict_num_cmp { # only allow numbers as submitted answer
650
521 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 651 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
652
653 my %options = ( 'tolerance' => $relPercentTol,
654 'format' => $format,
655 'zeroLevel' => $zeroLevel,
656 'zeroLevelTol' => $zeroLevelTol
657 );
658
659 set_default_options( \%options,
660 'tolType' => 'relative',
661 'tolerance' => $relPercentTol,
662 'mode' => 'strict',
663 'format' => $numFormatDefault,
664 'zeroLevel' => $numZeroLevelDefault,
665 'zeroLevelTol' => $numZeroLevelTolDefault,
666 'relTol' => $numRelPercentTolDefault,
667 'debug' => 0,
668 );
669
670 num_cmp([$correctAnswer], %options);
522 671
523 NUM_CMP( 'correctAnswer' => $correctAnswer,
524 'tolerance' => $relPercentTol,
525 'tolType' => 'relative',
526 'format' => $format,
527 'mode' => 'strict',
528 'zeroLevel' => $zeroLevel,
529 'zeroLevelTol' => $zeroLevelTol
530 );
531} 672}
532 673
533## See std_num_cmp_list for usage 674## See std_num_cmp_list for usage
534sub strict_num_cmp_list { # compare numbers 675sub strict_num_cmp_list { # compare numbers
535 my ( $relPercentTol, $format, @answerList ) = @_; 676 my ( $relPercentTol, $format, @answerList ) = @_;
677
678 my %options = ( 'tolerance' => $relPercentTol,
679 'format' => $format,
680 );
681
682 set_default_options( \%options,
683 'tolType' => 'relative',
684 'tolerance' => $relPercentTol,
685 'mode' => 'strict',
686 'format' => $numFormatDefault,
687 'zeroLevel' => $numZeroLevelDefault,
688 'zeroLevelTol' => $numZeroLevelTolDefault,
689 'relTol' => $numRelPercentTolDefault,
690 'debug' => 0,
691 );
536 692
537 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 693 num_cmp(\@answerList, %options);
538 'tolType' => 'relative', 694 }
539 'format' => $format, 695
540 'mode' => 'strict',
541 'zeroLevel' => $numZeroLevelDefault,
542 'zeroLevelTol' => $numZeroLevelTolDefault,
543 'answerList' => \@answerList
544 );
545}
546 696
547sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance 697sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
698
548 my ( $correctAnswer, $absTol, $format ) = @_; 699 my ( $correctAnswer, $absTol, $format ) = @_;
549 700
550 NUM_CMP( 'correctAnswer' => $correctAnswer, 701 my %options = ( 'tolerance' => $absTol,
551 'tolerance' => $absTol, 702 'format' => $format
552 'tolType' => 'absolute', 703 );
553 'format' => $format, 704
554 'mode' => 'strict', 705 set_default_options (\%options,
555 'zeroLevel' => 0, 706 'tolType' => 'absolute',
556 'zeroLevelTol' => 0 707 'tolerance' => $absTol,
557 ); 708 'mode' => 'strict',
709 'format' => $numFormatDefault,
710 'zeroLevel' => 0,
711 'zeroLevelTol' => 0,
712 'debug' => 0,
713 );
714
715 num_cmp([$correctAnswer], %options);
716
558} 717}
559 718
560## See std_num_cmp_list for usage 719## See std_num_cmp_list for usage
561sub strict_num_cmp_abs_list { # compare numbers 720sub strict_num_cmp_abs_list { # compare numbers
562 my ( $absTol, $format, @answerList ) = @_; 721 my ( $absTol, $format, @answerList ) = @_;
563 722
564 NUM_CMP_LIST( 'tolerance' => $absTol, 723
565 'tolType' => 'absolute', 724 my %options = ( 'tolerance' => $absTol,
566 'format' => $format, 725 'format' => $format
567 'mode' => 'strict', 726 );
568 'zeroLevel' => 0, 727
569 'zeroLevelTol' => 0, 728 set_default_options (\%options,
570 'answerList' => \@answerList 729 'tolType' => 'absolute',
571 ); 730 'tolerance' => $absTol,
731 'mode' => 'strict',
732 'format' => $numFormatDefault,
733 'zeroLevel' => 0,
734 'zeroLevelTol' => 0,
735 'debug' => 0,
736 );
737
738 num_cmp(\@answerList, %options);
739
740
741
572} 742}
573 743
574 744
575## Compares a number with units 745## Compares a number with units
576## Deprecated; use num_cmp() 746## Deprecated; use num_cmp()
… …
581## format -- the format to use when displaying the answer 751## format -- the format to use when displaying the answer
582## tol -- an absolute tolerance, or 752## tol -- an absolute tolerance, or
583## relTol -- a relative tolerance 753## relTol -- a relative tolerance
584## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 754## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
585## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero 755## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
756
757
758sub check_strings {
759 my ($rh_ans, %options) = @_;
760
761 # if the student's answer is a number, simply return the answer hash (unchanged).
762
763 if ( $rh_ans->{student_ans} =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
764 if ( $rh_ans->{answerIsString} == 1) {
765 $rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
766 }
767 return $rh_ans;
768 }
769 # the student's answer is recognized as a string
770 my $ans = $rh_ans->{student_ans};
771
772# OVERVIEW of remindar of function:
773# if answer is correct, return correct. (adjust score to 1)
774# if answer is incorect:
775# 1) determine if the answer is sensible. if it is, return incorrect.
776# 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
777# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
778# last: 'STRING' post_filter will clear the error (avoiding pink screen.)
779
780 my $sensibleAnswer = 0;
781 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
782 my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
783 my $temp_ans_hash = &$ans_eval($ans);
784 $rh_ans->{test} = $temp_ans_hash;
785 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
786 $rh_ans->{score} = 1;
787 $sensibleAnswer = 1;
788 } else { # students answer does not match the correct answer.
789 ## find out if string makes sense
790 my $legalString = '';
791 my @legalStrings = @{$options{strings}};
792 foreach $legalString (@legalStrings) {
793 if ( uc($ans) eq uc($legalString) ) {
794 $sensibleAnswer = 1;
795 last;
796 }
797 }
798 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
799 $rh_ans->throw_error('EVAL', "$BR Your answer is not a recognized answer") unless ($sensibleAnswer);
800 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
801 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
802 }
803 $rh_ans->{student_ans} = $ans;
804 if ($sensibleAnswer) {
805 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
806 }
807 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
808
809 $rh_ans;
810
811}
812
813
814
815sub check_units {
816 my ($rh_ans, %options) = @_;
817
818 my %correct_units = %{$rh_ans-> {rh_correct_units}};
819
820 my $ans = $rh_ans->{student_ans};
821 # $ans = '' unless defined ($ans);
822 $ans = str_filters ($ans, 'trim_whitespace');
823 my $original_student_ans = $ans;
824
825 $rh_ans->{original_student_ans} = $original_student_ans;
826
827 # it surprises me that the match below works since the first .* is greedy.
828 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
829
830 unless ( defined($num_answer) && $units ) {
831 # there is an error reading the input
832 if ( $ans =~ /\S/ ) { # the answer is not blank
833 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
834 "as a number or an arithmetic expression followed by a unit specification. " .
835 "Your answer must contain units." );
836 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
837 "as a number or an arithmetic expression followed by a unit specification. " .
838 "Your answer must contain units." );
839 }
840
841 return $rh_ans;
842 }
843
844 # we have been able to parse the answer into a numerical part and a unit part
845
846 # $num_answer = $1; #$1 and $2 from the regular expression above
847 # $units = $2;
848
849 my %units = Units::evaluate_units($units);
850 if ( defined( $units{'ERROR'} ) ) {
851 # handle error condition
852 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
853 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
854 return $rh_ans;
855 }
856
857 my $units_match = 1;
858 my $fund_unit;
859 foreach $fund_unit (keys %correct_units) {
860 next if $fund_unit eq 'factor';
861 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
862 }
863
864 if ( $units_match ) {
865 # units are ok. Evaluate the numerical part of the answer
866 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
867 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
868 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
869 $rh_ans->{student_ans} = $num_answer;
870
871 } else {
872 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
873 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
874 }
875
876 return $rh_ans;
877 }
878
879
880# This mode is depricated. send input through num_cmp -- it can handle units.
586sub numerical_compare_with_units { 881sub numerical_compare_with_units {
587 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 882 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
588 my %options = @_; # all of the other inputs are (key value) pairs 883 my %options = @_; # all of the other inputs are (key value) pairs
589
590 # handle the defaults
591 $options{'mode'} = 'std' unless defined( $options{'mode'} );
592 $options{'format'} = $numFormatDefault unless defined( $options{'format'} );
593 $options{'zeroLevel'} = $numZeroLevelDefault unless defined( $options{'zeroLevel'} );
594 $options{'zeroLevelTol'} = $numZeroLevelTolDefault unless defined( $options{'zeroLevelTol'} );
595
596 # both spellings are maintained for backward compatibility
597 # relTol is preferred
598 if( defined $options{'reltol'} ) {
599 $options{'relTol'} = $options{'reltol'};
600 delete $options{'reltol'};
601 }
602
603 my ($tol, $tolerance_mode);
604 if ( defined $options{'tol'} ) {
605 $tol = $options{'tol'};
606 $tolerance_mode = 'absolute';
607 }
608 elsif( defined $options{'relTol'} ) {
609 $tol = $options{'relTol'};
610 $tolerance_mode = 'relative';
611 }
612 else { #the default is a relative tolerance
613 $tol = $numRelPercentTolDefault;
614 $tolerance_mode = 'relative';
615 }
616 884
617 # Prepare the correct answer 885 # Prepare the correct answer
618 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' ); 886 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
619 887
620 # it surprises me that the match below works since the first .* is greedy. 888 # it surprises me that the match below works since the first .* is greedy.
621 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/; 889 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
622 890
623 my %correct_units = Units::evaluate_units($correct_units); 891 $options{units} = $correct_units;
624 if ( defined( $correct_units{'ERROR'} ) ) { 892
625 die "ERROR: The answer \"$correct_answer\" in the problem definition cannot be parsed:\n" . 893
626 "$correct_units{'ERROR'}\n"; 894 num_cmp($correct_num_answer, %options);
627 }
628
629 my $ans_evaluator = sub {
630
631 my $ans = shift;
632 $ans = '' unless defined($ans);
633 my $original_student_ans = $ans;
634
635 $ans = str_filters( $ans, 'trim_whitespace' );
636
637 my $ans_hash = new AnswerHash(
638 'score' => 0,
639 'correct_ans' => spf($correct_num_answer,$options{'format'}) . " $correct_units",
640 'student_ans' => $ans,
641 'ans_message' => '',
642 'type' => 'num_cmp_with_units',
643 'preview_text_string' => '',
644 'original_student_ans' => $original_student_ans
645 );
646
647 # it surprises me that the match below works since the first .* is greedy.
648 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
649
650 unless ( defined($num_answer) && $units ) {
651 # there is an error reading the input
652 if ( $ans =~ /\S/ ) { # the answer is not blank
653 $ans_hash -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
654 "as a number or an arithmetic expression followed by a unit specification. " .
655 "Your answer must contain units." );
656 }
657
658 return $ans_hash;
659 }
660
661 # we have been able to parse the answer into a numerical part and a unit part
662
663 $num_answer = $1; #$1 and $2 from the regular expression above
664 $units = $2;
665
666 my %units = Units::evaluate_units($units);
667 if ( defined( $units{'ERROR'} ) ) {
668 # handle error condition
669 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
670
671 $ans_hash -> setKeys( 'ans_message' => "$units{'ERROR'}" );
672
673 return $ans_hash;
674 }
675
676 my $units_match = 1;
677 my $fund_unit;
678 foreach $fund_unit (keys %correct_units) {
679 next if $fund_unit eq 'factor';
680 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
681 }
682
683 if ( $units_match ) {
684
685 # units are ok. Evaluate the numerical part of the answer
686 $tol = $tol * $correct_units{'factor'}/$units{'factor'} if
687 $tolerance_mode eq 'absolute'; # the tolerance is in the units specified by the instructor.
688
689 my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
690 'tolerance' => $tol,
691 'tolType' => $tolerance_mode,
692 'format' => $options{'format'},
693 'mode' => $options{'mode'},
694 'zeroLevel' => $options{'zeroLevel'},
695 'zeroLevelTol' => $options{'zeroLevelTol'} );
696
697 # because num_answer may contain an arithmetic expression rather than
698 # a number we can't multiply it by the $units{'factor'}
699 # instead we divide the correct answer by this amount;
700 # this is also why the numerical_answer_evaluator is not defined outside this subroutine.
701
702 $ans_hash = &$numerical_answer_evaluator($num_answer);
703
704 # now we need to doctor the correct answer in order to add units
705 # to it and correct for the division we did before
706 $ans_hash -> {correct_ans} =
707 prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
708 $options{'format'} ) . " $correct_units";
709 # we also need to doctor the submitted answer to get it back in its original format.
710
711 # we don't add the units on if there is an error message from numerical_answer_evaluator
712 if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
713 $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
714 $ans_hash -> setKeys( original_student_ans => $ans );
715 }
716 else {
717 # error message from numerical_answer_evaluator doesn't have units tacked on
718 $ans_hash -> setKeys( original_student_ans => $ans );
719 }
720 }
721 else {
722 $ans_hash -> setKeys( ans_message => 'There is an error in the units for this answer.' );
723 }
724
725 return $ans_hash;
726 };
727
728 $ans_evaluator;
729} 895}
896
730 897
731=head3 std_num_str_cmp() 898=head3 std_num_str_cmp()
732 899
733NOTE: This function is maintained for compatibility. num_cmp() with the 900NOTE: This function is maintained for compatibility. num_cmp() with the
734 'strings' parameter is slightly preferred. 901 'strings' parameter is slightly preferred.
735 902
736std_num_str_cmp() is used when the correct answer could be either a number or a 903std_num_str_cmp() is used when the correct answer could be either a number or a
737string. For example, if you wanted the student to evaluate a function at number 904string. For example, if you wanted the student to evaluate a function at number
… …
758Example: 925Example:
759 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) ); 926 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
760 927
761=cut 928=cut
762 929
763sub std_num_str_cmp { 930sub std_num_str_cmp {
764 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 931 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
932 # warn ('This method is depreciated. Use num_cmp instead.');
933 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
934 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
935}
765 936
937#sub old_std_num_str_cmp {
938# my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
939#
766 $ra_legalStrings = [''] unless defined $ra_legalStrings; 940# $ra_legalStrings = [''] unless defined $ra_legalStrings;
767 my @legalStrings = @{$ra_legalStrings}; 941# my @legalStrings = @{$ra_legalStrings};
768 942#
769 my $ans_evaluator = sub { 943# my $ans_evaluator = sub {
770 944#
771 my $ans = shift; 945# my $ans = shift;
772 my $ans_hash; 946# my $ans_hash;
773 my $corrAnswerIsString = 0; 947# my $corrAnswerIsString = 0;
774# my $studAnswerIsString = 0; ## uses new incorrect logic 948## my $studAnswerIsString = 0; ## uses new incorrect logic
775 my $studAnswerIsString = 1; 949# my $studAnswerIsString = 1;
776 950#
777 my $legalString = ''; 951# my $legalString = '';
778 foreach $legalString (@legalStrings) { 952# foreach $legalString (@legalStrings) {
779 if ( uc($correctAnswer) eq uc($legalString) ) { 953# if ( uc($correctAnswer) eq uc($legalString) ) {
780 $corrAnswerIsString = 1; 954# $corrAnswerIsString = 1;
781 last; 955# last;
782 } 956# }
783 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 957# } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
784 958#
785 # Neither of these is perfect; the first is more general, but 959# # Neither of these is perfect; the first is more general, but
786 # has problems with certain special strings like "ee", while the 960# # has problems with certain special strings like "ee", while the
787 # second doesn't support arithmetic expressions. 961# # second doesn't support arithmetic expressions.
788 # 962# #
789# if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) { 963## if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) {
790# $studAnswerIsString = 1; 964## $studAnswerIsString = 1;
965## }
966# #if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) {
967# # $studAnswerIsString = 1;
968# #}
969#
970# ## Both the above new versions are incorrect. We replace this by the original logic namely that
971# ## an answer that contain any of the symbols
972# ## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ]
973# ## or an answer that consists of "pi" or "e" alone
974# ## will be considered an arithmetic expression rather than a string answer.
975#
976# if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;}
977#
978#
979# ## at this point $studAnswerIsString = 0 iff correct answer is numeric
980#
981# if( $studAnswerIsString ) {
982# $ans = str_filters( $ans, 'compress_whitespace' )
791# } 983# }
792 #if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) { 984#
793 # $studAnswerIsString = 1; 985#
794 #} 986#
795 987#
796 ## Both the above new versions are incorrect. We replace this by the original logic namely that
797 ## an answer that contain any of the symbols
798 ## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ]
799 ## or an answer that consists of "pi" or "e" alone
800 ## will be considered an arithmetic expression rather than a string answer.
801
802 if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;}
803
804
805 ## at this point $studAnswerIsString = 0 iff correct answer is numeric
806
807 if( $studAnswerIsString ) {
808 $ans = str_filters( $ans, 'compress_whitespace' )
809 }
810
811 if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) { 988# if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) {
812 my $string_answer_evaluator = std_str_cmp( $correctAnswer ); 989# my $string_answer_evaluator = std_str_cmp( $correctAnswer );
813 $ans_hash = &$string_answer_evaluator( $ans ); 990# $ans_hash = &$string_answer_evaluator( $ans );
814 991#
815 if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense 992# if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense
816 my $sensibleAnswer = 0; 993# my $sensibleAnswer = 0;
817 foreach $legalString (@legalStrings) { 994# foreach $legalString (@legalStrings) {
818 if ( uc($ans) eq uc($legalString) ) { 995# if ( uc($ans) eq uc($legalString) ) {
819 $sensibleAnswer = 1; 996# $sensibleAnswer = 1;
820 last; 997# last;
821 } 998# }
822 } 999# }
823 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 1000# $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
824 1001#
825 $ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) 1002# $ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' )
826 unless ($sensibleAnswer); 1003# unless ($sensibleAnswer);
827 $ans_hash -> setKeys( 'student_ans' => uc($ans) ); 1004# $ans_hash -> setKeys( 'student_ans' => uc($ans) );
828 } 1005# }
829 } 1006# }
830 elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) { 1007# elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) {
831 my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol); 1008# my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol);
832 $ans_hash = &$numeric_answer_evaluator($ans); 1009# $ans_hash = &$numeric_answer_evaluator($ans);
833 } 1010# }
834 elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) { 1011# elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) {
835 my $numeric_answer_evaluator = std_num_cmp(1); 1012# my $numeric_answer_evaluator = std_num_cmp(1);
836 $ans_hash = &$numeric_answer_evaluator($ans); 1013# $ans_hash = &$numeric_answer_evaluator($ans);
837 $ans_hash -> setKeys( 'score' => 0, 1014# $ans_hash -> setKeys( 'score' => 0,
838 'correct_ans' => $correctAnswer 1015# 'correct_ans' => $correctAnswer
839 ); 1016# );
840 } 1017# }
841 elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) { 1018# elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) {
842 my $string_answer_evaluator = std_str_cmp('bad'); 1019# my $string_answer_evaluator = std_str_cmp('bad');
843 $ans_hash = &$string_answer_evaluator($ans); 1020# $ans_hash = &$string_answer_evaluator($ans);
844 1021#
845 $ans_hash -> setKeys( 'score' => 0, 1022# $ans_hash -> setKeys( 'score' => 0,
846 'correct_ans' => $correctAnswer 1023# 'correct_ans' => $correctAnswer
847 ); 1024# );
848 1025#
849 ## find out if string makes sense 1026# ## find out if string makes sense
850 my $sensibleAnswer = 0; 1027# my $sensibleAnswer = 0;
851 foreach $legalString (@legalStrings) { 1028# foreach $legalString (@legalStrings) {
852 if ( uc($ans) eq uc($legalString) ) { 1029# if ( uc($ans) eq uc($legalString) ) {
853 $sensibleAnswer = 1; 1030# $sensibleAnswer = 1;
854 last; 1031# last;
855 } 1032# }
856 } 1033# }
857 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 1034# $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
858 1035#
859 $ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" ) 1036# $ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" )
860 unless $sensibleAnswer; 1037# unless $sensibleAnswer;
861 } 1038# }
862 1039#
863 return $ans_hash; 1040# return $ans_hash;
864 }; 1041# };
865 1042#
866 return $ans_evaluator; 1043# return $ans_evaluator;
867} 1044#}
868 1045
869=head3 num_cmp() 1046=head3 num_cmp()
870 1047
871Compares a number or a list of numbers, using a named hash of options to set 1048Compares a number or a list of numbers, using a named hash of options to set
872parameters. This can make for more readable code than using the "mode"_num_cmp() 1049parameters. This can make for more readable code than using the "mode"_num_cmp()
… …
907=cut 1084=cut
908 1085
909sub num_cmp { 1086sub num_cmp {
910 my $correctAnswer = shift @_; 1087 my $correctAnswer = shift @_;
911 my @opt = @_; 1088 my @opt = @_;
1089 my %out_options;
912 1090
1091#########################################################################
1092# Retain this first check for backword compatibility. Allows input of the form
1093# num_cmp($ans, 1, '%0.5f') but warns against it
1094#########################################################################
1095
913 my %known_options = ( 'mode' => 'std', 1096 my %known_options = ( 'mode' => 'std',
914 'format' => $numFormatDefault, 1097 'format' => $numFormatDefault,
915 'tol' => $numAbsTolDefault, 1098 'tol' => $numAbsTolDefault,
916 'relTol' => $numRelPercentTolDefault, 1099 'relTol' => $numRelPercentTolDefault,
917 'units' => undef, 1100 'units' => undef,
918 'strings' => undef, 1101 'strings' => undef,
919 'zeroLevel' => $numZeroLevelDefault, 1102 'zeroLevel' => $numZeroLevelDefault,
920 'zeroLevelTol' => $numZeroLevelTolDefault, 1103 'zeroLevelTol' => $numZeroLevelTolDefault,
921 1104 'tolType' => 'relative',
1105 'tolerance' => 1,
922 'reltol' => undef, #alternate spelling 1106 'reltol' => undef, #alternate spelling
923 'unit' => undef #alternate spelling 1107 'unit' => undef); #alternate spelling
924 ); 1108
925 my %in_options;
926 my @output_list; 1109 my @output_list;
927 my %out_options; 1110 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
928 1111
929 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 || 1112 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
930 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) { 1113 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
931 # unless the first parameter is a list of arrays 1114 # unless the first parameter is a list of arrays
932 # or the second parameter is a known option or 1115 # or the second parameter is a known option or
933 # no options were used, 1116 # no options were used,
934 # use the old num_cmp which does not use options, but has inputs 1117 # use the old num_cmp which does not use options, but has inputs
935 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol 1118 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol
936 warn "This method of using num_cmp() is deprecated. Please rewrite this" . 1119 warn "This method of using num_cmp() is deprecated. Please rewrite this" .
937 " problem using the options style of parameter passing (or" . 1120 " problem using the options style of parameter passing (or" .
938 " check that your first option is spelled correctly)."; 1121 " check that your first option is spelled correctly).";
939 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt; 1122
940 1123
941 %out_options = ( 'relTol' => $relPercentTol, 1124 %out_options = ( 'relTol' => $relPercentTol,
942 'format' => $format, 1125 'format' => $format,
943 'zeroLevel' => $zeroLevel, 1126 'zeroLevel' => $zeroLevel,
944 'zeroLevelTol' => $zeroLevelTol, 1127 'zeroLevelTol' => $zeroLevelTol,
945 'mode' => 'std' 1128 'mode' => 'std'
946 ); 1129 );
947 } 1130 }
948 else { 1131# else {
949 # handle options 1132# # handle options
950 1133#
951 check_option_list( @opt ); 1134#
1135# @opt = ( 'relTol' => $relPercentTol,
1136# 'format' => $format,
1137# 'zeroLevel' => $numZeroLevelDefault,
1138# 'zeroLevelTol' => $numZeroLevelTolDefault,
1139# 'mode' => 'std'
1140# );
1141# }
1142#########################################################################
1143# Now handle the options assuming they are entered in the form
1144# num_cmp($ans, relTol=>1, format=>'%0.5f')
1145#########################################################################
952 %in_options = @opt; 1146 %out_options = @opt;
1147 assign_option_aliases( \%out_options,
1148 'reltol' => 'relTol',
1149 'unit' => 'units',
1150 );
953 1151
954 # both spellings maintained for compatibility 1152
955 # relTol is preferred 1153
956 if( defined( $in_options{'reltol'} ) ) { 1154
957 $in_options{'relTol'} = $in_options{'reltol'}; 1155 set_default_options( \%out_options,
958 delete $in_options{'reltol'}; 1156 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative',
1157 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault,
1158 'mode' => 'std',
1159 'format' => $numFormatDefault,
1160 'tol' => $numAbsTolDefault,
1161 'relTol' => $numRelPercentTolDefault,
1162 'units' => undef,
1163 'strings' => undef,
1164 'zeroLevel' => $numZeroLevelDefault,
1165 'zeroLevelTol' => $numZeroLevelTolDefault,
1166 'debug' => 0,
959 } 1167
1168 );
960 1169
961 # both spellings maintained for compatibility
962 # units is preferred
963 if( defined( $in_options{'unit'} ) ) {
964 $in_options{'units'} = $in_options{'unit'};
965 delete $in_options{'unit'};
966 }
967 1170
1171
1172
1173
1174
968 # can't use both units and strings 1175 # can't use both units and strings
969 if( defined( $in_options{'units'} ) && defined( $in_options{'strings'} ) ) { 1176 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
970 warn "Can't use both 'units' and 'strings' in the same problem " . 1177 warn "Can't use both 'units' and 'strings' in the same problem " .
971 "(check your parameters to num_cmp() )"; 1178 "(check your parameters to num_cmp() )";
1179
972 } 1180 }
973 1181
974 #%out_options = %known_options;
975 foreach my $opt_name (keys %in_options) {
976 1182
977 if( exists( $known_options{$opt_name} ) ) {
978 $out_options{$opt_name} = $in_options{$opt_name};
979 }
980 else {
981 die "Option $opt_name is not defined for num_cmp. Answer is $correctAnswer; " .
982 "Default options are:<BR> ", pretty_print(\%known_options);
983 }
984 }
985 }
986
987 # set tolerance flags -- note that the order of testing means that
988 # relative tolerance is the default
989 my ($tolType, $tol); 1183 # my ($tolType, $tol);
990 1184 if ($out_options{tolType} eq 'absolute') {
991 if ( defined( $out_options{'tol'} ) ) {
992 $tolType = 'absolute'; 1185 # $tolType = 'absolute';
1186 # $out_options{tolType} = 'absolute';
993 $tol = $out_options{'tol'}; 1187 # $tol = $out_options{'tol'};
994 } 1188 $out_options{'tolerance'}=$out_options{'tol'};
1189 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
995 else { 1190 } else {
996 $tolType = 'relative'; 1191 # $tolType = 'relative';
1192 # $out_options{tolType} = 'relative';
997 $tol = $out_options{'relTol'}; 1193 # $tol = $out_options{'relTol'};
1194 # $out_options{'tolType'} = $out_options{'relative'};
1195 $out_options{'tolerance'}=$out_options{'relTol'};
1196 # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
998 } 1197 }
999 1198
1000 # thread over lists 1199 # thread over lists
1001 my @ans_list = (); 1200 my @ans_list = ();
1002 1201
… …
1004 @ans_list = @{$correctAnswer}; 1203 @ans_list = @{$correctAnswer};
1005 } 1204 }
1006 else { 1205 else {
1007 push( @ans_list, $correctAnswer ); 1206 push( @ans_list, $correctAnswer );
1008 } 1207 }
1208
1009 # produce answer evaluators 1209 # produce answer evaluators
1010 foreach my $ans (@ans_list) { 1210 foreach my $ans (@ans_list) {
1011 if( defined( $out_options{'units'} ) ) { 1211 if( defined( $out_options{'units'} ) ) {
1012 $ans = "$ans $out_options{'units'}"; 1212 $ans = "$ans $out_options{'units'}";
1013 push( @output_list, numerical_compare_with_units($ans, %out_options) );
1014 } 1213
1214 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
1215 'tolerance' => $out_options{tolerance},
1216 'tolType' => $out_options{tolType},
1217 'format' => $out_options{'format'},
1218 'mode' => $out_options{'mode'},
1219 'zeroLevel' => $out_options{'zeroLevel'},
1220 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1221 'debug' => $out_options{'debug'},
1222 'units' => $out_options{'units'},
1223 )
1224 );
1225 }
1015 elsif( defined( $out_options{'strings'} ) ) { 1226 elsif( defined( $out_options{'strings'} ) ) {
1016 if( defined $out_options{'tol'} ) { 1227 #if( defined $out_options{'tol'} ) {
1017 warn "You are using 'tol' (for absolute tolerance) with a num/str " . 1228 # warn "You are using 'tol' (for absolute tolerance) with a num/str " .
1018 "compare, which currently only uses relative tolerance. The default " . 1229 # "compare, which currently only uses relative tolerance. The default " .
1019 "tolerance will be used."; 1230 # "tolerance will be used.";
1231 #}
1232
1233 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
1234 'tolerance' => $out_options{tolerance},
1235 'tolType' => $out_options{tolType},
1236 'format' => $out_options{'format'},
1237 'mode' => $out_options{'mode'},
1238 'zeroLevel' => $out_options{'zeroLevel'},
1239 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1240 'debug' => $out_options{'debug'},
1241 'strings' => $out_options{'strings'},
1242
1243 )
1244 );
1245 }
1246 else {
1020 } 1247
1021
1022 push( @output_list, std_num_str_cmp( $ans, $out_options{'strings'},
1023 $out_options{'relTol'},
1024 $out_options{'format'},
1025 $out_options{'zeroLevel'},
1026 $out_options{'zeroLevelTol'}
1027 )
1028 );
1029 } else {
1030 push(@output_list, 1248 push(@output_list,
1031 NUM_CMP( 'correctAnswer' => $ans, 1249 NUM_CMP( 'correctAnswer' => $ans,
1032 'tolerance' => $tol, 1250 'tolerance' => $out_options{tolerance},
1033 'tolType' => $tolType, 1251 'tolType' => $out_options{tolType},
1034 'format' => $out_options{'format'}, 1252 'format' => $out_options{'format'},
1035 'mode' => $out_options{'mode'}, 1253 'mode' => $out_options{'mode'},
1036 'zeroLevel' => $out_options{'zeroLevel'}, 1254 'zeroLevel' => $out_options{'zeroLevel'},
1037 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1255 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1256 'debug' => $out_options{'debug'},
1257
1038 ), 1258 ),
1039 ); 1259 );
1260 }
1040 } 1261 }
1041 } 1262
1042
1043 return @output_list; 1263 return @output_list;
1044} 1264 }
1045 1265
1046#legacy code for compatability purposes 1266#legacy code for compatability purposes
1047sub num_rel_cmp { # compare numbers 1267sub num_rel_cmp { # compare numbers
1048 std_num_cmp( @_ ); 1268 std_num_cmp( @_ );
1049} 1269}
1050 1270
1051## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1271## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1052## 1272##
1053## IN: a hash containing the following items (error-checking to be added later?): 1273## IN: a hash containing the following items (error-checking to be added later?):
… …
1057## format -- the display format of the answer 1277## format -- the display format of the answer
1058## mode -- one of 'std', 'strict', 'arith', or 'frac'; 1278## mode -- one of 'std', 'strict', 'arith', or 'frac';
1059## determines allowable formats for the input 1279## determines allowable formats for the input
1060## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1280## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
1061## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1281## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1282
1283sub compare_numbers {
1284 my ($rh_ans, %options) = @_;
1285 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1286 if ($PG_eval_errors) {
1287 $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
1288 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
1289
1290
1291 } else {
1292 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
1293 }
1294
1295 my $permitted_error;
1296
1297 if ($rh_ans->{tolType} eq 'absolute') {
1298 $permitted_error = $rh_ans->{tolerance};
1299
1300 }
1301 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
1302 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
1303 }
1304 else {
1305 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
1306 }
1307
1308 my $is_a_number = is_a_number($inVal);
1309 $rh_ans->{score} = 1 if ( ($is_a_number) and
1310 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
1311 if (not $is_a_number) {
1312 $rh_ans->throw_error('EVAL','Your answer does not evaluate to a number');
1313 }
1314
1315 $rh_ans;
1316}
1317
1062sub NUM_CMP { # low level numeric compare 1318sub NUM_CMP { # low level numeric compare
1063 my %num_params = @_; 1319 my %num_params = @_;
1320
1321 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1322 foreach my $key (@keys) {
1323 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1324 }
1064 1325
1065 my $correctAnswer = $num_params{'correctAnswer'}; 1326 my $correctAnswer = $num_params{'correctAnswer'};
1066 my $tol = $num_params{'tolerance'};
1067 my $tolType = $num_params{'tolType'};
1068 my $format = $num_params{'format'}; 1327 my $format = $num_params{'format'};
1069 my $mode = $num_params{'mode'}; 1328 my $mode = $num_params{'mode'};
1329
1330 # my $tol = $num_params{'tolerance'};
1331 # my $tolType = $num_params{'tolType'};
1070 my $zeroLevel = $num_params{'zeroLevel'}; 1332 # my $zeroLevel = $num_params{'zeroLevel'};
1071 my $zeroLevelTol = $num_params{'zeroLevelTol'}; 1333 # my $zeroLevelTol = $num_params{'zeroLevelTol'};
1072 1334
1073 if( $tolType eq 'relative' ) { 1335 if( $num_params{tolType} eq 'relative' ) {
1074 $tol = $numRelPercentTolDefault unless defined $tol; 1336 $num_params{'tolerance'} = .01*$num_params{'tolerance'};
1075 $tol *= .01; 1337 }
1338
1339 #$format = $numFormatDefault unless defined $format;
1340 #$mode = 'std' unless defined $mode;
1341 #$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1342 #$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1343
1344 my $formattedCorrectAnswer;
1345 my $correct_units;
1346 my $correct_num_answer;
1347 my %correct_units;
1348 my $corrAnswerIsString = 0;
1349
1350
1351 if (defined($num_params{units}) && $num_params{units}) {
1352 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1353 # units are in form stuff space units where units contains no spaces.
1354
1355 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
1356 %correct_units = Units::evaluate_units($correct_units);
1357 if ( defined( $correct_units{'ERROR'} ) ) {
1358 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1359 "$correct_units{'ERROR'}\n");
1360 }
1361 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1362 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1363
1364 } elsif (defined($num_params{strings}) && $num_params{strings}) {
1365
1366 my $legalString = '';
1367 my @legalStrings = @{$num_params{strings}};
1368 $correct_num_answer = $correctAnswer;
1369 $formattedCorrectAnswer = $correctAnswer;
1370 foreach $legalString (@legalStrings) {
1371 if ( uc($correctAnswer) eq uc($legalString) ) {
1372 $corrAnswerIsString = 1;
1373 last;
1374 }
1375 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1376
1076 1377
1077 } else { 1378 } else {
1078 $tol = $numAbsTolDefault unless defined $tol; 1379 $correct_num_answer = $correctAnswer;
1079 }
1080 $format = $numFormatDefault unless defined $format;
1081 $mode = 'std' unless defined $mode;
1082 $zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1083 $zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1084
1085 my $formattedCorrectAnswer = prfmt( $correctAnswer, $format ); 1380 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1381 }
1086 1382
1087 my $answer_evaluator = sub { 1383 $correct_num_answer = math_constants($correct_num_answer);
1088 my $in = shift @_; 1384
1089 $in = '' unless defined $in; 1385 my $PGanswerMessage = '';
1090 my $score = 0; 1386
1091 my $original_student_answer = $in; 1387 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1092 my $parser = new AlgParserWithImplicitExpand; 1388
1093 my $ret = $parser -> parse($in); 1389 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1094 my $preview_text_string = ''; 1390 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1095 my $preview_latex_string = ''; 1391 }
1392 else {
1393 $PG_eval_errors = ' ';
1394 }
1096 1395
1097 if ( ref($ret) ) { ## parsed successfully 1396 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1098 $parser -> tostring(); 1397 ##error message from eval or above
1099 $parser -> normalize(); 1398 warn "Error in 'correct' answer: $PG_eval_errors<br>
1100 $in = $parser -> tostring(); 1399 The answer $correctAnswer evaluates to $correctVal,
1101 $preview_text_string = $in; 1400 which cannot be interpreted as a number. ";
1102 $preview_latex_string = $parser -> tolatex(); 1401
1402 }
1403 #########################################################################
1103 1404
1405 #construct the answer evaluator
1406 my $answer_evaluator = new AnswerEvaluator;
1407 $answer_evaluator->{debug} = $num_params{debug};
1408 $answer_evaluator->ans_hash( correct_ans => $correct_num_answer,
1409 type => "${mode}_number",
1410 tolerance => $num_params{tolerance},
1411 tolType => $num_params{tolType},
1412 units => $correct_units,
1413 original_correct_ans => $formattedCorrectAnswer,
1414 rh_correct_units => \%correct_units,
1415 answerIsString => $corrAnswerIsString,
1416 );
1417 my ($in, $formattedSubmittedAnswer);
1418 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1419 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1420 );
1421 if (defined($num_params{units}) && $num_params{units}) {
1422 $answer_evaluator->install_pre_filter(\&check_units);
1423 }
1424 if (defined($num_params{strings}) && $num_params{strings}) {
1425 $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
1426 }
1427
1428
1429 $answer_evaluator->install_pre_filter(\&check_syntax);
1430
1431 $answer_evaluator->install_pre_filter(\&math_constants);
1432
1433
1434
1435 if ($mode eq 'std') {
1436 # do nothing
1437 } elsif ($mode eq 'strict') {
1438 $answer_evaluator->install_pre_filter(\&is_a_number);
1439 } elsif ($mode eq 'arith') {
1440 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
1441 } elsif ($mode eq 'frac') {
1442 $answer_evaluator->install_pre_filter(\&is_a_fraction);
1443
1444 } else {
1445 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1446 $formattedSubmittedAnswer = $in;
1104 } 1447 }
1105 else { ## error in parsing 1448
1106 my $ans_hash = new AnswerHash( 1449 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
1107 'score' => $score, 1450 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1108 'correct_ans' => $formattedCorrectAnswer,
1109 'student_ans' => "error: $parser->{htmlerror}",
1110 'ans_message' => $parser -> {error_msg},
1111 'type' => "${mode}_number",
1112 'preview_text_string' => $preview_text_string,
1113 'preview_latex_string' => $preview_latex_string,
1114 'original_student_ans' => $original_student_answer
1115 );
1116
1117 return $ans_hash;
1118 } 1451 }
1119 1452
1120 my $PGanswerMessage = ''; 1453 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1121
1122 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1123
1124 $inVal = '';
1125 $correctAnswer = math_constants($correctAnswer);
1126 my $formattedSubmittedAnswer = '';
1127
1128 #special variable $@ holds the last error from a Perl eval statement
1129 $@='';
1130
1131 if ($correctAnswer =~ /\S/) {
1132 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correctAnswer);
1133 }
1134 else {
1135 $PG_eval_errors = ' ';
1136 }
1137
1138 if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above
1139 $formattedSubmittedAnswer = $PG_eval_errors;
1140 $formattedSubmittedAnswer = clean_up_error_msg($formattedSubmittedAnswer);
1141 $PGanswerMessage = 'Tell your professor that there is an error in this problem';
1142 my $ans_hash = new AnswerHash(
1143 'score' => $score,
1144 'correct_ans' => $formattedCorrectAnswer,
1145 'student_ans' => $formattedSubmittedAnswer,
1146 'ans_message' => $PGanswerMessage,
1147 'type' => 'number',
1148 'preview_text_string' => $preview_text_string,
1149 'preview_latex_string' => $preview_latex_string,
1150 'original_student_ans' => $original_student_answer
1151 );
1152
1153 return $ans_hash;
1154 }
1155
1156 $in = &math_constants($in);
1157
1158 MODE_CASE: { ## bare block for "case" statement
1159 if ($mode eq 'std') {
1160 last MODE_CASE;
1161 }
1162 elsif ($mode eq 'strict') {
1163 unless (is_a_number($in)) {
1164 $PGanswerMessage = 'You must enter a number, e.g. -6, 5.3, or 6.12E-3';
1165 $formattedSubmittedAnswer = 'Incorrect number format';
1166 }
1167 else {
1168 last MODE_CASE;
1169 }
1170 }
1171 elsif ($mode eq 'arith') {
1172 unless (is_an_arithmetic_expression($in)) {
1173 $PGanswerMessage = 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2';
1174 $formattedSubmittedAnswer = 'Not an arithmetic expression';
1175 }
1176 else {
1177 last MODE_CASE;
1178 }
1179 }
1180 elsif ($mode eq 'frac') {
1181 unless (is_a_fraction($in)) {
1182 $PGanswerMessage = 'You must enter a number or fraction , e.g. -6 or 7/13';
1183 $formattedSubmittedAnswer = 'Not a number or fraction';
1184 }
1185 else {
1186 last MODE_CASE;
1187 }
1188 }
1189 else {
1190 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1191 $formattedSubmittedAnswer = $in;
1192 }
1193
1194 my $ans_hash = new AnswerHash(
1195 score => $score,
1196 correct_ans => $formattedCorrectAnswer,
1197 student_ans => $formattedSubmittedAnswer,
1198 ans_message => $PGanswerMessage,
1199 type => "${mode}_number",
1200 preview_text_string => $preview_text_string,
1201 preview_latex_string => $preview_latex_string,
1202 original_student_ans => $original_student_answer
1203 );
1204
1205 return $ans_hash;
1206 } # end of MODE_CASES bare block
1207
1208 $@ = '';
1209 if ($in =~ /\S/) {
1210
1211 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
1212 }
1213 else {
1214 $PG_eval_errors = ' ';
1215 }
1216
1217 if ($PG_eval_errors) { ##error message from eval or above
1218 $formattedSubmittedAnswer = $PG_eval_errors;
1219 $formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer);
1220 $PGanswerMessage = 'There is a syntax error in your answer';
1221 $PGanswerMessage = '' if $PG_eval_errors eq ' ';
1222 my $ans_hash = new AnswerHash(
1223 'score' => $score,
1224 'correct_ans' => $formattedCorrectAnswer,
1225 'student_ans' => $formattedSubmittedAnswer,
1226 'ans_message' => $PGanswerMessage,
1227 'type' => "${mode}_number",
1228 'preview_text_string' => $preview_text_string,
1229 'preview_latex_string' => $preview_latex_string,
1230 'original_student_ans' => $original_student_answer
1231 );
1232
1233 return $ans_hash;
1234 }
1235 else {
1236 $formattedSubmittedAnswer = prfmt($inVal,$format);
1237 }
1238
1239 my $permitted_error;
1240 if (defined($tolType) && $tolType eq 'absolute') {
1241 $permitted_error = $tol;
1242 }
1243 elsif ( abs($correctVal) <= $zeroLevel) {
1244 $permitted_error = $zeroLevelTol; ## want $tol to be non zero
1245 }
1246 else {
1247 $permitted_error = abs($tol*$correctVal);
1248 }
1249
1250 my $is_a_number = is_a_number($inVal);
1251 $score = 1 if ( ($is_a_number) and
1252 (abs( $inVal - $correctVal ) <= $permitted_error) );
1253 if ($PG_eval_errors) {
1254 $PGanswerMessage = 'There is a syntax error in your answer';
1255 }
1256 elsif (not $is_a_number) {
1257 $PGanswerMessage = 'Your answer does not evaluate to a number';
1258 }
1259
1260 my $ans_hash = new AnswerHash(
1261 'score' => $score,
1262 'correct_ans' => $formattedCorrectAnswer,
1263 'student_ans' => $formattedSubmittedAnswer,
1264 'ans_message' => $PGanswerMessage,
1265 'type' => "${mode}_number",
1266 'preview_text_string' => $preview_text_string,
1267 'preview_latex_string' => $preview_latex_string,
1268 'original_student_ans' => $original_student_answer
1269 );
1270
1271 return $ans_hash;
1272 };
1273
1274 return $answer_evaluator;
1275}
1276
1277## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1278sub NUM_CMP_LIST { # low level numeric list compare
1279 my %num_params = @_;
1280
1281 my @outputList;
1282 my $ans;
1283
1284 while ( @{$num_params{'answerList'}} ) {
1285 $ans = shift @{$num_params{'answerList'}};
1286 push( @outputList, NUM_CMP( 'correctAnswer' => $ans,
1287 'tolerance' => $num_params{'tolerance'},
1288 'tolType' => $num_params{'tolType'},
1289 'format' => $num_params{'format'},
1290 'mode' => $num_params{'mode'},
1291 'zeroLevel' => $num_params{'zeroLevel'},
1292 'zeroLevelTol' => $num_params{'zeroLevelTol'}
1293 ) 1454
1455 $rh_ans->{student_ans} = $rh_ans->{original_student_ans};
1456 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
1457 $rh_ans;}
1294 ); 1458 );
1295 }
1296 1459
1297 return @outputList; 1460 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1461 return $rh_ans unless $rh_ans->catch_error('EVAL');
1462 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1463 $rh_ans->clear_error('EVAL'); } );
1464 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
1465 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
1466 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
1467 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
1468
1469
1470 $answer_evaluator;
1298} 1471}
1472
1473
1299 1474
1300 1475
1301 1476
1302########################################################################## 1477##########################################################################
1303########################################################################## 1478##########################################################################
… …
1487 'params' => [], 1662 'params' => [],
1488 'limits' => [ [0,1], [0,1]], 1663 'limits' => [ [0,1], [0,1]],
1489 'reltol' => $main::functRelPercentTolDefault, 1664 'reltol' => $main::functRelPercentTolDefault,
1490 'numPoints' => $main::functNumOfPoints, 1665 'numPoints' => $main::functNumOfPoints,
1491 'zeroLevel' => $main::functZeroLevelDefault, 1666 'zeroLevel' => $main::functZeroLevelDefault,
1492 'zeroLevelTol' => $main::functZeroLevelTolDefault, 1667 'zeroLevelTol' => $main::functZeroLevelTolDefault,
1493 'debug' => 0, 1668 'debug' => 0,
1494 ); 1669 );
1495 1670
1496 my $var_ref = $options{'vars'}; 1671 my $var_ref = $options{'vars'};
1497 my $ra_params = $options{ 'params'}; 1672 my $ra_params = $options{ 'params'};
… …
1499 my $relPercentTol= $options{'reltol'}; 1674 my $relPercentTol= $options{'reltol'};
1500 my $numPoints = $options{'numPoints'}; 1675 my $numPoints = $options{'numPoints'};
1501 my $zeroLevel = $options{'zeroLevel'}; 1676 my $zeroLevel = $options{'zeroLevel'};
1502 my $zeroLevelTol = $options{'zeroLevelTol'}; 1677 my $zeroLevelTol = $options{'zeroLevelTol'};
1503 1678
1504 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1679 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1505 'var' => $var_ref, 1680 'var' => $var_ref,
1506 'limits' => $limit_ref, 1681 'limits' => $limit_ref,
1507 'tolerance' => $relPercentTol, 1682 'tolerance' => $relPercentTol,
1508 'tolType' => 'relative', 1683 'tolType' => 'relative',
1509 'numPoints' => $numPoints, 1684 'numPoints' => $numPoints,
1510 'mode' => 'std', 1685 'mode' => 'std',
1511 'maxConstantOfIntegration' => 10**100, 1686 'maxConstantOfIntegration' => 10**100,
1512 'zeroLevel' => $zeroLevel, 1687 'zeroLevel' => $zeroLevel,
1513 'zeroLevelTol' => $zeroLevelTol, 1688 'zeroLevelTol' => $zeroLevelTol,
1514 'scale_norm' => 1, 1689 'scale_norm' => 1,
1515 'params' => $ra_params, 1690 'params' => $ra_params,
1516 'debug' => $options{debug} , 1691 'debug' => $options{debug} ,
1517 ); 1692 );
1518 1693
1519} 1694}
1520 1695
1521sub function_cmp { 1696sub function_cmp {
… …
1523 1698
1524 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) { 1699 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
1525 function_invalid_params( $correctEqn ); 1700 function_invalid_params( $correctEqn );
1526 } 1701 }
1527 else { 1702 else {
1528 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1703 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1529 'var' => $var, 1704 'var' => $var,
1530 'limits' => [$llimit, $ulimit], 1705 'limits' => [$llimit, $ulimit],
1531 'tolerance' => $relPercentTol, 1706 'tolerance' => $relPercentTol,
1532 'tolType' => 'relative', 1707 'tolType' => 'relative',
1533 'numPoints' => $numPoints, 1708 'numPoints' => $numPoints,
1534 'mode' => 'std', 1709 'mode' => 'std',
1535 'maxConstantOfIntegration' => 0, 1710 'maxConstantOfIntegration' => 0,
1536 'zeroLevel' => $zeroLevel, 1711 'zeroLevel' => $zeroLevel,
1537 'zeroLevelTol' => $zeroLevelTol 1712 'zeroLevelTol' => $zeroLevelTol
1538 ); 1713 );
1539 } 1714 }
1540} 1715}
1541 1716
1542sub function_cmp_up_to_constant { ## for antiderivative problems 1717sub function_cmp_up_to_constant { ## for antiderivative problems
… …
1544 1719
1545 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) { 1720 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
1546 function_invalid_params( $correctEqn ); 1721 function_invalid_params( $correctEqn );
1547 } 1722 }
1548 else { 1723 else {
1549 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1724 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1550 'var' => $var, 1725 'var' => $var,
1551 'limits' => [$llimit, $ulimit], 1726 'limits' => [$llimit, $ulimit],
1552 'tolerance' => $relPercentTol, 1727 'tolerance' => $relPercentTol,
1553 'tolType' => 'relative', 1728 'tolType' => 'relative',
1554 'numPoints' => $numPoints, 1729 'numPoints' => $numPoints,
1555 'mode' => 'antider', 1730 'mode' => 'antider',
1556 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1731 'maxConstantOfIntegration' => $maxConstantOfIntegration,
1557 'zeroLevel' => $zeroLevel, 1732 'zeroLevel' => $zeroLevel,
1558 'zeroLevelTol' => $zeroLevelTol 1733 'zeroLevelTol' => $zeroLevelTol
1559 ); 1734 );
1560 } 1735 }
1561} 1736}
1562 1737
1563sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance 1738sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance
… …
1590 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) { 1765 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
1591 function_invalid_params( $correctEqn ); 1766 function_invalid_params( $correctEqn );
1592 } 1767 }
1593 1768
1594 else { 1769 else {
1595 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1770 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1596 'var' => $var, 1771 'var' => $var,
1597 'limits' => [$llimit, $ulimit], 1772 'limits' => [$llimit, $ulimit],
1598 'tolerance' => $absTol, 1773 'tolerance' => $absTol,
1599 'tolType' => 'absolute', 1774 'tolType' => 'absolute',
1600 'numPoints' => $numPoints, 1775 'numPoints' => $numPoints,
1601 'mode' => 'antider', 1776 'mode' => 'antider',
1602 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1777 'maxConstantOfIntegration' => $maxConstantOfIntegration,
1603 'zeroLevel' => 0, 1778 'zeroLevel' => 0,
1604 'zeroLevelTol' => 0 1779 'zeroLevelTol' => 0
1605 ); 1780 );
1606 } 1781 }
1607} 1782}
1608 1783
1609## The following answer evaluator for comparing multivarable functions was 1784## The following answer evaluator for comparing multivarable functions was
… …
1735sub fun_cmp { 1910sub fun_cmp {
1736 my $correctAnswer = shift @_; 1911 my $correctAnswer = shift @_;
1737 my %opt = @_; 1912 my %opt = @_;
1738 1913
1739 assign_option_aliases( \%opt, 1914 assign_option_aliases( \%opt,
1740 'vars' => 'var', # set the standard option 'var' to the one specified as vars 1915 'vars' => 'var', # set the standard option 'var' to the one specified as vars
1741 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain 1916 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain
1742 'reltol' => 'relTol', 1917 'reltol' => 'relTol',
1743 'param' => 'params', 1918 'param' => 'params',
1744 ); 1919 );
1745 1920
1746 set_default_options( \%opt, 1921 set_default_options( \%opt,
1747 'var' => $functVarDefault, 1922 'var' => $functVarDefault,
1748 'params' => [], 1923 'params' => [],
1749 'limits' => [[$functLLimitDefault, $functULimitDefault]], 1924 'limits' => [[$functLLimitDefault, $functULimitDefault]],
1750 'mode' => 'std', 1925 'mode' => 'std',
1751 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative', 1926 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative',
1752 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined 1927 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined
1753 'relTol' => $functRelPercentTolDefault, 1928 'relTol' => $functRelPercentTolDefault,
1754 'numPoints' => $functNumOfPoints, 1929 'numPoints' => $functNumOfPoints,
1755 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 1930 'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
1756 'zeroLevel' => $functZeroLevelDefault, 1931 'zeroLevel' => $functZeroLevelDefault,
1757 'zeroLevelTol' => $functZeroLevelTolDefault, 1932 'zeroLevelTol' => $functZeroLevelTolDefault,
1758 'debug' => 0, 1933 'debug' => 0,
1759 ); 1934 );
1760 1935
1761 1936
1762 1937
1763 # allow var => 'x' as an abbreviation for var => ['x'] 1938 # allow var => 'x' as an abbreviation for var => ['x']
… …
1778 $tolType = 'relative'; 1953 $tolType = 'relative';
1779 $tol = $out_options{'relTol'}; 1954 $tol = $out_options{'relTol'};
1780 delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 1955 delete($out_options{'tol'}) if exists( $out_options{'tol'} );
1781 } 1956 }
1782 1957
1783
1784
1785 my @output_list = (); 1958 my @output_list = ();
1786 # thread over lists 1959 # thread over lists
1787 my @ans_list = (); 1960 my @ans_list = ();
1788 1961
1789 if ( ref($correctAnswer) eq 'ARRAY' ) { 1962 if ( ref($correctAnswer) eq 'ARRAY' ) {
… …
1791 } 1964 }
1792 else { 1965 else {
1793 push( @ans_list, $correctAnswer ); 1966 push( @ans_list, $correctAnswer );
1794 } 1967 }
1795 1968
1796
1797
1798 # produce answer evaluators 1969 # produce answer evaluators
1799 foreach my $ans (@ans_list) { 1970 foreach my $ans (@ans_list) {
1800 push(@output_list, 1971 push(@output_list,
1801 FUNCTION_CMP( 'correctEqn' => $ans, 1972 FUNCTION_CMP( 'correctEqn' => $ans,
1802 'var' => $out_options{'var'}, 1973 'var' => $out_options{'var'},
1803 'limits' => $out_options{'limits'}, 1974 'limits' => $out_options{'limits'},
1804 'tolerance' => $tol, 1975 'tolerance' => $tol,
1805 'tolType' => $tolType, 1976 'tolType' => $tolType,
1806 'numPoints' => $out_options{'numPoints'}, 1977 'numPoints' => $out_options{'numPoints'},
1807 'mode' => $out_options{'mode'}, 1978 'mode' => $out_options{'mode'},
1808 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'}, 1979 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'},
1809 'zeroLevel' => $out_options{'zeroLevel'}, 1980 'zeroLevel' => $out_options{'zeroLevel'},
1810 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1981 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1811 'params' => $out_options{'params'}, 1982 'params' => $out_options{'params'},
1812 'debug' => $out_options{'debug'}, 1983 'debug' => $out_options{'debug'},
1813 ), 1984 ),
1814 ); 1985 );
1815 } 1986 }
1816 1987
1817 return @output_list; 1988 return @output_list;
… …
1839 2010
1840sub FUNCTION_CMP { 2011sub FUNCTION_CMP {
1841 my %func_params = @_; 2012 my %func_params = @_;
1842 2013
1843 my $correctEqn = $func_params{'correctEqn'}; 2014 my $correctEqn = $func_params{'correctEqn'};
1844 my $var = $func_params{'var'}; 2015 my $var = $func_params{'var'};
1845 my $ra_limits = $func_params{'limits'}; 2016 my $ra_limits = $func_params{'limits'};
1846 my $tol = $func_params{'tolerance'}; 2017 my $tol = $func_params{'tolerance'};
1847 my $tolType = $func_params{'tolType'}; 2018 my $tolType = $func_params{'tolType'};
1848 my $numPoints = $func_params{'numPoints'}; 2019 my $numPoints = $func_params{'numPoints'};
1849 my $mode = $func_params{'mode'}; 2020 my $mode = $func_params{'mode'};
1850 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 2021 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
1851 my $zeroLevel = $func_params{'zeroLevel'}; 2022 my $zeroLevel = $func_params{'zeroLevel'};
1852 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 2023 my $zeroLevelTol = $func_params{'zeroLevelTol'};
1853 2024
1854 2025
1855 # Check that everything is defined: 2026 # Check that everything is defined:
… …
1886 $numPoints = $functNumOfPoints unless defined $numPoints; 2057 $numPoints = $functNumOfPoints unless defined $numPoints;
1887 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 2058 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
1888 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 2059 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
1889 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 2060 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
1890 2061
1891 $func_params{'var'} = $var; 2062 $func_params{'var'} = $var;
1892 $func_params{'limits'} = \@limits; 2063 $func_params{'limits'} = \@limits;
1893 $func_params{'tolerance'}= $tol; 2064 $func_params{'tolerance'} = $tol;
1894 $func_params{'tolType'} = $tolType; 2065 $func_params{'tolType'} = $tolType;
1895 $func_params{'numPoints'}= $numPoints; 2066 $func_params{'numPoints'} = $numPoints;
1896 $func_params{'mode'} = $mode; 2067 $func_params{'mode'} = $mode;
1897 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 2068 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
1898 $func_params{'zeroLevel'} = $zeroLevel; 2069 $func_params{'zeroLevel'} = $zeroLevel;
1899 $func_params{'zeroLevelTol'} = $zeroLevelTol; 2070 $func_params{'zeroLevelTol'} = $zeroLevelTol;
2071
1900######################################################## 2072########################################################
1901# End of cleanup of calling parameters 2073# End of cleanup of calling parameters
1902######################################################## 2074########################################################
1903 my $i; #for use with loops 2075 my $i; #for use with loops
1904 my $PGanswerMessage = ""; 2076 my $PGanswerMessage = "";
1905 my $originalCorrEqn = $correctEqn; 2077 my $originalCorrEqn = $correctEqn;
1906 2078
1907#prepare the correct answer and check it's syntax 2079#prepare the correct answer and check it's syntax
1908 my $rh_correct_ans = new AnswerHash; 2080 my $rh_correct_ans = new AnswerHash;
1909 $rh_correct_ans->input($correctEqn); 2081 $rh_correct_ans->input($correctEqn);
1910 $rh_correct_ans = check_syntax($rh_correct_ans); 2082 $rh_correct_ans = check_syntax($rh_correct_ans);
1911 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2083 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1912 $rh_correct_ans->clear_error(); 2084 $rh_correct_ans->clear_error();
1913 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ], 2085 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ],
… …
1916 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans}; 2088 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
1917 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2089 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1918 2090
1919#create the evaluation points 2091#create the evaluation points
1920 my $random_for_answers = new PGrandom($main::PG_original_problemSeed); 2092 my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
1921 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator 2093 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
1922 my (@evaluation_points); 2094 my (@evaluation_points);
1923 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) { 2095 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) {
1924 my (@vars,$iteration_limit); 2096 my (@vars,$iteration_limit);
1925 for( my $i = 0; $i < @VARS; $i++ ) { 2097 for( my $i = 0; $i < @VARS; $i++ ) {
1926 my $iteration_limit = 10; 2098 my $iteration_limit = 10;
… …
1935 push(@evaluation_points,\@vars); 2107 push(@evaluation_points,\@vars);
1936 } 2108 }
1937 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points); 2109 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
1938 2110
1939 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters); 2111 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
1940 #warn "coeff", join(" | ", @{$COEFFS}); 2112 #warn "coeff", join(" | ", @{$COEFFS});
1941 2113
1942#construct the answer evaluator 2114#construct the answer evaluator
1943 my $answer_evaluator = new AnswerEvaluator; 2115 my $answer_evaluator = new AnswerEvaluator;
1944 $answer_evaluator->{debug} = $func_params{debug}; 2116 $answer_evaluator->{debug} = $func_params{debug};
1945 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn, 2117 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn,
… …
2098 push(@out, $temp_hash->input()); 2270 push(@out, $temp_hash->input());
2099 2271
2100 } 2272 }
2101 if ($PGanswerMessage) { 2273 if ($PGanswerMessage) {
2102 $rh_ans->input( "( " . join(", ", @out ) . " )" ); 2274 $rh_ans->input( "( " . join(", ", @out ) . " )" );
2103 $rh_ans->throw_error('SYTNAX', 'There is a syntax error in your answer.'); 2275 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
2104 } else { 2276 } else {
2105 $rh_ans->input( [@out] ); 2277 $rh_ans->input( [@out] );
2106 } 2278 }
2107 $rh_ans; 2279 $rh_ans;
2108} 2280}
… …
2440 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 2612 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
2441 2613
2442 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 2614 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance
2443 #warn "diff = $diff"; 2615 #warn "diff = $diff";
2444 2616
2445 $diff = abs(( $inVal - ($correctVal-$tol_val ) )/$tol_val -1 ) if abs($tol_val) > $options{zeroLevel}; 2617 $diff = ( $inVal - ($correctVal-$tol_val ) )/abs($tol_val) -1 if abs($tol_val) > $options{zeroLevel};
2446 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel}; 2618 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel};
2447 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal"; 2619 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
2448 } 2620 }
2449 } 2621 }
2450 last if $errors; # break if there are any errors. 2622 last if $errors; # break if there are any errors.
… …
2455 push(@correct_values,( $inVal - ($correctVal-$tol_val ) )); 2627 push(@correct_values,( $inVal - ($correctVal-$tol_val ) ));
2456 push(@differences, $diff); 2628 push(@differences, $diff);
2457 push(@tol_values,$tol_val); 2629 push(@tol_values,$tol_val);
2458 } 2630 }
2459 $rh_ans ->{ra_differences} = \@differences; 2631 $rh_ans ->{ra_differences} = \@differences;
2460 $rh_ans ->{ra_student_values} = \@student_values; # values from student function 2632 $rh_ans ->{ra_student_values} = \@student_values;
2461 $rh_ans ->{ra_adjusted_instructor_values} = \@correct_values; #values 2633 $rh_ans ->{ra_adjusted_student_values} = \@correct_values;
2462 $rh_ans->{ra_instructor_values}=\@tol_values; 2634 $rh_ans->{ra_tol_values}=\@tol_values;
2463 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 2635 $rh_ans->throw_error('EVAL', $errors) if defined($errors);
2464 $rh_ans; 2636 $rh_ans;
2465} 2637}
2466 2638
2467 2639
… …
2523## individual filters below it 2695## individual filters below it
2524sub str_filters { 2696sub str_filters {
2525 my $stringToFilter = shift @_; 2697 my $stringToFilter = shift @_;
2526 my @filters_to_use = @_; 2698 my @filters_to_use = @_;
2527 my %known_filters = ( 'remove_whitespace' => undef, 2699 my %known_filters = ( 'remove_whitespace' => undef,
2528 'compress_whitespace' => undef, 2700 'compress_whitespace' => undef,
2529 'trim_whitespace' => undef, 2701 'trim_whitespace' => undef,
2530 'ignore_case' => undef, 2702 'ignore_case' => undef,
2531 'ignore_order' => undef 2703 'ignore_order' => undef
2532 ); 2704 );
2533 2705
2534 #test for unknown filters 2706 #test for unknown filters
2535 my $filter; 2707 my $filter;
2536 foreach $filter (@filters_to_use) { 2708 foreach $filter (@filters_to_use) {
… …
2658sub std_str_cmp { # compare strings 2830sub std_str_cmp { # compare strings
2659 my $correctAnswer = shift @_; 2831 my $correctAnswer = shift @_;
2660 my @filters = ( 'compress_whitespace', 'ignore_case' ); 2832 my @filters = ( 'compress_whitespace', 'ignore_case' );
2661 my $type = 'std_str_cmp'; 2833 my $type = 'std_str_cmp';
2662 STR_CMP( 'correctAnswer' => $correctAnswer, 2834 STR_CMP( 'correctAnswer' => $correctAnswer,
2663 'filters' => \@filters, 2835 'filters' => \@filters,
2664 'type' => $type 2836 'type' => $type
2665 ); 2837 );
2666} 2838}
2667 2839
2668sub std_str_cmp_list { # alias for std_str_cmp 2840sub std_str_cmp_list { # alias for std_str_cmp
2669 my @answerList = @_; 2841 my @answerList = @_;
… …
2872## IN: a hashtable with the following entries (error-checking to be added later?): 3044## IN: a hashtable with the following entries (error-checking to be added later?):
2873## correctAnswer -- the correct answer, before filtering 3045## correctAnswer -- the correct answer, before filtering
2874## filters -- reference to an array containing the filters to be applied 3046## filters -- reference to an array containing the filters to be applied
2875## type -- a string containing the type of answer evaluator in use 3047## type -- a string containing the type of answer evaluator in use
2876## OUT: a reference to an answer evaluator subroutine 3048## OUT: a reference to an answer evaluator subroutine
3049
2877sub STR_CMP { 3050sub STR_CMP {
2878 my %str_params = @_; 3051 my %str_params = @_;
2879
2880 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} ); 3052 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} );
2881
2882 my $answer_evaluator = sub { 3053 my $answer_evaluator = sub {
2883 my $in = shift @_; 3054 my $in = shift @_;
2884 $in = '' unless defined $in; 3055 $in = '' unless defined $in;
2885 my $original_student_ans = $in; 3056 my $original_student_ans = $in;
2886
2887 $in = str_filters( $in, @{$str_params{'filters'}} ); 3057 $in = str_filters( $in, @{$str_params{'filters'}} );
2888
2889 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0; 3058 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0;
2890 my $ans_hash = new AnswerHash( 3059 my $ans_hash = new AnswerHash( 'score' => $correctQ,
2891 'score' => $correctQ,
2892 'correct_ans' => $str_params{'correctAnswer'}, 3060 'correct_ans' => $str_params{'correctAnswer'},
2893 'student_ans' => $in, 3061 'student_ans' => $in,
2894 'ans_message' => '', 3062 'ans_message' => '',
2895 'type' => $str_params{'type'}, 3063 'type' => $str_params{'type'},
2896 'preview_text_string' => $in, 3064 'preview_text_string' => $in,
2897 'preview_latex_string' => $in, 3065 'preview_latex_string' => $in,
2898 'original_student_ans' => $original_student_ans 3066 'original_student_ans' => $original_student_ans
2899 ); 3067 );
2900
2901 return $ans_hash; 3068 return $ans_hash;
2902 }; 3069 };
2903
2904 return $answer_evaluator; 3070 return $answer_evaluator;
2905} 3071}
2906
2907
2908 3072
2909########################################################################## 3073##########################################################################
2910########################################################################## 3074##########################################################################
2911## Miscellaneous answer evaluators 3075## Miscellaneous answer evaluators
2912 3076
… …
3191 $problem_result{score} = $allAnswersCorrectQ; 3355 $problem_result{score} = $allAnswersCorrectQ;
3192 3356
3193 # I don't like to put in this bit of code. 3357 # I don't like to put in this bit of code.
3194 # It makes it hard to construct error free problem graders 3358 # It makes it hard to construct error free problem graders
3195 # I would prefer to know that the problem score was numeric. 3359 # I would prefer to know that the problem score was numeric.
3196 unless (defined($problem_state{recorded_score}) and $problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 3360 unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
3197 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 3361 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores
3198 } 3362 }
3199 # 3363 #
3200 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 3364 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
3201 $problem_state{recorded_score} = 1; 3365 $problem_state{recorded_score} = 1;
… …
3424## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]] 3588## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
3425## a reference to an array of limits -- [llim, ulim] 3589## a reference to an array of limits -- [llim, ulim]
3426## an array of array references -- ([llim,ulim], [llim,ulim]) 3590## an array of array references -- ([llim,ulim], [llim,ulim])
3427## an array of limits -- (llim,ulim) 3591## an array of limits -- (llim,ulim)
3428## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim]) 3592## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
3593
3429sub get_limits_array { 3594sub get_limits_array {
3430 my $in = shift @_; 3595 my $in = shift @_;
3431 my @out; 3596 my @out;
3432 3597
3433 if( not defined($in) ) { #if nothing defined, build default array and return 3598 if( not defined($in) ) { #if nothing defined, build default array and return
… …
3479 }; 3644 };
3480 3645
3481 return $error_response; 3646 return $error_response;
3482} 3647}
3483 3648
3484# outputs a hash to the screen 3649
3485# sub display_options { 3650#########################################################################
3486# my %options = @_; 3651# Filters for answer evaluators
3487# my $out_string = ""; 3652#########################################################################
3488# foreach my $key (keys %options) { 3653
3489# $out_string .= " $key => $options{$key},<BR>";
3490# }
3491# return $out_string;
3492# }
3493 3654
3494sub is_a_number { 3655sub is_a_number {
3495 my ($num) = @_; 3656 my ($num,%options) = @_;
3657 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3658 my ($rh_ans);
3659 if ($process_ans_hash) {
3660 $rh_ans = $num;
3661 $num = $rh_ans->{student_ans};
3662 }
3663
3496 my $is_a_number = 0; 3664 my $is_a_number = 0;
3497 return $is_a_number unless defined($num); 3665 return $is_a_number unless defined($num);
3498 $num =~ s/^\s*//; ## remove initial spaces 3666 $num =~ s/^\s*//; ## remove initial spaces
3499 $num =~ s/\s*$//; ## remove trailing spaces 3667 $num =~ s/\s*$//; ## remove trailing spaces
3500 3668
3501 ## the following is copied from the online perl manual 3669 ## the following is copied from the online perl manual
3502 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ 3670 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
3503 $is_a_number = 1; 3671 $is_a_number = 1;
3504 } 3672 }
3505 3673
3674 if ($process_ans_hash) {
3675 if ($is_a_number == 1 ) {
3676 $rh_ans->{student_ans}=$num;
3677 return $rh_ans;
3678 } else {
3679 $rh_ans->{student_ans} = "Incorrect number format: You must enter a number, e.g. -6, 5.3, or 6.12E-3";
3680 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3681 return $rh_ans;
3682 }
3683 } else {
3506 return $is_a_number; 3684 return $is_a_number;
3685 }
3507} 3686}
3508 3687
3509sub is_a_fraction { 3688sub is_a_fraction {
3510 3689 my ($num,%options) = @_;
3511 ## does not test for validity, just for allowed characters 3690 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3512 ## note that an integer will qualify as a fraction 3691 my ($rh_ans);
3513 my ($exp) = @_; 3692 if ($process_ans_hash) {
3693 $rh_ans = $num;
3694 $num = $rh_ans->{student_ans};
3695 }
3696
3514 my $is_a_fraction = 0; 3697 my $is_a_fraction = 0;
3515 return $is_a_fraction unless defined($exp); 3698 return $is_a_fraction unless defined($num);
3699 $num =~ s/^\s*//; ## remove initial spaces
3700 $num =~ s/\s*$//; ## remove trailing spaces
3701
3516 if ($exp =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) { 3702 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
3517 $is_a_fraction = 1; 3703 $is_a_fraction = 1;
3518 } 3704 }
3519 3705
3706 if ($process_ans_hash) {
3707 if ($is_a_fraction == 1 ) {
3708 $rh_ans->{student_ans}=$num;
3709 return $rh_ans;
3710 } else {
3711 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
3712 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3713 return $rh_ans;
3714 }
3715
3716 } else {
3520 return $is_a_fraction; 3717 return $is_a_fraction;
3718 }
3521} 3719}
3522 3720
3721
3523sub is_an_arithmetic_expression { 3722sub is_an_arithmetic_expression {
3524 ## does not test for validity, just for allowed characters 3723 my ($num,%options) = @_;
3525 my ($exp) = @_; 3724 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3725 my ($rh_ans);
3726 if ($process_ans_hash) {
3727 $rh_ans = $num;
3728 $num = $rh_ans->{student_ans};
3729 }
3730
3526 my $is_an_arithmetic_expression = 0; 3731 my $is_an_arithmetic_expression = 0;
3732 return $is_an_arithmetic_expression unless defined($num);
3733 $num =~ s/^\s*//; ## remove initial spaces
3734 $num =~ s/\s*$//; ## remove trailing spaces
3735
3527 if ($exp =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) { 3736 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
3528 $is_an_arithmetic_expression = 1; 3737 $is_an_arithmetic_expression = 1;
3529 } 3738 }
3530 3739
3740 if ($process_ans_hash) {
3741 if ($is_an_arithmetic_expression == 1 ) {
3742 $rh_ans->{student_ans}=$num;
3743 return $rh_ans;
3744 } else {
3745
3746 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
3747 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
3748 return $rh_ans;
3749 }
3750
3751 } else {
3531 return $is_an_arithmetic_expression; 3752 return $is_an_arithmetic_expression;
3753 }
3532} 3754}
3533 3755
3534#replaces pi, e, and ^ with their Perl equivalents 3756#replaces pi, e, and ^ with their Perl equivalents
3535sub math_constants { 3757sub math_constants {
3536 my($in) = @_; 3758 my($in,%options) = @_;
3759 my $rh_ans;
3760 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
3761 if ($process_ans_hash) {
3762 $rh_ans = $in;
3763 $in = $rh_ans->{student_ans};
3764 }
3765
3537 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 3766 $in =~s/\bpi\b/(4*atan2(1,1))/ge;
3538 $in =~s/\be\b/(exp(1))/ge; 3767 $in =~s/\be\b/(exp(1))/ge;
3539 $in =~s/\^/**/g; 3768 $in =~s/\^/**/g;
3540 3769
3770 if ($process_ans_hash) {
3771 $rh_ans->{student_ans}=$in;
3772 return $rh_ans;
3773 } else {
3541 return $in; 3774 return $in;
3775 }
3542} 3776}
3543 3777
3544sub clean_up_error_msg { 3778sub clean_up_error_msg {
3545 my $msg = $_[0]; 3779 my $msg = $_[0];
3546 $msg =~ s/^\[[^\]]*\][^:]*://; 3780 $msg =~ s/^\[[^\]]*\][^:]*://;
… …
3574 3808
3575 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 3809 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3576 } 3810 }
3577 else { 3811 else {
3578 $out = $number; 3812 $out = $number;
3579 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3580 } 3813 }
3581 3814
3582 return $out; 3815 return $out;
3583} 3816}
3584 3817
… …
3626 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1}); 3859 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
3627 } 3860 }
3628 } 3861 }
3629 foreach my $key (keys %default_options) { 3862 foreach my $key (keys %default_options) {
3630 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) { 3863 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
3631 $rh_options->{$key} = $default_options{$key}; # using 'defined' instead of 'exists' allows 3864 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define
3632 # tol => undef to allow the tol option, but doesn't define
3633 # this key unless tol is explicitly defined. 3865 # this key unless tol is explicitly defined.
3634 } 3866 }
3635 } 3867 }
3636} 3868}
3637# Use this to assign aliases for the standard options 3869# Use this to assign aliases for the standard options
Legend:
Removed from v.5  
changed lines
  Added in v.35
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9