[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 2 Revision 53
1#!/usr/bin/perl 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
… …
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}
111 112
113
114my ($BR , # convenient localizations.
115 $PAR ,
116 $numRelPercentTolDefault ,
117 $numZeroLevelDefault ,
118 $numZeroLevelTolDefault ,
119 $numAbsTolDefault ,
120 $numFormatDefault ,
121 $functRelPercentTolDefault ,
122 $functZeroLevelDefault ,
123 $functZeroLevelTolDefault ,
124 $functAbsTolDefault ,
125 $functNumOfPoints ,
126 $functVarDefault ,
127 $functLLimitDefault ,
128 $functULimitDefault ,
129 $functMaxConstantOfIntegration
130);
131
132sub _PGanswermacros_init {
133
112my $BR = $main::BR; # convenient localizations. 134 $BR = $main::BR; # convenient localizations.
113my $PAR = $main::PAR; 135 $PAR = $main::PAR;
114 136
115# import defaults 137 # import defaults
116# these are now imported from the %envir variable 138 # these are now imported from the %envir variable
117my $numRelPercentTolDefault = $main::numRelPercentTolDefault; 139 $numRelPercentTolDefault = $main::numRelPercentTolDefault;
118my $numZeroLevelDefault = $main::numZeroLevelDefault; 140 $numZeroLevelDefault = $main::numZeroLevelDefault;
119my $numZeroLevelTolDefault = $main::numZeroLevelTolDefault; 141 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault;
120my $numAbsTolDefault = $main::numAbsTolDefault; 142 $numAbsTolDefault = $main::numAbsTolDefault;
121my $numFormatDefault = $main::numFormatDefault; 143 $numFormatDefault = $main::numFormatDefault;
122 144
123my $functRelPercentTolDefault = $main::functRelPercentTolDefault; 145 $functRelPercentTolDefault = $main::functRelPercentTolDefault;
124my $functZeroLevelDefault = $main::functZeroLevelDefault; 146 $functZeroLevelDefault = $main::functZeroLevelDefault;
125my $functZeroLevelTolDefault = $main::functZeroLevelTolDefault; 147 $functZeroLevelTolDefault = $main::functZeroLevelTolDefault;
126my $functAbsTolDefault = $main::functAbsTolDefault; 148 $functAbsTolDefault = $main::functAbsTolDefault;
127my $functNumOfPoints = $main::functNumOfPoints; 149 $functNumOfPoints = $main::functNumOfPoints;
128my $functVarDefault = $main::functVarDefault; 150 $functVarDefault = $main::functVarDefault;
129my $functLLimitDefault = $main::functLLimitDefault; 151 $functLLimitDefault = $main::functLLimitDefault;
130my $functULimitDefault = $main::functULimitDefault; 152 $functULimitDefault = $main::functULimitDefault;
131my $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration; 153 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration;
132 154
133 155
156
157}
134 158
135########################################################################## 159##########################################################################
136########################################################################## 160##########################################################################
137## Number answer evaluators 161## Number answer evaluators
138 162
… …
329 The student answer can contain elementary functions, e.g. sin(.3+pi/2) 353 The student answer can contain elementary functions, e.g. sin(.3+pi/2)
330 354
331=cut 355=cut
332 356
333sub std_num_cmp { # compare numbers allowing use of elementary functions 357sub std_num_cmp { # compare numbers allowing use of elementary functions
334 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 358 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
335 359
336 NUM_CMP( 'correctAnswer' => $correctAnswer, 360 my %options = ( 'tolerance' => $relPercentTol,
337 'tolerance' => $relPercentTol,
338 'tolType' => 'relative',
339 'format' => $format, 361 'format' => $format,
362 'zeroLevel' => $zeroLevel,
363 'zeroLevelTol' => $zeroLevelTol
364 );
365
366 set_default_options( \%options,
367 'tolType' => 'relative',
368 'tolerance' => $numRelPercentTolDefault,
340 'mode' => 'std', 369 'mode' => 'std',
341 'zeroLevel' => $zeroLevel, 370 'format' => $numFormatDefault,
342 'zeroLevelTol' => $zeroLevelTol 371 'relTol' => $numRelPercentTolDefault,
372 'zeroLevel' => $numZeroLevelDefault,
373 'zeroLevelTol' => $numZeroLevelTolDefault,
374 'debug' => 0,
343 ); 375 );
376
377 num_cmp([$correctAnswer], %options);
344} 378}
345 379
346## Similar to std_num_cmp but accepts a list of numbers in the form 380## Similar to std_num_cmp but accepts a list of numbers in the form
347## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...) 381## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
348## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default 382## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
349## You must enter a format and tolerance 383## You must enter a format and tolerance
350sub std_num_cmp_list { 384sub std_num_cmp_list {
351 my ( $relPercentTol, $format, @answerList) = @_; 385 my ( $relPercentTol, $format, @answerList) = @_;
352 386
353 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 387 my %options = ( 'tolerance' => $relPercentTol,
354 'tolType' => 'relative', 388 'format' => $format,
355 'format' => $format,
356 'mode' => 'std',
357 'zeroLevel' => $numZeroLevelDefault,
358 'zeroLevelTol' => $numZeroLevelTolDefault,
359 'answerList' => \@answerList
360 ); 389 );
361}
362 390
391 set_default_options( \%options,
392 'tolType' => 'relative',
393 'tolerance' => $numRelPercentTolDefault,
394 'mode' => 'std',
395 'format' => $numFormatDefault,
396 'relTol' => $numRelPercentTolDefault,
397 'zeroLevel' => $numZeroLevelDefault,
398 'zeroLevelTol' => $numZeroLevelTolDefault,
399 'debug' => 0,
400 );
401
402 num_cmp(\@answerList, %options);
403
404}
405
363sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance 406sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
364 my ( $correctAnswer, $absTol, $format) = @_; 407 my ( $correctAnswer, $absTol, $format) = @_;
408 my %options = ( 'tolerance' => $absTol,
409 'format' => $format);
410
411 set_default_options (\%options,
412 'tolType' => 'absolute',
413 'tolerance' => $absTol,
414 'mode' => 'std',
415 'format' => $numFormatDefault,
416 'zeroLevel' => 0,
417 'zeroLevelTol' => 0,
418 'debug' => 0,
419 );
365 420
366 NUM_CMP( 'correctAnswer' => $correctAnswer, 421 num_cmp([$correctAnswer], %options);
367 'tolerance' => $absTol,
368 'tolType' => 'absolute',
369 'format' => $format,
370 'mode' => 'std',
371 'zeroLevel' => 0,
372 'zeroLevelTol' => 0
373 );
374} 422}
375 423
376## See std_num_cmp_list for usage 424## See std_num_cmp_list for usage
425
377sub std_num_cmp_abs_list { 426sub std_num_cmp_abs_list {
378 my ( $absTol, $format, @answerList ) = @_; 427 my ( $absTol, $format, @answerList ) = @_;
379 428
380 NUM_CMP_LIST( 'tolerance' => $absTol, 429 my %options = ( 'tolerance' => $absTol,
381 'tolType' => 'absolute', 430 'format' => $format,
382 'format' => $format,
383 'mode' => 'std',
384 'zeroLevel' => 0,
385 'zeroLevelTol' => 0,
386 'answerList' => \@answerList
387 ); 431 );
388}
389 432
433 set_default_options( \%options,
434 'tolType' => 'absolute',
435 'tolerance' => $absTol,
436 'mode' => 'std',
437 'format' => $numFormatDefault,
438 'zeroLevel' => 0,
439 'zeroLevelTol' => 0,
440 'debug' => 0,
441 );
442
443 num_cmp(\@answerList, %options);
444
445}
390 446
391sub frac_num_cmp { # only allow fractions and numbers as submitted answer 447sub frac_num_cmp { # only allow fractions and numbers as submitted answer
448
392 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 449 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
450
451 my %options = ( 'tolerance' => $relPercentTol,
452 'format' => $format,
453 'zeroLevel' => $zeroLevel,
454 'zeroLevelTol' => $zeroLevelTol
455 );
393 456
394 NUM_CMP( 'correctAnswer' => $correctAnswer, 457 set_default_options( \%options,
458 'tolType' => 'relative',
395 'tolerance' => $relPercentTol, 459 'tolerance' => $relPercentTol,
396 'tolType' => 'relative', 460 'mode' => 'frac',
397 'format' => $format, 461 'format' => $numFormatDefault,
398 'mode' => 'frac', 462 'zeroLevel' => $numZeroLevelDefault,
399 'zeroLevel' => $zeroLevel, 463 'zeroLevelTol' => $numZeroLevelTolDefault,
400 'zeroLevelTol' => $zeroLevelTol 464 'relTol' => $numRelPercentTolDefault,
465 'debug' => 0,
401 ); 466 );
467
468 num_cmp([$correctAnswer], %options);
402} 469}
403 470
404## See std_num_cmp_list for usage 471## See std_num_cmp_list for usage
405sub frac_num_cmp_list { 472sub frac_num_cmp_list {
406 my ( $relPercentTol, $format, @answerList ) = @_; 473 my ( $relPercentTol, $format, @answerList ) = @_;
407 474
408 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 475 my %options = ( 'tolerance' => $relPercentTol,
409 'tolType' => 'relative', 476 'format' => $format
410 'format' => $format, 477 );
411 'mode' => 'frac', 478
479 set_default_options( \%options,
480 'tolType' => 'relative',
481 'tolerance' => $relPercentTol,
482 'mode' => 'frac',
483 'format' => $numFormatDefault,
412 'zeroLevel' => $numZeroLevelDefault, 484 'zeroLevel' => $numZeroLevelDefault,
413 'zeroLevelTol' => $numZeroLevelTolDefault, 485 'zeroLevelTol' => $numZeroLevelTolDefault,
414 'answerList' => \@answerList 486 'relTol' => $numRelPercentTolDefault,
415 ); 487 'debug' => 0,
488 );
489
490 num_cmp(\@answerList, %options);
491
416} 492}
417 493
494
418sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance 495sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
419 my ( $correctAnswer, $absTol, $format ) = @_; 496 my ( $correctAnswer, $absTol, $format ) = @_;
420 497
421 NUM_CMP( 'correctAnswer' => $correctAnswer, 498 my %options = ( 'tolerance' => $absTol,
499 'format' => $format
500 );
501
502 set_default_options (\%options,
503 'tolType' => 'absolute',
422 'tolerance' => $absTol, 504 'tolerance' => $absTol,
423 'tolType' => 'absolute', 505 'mode' => 'frac',
424 'format' => $format, 506 'format' => $numFormatDefault,
425 'mode' => 'frac', 507 'zeroLevel' => 0,
426 'zeroLevel' => 0,
427 'zeroLevelTol' => 0 508 'zeroLevelTol' => 0,
428 ); 509 'debug' => 0,
429} 510 );
511 num_cmp([$correctAnswer], %options);
512
430 513
514}
515
431## See std_num_cmp_list for usage 516## See std_num_cmp_list for usage
432sub frac_num_cmp_abs_list { 517sub frac_num_cmp_abs_list {
433 my ( $absTol, $format, @answerList ) = @_; 518 my ( $absTol, $format, @answerList ) = @_;
434 519
435 NUM_CMP_LIST( 'tolerance' => $absTol, 520 my %options = ( 'tolerance' => $absTol,
436 'tolType' => 'absolute', 521 'format' => $format
437 'format' => $format, 522 );
438 'mode' => 'frac', 523
439 'zeroLevel' => 0, 524 set_default_options (\%options,
525 'tolType' => 'absolute',
526 'tolerance' => $absTol,
527 'mode' => 'frac',
528 'format' => $numFormatDefault,
529 'zeroLevel' => 0,
440 'zeroLevelTol' => 0, 530 'zeroLevelTol' => 0,
441 'answerList' => \@answerList 531 'debug' => 0,
442 ); 532 );
533
534 num_cmp(\@answerList, %options);
443} 535}
444 536
445 537
446sub arith_num_cmp { # only allow arithmetic expressions as submitted answer 538sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
539
447 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 540 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
448 541
449 NUM_CMP( 'correctAnswer' => $correctAnswer, 542 my %options = ( 'tolerance' => $relPercentTol,
450 'tolerance' => $relPercentTol, 543 'format' => $format,
451 'tolType' => 'relative', 544 'zeroLevel' => $zeroLevel,
452 'format' => $format,
453 'mode' => 'arith',
454 'zeroLevel' => $zeroLevel,
455 'zeroLevelTol' => $zeroLevelTol 545 'zeroLevelTol' => $zeroLevelTol
456 ); 546 );
547
548 set_default_options( \%options,
549 'tolType' => 'relative',
550 'tolerance' => $relPercentTol,
551 'mode' => 'arith',
552 'format' => $numFormatDefault,
553 'zeroLevel' => $numZeroLevelDefault,
554 'zeroLevelTol' => $numZeroLevelTolDefault,
555 'relTol' => $numRelPercentTolDefault,
556 'debug' => 0,
557 );
558
559 num_cmp([$correctAnswer], %options);
457} 560}
458 561
459## See std_num_cmp_list for usage 562## See std_num_cmp_list for usage
460sub arith_num_cmp_list { 563sub arith_num_cmp_list {
461 my ( $relPercentTol, $format, @answerList ) = @_; 564 my ( $relPercentTol, $format, @answerList ) = @_;
462 565
463 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 566 my %options = ( 'tolerance' => $relPercentTol,
464 'tolType' => 'relative', 567 'format' => $format,
465 'format' => $format, 568 );
466 'mode' => 'arith',
467 'zeroLevel' => $numZeroLevelDefault,
468 'zeroLevelTol' => $numZeroLevelTolDefault,
469 'answerList' => \@answerList
470 );
471}
472 569
570 set_default_options( \%options,
571 'tolType' => 'relative',
572 'tolerance' => $relPercentTol,
573 'mode' => 'arith',
574 'format' => $numFormatDefault,
575 'zeroLevel' => $numZeroLevelDefault,
576 'zeroLevelTol' => $numZeroLevelTolDefault,
577 'relTol' => $numRelPercentTolDefault,
578 'debug' => 0,
579 );
580 num_cmp(\@answerList, %options);
581}
582
473sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance 583sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
474 my ( $correctAnswer, $absTol, $format ) = @_; 584 my ( $correctAnswer, $absTol, $format ) = @_;
585
586 my %options = ( 'tolerance' => $absTol,
587 'format' => $format
588 );
589
590 set_default_options (\%options,
591 'tolType' => 'absolute',
592 'tolerance' => $absTol,
593 'mode' => 'arith',
594 'format' => $numFormatDefault,
595 'zeroLevel' => 0,
596 'zeroLevelTol' => 0,
597 'debug' => 0,
598 );
599 num_cmp([$correctAnswer], %options);
475 600
476 NUM_CMP( 'correctAnswer' => $correctAnswer, 601
477 'tolerance' => $absTol,
478 'tolType' => 'absolute',
479 'format' => $format,
480 'mode' => 'arith',
481 'zeroLevel' => 0,
482 'zeroLevelTol' => 0
483 );
484} 602}
485 603
486## See std_num_cmp_list for usage 604## See std_num_cmp_list for usage
487sub arith_num_cmp_abs_list { 605sub arith_num_cmp_abs_list {
488 my ( $absTol, $format, @answerList ) = @_; 606 my ( $absTol, $format, @answerList ) = @_;
489 607
490 NUM_CMP_LIST( 'tolerance' => $absTol, 608 my %options = ( 'tolerance' => $absTol,
491 'tolType' => 'absolute', 609 'format' => $format
492 'format' => $format, 610 );
493 'mode' => 'arith', 611
494 'zeroLevel' => 0, 612 set_default_options (\%options,
495 'zeroLevelTol' => 0, 613 'tolType' => 'absolute',
496 'answerList' => \@answerList 614 'tolerance' => $absTol,
497 ); 615 'mode' => 'arith',
616 'format' => $numFormatDefault,
617 'zeroLevel' => 0,
618 'zeroLevelTol' => 0,
619 'debug' => 0,
620 );
621 num_cmp(\@answerList, %options);
622
498} 623}
499 624
500sub strict_num_cmp { # only allow numbers as submitted answer 625sub strict_num_cmp { # only allow numbers as submitted answer
626
501 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 627 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
628
629 my %options = ( 'tolerance' => $relPercentTol,
630 'format' => $format,
631 'zeroLevel' => $zeroLevel,
632 'zeroLevelTol' => $zeroLevelTol
633 );
634
635 set_default_options( \%options,
636 'tolType' => 'relative',
637 'tolerance' => $relPercentTol,
638 'mode' => 'strict',
639 'format' => $numFormatDefault,
640 'zeroLevel' => $numZeroLevelDefault,
641 'zeroLevelTol' => $numZeroLevelTolDefault,
642 'relTol' => $numRelPercentTolDefault,
643 'debug' => 0,
644 );
645
646 num_cmp([$correctAnswer], %options);
502 647
503 NUM_CMP( 'correctAnswer' => $correctAnswer,
504 'tolerance' => $relPercentTol,
505 'tolType' => 'relative',
506 'format' => $format,
507 'mode' => 'strict',
508 'zeroLevel' => $zeroLevel,
509 'zeroLevelTol' => $zeroLevelTol
510 );
511} 648}
512 649
513## See std_num_cmp_list for usage 650## See std_num_cmp_list for usage
514sub strict_num_cmp_list { # compare numbers 651sub strict_num_cmp_list { # compare numbers
515 my ( $relPercentTol, $format, @answerList ) = @_; 652 my ( $relPercentTol, $format, @answerList ) = @_;
653
654 my %options = ( 'tolerance' => $relPercentTol,
655 'format' => $format,
656 );
657
658 set_default_options( \%options,
659 'tolType' => 'relative',
660 'tolerance' => $relPercentTol,
661 'mode' => 'strict',
662 'format' => $numFormatDefault,
663 'zeroLevel' => $numZeroLevelDefault,
664 'zeroLevelTol' => $numZeroLevelTolDefault,
665 'relTol' => $numRelPercentTolDefault,
666 'debug' => 0,
667 );
516 668
517 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 669 num_cmp(\@answerList, %options);
518 'tolType' => 'relative', 670 }
519 'format' => $format, 671
520 'mode' => 'strict',
521 'zeroLevel' => $numZeroLevelDefault,
522 'zeroLevelTol' => $numZeroLevelTolDefault,
523 'answerList' => \@answerList
524 );
525}
526 672
527sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance 673sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
674
528 my ( $correctAnswer, $absTol, $format ) = @_; 675 my ( $correctAnswer, $absTol, $format ) = @_;
529 676
530 NUM_CMP( 'correctAnswer' => $correctAnswer, 677 my %options = ( 'tolerance' => $absTol,
531 'tolerance' => $absTol, 678 'format' => $format
532 'tolType' => 'absolute', 679 );
533 'format' => $format, 680
534 'mode' => 'strict', 681 set_default_options (\%options,
535 'zeroLevel' => 0, 682 'tolType' => 'absolute',
536 'zeroLevelTol' => 0 683 'tolerance' => $absTol,
537 ); 684 'mode' => 'strict',
685 'format' => $numFormatDefault,
686 'zeroLevel' => 0,
687 'zeroLevelTol' => 0,
688 'debug' => 0,
689 );
690
691 num_cmp([$correctAnswer], %options);
692
538} 693}
539 694
540## See std_num_cmp_list for usage 695## See std_num_cmp_list for usage
541sub strict_num_cmp_abs_list { # compare numbers 696sub strict_num_cmp_abs_list { # compare numbers
542 my ( $absTol, $format, @answerList ) = @_; 697 my ( $absTol, $format, @answerList ) = @_;
543 698
544 NUM_CMP_LIST( 'tolerance' => $absTol, 699
545 'tolType' => 'absolute', 700 my %options = ( 'tolerance' => $absTol,
546 'format' => $format, 701 'format' => $format
547 'mode' => 'strict', 702 );
548 'zeroLevel' => 0, 703
549 'zeroLevelTol' => 0, 704 set_default_options (\%options,
550 'answerList' => \@answerList 705 'tolType' => 'absolute',
551 ); 706 'tolerance' => $absTol,
707 'mode' => 'strict',
708 'format' => $numFormatDefault,
709 'zeroLevel' => 0,
710 'zeroLevelTol' => 0,
711 'debug' => 0,
712 );
713
714 num_cmp(\@answerList, %options);
715
716
717
552} 718}
553 719
554 720
555## Compares a number with units 721## Compares a number with units
556## Deprecated; use num_cmp() 722## Deprecated; use num_cmp()
… …
561## format -- the format to use when displaying the answer 727## format -- the format to use when displaying the answer
562## tol -- an absolute tolerance, or 728## tol -- an absolute tolerance, or
563## relTol -- a relative tolerance 729## relTol -- a relative tolerance
564## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 730## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
565## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero 731## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
732
733
734sub check_strings {
735 my ($rh_ans, %options) = @_;
736
737 # if the student's answer is a number, simply return the answer hash (unchanged).
738
739
740 if ( $rh_ans->{student_ans} =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
741 if ( $rh_ans->{answerIsString} == 1) {
742 #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
743 }
744 return $rh_ans;
745 }
746 # the student's answer is recognized as a string
747 my $ans = $rh_ans->{student_ans};
748
749# OVERVIEW of remindar of function:
750# if answer is correct, return correct. (adjust score to 1)
751# if answer is incorect:
752# 1) determine if the answer is sensible. if it is, return incorrect.
753# 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
754# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
755# last: 'STRING' post_filter will clear the error (avoiding pink screen.)
756
757 my $sensibleAnswer = 0;
758 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
759 my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
760 my $temp_ans_hash = &$ans_eval($ans);
761 $rh_ans->{test} = $temp_ans_hash;
762 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
763 $rh_ans->{score} = 1;
764 $sensibleAnswer = 1;
765 } else { # students answer does not match the correct answer.
766 ## find out if string makes sense
767 my $legalString = '';
768 my @legalStrings = @{$options{strings}};
769 foreach $legalString (@legalStrings) {
770 if ( uc($ans) eq uc($legalString) ) {
771 $sensibleAnswer = 1;
772 last;
773 }
774 }
775 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
776 $rh_ans->throw_error('EVAL', "$BR Your answer is not a recognized answer") unless ($sensibleAnswer);
777 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
778 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
779 }
780 $rh_ans->{student_ans} = $ans;
781 if ($sensibleAnswer) {
782 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
783 }
784 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
785
786 $rh_ans;
787
788}
789
790
791
792sub check_units {
793
794 my ($rh_ans, %options) = @_;
795
796 my %correct_units = %{$rh_ans-> {rh_correct_units}};
797
798 my $ans = $rh_ans->{student_ans};
799 # $ans = '' unless defined ($ans);
800 $ans = str_filters ($ans, 'trim_whitespace');
801 my $original_student_ans = $ans;
802
803 $rh_ans->{original_student_ans} = $original_student_ans;
804
805 # it surprises me that the match below works since the first .* is greedy.
806 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
807
808 unless ( defined($num_answer) && $units ) {
809 # there is an error reading the input
810 if ( $ans =~ /\S/ ) { # the answer is not blank
811 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
812 "as a number or an arithmetic expression followed by a unit specification. " .
813 "Your answer must contain units." );
814 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
815 "as a number or an arithmetic expression followed by a unit specification. " .
816 "Your answer must contain units." );
817 }
818
819 return $rh_ans;
820 }
821
822 # we have been able to parse the answer into a numerical part and a unit part
823
824 # $num_answer = $1; #$1 and $2 from the regular expression above
825 # $units = $2;
826
827 my %units = Units::evaluate_units($units);
828 if ( defined( $units{'ERROR'} ) ) {
829 # handle error condition
830 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
831 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
832 $rh_ans -> throw_error('UNITS', "$units{'ERROR'}");
833 return $rh_ans;
834 }
835
836 my $units_match = 1;
837 my $fund_unit;
838 foreach $fund_unit (keys %correct_units) {
839 next if $fund_unit eq 'factor';
840 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
841 }
842
843 if ( $units_match ) {
844 # units are ok. Evaluate the numerical part of the answer
845 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
846 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
847 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
848 $rh_ans->{student_units} = $units;
849 $rh_ans->{student_ans} = $num_answer;
850
851 } else {
852 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
853 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
854 }
855
856 return $rh_ans;
857 }
858
859
860# This mode is depricated. send input through num_cmp -- it can handle units.
566sub numerical_compare_with_units { 861sub numerical_compare_with_units {
567 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 862 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
568 my %options = @_; # all of the other inputs are (key value) pairs 863 my %options = @_; # all of the other inputs are (key value) pairs
569
570 # handle the defaults
571 $options{'mode'} = 'std' unless defined( $options{'mode'} );
572 $options{'format'} = $numFormatDefault unless defined( $options{'format'} );
573 $options{'zeroLevel'} = $numZeroLevelDefault unless defined( $options{'zeroLevel'} );
574 $options{'zeroLevelTol'} = $numZeroLevelTolDefault unless defined( $options{'zeroLevelTol'} );
575
576 # both spellings are maintained for backward compatibility
577 # relTol is preferred
578 if( defined $options{'reltol'} ) {
579 $options{'relTol'} = $options{'reltol'};
580 delete $options{'reltol'};
581 }
582
583 my ($tol, $tolerance_mode);
584 if ( defined $options{'tol'} ) {
585 $tol = $options{'tol'};
586 $tolerance_mode = 'absolute';
587 }
588 elsif( defined $options{'relTol'} ) {
589 $tol = $options{'relTol'};
590 $tolerance_mode = 'relative';
591 }
592 else { #the default is a relative tolerance
593 $tol = $numRelPercentTolDefault;
594 $tolerance_mode = 'relative';
595 }
596 864
597 # Prepare the correct answer 865 # Prepare the correct answer
598 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' ); 866 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
599 867
600 # it surprises me that the match below works since the first .* is greedy. 868 # it surprises me that the match below works since the first .* is greedy.
601 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/; 869 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
602 870
603 my %correct_units = Units::evaluate_units($correct_units); 871 $options{units} = $correct_units;
604 if ( defined( $correct_units{'ERROR'} ) ) { 872
605 die "ERROR: The answer \"$correct_answer\" in the problem definition cannot be parsed:\n" . 873 num_cmp($correct_num_answer, %options);
606 "$correct_units{'ERROR'}\n";
607 }
608
609 my $ans_evaluator = sub {
610
611 my $ans = shift;
612 $ans = '' unless defined($ans);
613 my $original_student_ans = $ans;
614
615 $ans = str_filters( $ans, 'trim_whitespace' );
616
617 my $ans_hash = new AnswerHash(
618 'score' => 0,
619 'correct_ans' => spf($correct_num_answer,$options{'format'}) . " $correct_units",
620 'student_ans' => $ans,
621 'ans_message' => '',
622 'type' => 'num_cmp_with_units',
623 'preview_text_string' => '',
624 'original_student_ans' => $original_student_ans
625 );
626
627 # it surprises me that the match below works since the first .* is greedy.
628 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
629
630 unless ( defined($num_answer) && $units ) {
631 # there is an error reading the input
632 if ( $ans =~ /\S/ ) { # the answer is not blank
633 $ans_hash -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
634 "as a number or an arithmetic expression followed by a unit specification. " .
635 "Your answer must contain units." );
636 }
637
638 return $ans_hash;
639 }
640
641 # we have been able to parse the answer into a numerical part and a unit part
642
643 $num_answer = $1; #$1 and $2 from the regular expression above
644 $units = $2;
645
646 my %units = Units::evaluate_units($units);
647 if ( defined( $units{'ERROR'} ) ) {
648 # handle error condition
649 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
650
651 $ans_hash -> setKeys( 'ans_message' => "$units{'ERROR'}" );
652
653 return $ans_hash;
654 }
655
656 my $units_match = 1;
657 my $fund_unit;
658 foreach $fund_unit (keys %correct_units) {
659 next if $fund_unit eq 'factor';
660 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
661 }
662
663 if ( $units_match ) {
664
665 # units are ok. Evaluate the numerical part of the answer
666 $tol = $tol * $correct_units{'factor'}/$units{'factor'} if
667 $tolerance_mode eq 'absolute'; # the tolerance is in the units specified by the instructor.
668
669 my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
670 'tolerance' => $tol,
671 'tolType' => $tolerance_mode,
672 'format' => $options{'format'},
673 'mode' => $options{'mode'},
674 'zeroLevel' => $options{'zeroLevel'},
675 'zeroLevelTol' => $options{'zeroLevelTol'} );
676
677 # because num_answer may contain an arithmetic expression rather than
678 # a number we can't multiply it by the $units{'factor'}
679 # instead we divide the correct answer by this amount;
680 # this is also why the numerical_answer_evaluator is not defined outside this subroutine.
681
682 $ans_hash = &$numerical_answer_evaluator($num_answer);
683
684 # now we need to doctor the correct answer in order to add units
685 # to it and correct for the division we did before
686 $ans_hash -> {correct_ans} =
687 prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
688 $options{'format'} ) . " $correct_units";
689 # we also need to doctor the submitted answer to get it back in its original format.
690
691 # we don't add the units on if there is an error message from numerical_answer_evaluator
692 if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
693 $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
694 $ans_hash -> setKeys( original_student_ans => $ans );
695 }
696 else {
697 # error message from numerical_answer_evaluator doesn't have units tacked on
698 $ans_hash -> setKeys( original_student_ans => $ans );
699 }
700 }
701 else {
702 $ans_hash -> setKeys( ans_message => 'There is an error in the units for this answer.' );
703 }
704
705 return $ans_hash;
706 };
707
708 $ans_evaluator;
709} 874}
875
710 876
711=head3 std_num_str_cmp() 877=head3 std_num_str_cmp()
712 878
713NOTE: This function is maintained for compatibility. num_cmp() with the 879NOTE: This function is maintained for compatibility. num_cmp() with the
714 'strings' parameter is slightly preferred. 880 'strings' parameter is slightly preferred.
715 881
716std_num_str_cmp() is used when the correct answer could be either a number or a 882std_num_str_cmp() is used when the correct answer could be either a number or a
717string. For example, if you wanted the student to evaluate a function at number 883string. For example, if you wanted the student to evaluate a function at number
… …
738Example: 904Example:
739 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) ); 905 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
740 906
741=cut 907=cut
742 908
743sub std_num_str_cmp { 909sub std_num_str_cmp {
744 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 910 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
745 911 # warn ('This method is depreciated. Use num_cmp instead.');
746 $ra_legalStrings = [''] unless defined $ra_legalStrings; 912 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
747 my @legalStrings = @{$ra_legalStrings}; 913 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
748
749 my $ans_evaluator = sub {
750
751 my $ans = shift;
752 my $ans_hash;
753 my $corrAnswerIsString = 0;
754# my $studAnswerIsString = 0; ## uses new incorrect logic
755 my $studAnswerIsString = 1;
756
757 my $legalString = '';
758 foreach $legalString (@legalStrings) {
759 if ( uc($correctAnswer) eq uc($legalString) ) {
760 $corrAnswerIsString = 1;
761 last;
762 }
763 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
764
765 # Neither of these is perfect; the first is more general, but
766 # has problems with certain special strings like "ee", while the
767 # second doesn't support arithmetic expressions.
768 #
769# if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) {
770# $studAnswerIsString = 1;
771# }
772 #if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) {
773 # $studAnswerIsString = 1;
774 #}
775
776 ## Both the above new versions are incorrect. We replace this by the original logic namely that
777 ## an answer that contain any of the symbols
778 ## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ]
779 ## or an answer that consists of "pi" or "e" alone
780 ## will be considered an arithmetic expression rather than a string answer.
781
782 if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;}
783
784
785 ## at this point $studAnswerIsString = 0 iff correct answer is numeric
786
787 if( $studAnswerIsString ) {
788 $ans = str_filters( $ans, 'compress_whitespace' )
789 }
790
791 if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) {
792 my $string_answer_evaluator = std_str_cmp( $correctAnswer );
793 $ans_hash = &$string_answer_evaluator( $ans );
794
795 if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense
796 my $sensibleAnswer = 0;
797 foreach $legalString (@legalStrings) {
798 if ( uc($ans) eq uc($legalString) ) {
799 $sensibleAnswer = 1;
800 last;
801 }
802 }
803 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
804
805 $ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' )
806 unless ($sensibleAnswer);
807 $ans_hash -> setKeys( 'student_ans' => uc($ans) );
808 }
809 }
810 elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) {
811 my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol);
812 $ans_hash = &$numeric_answer_evaluator($ans);
813 }
814 elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) {
815 my $numeric_answer_evaluator = std_num_cmp(1);
816 $ans_hash = &$numeric_answer_evaluator($ans);
817 $ans_hash -> setKeys( 'score' => 0,
818 'correct_ans' => $correctAnswer
819 );
820 }
821 elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) {
822 my $string_answer_evaluator = std_str_cmp('bad');
823 $ans_hash = &$string_answer_evaluator($ans);
824
825 $ans_hash -> setKeys( 'score' => 0,
826 'correct_ans' => $correctAnswer
827 );
828
829 ## find out if string makes sense
830 my $sensibleAnswer = 0;
831 foreach $legalString (@legalStrings) {
832 if ( uc($ans) eq uc($legalString) ) {
833 $sensibleAnswer = 1;
834 last;
835 }
836 }
837 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
838
839 $ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" )
840 unless $sensibleAnswer;
841 }
842
843 return $ans_hash;
844 };
845
846 return $ans_evaluator;
847} 914}
848 915
849=head3 num_cmp() 916=head3 num_cmp()
850 917
851Compares a number or a list of numbers, using a named hash of options to set 918Compares a number or a list of numbers, using a named hash of options to set
… …
887=cut 954=cut
888 955
889sub num_cmp { 956sub num_cmp {
890 my $correctAnswer = shift @_; 957 my $correctAnswer = shift @_;
891 my @opt = @_; 958 my @opt = @_;
959 my %out_options;
892 960
961#########################################################################
962# Retain this first check for backword compatibility. Allows input of the form
963# num_cmp($ans, 1, '%0.5f') but warns against it
964#########################################################################
965
893 my %known_options = ( 'mode' => 'std', 966 my %known_options = ( 'mode' => 'std',
894 'format' => $numFormatDefault, 967 'format' => $numFormatDefault,
895 'tol' => $numAbsTolDefault, 968 'tol' => $numAbsTolDefault,
896 'relTol' => $numRelPercentTolDefault, 969 'relTol' => $numRelPercentTolDefault,
897 'units' => undef, 970 'units' => undef,
898 'strings' => undef, 971 'strings' => undef,
899 'zeroLevel' => $numZeroLevelDefault, 972 'zeroLevel' => $numZeroLevelDefault,
900 'zeroLevelTol' => $numZeroLevelTolDefault, 973 'zeroLevelTol' => $numZeroLevelTolDefault,
901 974 'tolType' => 'relative',
975 'tolerance' => 1,
902 'reltol' => undef, #alternate spelling 976 'reltol' => undef, #alternate spelling
903 'unit' => undef #alternate spelling 977 'unit' => undef, #alternate spelling
904 ); 978 'debug' => 0
905 my %in_options; 979
980 );
981
906 my @output_list; 982 my @output_list;
907 my %out_options; 983 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
908 984
909 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 || 985 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
910 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) { 986 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
911 # unless the first parameter is a list of arrays 987 # unless the first parameter is a list of arrays
912 # or the second parameter is a known option or 988 # or the second parameter is a known option or
913 # no options were used, 989 # no options were used,
914 # use the old num_cmp which does not use options, but has inputs 990 # use the old num_cmp which does not use options, but has inputs
915 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol 991 # $relPercentTol,$format,$zeroLevel,$zeroLevelTol
916 warn "This method of using num_cmp() is deprecated. Please rewrite this" . 992 warn "This method of using num_cmp() is deprecated. Please rewrite this" .
917 " problem using the options style of parameter passing (or" . 993 " problem using the options style of parameter passing (or" .
918 " check that your first option is spelled correctly)."; 994 " check that your first option is spelled correctly).";
919 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt; 995
920 996
921 %out_options = ( 'relTol' => $relPercentTol, 997 %out_options = ( 'relTol' => $relPercentTol,
922 'format' => $format, 998 'format' => $format,
923 'zeroLevel' => $zeroLevel, 999 'zeroLevel' => $zeroLevel,
924 'zeroLevelTol' => $zeroLevelTol, 1000 'zeroLevelTol' => $zeroLevelTol,
925 'mode' => 'std' 1001 'mode' => 'std'
926 ); 1002 );
927 } 1003 }
928 else { 1004# else {
929 # handle options 1005# # handle options
930 1006#
931 check_option_list( @opt ); 1007#
1008# @opt = ( 'relTol' => $relPercentTol,
1009# 'format' => $format,
1010# 'zeroLevel' => $numZeroLevelDefault,
1011# 'zeroLevelTol' => $numZeroLevelTolDefault,
1012# 'mode' => 'std'
1013# );
1014# }
1015#########################################################################
1016# Now handle the options assuming they are entered in the form
1017# num_cmp($ans, relTol=>1, format=>'%0.5f')
1018#########################################################################
932 %in_options = @opt; 1019 %out_options = @opt;
1020 assign_option_aliases( \%out_options,
1021 'reltol' => 'relTol',
1022 'unit' => 'units',
1023 );
933 1024
934 # both spellings maintained for compatibility 1025
935 # relTol is preferred 1026
936 if( defined( $in_options{'reltol'} ) ) { 1027
937 $in_options{'relTol'} = $in_options{'reltol'}; 1028 set_default_options( \%out_options,
938 delete $in_options{'reltol'}; 1029 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative',
1030 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault,
1031 'mode' => 'std',
1032 'format' => $numFormatDefault,
1033 'tol' => $numAbsTolDefault,
1034 'relTol' => $numRelPercentTolDefault,
1035 'units' => undef,
1036 'strings' => undef,
1037 'zeroLevel' => $numZeroLevelDefault,
1038 'zeroLevelTol' => $numZeroLevelTolDefault,
1039 'debug' => 0,
939 } 1040
1041 );
940 1042
941 # both spellings maintained for compatibility
942 # units is preferred
943 if( defined( $in_options{'unit'} ) ) {
944 $in_options{'units'} = $in_options{'unit'};
945 delete $in_options{'unit'};
946 }
947 1043
1044
1045
1046
1047
948 # can't use both units and strings 1048 # can't use both units and strings
949 if( defined( $in_options{'units'} ) && defined( $in_options{'strings'} ) ) { 1049 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
950 warn "Can't use both 'units' and 'strings' in the same problem " . 1050 warn "Can't use both 'units' and 'strings' in the same problem " .
951 "(check your parameters to num_cmp() )"; 1051 "(check your parameters to num_cmp() )";
1052
952 } 1053 }
953 1054
954 #%out_options = %known_options;
955 foreach my $opt_name (keys %in_options) {
956 1055
957 if( exists( $known_options{$opt_name} ) ) {
958 $out_options{$opt_name} = $in_options{$opt_name};
959 }
960 else {
961 die "Option $opt_name is not defined for num_cmp. Answer is $correctAnswer; " .
962 "Default options are:<BR> ", pretty_print(\%known_options);
963 }
964 }
965 }
966
967 # set tolerance flags -- note that the order of testing means that
968 # relative tolerance is the default
969 my ($tolType, $tol); 1056 # my ($tolType, $tol);
970 1057 if ($out_options{tolType} eq 'absolute') {
971 if ( defined( $out_options{'tol'} ) ) { 1058 $out_options{'tolerance'}=$out_options{'tol'};
972 $tolType = 'absolute'; 1059 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
973 $tol = $out_options{'tol'};
974 }
975 else { 1060 } else {
976 $tolType = 'relative'; 1061 $out_options{'tolerance'}=$out_options{'relTol'};
977 $tol = $out_options{'relTol'}; 1062 # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
978 } 1063 }
979 1064
980 # thread over lists 1065 # thread over lists
981 my @ans_list = (); 1066 my @ans_list = ();
982 1067
… …
984 @ans_list = @{$correctAnswer}; 1069 @ans_list = @{$correctAnswer};
985 } 1070 }
986 else { 1071 else {
987 push( @ans_list, $correctAnswer ); 1072 push( @ans_list, $correctAnswer );
988 } 1073 }
1074
989 # produce answer evaluators 1075 # produce answer evaluators
990 foreach my $ans (@ans_list) { 1076 foreach my $ans (@ans_list) {
991 if( defined( $out_options{'units'} ) ) { 1077 if( defined( $out_options{'units'} ) ) {
992 $ans = "$ans $out_options{'units'}"; 1078 $ans = "$ans $out_options{'units'}";
993 push( @output_list, numerical_compare_with_units($ans, %out_options) );
994 } 1079
1080 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
1081 'tolerance' => $out_options{tolerance},
1082 'tolType' => $out_options{tolType},
1083 'format' => $out_options{'format'},
1084 'mode' => $out_options{'mode'},
1085 'zeroLevel' => $out_options{'zeroLevel'},
1086 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1087 'debug' => $out_options{'debug'},
1088 'units' => $out_options{'units'},
1089 )
1090 );
1091 }
995 elsif( defined( $out_options{'strings'} ) ) { 1092 elsif( defined( $out_options{'strings'} ) ) {
996 if( defined $out_options{'tol'} ) { 1093 #if( defined $out_options{'tol'} ) {
997 warn "You are using 'tol' (for absolute tolerance) with a num/str " . 1094 # warn "You are using 'tol' (for absolute tolerance) with a num/str " .
998 "compare, which currently only uses relative tolerance. The default " . 1095 # "compare, which currently only uses relative tolerance. The default " .
999 "tolerance will be used."; 1096 # "tolerance will be used.";
1000 }
1001
1002 push( @output_list, std_num_str_cmp( $ans, $out_options{'strings'},
1003 $out_options{'relTol'},
1004 $out_options{'format'},
1005 $out_options{'zeroLevel'},
1006 $out_options{'zeroLevelTol'}
1007 )
1008 );
1009 } 1097 #}
1010 else { 1098
1099 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
1100 'tolerance' => $out_options{tolerance},
1101 'tolType' => $out_options{tolType},
1102 'format' => $out_options{'format'},
1103 'mode' => $out_options{'mode'},
1104 'zeroLevel' => $out_options{'zeroLevel'},
1105 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1106 'debug' => $out_options{'debug'},
1107 'strings' => $out_options{'strings'},
1108
1109 )
1110 );
1111 }
1112 else {
1113
1011 push(@output_list, 1114 push(@output_list,
1012 NUM_CMP( 'correctAnswer' => $ans, 1115 NUM_CMP( 'correctAnswer' => $ans,
1013 'tolerance' => $tol, 1116 'tolerance' => $out_options{tolerance},
1014 'tolType' => $tolType, 1117 'tolType' => $out_options{tolType},
1015 'format' => $out_options{'format'}, 1118 'format' => $out_options{'format'},
1016 'mode' => $out_options{'mode'}, 1119 'mode' => $out_options{'mode'},
1017 'zeroLevel' => $out_options{'zeroLevel'}, 1120 'zeroLevel' => $out_options{'zeroLevel'},
1018 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1121 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1122 'debug' => $out_options{'debug'},
1123
1019 ), 1124 ),
1020 ); 1125 );
1126 }
1021 } 1127 }
1022 } 1128
1023
1024 return @output_list; 1129 return @output_list;
1025} 1130 }
1026 1131
1027#legacy code for compatability purposes 1132#legacy code for compatability purposes
1028sub num_rel_cmp { # compare numbers 1133sub num_rel_cmp { # compare numbers
1029 std_num_cmp( @_ ); 1134 std_num_cmp( @_ );
1030} 1135}
1031 1136
1032## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1137## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1033## 1138##
1034## IN: a hash containing the following items (error-checking to be added later?): 1139## IN: a hash containing the following items (error-checking to be added later?):
… …
1038## format -- the display format of the answer 1143## format -- the display format of the answer
1039## mode -- one of 'std', 'strict', 'arith', or 'frac'; 1144## mode -- one of 'std', 'strict', 'arith', or 'frac';
1040## determines allowable formats for the input 1145## determines allowable formats for the input
1041## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1146## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
1042## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1147## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1148
1149sub compare_numbers {
1150 my ($rh_ans, %options) = @_;
1151 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1152 if ($PG_eval_errors) {
1153 $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
1154 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
1155
1156
1157 } else {
1158 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
1159 }
1160
1161 my $permitted_error;
1162
1163 if ($rh_ans->{tolType} eq 'absolute') {
1164 $permitted_error = $rh_ans->{tolerance};
1165
1166 }
1167 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
1168 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
1169 }
1170 else {
1171 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
1172 }
1173
1174 my $is_a_number = is_a_number($inVal);
1175 $rh_ans->{score} = 1 if ( ($is_a_number) and
1176 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
1177 if (not $is_a_number) {
1178 $rh_ans->throw_error('EVAL','Your answer does not evaluate to a number');
1179 }
1180
1181 $rh_ans;
1182}
1183
1043sub NUM_CMP { # low level numeric compare 1184sub NUM_CMP { # low level numeric compare
1044 my %num_params = @_; 1185 my %num_params = @_;
1186
1187 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1188 foreach my $key (@keys) {
1189 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1190 }
1045 1191
1046 my $correctAnswer = $num_params{'correctAnswer'}; 1192 my $correctAnswer = $num_params{'correctAnswer'};
1047 my $tol = $num_params{'tolerance'};
1048 my $tolType = $num_params{'tolType'};
1049 my $format = $num_params{'format'}; 1193 my $format = $num_params{'format'};
1050 my $mode = $num_params{'mode'}; 1194 my $mode = $num_params{'mode'};
1195
1196 # my $tol = $num_params{'tolerance'};
1197 # my $tolType = $num_params{'tolType'};
1051 my $zeroLevel = $num_params{'zeroLevel'}; 1198 # my $zeroLevel = $num_params{'zeroLevel'};
1052 my $zeroLevelTol = $num_params{'zeroLevelTol'}; 1199 # my $zeroLevelTol = $num_params{'zeroLevelTol'};
1053 1200
1054 if( $tolType eq 'relative' ) { 1201 if( $num_params{tolType} eq 'relative' ) {
1055 $tol = $numRelPercentTolDefault unless defined $tol; 1202 $num_params{'tolerance'} = .01*$num_params{'tolerance'};
1056 $tol *= .01; 1203 }
1204
1205 #$format = $numFormatDefault unless defined $format;
1206 #$mode = 'std' unless defined $mode;
1207 #$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1208 #$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1209
1210 my $formattedCorrectAnswer;
1211 my $correct_units;
1212 my $correct_num_answer;
1213 my %correct_units;
1214 my $corrAnswerIsString = 0;
1215
1216
1217 if (defined($num_params{units}) && $num_params{units}) {
1218 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1219 # units are in form stuff space units where units contains no spaces.
1220
1221 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
1222 %correct_units = Units::evaluate_units($correct_units);
1223 if ( defined( $correct_units{'ERROR'} ) ) {
1224 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1225 "$correct_units{'ERROR'}\n");
1226 }
1227 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1228 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1229
1230 } elsif (defined($num_params{strings}) && $num_params{strings}) {
1231
1232 my $legalString = '';
1233 my @legalStrings = @{$num_params{strings}};
1234 $correct_num_answer = $correctAnswer;
1235 $formattedCorrectAnswer = $correctAnswer;
1236 foreach $legalString (@legalStrings) {
1237 if ( uc($correctAnswer) eq uc($legalString) ) {
1238 $corrAnswerIsString = 1;
1239 last;
1240 }
1241 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1242
1243
1244 } else {
1245 $correct_num_answer = $correctAnswer;
1246 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1247 }
1248
1249 $correct_num_answer = math_constants($correct_num_answer);
1250
1251 my $PGanswerMessage = '';
1252
1253 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1254
1255 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1256 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1057 } 1257 }
1058 else { 1258 else {
1059 $tol = $numAbsTolDefault unless defined $tol; 1259 $PG_eval_errors = ' ';
1060 } 1260 }
1061 $format = $numFormatDefault unless defined $format;
1062 $mode = 'std' unless defined $mode;
1063 $zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1064 $zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1065 1261
1066 my $formattedCorrectAnswer = prfmt( $correctAnswer, $format ); 1262 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1263 ##error message from eval or above
1264 warn "Error in 'correct' answer: $PG_eval_errors<br>
1265 The answer $correctAnswer evaluates to $correctVal,
1266 which cannot be interpreted as a number. ";
1267
1268 }
1269 #########################################################################
1067 1270
1068 my $answer_evaluator = sub { 1271 #construct the answer evaluator
1069 my $in = shift @_; 1272 my $answer_evaluator = new AnswerEvaluator;
1070 $in = '' unless defined $in; 1273 $answer_evaluator->{debug} = $num_params{debug};
1071 my $score = 0; 1274 $answer_evaluator->ans_hash( correct_ans => $correct_num_answer,
1072 my $original_student_answer = $in; 1275 type => "${mode}_number",
1073 my $parser = new AlgParserWithImplicitExpand; 1276 tolerance => $num_params{tolerance},
1074 my $ret = $parser -> parse($in); 1277 tolType => $num_params{tolType},
1075 my $preview_text_string = ''; 1278 units => $correct_units,
1076 my $preview_latex_string = ''; 1279 original_correct_ans => $formattedCorrectAnswer,
1280 rh_correct_units => \%correct_units,
1281 answerIsString => $corrAnswerIsString,
1282 );
1283 my ($in, $formattedSubmittedAnswer);
1284 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1285 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1286 );
1287 if (defined($num_params{units}) && $num_params{units}) {
1288 $answer_evaluator->install_pre_filter(\&check_units);
1289 }
1290 if (defined($num_params{strings}) && $num_params{strings}) {
1291 $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
1292 }
1077 1293
1078 if ( ref($ret) ) { ## parsed successfully 1294 $answer_evaluator->install_pre_filter(\&check_syntax);
1079 $parser -> tostring(); 1295
1080 $parser -> normalize(); 1296 $answer_evaluator->install_pre_filter(\&math_constants);
1081 $in = $parser -> tostring(); 1297
1082 $preview_text_string = $in; 1298 if ($mode eq 'std') {
1083 $preview_latex_string = $parser -> tolatex(); 1299 # do nothing
1300 } elsif ($mode eq 'strict') {
1301 $answer_evaluator->install_pre_filter(\&is_a_number);
1302 } elsif ($mode eq 'arith') {
1303 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
1304 } elsif ($mode eq 'frac') {
1305 $answer_evaluator->install_pre_filter(\&is_a_fraction);
1084 1306
1307 } else {
1308 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1309 $formattedSubmittedAnswer = $in;
1085 } 1310 }
1086 else { ## error in parsing 1311
1087 my $ans_hash = new AnswerHash( 1312 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
1088 'score' => $score, 1313 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1089 'correct_ans' => $formattedCorrectAnswer, 1314 }
1090 'student_ans' => "error: $parser->{htmlerror}", 1315
1091 'ans_message' => $parser -> {error_msg}, 1316
1092 'type' => "${mode}_number", 1317###############################################################################
1093 'preview_text_string' => $preview_text_string, 1318# We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
1094 'preview_latex_string' => $preview_latex_string, 1319# can be displayed in the answer message. This may still cause a few anomolies when strings are used
1095 'original_student_ans' => $original_student_answer 1320#
1096 ); 1321###############################################################################
1097 1322
1098 return $ans_hash; 1323 $answer_evaluator->install_post_filter(\&fix_answers_for_display);
1324
1325 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1326 return $rh_ans unless $rh_ans->catch_error('EVAL');
1327 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1328 $rh_ans->clear_error('EVAL'); } );
1329 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
1330 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
1331 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
1332 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
1333
1334
1335 $answer_evaluator;
1336}
1337
1338sub fix_answers_for_display {
1339 my ($rh_ans, %options) = @_;
1340 if ( $rh_ans->{answerIsString} ==1) {
1341 $rh_ans = evaluatesToNumber ($rh_ans, %options);
1342 }
1343 if (defined ($rh_ans->{student_units})) {
1344 $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units};
1345 }
1346 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
1347 $rh_ans;
1348}
1349
1350sub evaluatesToNumber {
1351 my ($rh_ans, %options) = @_;
1352 if (is_a_numeric_expression($rh_ans->{student_ans})) {
1353 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1354 if ($PG_eval_errors) { # this if statement should never be run
1355 # change nothing
1356 } else {
1357 # change this
1358 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
1099 } 1359 }
1100
1101 my $PGanswerMessage = '';
1102
1103 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1104
1105 $inVal = '';
1106 $correctAnswer = math_constants($correctAnswer);
1107 my $formattedSubmittedAnswer = '';
1108
1109 #special variable $@ holds the last error from a Perl eval statement
1110 $@='';
1111
1112 if ($correctAnswer =~ /\S/) {
1113 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correctAnswer);
1114 } 1360 }
1115 else { 1361 $rh_ans;
1116 $PG_eval_errors = ' '; 1362}
1117 }
1118 1363
1119 if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above 1364sub is_a_numeric_expression {
1120 $formattedSubmittedAnswer = $PG_eval_errors; 1365 my $testString = shift;
1121 $formattedSubmittedAnswer = clean_up_error_msg($formattedSubmittedAnswer); 1366 my $is_a_numeric_expression = 0;
1122 $PGanswerMessage = 'Tell your professor that there is an error in this problem';
1123 my $ans_hash = new AnswerHash(
1124 'score' => $score,
1125 'correct_ans' => $formattedCorrectAnswer,
1126 'student_ans' => $formattedSubmittedAnswer,
1127 'ans_message' => $PGanswerMessage,
1128 'type' => 'number',
1129 'preview_text_string' => $preview_text_string,
1130 'preview_latex_string' => $preview_latex_string,
1131 'original_student_ans' => $original_student_answer
1132 );
1133
1134 return $ans_hash;
1135 }
1136
1137 $in = &math_constants($in);
1138
1139 MODE_CASE: { ## bare block for "case" statement
1140 if ($mode eq 'std') {
1141 last MODE_CASE;
1142 }
1143 elsif ($mode eq 'strict') {
1144 unless (is_a_number($in)) {
1145 $PGanswerMessage = 'You must enter a number, e.g. -6, 5.3, or 6.12E-3';
1146 $formattedSubmittedAnswer = 'Incorrect number format';
1147 }
1148 else {
1149 last MODE_CASE;
1150 }
1151 }
1152 elsif ($mode eq 'arith') {
1153 unless (is_an_arithmetic_expression($in)) {
1154 $PGanswerMessage = 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2';
1155 $formattedSubmittedAnswer = 'Not an arithmetic expression';
1156 }
1157 else {
1158 last MODE_CASE;
1159 }
1160 }
1161 elsif ($mode eq 'frac') {
1162 unless (is_a_fraction($in)) {
1163 $PGanswerMessage = 'You must enter a number or fraction , e.g. -6 or 7/13';
1164 $formattedSubmittedAnswer = 'Not a number or fraction';
1165 }
1166 else {
1167 last MODE_CASE;
1168 }
1169 }
1170 else {
1171 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1172 $formattedSubmittedAnswer = $in;
1173 }
1174
1175 my $ans_hash = new AnswerHash(
1176 score => $score,
1177 correct_ans => $formattedCorrectAnswer,
1178 student_ans => $formattedSubmittedAnswer,
1179 ans_message => $PGanswerMessage,
1180 type => "${mode}_number",
1181 preview_text_string => $preview_text_string,
1182 preview_latex_string => $preview_latex_string,
1183 original_student_ans => $original_student_answer
1184 );
1185
1186 return $ans_hash;
1187 } # end of MODE_CASES bare block
1188
1189 $@ = '';
1190 if ($in =~ /\S/) {
1191
1192 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in); 1367 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString);
1193 }
1194 else {
1195 $PG_eval_errors = ' ';
1196 }
1197
1198 if ($PG_eval_errors) { ##error message from eval or above
1199 $formattedSubmittedAnswer = $PG_eval_errors;
1200 $formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer);
1201 $PGanswerMessage = 'There is a syntax error in your answer';
1202 $PGanswerMessage = '' if $PG_eval_errors eq ' ';
1203 my $ans_hash = new AnswerHash(
1204 'score' => $score,
1205 'correct_ans' => $formattedCorrectAnswer,
1206 'student_ans' => $formattedSubmittedAnswer,
1207 'ans_message' => $PGanswerMessage,
1208 'type' => "${mode}_number",
1209 'preview_text_string' => $preview_text_string,
1210 'preview_latex_string' => $preview_latex_string,
1211 'original_student_ans' => $original_student_answer
1212 );
1213
1214 return $ans_hash;
1215 }
1216 else {
1217 $formattedSubmittedAnswer = prfmt($inVal,$format);
1218 }
1219
1220 my $permitted_error;
1221 if (defined($tolType) && $tolType eq 'absolute') {
1222 $permitted_error = $tol;
1223 }
1224 elsif ( abs($correctVal) <= $zeroLevel) {
1225 $permitted_error = $zeroLevelTol; ## want $tol to be non zero
1226 }
1227 else {
1228 $permitted_error = abs($tol*$correctVal);
1229 }
1230
1231 my $is_a_number = is_a_number($inVal);
1232 $score = 1 if ( ($is_a_number) and
1233 (abs( $inVal - $correctVal ) <= $permitted_error) );
1234 if ($PG_eval_errors) { 1368 if ($PG_eval_errors) {
1235 $PGanswerMessage = 'There is a syntax error in your answer'; 1369 $is_a_numeric_expression = 0;
1370 } else {
1371 $is_a_numeric_expression = 1;
1236 } 1372
1237 elsif (not $is_a_number) {
1238 $PGanswerMessage = 'Your answer does not evaluate to a number';
1239 } 1373 }
1240 1374
1241 my $ans_hash = new AnswerHash( 1375 $is_a_numeric_expression;
1242 'score' => $score,
1243 'correct_ans' => $formattedCorrectAnswer,
1244 'student_ans' => $formattedSubmittedAnswer,
1245 'ans_message' => $PGanswerMessage,
1246 'type' => "${mode}_number",
1247 'preview_text_string' => $preview_text_string,
1248 'preview_latex_string' => $preview_latex_string,
1249 'original_student_ans' => $original_student_answer
1250 );
1251
1252 return $ans_hash;
1253 };
1254
1255 return $answer_evaluator;
1256} 1376}
1257
1258## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1259sub NUM_CMP_LIST { # low level numeric list compare
1260 my %num_params = @_;
1261
1262 my @outputList;
1263 my $ans;
1264
1265 while ( @{$num_params{'answerList'}} ) {
1266 $ans = shift @{$num_params{'answerList'}};
1267 push( @outputList, NUM_CMP( 'correctAnswer' => $ans,
1268 'tolerance' => $num_params{'tolerance'},
1269 'tolType' => $num_params{'tolType'},
1270 'format' => $num_params{'format'},
1271 'mode' => $num_params{'mode'},
1272 'zeroLevel' => $num_params{'zeroLevel'},
1273 'zeroLevelTol' => $num_params{'zeroLevelTol'}
1274 )
1275 );
1276 }
1277
1278 return @outputList;
1279}
1280
1281 1377
1282 1378
1283########################################################################## 1379##########################################################################
1284########################################################################## 1380##########################################################################
1285## Function answer evaluators 1381## Function answer evaluators
… …
1468 'params' => [], 1564 'params' => [],
1469 'limits' => [ [0,1], [0,1]], 1565 'limits' => [ [0,1], [0,1]],
1470 'reltol' => $main::functRelPercentTolDefault, 1566 'reltol' => $main::functRelPercentTolDefault,
1471 'numPoints' => $main::functNumOfPoints, 1567 'numPoints' => $main::functNumOfPoints,
1472 'zeroLevel' => $main::functZeroLevelDefault, 1568 'zeroLevel' => $main::functZeroLevelDefault,
1473 'zeroLevelTol' => $main::functZeroLevelTolDefault, 1569 'zeroLevelTol' => $main::functZeroLevelTolDefault,
1474 'debug' => 0, 1570 'debug' => 0,
1475 ); 1571 );
1476 1572
1477 my $var_ref = $options{'vars'}; 1573 my $var_ref = $options{'vars'};
1478 my $ra_params = $options{ 'params'}; 1574 my $ra_params = $options{ 'params'};
… …
1480 my $relPercentTol= $options{'reltol'}; 1576 my $relPercentTol= $options{'reltol'};
1481 my $numPoints = $options{'numPoints'}; 1577 my $numPoints = $options{'numPoints'};
1482 my $zeroLevel = $options{'zeroLevel'}; 1578 my $zeroLevel = $options{'zeroLevel'};
1483 my $zeroLevelTol = $options{'zeroLevelTol'}; 1579 my $zeroLevelTol = $options{'zeroLevelTol'};
1484 1580
1485 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1581 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1486 'var' => $var_ref, 1582 'var' => $var_ref,
1487 'limits' => $limit_ref, 1583 'limits' => $limit_ref,
1488 'tolerance' => $relPercentTol, 1584 'tolerance' => $relPercentTol,
1489 'tolType' => 'relative', 1585 'tolType' => 'relative',
1490 'numPoints' => $numPoints, 1586 'numPoints' => $numPoints,
1491 'mode' => 'std', 1587 'mode' => 'std',
1492 'maxConstantOfIntegration' => 10**100, 1588 'maxConstantOfIntegration' => 10**100,
1493 'zeroLevel' => $zeroLevel, 1589 'zeroLevel' => $zeroLevel,
1494 'zeroLevelTol' => $zeroLevelTol, 1590 'zeroLevelTol' => $zeroLevelTol,
1495 'scale_norm' => 1, 1591 'scale_norm' => 1,
1496 'params' => $ra_params, 1592 'params' => $ra_params,
1497 'debug' => $options{debug} , 1593 'debug' => $options{debug} ,
1498 ); 1594 );
1499 1595
1500} 1596}
1501 1597
1502sub function_cmp { 1598sub function_cmp {
… …
1504 1600
1505 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) { 1601 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
1506 function_invalid_params( $correctEqn ); 1602 function_invalid_params( $correctEqn );
1507 } 1603 }
1508 else { 1604 else {
1509 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1605 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1510 'var' => $var, 1606 'var' => $var,
1511 'limits' => [$llimit, $ulimit], 1607 'limits' => [$llimit, $ulimit],
1512 'tolerance' => $relPercentTol, 1608 'tolerance' => $relPercentTol,
1513 'tolType' => 'relative', 1609 'tolType' => 'relative',
1514 'numPoints' => $numPoints, 1610 'numPoints' => $numPoints,
1515 'mode' => 'std', 1611 'mode' => 'std',
1516 'maxConstantOfIntegration' => 0, 1612 'maxConstantOfIntegration' => 0,
1517 'zeroLevel' => $zeroLevel, 1613 'zeroLevel' => $zeroLevel,
1518 'zeroLevelTol' => $zeroLevelTol 1614 'zeroLevelTol' => $zeroLevelTol
1519 ); 1615 );
1520 } 1616 }
1521} 1617}
1522 1618
1523sub function_cmp_up_to_constant { ## for antiderivative problems 1619sub function_cmp_up_to_constant { ## for antiderivative problems
… …
1525 1621
1526 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) { 1622 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
1527 function_invalid_params( $correctEqn ); 1623 function_invalid_params( $correctEqn );
1528 } 1624 }
1529 else { 1625 else {
1530 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1626 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1531 'var' => $var, 1627 'var' => $var,
1532 'limits' => [$llimit, $ulimit], 1628 'limits' => [$llimit, $ulimit],
1533 'tolerance' => $relPercentTol, 1629 'tolerance' => $relPercentTol,
1534 'tolType' => 'relative', 1630 'tolType' => 'relative',
1535 'numPoints' => $numPoints, 1631 'numPoints' => $numPoints,
1536 'mode' => 'antider', 1632 'mode' => 'antider',
1537 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1633 'maxConstantOfIntegration' => $maxConstantOfIntegration,
1538 'zeroLevel' => $zeroLevel, 1634 'zeroLevel' => $zeroLevel,
1539 'zeroLevelTol' => $zeroLevelTol 1635 'zeroLevelTol' => $zeroLevelTol
1540 ); 1636 );
1541 } 1637 }
1542} 1638}
1543 1639
1544sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance 1640sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance
… …
1571 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) { 1667 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
1572 function_invalid_params( $correctEqn ); 1668 function_invalid_params( $correctEqn );
1573 } 1669 }
1574 1670
1575 else { 1671 else {
1576 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1672 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1577 'var' => $var, 1673 'var' => $var,
1578 'limits' => [$llimit, $ulimit], 1674 'limits' => [$llimit, $ulimit],
1579 'tolerance' => $absTol, 1675 'tolerance' => $absTol,
1580 'tolType' => 'absolute', 1676 'tolType' => 'absolute',
1581 'numPoints' => $numPoints, 1677 'numPoints' => $numPoints,
1582 'mode' => 'antider', 1678 'mode' => 'antider',
1583 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1679 'maxConstantOfIntegration' => $maxConstantOfIntegration,
1584 'zeroLevel' => 0, 1680 'zeroLevel' => 0,
1585 'zeroLevelTol' => 0 1681 'zeroLevelTol' => 0
1586 ); 1682 );
1587 } 1683 }
1588} 1684}
1589 1685
1590## The following answer evaluator for comparing multivarable functions was 1686## The following answer evaluator for comparing multivarable functions was
… …
1716sub fun_cmp { 1812sub fun_cmp {
1717 my $correctAnswer = shift @_; 1813 my $correctAnswer = shift @_;
1718 my %opt = @_; 1814 my %opt = @_;
1719 1815
1720 assign_option_aliases( \%opt, 1816 assign_option_aliases( \%opt,
1721 'vars' => 'var', # set the standard option 'var' to the one specified as vars 1817 'vars' => 'var', # set the standard option 'var' to the one specified as vars
1722 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain 1818 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain
1723 'reltol' => 'relTol', 1819 'reltol' => 'relTol',
1724 'param' => 'params', 1820 'param' => 'params',
1725 ); 1821 );
1726 1822
1727 set_default_options( \%opt, 1823 set_default_options( \%opt,
1728 'var' => $functVarDefault, 1824 'var' => $functVarDefault,
1729 'params' => [], 1825 'params' => [],
1730 'limits' => [[$functLLimitDefault, $functULimitDefault]], 1826 'limits' => [[$functLLimitDefault, $functULimitDefault]],
1731 'mode' => 'std', 1827 'mode' => 'std',
1732 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative', 1828 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative',
1733 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined 1829 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined
1734 'relTol' => $functRelPercentTolDefault, 1830 'relTol' => $functRelPercentTolDefault,
1735 'numPoints' => $functNumOfPoints, 1831 'numPoints' => $functNumOfPoints,
1736 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 1832 'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
1737 'zeroLevel' => $functZeroLevelDefault, 1833 'zeroLevel' => $functZeroLevelDefault,
1738 'zeroLevelTol' => $functZeroLevelTolDefault, 1834 'zeroLevelTol' => $functZeroLevelTolDefault,
1739 'debug' => 0, 1835 'debug' => 0,
1740 ); 1836 );
1741 1837
1742 1838
1743 1839
1744 # allow var => 'x' as an abbreviation for var => ['x'] 1840 # allow var => 'x' as an abbreviation for var => ['x']
… …
1759 $tolType = 'relative'; 1855 $tolType = 'relative';
1760 $tol = $out_options{'relTol'}; 1856 $tol = $out_options{'relTol'};
1761 delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 1857 delete($out_options{'tol'}) if exists( $out_options{'tol'} );
1762 } 1858 }
1763 1859
1764
1765
1766 my @output_list = (); 1860 my @output_list = ();
1767 # thread over lists 1861 # thread over lists
1768 my @ans_list = (); 1862 my @ans_list = ();
1769 1863
1770 if ( ref($correctAnswer) eq 'ARRAY' ) { 1864 if ( ref($correctAnswer) eq 'ARRAY' ) {
… …
1772 } 1866 }
1773 else { 1867 else {
1774 push( @ans_list, $correctAnswer ); 1868 push( @ans_list, $correctAnswer );
1775 } 1869 }
1776 1870
1777
1778
1779 # produce answer evaluators 1871 # produce answer evaluators
1780 foreach my $ans (@ans_list) { 1872 foreach my $ans (@ans_list) {
1781 push(@output_list, 1873 push(@output_list,
1782 FUNCTION_CMP( 'correctEqn' => $ans, 1874 FUNCTION_CMP( 'correctEqn' => $ans,
1783 'var' => $out_options{'var'}, 1875 'var' => $out_options{'var'},
1784 'limits' => $out_options{'limits'}, 1876 'limits' => $out_options{'limits'},
1785 'tolerance' => $tol, 1877 'tolerance' => $tol,
1786 'tolType' => $tolType, 1878 'tolType' => $tolType,
1787 'numPoints' => $out_options{'numPoints'}, 1879 'numPoints' => $out_options{'numPoints'},
1788 'mode' => $out_options{'mode'}, 1880 'mode' => $out_options{'mode'},
1789 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'}, 1881 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'},
1790 'zeroLevel' => $out_options{'zeroLevel'}, 1882 'zeroLevel' => $out_options{'zeroLevel'},
1791 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1883 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1792 'params' => $out_options{'params'}, 1884 'params' => $out_options{'params'},
1793 'debug' => $out_options{'debug'}, 1885 'debug' => $out_options{'debug'},
1794 ), 1886 ),
1795 ); 1887 );
1796 } 1888 }
1797 1889
1798 return @output_list; 1890 return @output_list;
… …
1820 1912
1821sub FUNCTION_CMP { 1913sub FUNCTION_CMP {
1822 my %func_params = @_; 1914 my %func_params = @_;
1823 1915
1824 my $correctEqn = $func_params{'correctEqn'}; 1916 my $correctEqn = $func_params{'correctEqn'};
1825 my $var = $func_params{'var'}; 1917 my $var = $func_params{'var'};
1826 my $ra_limits = $func_params{'limits'}; 1918 my $ra_limits = $func_params{'limits'};
1827 my $tol = $func_params{'tolerance'}; 1919 my $tol = $func_params{'tolerance'};
1828 my $tolType = $func_params{'tolType'}; 1920 my $tolType = $func_params{'tolType'};
1829 my $numPoints = $func_params{'numPoints'}; 1921 my $numPoints = $func_params{'numPoints'};
1830 my $mode = $func_params{'mode'}; 1922 my $mode = $func_params{'mode'};
1831 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 1923 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
1832 my $zeroLevel = $func_params{'zeroLevel'}; 1924 my $zeroLevel = $func_params{'zeroLevel'};
1833 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 1925 my $zeroLevelTol = $func_params{'zeroLevelTol'};
1834 1926
1835 1927
1836 # Check that everything is defined: 1928 # Check that everything is defined:
… …
1867 $numPoints = $functNumOfPoints unless defined $numPoints; 1959 $numPoints = $functNumOfPoints unless defined $numPoints;
1868 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 1960 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
1869 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 1961 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
1870 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 1962 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
1871 1963
1872 $func_params{'var'} = $var; 1964 $func_params{'var'} = $var;
1873 $func_params{'limits'} = \@limits; 1965 $func_params{'limits'} = \@limits;
1874 $func_params{'tolerance'}= $tol; 1966 $func_params{'tolerance'} = $tol;
1875 $func_params{'tolType'} = $tolType; 1967 $func_params{'tolType'} = $tolType;
1876 $func_params{'numPoints'}= $numPoints; 1968 $func_params{'numPoints'} = $numPoints;
1877 $func_params{'mode'} = $mode; 1969 $func_params{'mode'} = $mode;
1878 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 1970 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
1879 $func_params{'zeroLevel'} = $zeroLevel; 1971 $func_params{'zeroLevel'} = $zeroLevel;
1880 $func_params{'zeroLevelTol'} = $zeroLevelTol; 1972 $func_params{'zeroLevelTol'} = $zeroLevelTol;
1881 1973
1974########################################################
1975# End of cleanup of calling parameters
1976########################################################
1882 my $i; #for use with loops 1977 my $i; #for use with loops
1883 my $PGanswerMessage = ""; 1978 my $PGanswerMessage = "";
1884 my $originalCorrEqn = $correctEqn; 1979 my $originalCorrEqn = $correctEqn;
1885 1980
1886#prepare the correct answer and check it's syntax 1981#prepare the correct answer and check it's syntax
1887 my $rh_correct_ans = new AnswerHash; 1982 my $rh_correct_ans = new AnswerHash;
1888 $rh_correct_ans->input($correctEqn); 1983 $rh_correct_ans->input($correctEqn);
1889 $rh_correct_ans = check_syntax($rh_correct_ans); 1984 $rh_correct_ans = check_syntax($rh_correct_ans);
1890 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 1985 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1891 $rh_correct_ans->clear_error(); 1986 $rh_correct_ans->clear_error();
1892 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ], 1987 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ],
… …
1895 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans}; 1990 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
1896 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 1991 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1897 1992
1898#create the evaluation points 1993#create the evaluation points
1899 my $random_for_answers = new PGrandom($main::PG_original_problemSeed); 1994 my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
1900 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator 1995 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
1901 my (@evaluation_points); 1996 my (@evaluation_points);
1902 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) { 1997 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) {
1903 my (@vars,$iteration_limit); 1998 my (@vars,$iteration_limit);
1904 for( my $i = 0; $i < @VARS; $i++ ) { 1999 for( my $i = 0; $i < @VARS; $i++ ) {
1905 my $iteration_limit = 10; 2000 my $iteration_limit = 10;
… …
1914 push(@evaluation_points,\@vars); 2009 push(@evaluation_points,\@vars);
1915 } 2010 }
1916 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points); 2011 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
1917 2012
1918 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters); 2013 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
1919 #warn "coeff", join(" | ", @{$COEFFS}); 2014 #warn "coeff", join(" | ", @{$COEFFS});
1920 2015
1921#construct the answer evaluator 2016#construct the answer evaluator
1922 my $answer_evaluator = new AnswerEvaluator; 2017 my $answer_evaluator = new AnswerEvaluator;
1923 $answer_evaluator->{debug} = $func_params{debug}; 2018 $answer_evaluator->{debug} = $func_params{debug};
1924 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn, 2019 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn,
… …
2077 push(@out, $temp_hash->input()); 2172 push(@out, $temp_hash->input());
2078 2173
2079 } 2174 }
2080 if ($PGanswerMessage) { 2175 if ($PGanswerMessage) {
2081 $rh_ans->input( "( " . join(", ", @out ) . " )" ); 2176 $rh_ans->input( "( " . join(", ", @out ) . " )" );
2082 $rh_ans->throw_error('SYTNAX', 'There is a syntax error in your answer.'); 2177 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
2083 } else { 2178 } else {
2084 $rh_ans->input( [@out] ); 2179 $rh_ans->input( [@out] );
2085 } 2180 }
2086 $rh_ans; 2181 $rh_ans;
2087} 2182}
… …
2100 my @VARS = @{ $options{ 'ra_vars'}}; 2195 my @VARS = @{ $options{ 'ra_vars'}};
2101 warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1; 2196 warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
2102 my $originalEqn = $eqn; 2197 my $originalEqn = $eqn;
2103 $eqn = &math_constants($eqn); 2198 $eqn = &math_constants($eqn);
2104 for( my $i = 0; $i < @VARS; $i++ ) { 2199 for( my $i = 0; $i < @VARS; $i++ ) {
2200 # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1
2201 my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"');
2105 $eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g; 2202# $eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
2203 $eqn =~ s/\b$temp\b/\$VARS[$i]/g;
2204
2106 } 2205 }
2107 warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n", 2206 warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
2108 pretty_print(\%options) 2207 pretty_print(\%options)
2109 if defined($options{debug}) and $options{debug} ==1; 2208 if defined($options{debug}) and $options{debug} ==1;
2110 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q! 2209 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q!
… …
2179 my $error = "WeBWorK was unable evaluate your function. Please check that your 2278 my $error = "WeBWorK was unable evaluate your function. Please check that your
2180 expression doesn't take roots of negative numbers, or divide by zero."; 2279 expression doesn't take roots of negative numbers, or divide by zero.";
2181 $rh_ans->throw_error('EVAL',$error); 2280 $rh_ans->throw_error('EVAL',$error);
2182 } else { 2281 } else {
2183 my $tol = $options{tol} if defined($options{tol}); 2282 my $tol = $options{tol} if defined($options{tol});
2184 $tol = 0.01*$options{reltol} if defined($options{reltol}); 2283 #$tol = 0.01*$options{reltol} if defined($options{reltol});
2185 $tol = .000001 unless defined($tol); 2284 $tol = .000001 unless defined($tol);
2186 2285
2187 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0; 2286 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0;
2188 } 2287 }
2189 $rh_ans; 2288 $rh_ans;
… …
2273 my $rf_correct_fun = $rh_ans->{rf_correct_ans}; 2372 my $rf_correct_fun = $rh_ans->{rf_correct_ans};
2274 my $ra_vars_matrix = $rh_ans->{evaluation_points}; 2373 my $ra_vars_matrix = $rh_ans->{evaluation_points};
2275 my $dim_of_param_space = @{$options{param_vars}}; 2374 my $dim_of_param_space = @{$options{param_vars}};
2276 # Short cut. Bail if there are no param_vars 2375 # Short cut. Bail if there are no param_vars
2277 unless ($dim_of_param_space >0) { 2376 unless ($dim_of_param_space >0) {
2278 $rh_ans ->{ra_paramters} = []; 2377 $rh_ans ->{ra_parameters} = [];
2279 return $rh_ans; 2378 return $rh_ans;
2280 } 2379 }
2281 # inputs are row arrays in this case. 2380 # inputs are row arrays in this case.
2282 my @zero_params=(); 2381 my @zero_params=();
2283 2382
… …
2315 while(@coeff) { 2414 while(@coeff) {
2316 $matrix->assign($row_num,$col_num, shift(@coeff) ); 2415 $matrix->assign($row_num,$col_num, shift(@coeff) );
2317 $col_num++; 2416 $col_num++;
2318 } 2417 }
2319 } 2418 }
2320 # which might be useful for functions that are not defined at some points. 2419
2321 } 2420 }
2322 $row_num++; 2421 $row_num++;
2323 last if $errors; # break if there are any errors. 2422 last if $errors; # break if there are any errors.
2324 # This cuts down on the size of error messages. 2423 # This cuts down on the size of error messages.
2325 # However it impossible to check for equivalence at 95% of points 2424 # However it impossible to check for equivalence at 95% of points
2326 2425 # which might be useful for functions that are not defined at some points.
2327 } 2426 }
2328 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug}; 2427 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug};
2329 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug}; 2428 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug};
2330 2429
2331 # we have Matrix * parameter = data_vec + perpendicular vector 2430 # we have Matrix * parameter = data_vec + perpendicular vector
… …
2390 my $ra_parameters = $rh_ans ->{ra_parameters}; 2489 my $ra_parameters = $rh_ans ->{ra_parameters};
2391 my @evaluation_points = @{$rh_ans->{evaluation_points} }; 2490 my @evaluation_points = @{$rh_ans->{evaluation_points} };
2392 my @parameters = (); 2491 my @parameters = ();
2393 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY'; 2492 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY';
2394 my $errors = undef; 2493 my $errors = undef;
2494 my @zero_params=();
2495 for(my $i=1;$i<=@{$ra_parameters};$i++){push(@zero_params,0); }
2395 my @differences = (); 2496 my @differences = ();
2396 my $diff; 2497 my @student_values;
2498 my @correct_values;
2499 my @tol_values;
2500 my ($diff,$tol_val);
2397 # calculate the vector of differences between the test function and the comparison function. 2501 # calculate the vector of differences between the test function and the comparison function.
2398 while (@evaluation_points) { 2502 while (@evaluation_points) {
2399 my ($err1, $err2); 2503 my ($err1, $err2,$err3);
2400 my @vars = @{ shift(@evaluation_points) }; 2504 my @vars = @{ shift(@evaluation_points) };
2401 my @inputs = (@vars, @parameters); 2505 my @inputs = (@vars, @parameters);
2402 my ($inVal, $correctVal); 2506 my ($inVal, $correctVal);
2403 ($inVal, $err1) = &{$rf_fun}(@vars); 2507 ($inVal, $err1) = &{$rf_fun}(@vars);
2404 $errors .= " $err1 " if defined($err1); 2508 $errors .= " $err1 " if defined($err1);
2405 $errors .= " Error detected evaluating student input at @vars " if defined($options{debug}) and $options{debug}=1 and defined($err1); 2509 $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err1);
2406 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs); 2510 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs);
2407 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2); 2511 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2);
2408 $errors .= " Error detected evaluating correct answer at @inputs " if defined($options{debug}) and $options{debug}=1 and defined($err2); 2512 $errors .= " Error detected evaluating correct answer at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2);
2513 ($tol_val,$err3)= &$rf_correct_fun(@vars, @zero_params);
2514 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
2515 $errors .= " Error detected evaluating correct answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3);
2409 unless (defined($err1) or defined($err2) ) { 2516 unless (defined($err1) or defined($err2) or defined($err3) ) {
2410 $diff = $inVal - $correctVal; 2517 $diff = ( $inVal - ($correctVal -$tol_val ) ) - $tol_val; #prevents entering too high a number?
2411 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 2518 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
2412 2519
2413 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 2520 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance
2414 $diff = $diff/abs( &$rf_correct_fun(@inputs) ) if $correctVal > $options{zeroLevel}; 2521 #warn "diff = $diff";
2522
2523 $diff = ( $inVal - ($correctVal-$tol_val ) )/abs($tol_val) -1 if abs($tol_val) > $options{zeroLevel};
2524 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel};
2525 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
2415 } 2526 }
2416 } 2527 }
2417 last if $errors; # break if there are any errors. 2528 last if $errors; # break if there are any errors.
2418 # This cuts down on the size of error messages. 2529 # This cuts down on the size of error messages.
2419 # However it impossible to check for equivalence at 95% of points 2530 # However it impossible to check for equivalence at 95% of points
2420 # which might be useful for functions that are not defined at some points. 2531 # which might be useful for functions that are not defined at some points.
2532 push(@student_values,$inVal);
2533 push(@correct_values,( $inVal - ($correctVal-$tol_val ) ));
2421 push(@differences, $diff); 2534 push(@differences, $diff);
2535 push(@tol_values,$tol_val);
2422 } 2536 }
2423 $rh_ans ->{ra_differences} = \@differences; 2537 $rh_ans ->{ra_differences} = \@differences;
2538 $rh_ans ->{ra_student_values} = \@student_values;
2539 $rh_ans ->{ra_adjusted_student_values} = \@correct_values;
2540 $rh_ans->{ra_tol_values}=\@tol_values;
2424 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 2541 $rh_ans->throw_error('EVAL', $errors) if defined($errors);
2425 $rh_ans; 2542 $rh_ans;
2426} 2543}
2427 2544
2428 2545
… …
2484## individual filters below it 2601## individual filters below it
2485sub str_filters { 2602sub str_filters {
2486 my $stringToFilter = shift @_; 2603 my $stringToFilter = shift @_;
2487 my @filters_to_use = @_; 2604 my @filters_to_use = @_;
2488 my %known_filters = ( 'remove_whitespace' => undef, 2605 my %known_filters = ( 'remove_whitespace' => undef,
2489 'compress_whitespace' => undef, 2606 'compress_whitespace' => undef,
2490 'trim_whitespace' => undef, 2607 'trim_whitespace' => undef,
2491 'ignore_case' => undef, 2608 'ignore_case' => undef,
2492 'ignore_order' => undef 2609 'ignore_order' => undef
2493 ); 2610 );
2494 2611
2495 #test for unknown filters 2612 #test for unknown filters
2496 my $filter; 2613 my $filter;
2497 foreach $filter (@filters_to_use) { 2614 foreach $filter (@filters_to_use) {
… …
2619sub std_str_cmp { # compare strings 2736sub std_str_cmp { # compare strings
2620 my $correctAnswer = shift @_; 2737 my $correctAnswer = shift @_;
2621 my @filters = ( 'compress_whitespace', 'ignore_case' ); 2738 my @filters = ( 'compress_whitespace', 'ignore_case' );
2622 my $type = 'std_str_cmp'; 2739 my $type = 'std_str_cmp';
2623 STR_CMP( 'correctAnswer' => $correctAnswer, 2740 STR_CMP( 'correctAnswer' => $correctAnswer,
2624 'filters' => \@filters, 2741 'filters' => \@filters,
2625 'type' => $type 2742 'type' => $type
2626 ); 2743 );
2627} 2744}
2628 2745
2629sub std_str_cmp_list { # alias for std_str_cmp 2746sub std_str_cmp_list { # alias for std_str_cmp
2630 my @answerList = @_; 2747 my @answerList = @_;
… …
2833## IN: a hashtable with the following entries (error-checking to be added later?): 2950## IN: a hashtable with the following entries (error-checking to be added later?):
2834## correctAnswer -- the correct answer, before filtering 2951## correctAnswer -- the correct answer, before filtering
2835## filters -- reference to an array containing the filters to be applied 2952## filters -- reference to an array containing the filters to be applied
2836## type -- a string containing the type of answer evaluator in use 2953## type -- a string containing the type of answer evaluator in use
2837## OUT: a reference to an answer evaluator subroutine 2954## OUT: a reference to an answer evaluator subroutine
2955
2838sub STR_CMP { 2956sub STR_CMP {
2839 my %str_params = @_; 2957 my %str_params = @_;
2840
2841 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} ); 2958 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} );
2842
2843 my $answer_evaluator = sub { 2959 my $answer_evaluator = sub {
2844 my $in = shift @_; 2960 my $in = shift @_;
2845 $in = '' unless defined $in; 2961 $in = '' unless defined $in;
2846 my $original_student_ans = $in; 2962 my $original_student_ans = $in;
2847
2848 $in = str_filters( $in, @{$str_params{'filters'}} ); 2963 $in = str_filters( $in, @{$str_params{'filters'}} );
2849
2850 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0; 2964 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0;
2851 my $ans_hash = new AnswerHash( 2965 my $ans_hash = new AnswerHash( 'score' => $correctQ,
2852 'score' => $correctQ,
2853 'correct_ans' => $str_params{'correctAnswer'}, 2966 'correct_ans' => $str_params{'correctAnswer'},
2854 'student_ans' => $in, 2967 'student_ans' => $in,
2855 'ans_message' => '', 2968 'ans_message' => '',
2856 'type' => $str_params{'type'}, 2969 'type' => $str_params{'type'},
2857 'preview_text_string' => $in, 2970 'preview_text_string' => $in,
2858 'preview_latex_string' => $in, 2971 'preview_latex_string' => $in,
2859 'original_student_ans' => $original_student_ans 2972 'original_student_ans' => $original_student_ans
2860 ); 2973 );
2861
2862 return $ans_hash; 2974 return $ans_hash;
2863 }; 2975 };
2864
2865 return $answer_evaluator; 2976 return $answer_evaluator;
2866} 2977}
2867
2868
2869 2978
2870########################################################################## 2979##########################################################################
2871########################################################################## 2980##########################################################################
2872## Miscellaneous answer evaluators 2981## Miscellaneous answer evaluators
2873 2982
… …
3152 $problem_result{score} = $allAnswersCorrectQ; 3261 $problem_result{score} = $allAnswersCorrectQ;
3153 3262
3154 # I don't like to put in this bit of code. 3263 # I don't like to put in this bit of code.
3155 # It makes it hard to construct error free problem graders 3264 # It makes it hard to construct error free problem graders
3156 # I would prefer to know that the problem score was numeric. 3265 # I would prefer to know that the problem score was numeric.
3157 unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 3266 unless (defined($problem_state{recorded_score}) and $problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
3158 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 3267 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores
3159 } 3268 }
3160 # 3269 #
3161 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 3270 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
3162 $problem_state{recorded_score} = 1; 3271 $problem_state{recorded_score} = 1;
… …
3385## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]] 3494## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
3386## a reference to an array of limits -- [llim, ulim] 3495## a reference to an array of limits -- [llim, ulim]
3387## an array of array references -- ([llim,ulim], [llim,ulim]) 3496## an array of array references -- ([llim,ulim], [llim,ulim])
3388## an array of limits -- (llim,ulim) 3497## an array of limits -- (llim,ulim)
3389## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim]) 3498## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
3499
3390sub get_limits_array { 3500sub get_limits_array {
3391 my $in = shift @_; 3501 my $in = shift @_;
3392 my @out; 3502 my @out;
3393 3503
3394 if( not defined($in) ) { #if nothing defined, build default array and return 3504 if( not defined($in) ) { #if nothing defined, build default array and return
… …
3440 }; 3550 };
3441 3551
3442 return $error_response; 3552 return $error_response;
3443} 3553}
3444 3554
3445# outputs a hash to the screen 3555
3446# sub display_options { 3556#########################################################################
3447# my %options = @_; 3557# Filters for answer evaluators
3448# my $out_string = ""; 3558#########################################################################
3449# foreach my $key (keys %options) { 3559
3450# $out_string .= " $key => $options{$key},<BR>";
3451# }
3452# return $out_string;
3453# }
3454 3560
3455sub is_a_number { 3561sub is_a_number {
3456 my ($num) = @_; 3562 my ($num,%options) = @_;
3563 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3564 my ($rh_ans);
3565 if ($process_ans_hash) {
3566 $rh_ans = $num;
3567 $num = $rh_ans->{student_ans};
3568 }
3569
3457 my $is_a_number = 0; 3570 my $is_a_number = 0;
3458 return $is_a_number unless defined($num); 3571 return $is_a_number unless defined($num);
3459 $num =~ s/^\s*//; ## remove initial spaces 3572 $num =~ s/^\s*//; ## remove initial spaces
3460 $num =~ s/\s*$//; ## remove trailing spaces 3573 $num =~ s/\s*$//; ## remove trailing spaces
3461 3574
3462 ## the following is copied from the online perl manual 3575 ## the following is copied from the online perl manual
3463 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ 3576 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
3464 $is_a_number = 1; 3577 $is_a_number = 1;
3465 } 3578 }
3466 3579
3580 if ($process_ans_hash) {
3581 if ($is_a_number == 1 ) {
3582 $rh_ans->{student_ans}=$num;
3583 return $rh_ans;
3584 } else {
3585 $rh_ans->{student_ans} = "Incorrect number format: You must enter a number, e.g. -6, 5.3, or 6.12E-3";
3586 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3587 return $rh_ans;
3588 }
3589 } else {
3467 return $is_a_number; 3590 return $is_a_number;
3591 }
3468} 3592}
3469 3593
3470sub is_a_fraction { 3594sub is_a_fraction {
3471 3595 my ($num,%options) = @_;
3472 ## does not test for validity, just for allowed characters 3596 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3473 ## note that an integer will qualify as a fraction 3597 my ($rh_ans);
3474 my ($exp) = @_; 3598 if ($process_ans_hash) {
3599 $rh_ans = $num;
3600 $num = $rh_ans->{student_ans};
3601 }
3602
3475 my $is_a_fraction = 0; 3603 my $is_a_fraction = 0;
3476 return $is_a_fraction unless defined($exp); 3604 return $is_a_fraction unless defined($num);
3605 $num =~ s/^\s*//; ## remove initial spaces
3606 $num =~ s/\s*$//; ## remove trailing spaces
3607
3477 if ($exp =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) { 3608 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
3478 $is_a_fraction = 1; 3609 $is_a_fraction = 1;
3479 } 3610 }
3480 3611
3612 if ($process_ans_hash) {
3613 if ($is_a_fraction == 1 ) {
3614 $rh_ans->{student_ans}=$num;
3615 return $rh_ans;
3616 } else {
3617 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
3618 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3619 return $rh_ans;
3620 }
3621
3622 } else {
3481 return $is_a_fraction; 3623 return $is_a_fraction;
3624 }
3482} 3625}
3483 3626
3627
3484sub is_an_arithmetic_expression { 3628sub is_an_arithmetic_expression {
3485 ## does not test for validity, just for allowed characters 3629 my ($num,%options) = @_;
3486 my ($exp) = @_; 3630 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3631 my ($rh_ans);
3632 if ($process_ans_hash) {
3633 $rh_ans = $num;
3634 $num = $rh_ans->{student_ans};
3635 }
3636
3487 my $is_an_arithmetic_expression = 0; 3637 my $is_an_arithmetic_expression = 0;
3638 return $is_an_arithmetic_expression unless defined($num);
3639 $num =~ s/^\s*//; ## remove initial spaces
3640 $num =~ s/\s*$//; ## remove trailing spaces
3641
3488 if ($exp =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) { 3642 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
3489 $is_an_arithmetic_expression = 1; 3643 $is_an_arithmetic_expression = 1;
3490 } 3644 }
3491 3645
3646 if ($process_ans_hash) {
3647 if ($is_an_arithmetic_expression == 1 ) {
3648 $rh_ans->{student_ans}=$num;
3649 return $rh_ans;
3650 } else {
3651
3652 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
3653 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
3654 return $rh_ans;
3655 }
3656
3657 } else {
3492 return $is_an_arithmetic_expression; 3658 return $is_an_arithmetic_expression;
3659 }
3493} 3660}
3494 3661
3495#replaces pi, e, and ^ with their Perl equivalents 3662#replaces pi, e, and ^ with their Perl equivalents
3496sub math_constants { 3663sub math_constants {
3497 my($in) = @_; 3664 my($in,%options) = @_;
3665 my $rh_ans;
3666 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
3667 if ($process_ans_hash) {
3668 $rh_ans = $in;
3669 $in = $rh_ans->{student_ans};
3670 }
3671
3498 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 3672 $in =~s/\bpi\b/(4*atan2(1,1))/ge;
3499 $in =~s/\be\b/(exp(1))/ge; 3673 $in =~s/\be\b/(exp(1))/ge;
3500 $in =~s/\^/**/g; 3674 $in =~s/\^/**/g;
3501 3675
3676 if ($process_ans_hash) {
3677 $rh_ans->{student_ans}=$in;
3678 return $rh_ans;
3679 } else {
3502 return $in; 3680 return $in;
3681 }
3503} 3682}
3504 3683
3505sub clean_up_error_msg { 3684sub clean_up_error_msg {
3506 my $msg = $_[0]; 3685 my $msg = $_[0];
3507 $msg =~ s/^\[[^\]]*\][^:]*://; 3686 $msg =~ s/^\[[^\]]*\][^:]*://;
… …
3579# Use this to set default options 3758# Use this to set default options
3580sub set_default_options { 3759sub set_default_options {
3581 my $rh_options = shift; 3760 my $rh_options = shift;
3582 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 3761 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
3583 my %default_options = @_; 3762 my %default_options = @_;
3763 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
3584 foreach my $key (keys %$rh_options) { 3764 foreach my $key1 (keys %$rh_options) {
3585 warn "This option |$key| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key}); 3765 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
3766 }
3586 } 3767 }
3587 foreach my $key (keys %default_options) { 3768 foreach my $key (keys %default_options) {
3588 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) { 3769 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
3589 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define 3770 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define
3590 # this key unless tol is explicitly defined. 3771 # this key unless tol is explicitly defined.
Legend:
Removed from v.2  
changed lines
  Added in v.53
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9