[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 22
1#!/usr/bin/perl 1#!/usr/local/bin/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
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
… …
329 The student answer can contain elementary functions, e.g. sin(.3+pi/2) 330 The student answer can contain elementary functions, e.g. sin(.3+pi/2)
330 331
331=cut 332=cut
332 333
333sub std_num_cmp { # compare numbers allowing use of elementary functions 334sub std_num_cmp { # compare numbers allowing use of elementary functions
334 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 335 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
335 336
336 NUM_CMP( 'correctAnswer' => $correctAnswer, 337 my %options = ( 'tolerance' => $relPercentTol,
337 'tolerance' => $relPercentTol,
338 'tolType' => 'relative',
339 'format' => $format, 338 'format' => $format,
339 'zeroLevel' => $zeroLevel,
340 'zeroLevelTol' => $zeroLevelTol
341 );
342
343 set_default_options( \%options,
344 'tolType' => 'relative',
345 'tolerance' => $numRelPercentTolDefault,
340 'mode' => 'std', 346 'mode' => 'std',
341 'zeroLevel' => $zeroLevel, 347 'format' => $numFormatDefault,
342 'zeroLevelTol' => $zeroLevelTol 348 'relTol' => $numRelPercentTolDefault,
349 'zeroLevel' => $numZeroLevelDefault,
350 'zeroLevelTol' => $numZeroLevelTolDefault,
351 'debug' => 0,
343 ); 352 );
353
354 num_cmp([$correctAnswer], %options);
344} 355}
345 356
346## Similar to std_num_cmp but accepts a list of numbers in the form 357## Similar to std_num_cmp but accepts a list of numbers in the form
347## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...) 358## 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 359## 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 360## You must enter a format and tolerance
350sub std_num_cmp_list { 361sub std_num_cmp_list {
351 my ( $relPercentTol, $format, @answerList) = @_; 362 my ( $relPercentTol, $format, @answerList) = @_;
352 363
353 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 364 my %options = ( 'tolerance' => $relPercentTol,
354 'tolType' => 'relative', 365 'format' => $format,
355 'format' => $format,
356 'mode' => 'std',
357 'zeroLevel' => $numZeroLevelDefault,
358 'zeroLevelTol' => $numZeroLevelTolDefault,
359 'answerList' => \@answerList
360 ); 366 );
361}
362 367
368 set_default_options( \%options,
369 'tolType' => 'relative',
370 'tolerance' => $numRelPercentTolDefault,
371 'mode' => 'std',
372 'format' => $numFormatDefault,
373 'relTol' => $numRelPercentTolDefault,
374 'zeroLevel' => $numZeroLevelDefault,
375 'zeroLevelTol' => $numZeroLevelTolDefault,
376 'debug' => 0,
377 );
378
379 num_cmp(\@answerList, %options);
380
381}
382
363sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance 383sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
364 my ( $correctAnswer, $absTol, $format) = @_; 384 my ( $correctAnswer, $absTol, $format) = @_;
385 my %options = ( 'tolerance' => $absTol,
386 'format' => $format);
387
388 set_default_options (\%options,
389 'tolType' => 'absolute',
390 'tolerance' => $absTol,
391 'mode' => 'std',
392 'format' => $numFormatDefault,
393 'zeroLevel' => 0,
394 'zeroLevelTol' => 0,
395 'debug' => 0,
396 );
365 397
366 NUM_CMP( 'correctAnswer' => $correctAnswer, 398 num_cmp([$correctAnswer], %options);
367 'tolerance' => $absTol,
368 'tolType' => 'absolute',
369 'format' => $format,
370 'mode' => 'std',
371 'zeroLevel' => 0,
372 'zeroLevelTol' => 0
373 );
374} 399}
375 400
376## See std_num_cmp_list for usage 401## See std_num_cmp_list for usage
402
377sub std_num_cmp_abs_list { 403sub std_num_cmp_abs_list {
378 my ( $absTol, $format, @answerList ) = @_; 404 my ( $absTol, $format, @answerList ) = @_;
379 405
380 NUM_CMP_LIST( 'tolerance' => $absTol, 406 my %options = ( 'tolerance' => $absTol,
381 'tolType' => 'absolute', 407 'format' => $format,
382 'format' => $format,
383 'mode' => 'std',
384 'zeroLevel' => 0,
385 'zeroLevelTol' => 0,
386 'answerList' => \@answerList
387 ); 408 );
388}
389 409
410 set_default_options( \%options,
411 'tolType' => 'absolute',
412 'tolerance' => $absTol,
413 'mode' => 'std',
414 'format' => $numFormatDefault,
415 'zeroLevel' => 0,
416 'zeroLevelTol' => 0,
417 'debug' => 0,
418 );
419
420 num_cmp(\@answerList, %options);
421
422}
390 423
391sub frac_num_cmp { # only allow fractions and numbers as submitted answer 424sub frac_num_cmp { # only allow fractions and numbers as submitted answer
425
392 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 426 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
427
428 my %options = ( 'tolerance' => $relPercentTol,
429 'format' => $format,
430 'zeroLevel' => $zeroLevel,
431 'zeroLevelTol' => $zeroLevelTol
432 );
393 433
394 NUM_CMP( 'correctAnswer' => $correctAnswer, 434 set_default_options( \%options,
435 'tolType' => 'relative',
395 'tolerance' => $relPercentTol, 436 'tolerance' => $relPercentTol,
396 'tolType' => 'relative', 437 'mode' => 'frac',
397 'format' => $format, 438 'format' => $numFormatDefault,
398 'mode' => 'frac', 439 'zeroLevel' => $numZeroLevelDefault,
399 'zeroLevel' => $zeroLevel, 440 'zeroLevelTol' => $numZeroLevelTolDefault,
400 'zeroLevelTol' => $zeroLevelTol 441 'relTol' => $numRelPercentTolDefault,
442 'debug' => 0,
401 ); 443 );
444
445 num_cmp([$correctAnswer], %options);
402} 446}
403 447
404## See std_num_cmp_list for usage 448## See std_num_cmp_list for usage
405sub frac_num_cmp_list { 449sub frac_num_cmp_list {
406 my ( $relPercentTol, $format, @answerList ) = @_; 450 my ( $relPercentTol, $format, @answerList ) = @_;
407 451
408 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 452 my %options = ( 'tolerance' => $relPercentTol,
409 'tolType' => 'relative', 453 'format' => $format
410 'format' => $format, 454 );
411 'mode' => 'frac', 455
456 set_default_options( \%options,
457 'tolType' => 'relative',
458 'tolerance' => $relPercentTol,
459 'mode' => 'frac',
460 'format' => $numFormatDefault,
412 'zeroLevel' => $numZeroLevelDefault, 461 'zeroLevel' => $numZeroLevelDefault,
413 'zeroLevelTol' => $numZeroLevelTolDefault, 462 'zeroLevelTol' => $numZeroLevelTolDefault,
414 'answerList' => \@answerList 463 'relTol' => $numRelPercentTolDefault,
415 ); 464 'debug' => 0,
465 );
466
467 num_cmp(\@answerList, %options);
468
416} 469}
417 470
418sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance 471sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
419 my ( $correctAnswer, $absTol, $format ) = @_; 472 my ( $correctAnswer, $absTol, $format ) = @_;
420 473
421 NUM_CMP( 'correctAnswer' => $correctAnswer, 474 my %options = ( 'tolerance' => $absTol,
475 'format' => $format
476 );
477
478 set_default_options (\%options,
479 'tolType' => 'absolute',
422 'tolerance' => $absTol, 480 'tolerance' => $absTol,
423 'tolType' => 'absolute', 481 'mode' => 'frac',
424 'format' => $format, 482 'format' => $numFormatDefault,
425 'mode' => 'frac', 483 'zeroLevel' => 0,
426 'zeroLevel' => 0,
427 'zeroLevelTol' => 0 484 'zeroLevelTol' => 0,
428 ); 485 'debug' => 0,
486 );
487 num_cmp([$correctAnswer], %options);
488
429} 489}
430 490
431## See std_num_cmp_list for usage 491## See std_num_cmp_list for usage
432sub frac_num_cmp_abs_list { 492sub frac_num_cmp_abs_list {
433 my ( $absTol, $format, @answerList ) = @_; 493 my ( $absTol, $format, @answerList ) = @_;
434 494
435 NUM_CMP_LIST( 'tolerance' => $absTol, 495 my %options = ( 'tolerance' => $absTol,
436 'tolType' => 'absolute', 496 'format' => $format
437 'format' => $format, 497 );
438 'mode' => 'frac', 498
439 'zeroLevel' => 0, 499 set_default_options (\%options,
500 'tolType' => 'absolute',
501 'tolerance' => $absTol,
502 'mode' => 'frac',
503 'format' => $numFormatDefault,
504 'zeroLevel' => 0,
440 'zeroLevelTol' => 0, 505 'zeroLevelTol' => 0,
441 'answerList' => \@answerList 506 'debug' => 0,
442 ); 507 );
508
509 num_cmp(\@answerList, %options);
443} 510}
444 511
445 512
446sub arith_num_cmp { # only allow arithmetic expressions as submitted answer 513sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
514
447 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 515 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
448 516
449 NUM_CMP( 'correctAnswer' => $correctAnswer, 517 my %options = ( 'tolerance' => $relPercentTol,
450 'tolerance' => $relPercentTol, 518 'format' => $format,
451 'tolType' => 'relative', 519 'zeroLevel' => $zeroLevel,
452 'format' => $format,
453 'mode' => 'arith',
454 'zeroLevel' => $zeroLevel,
455 'zeroLevelTol' => $zeroLevelTol 520 'zeroLevelTol' => $zeroLevelTol
456 ); 521 );
522
523 set_default_options( \%options,
524 'tolType' => 'relative',
525 'tolerance' => $relPercentTol,
526 'mode' => 'arith',
527 'format' => $numFormatDefault,
528 'zeroLevel' => $numZeroLevelDefault,
529 'zeroLevelTol' => $numZeroLevelTolDefault,
530 'relTol' => $numRelPercentTolDefault,
531 'debug' => 0,
532 );
533
534 num_cmp([$correctAnswer], %options);
457} 535}
458 536
459## See std_num_cmp_list for usage 537## See std_num_cmp_list for usage
460sub arith_num_cmp_list { 538sub arith_num_cmp_list {
461 my ( $relPercentTol, $format, @answerList ) = @_; 539 my ( $relPercentTol, $format, @answerList ) = @_;
462 540
463 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 541 my %options = ( 'tolerance' => $relPercentTol,
464 'tolType' => 'relative', 542 'format' => $format,
465 'format' => $format, 543 );
466 'mode' => 'arith',
467 'zeroLevel' => $numZeroLevelDefault,
468 'zeroLevelTol' => $numZeroLevelTolDefault,
469 'answerList' => \@answerList
470 );
471}
472 544
545 set_default_options( \%options,
546 'tolType' => 'relative',
547 'tolerance' => $relPercentTol,
548 'mode' => 'arith',
549 'format' => $numFormatDefault,
550 'zeroLevel' => $numZeroLevelDefault,
551 'zeroLevelTol' => $numZeroLevelTolDefault,
552 'relTol' => $numRelPercentTolDefault,
553 'debug' => 0,
554 );
555 num_cmp(\@answerList, %options);
556}
557
473sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance 558sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
474 my ( $correctAnswer, $absTol, $format ) = @_; 559 my ( $correctAnswer, $absTol, $format ) = @_;
560
561 my %options = ( 'tolerance' => $absTol,
562 'format' => $format
563 );
564
565 set_default_options (\%options,
566 'tolType' => 'absolute',
567 'tolerance' => $absTol,
568 'mode' => 'arith',
569 'format' => $numFormatDefault,
570 'zeroLevel' => 0,
571 'zeroLevelTol' => 0,
572 'debug' => 0,
573 );
574 num_cmp([$correctAnswer], %options);
475 575
476 NUM_CMP( 'correctAnswer' => $correctAnswer, 576
477 'tolerance' => $absTol,
478 'tolType' => 'absolute',
479 'format' => $format,
480 'mode' => 'arith',
481 'zeroLevel' => 0,
482 'zeroLevelTol' => 0
483 );
484} 577}
485 578
486## See std_num_cmp_list for usage 579## See std_num_cmp_list for usage
487sub arith_num_cmp_abs_list { 580sub arith_num_cmp_abs_list {
488 my ( $absTol, $format, @answerList ) = @_; 581 my ( $absTol, $format, @answerList ) = @_;
489 582
490 NUM_CMP_LIST( 'tolerance' => $absTol, 583 my %options = ( 'tolerance' => $absTol,
491 'tolType' => 'absolute', 584 'format' => $format
492 'format' => $format, 585 );
493 'mode' => 'arith', 586
494 'zeroLevel' => 0, 587 set_default_options (\%options,
495 'zeroLevelTol' => 0, 588 'tolType' => 'absolute',
496 'answerList' => \@answerList 589 'tolerance' => $absTol,
497 ); 590 'mode' => 'arith',
591 'format' => $numFormatDefault,
592 'zeroLevel' => 0,
593 'zeroLevelTol' => 0,
594 'debug' => 0,
595 );
596 num_cmp(\@answerList, %options);
597
498} 598}
499 599
500sub strict_num_cmp { # only allow numbers as submitted answer 600sub strict_num_cmp { # only allow numbers as submitted answer
601
501 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 602 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
603
604 my %options = ( 'tolerance' => $relPercentTol,
605 'format' => $format,
606 'zeroLevel' => $zeroLevel,
607 'zeroLevelTol' => $zeroLevelTol
608 );
609
610 set_default_options( \%options,
611 'tolType' => 'relative',
612 'tolerance' => $relPercentTol,
613 'mode' => 'strict',
614 'format' => $numFormatDefault,
615 'zeroLevel' => $numZeroLevelDefault,
616 'zeroLevelTol' => $numZeroLevelTolDefault,
617 'relTol' => $numRelPercentTolDefault,
618 'debug' => 0,
619 );
620
621 num_cmp([$correctAnswer], %options);
502 622
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} 623}
512 624
513## See std_num_cmp_list for usage 625## See std_num_cmp_list for usage
514sub strict_num_cmp_list { # compare numbers 626sub strict_num_cmp_list { # compare numbers
515 my ( $relPercentTol, $format, @answerList ) = @_; 627 my ( $relPercentTol, $format, @answerList ) = @_;
628
629 my %options = ( 'tolerance' => $relPercentTol,
630 'format' => $format,
631 );
632
633 set_default_options( \%options,
634 'tolType' => 'relative',
635 'tolerance' => $relPercentTol,
636 'mode' => 'strict',
637 'format' => $numFormatDefault,
638 'zeroLevel' => $numZeroLevelDefault,
639 'zeroLevelTol' => $numZeroLevelTolDefault,
640 'relTol' => $numRelPercentTolDefault,
641 'debug' => 0,
642 );
516 643
517 NUM_CMP_LIST( 'tolerance' => $relPercentTol, 644 num_cmp(\@answerList, %options);
518 'tolType' => 'relative', 645 }
519 'format' => $format, 646
520 'mode' => 'strict',
521 'zeroLevel' => $numZeroLevelDefault,
522 'zeroLevelTol' => $numZeroLevelTolDefault,
523 'answerList' => \@answerList
524 );
525}
526 647
527sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance 648sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
649
528 my ( $correctAnswer, $absTol, $format ) = @_; 650 my ( $correctAnswer, $absTol, $format ) = @_;
529 651
530 NUM_CMP( 'correctAnswer' => $correctAnswer, 652 my %options = ( 'tolerance' => $absTol,
531 'tolerance' => $absTol, 653 'format' => $format
532 'tolType' => 'absolute', 654 );
533 'format' => $format, 655
534 'mode' => 'strict', 656 set_default_options (\%options,
535 'zeroLevel' => 0, 657 'tolType' => 'absolute',
536 'zeroLevelTol' => 0 658 'tolerance' => $absTol,
537 ); 659 'mode' => 'strict',
660 'format' => $numFormatDefault,
661 'zeroLevel' => 0,
662 'zeroLevelTol' => 0,
663 'debug' => 0,
664 );
665
666 num_cmp([$correctAnswer], %options);
667
538} 668}
539 669
540## See std_num_cmp_list for usage 670## See std_num_cmp_list for usage
541sub strict_num_cmp_abs_list { # compare numbers 671sub strict_num_cmp_abs_list { # compare numbers
542 my ( $absTol, $format, @answerList ) = @_; 672 my ( $absTol, $format, @answerList ) = @_;
543 673
544 NUM_CMP_LIST( 'tolerance' => $absTol, 674 my %options = ( 'tolerance' => $absTol,
545 'tolType' => 'absolute', 675 'format' => $format
546 'format' => $format, 676 );
547 'mode' => 'strict',
548 'zeroLevel' => 0,
549 'zeroLevelTol' => 0,
550 'answerList' => \@answerList
551 );
552}
553 677
678 set_default_options (\%options,
679 'tolType' => 'absolute',
680 'tolerance' => $absTol,
681 'mode' => 'strict',
682 'format' => $numFormatDefault,
683 'zeroLevel' => 0,
684 'zeroLevelTol' => 0,
685 'debug' => 0,
686 );
687
688 num_cmp(\@answerList, %options);
689
690}
554 691
555## Compares a number with units 692## Compares a number with units
556## Deprecated; use num_cmp() 693## Deprecated; use num_cmp()
557## 694##
558## IN: a string which includes the numerical answer and the units 695## IN: a string which includes the numerical answer and the units
… …
561## format -- the format to use when displaying the answer 698## format -- the format to use when displaying the answer
562## tol -- an absolute tolerance, or 699## tol -- an absolute tolerance, or
563## relTol -- a relative tolerance 700## relTol -- a relative tolerance
564## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 701## 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 702## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
703
704
705sub check_units {
706 my ($rh_ans, %options) = @_;
707
708 my %correct_units = %{$rh_ans-> {rh_correct_units}};
709
710 my $ans = $rh_ans->{student_ans};
711 # $ans = '' unless defined ($ans);
712 my $original_student_ans = $ans;
713
714 # $ans = str_filters ($ans, 'trim_whitespace');
715 $rh_ans->{original_student_ans} = $original_student_ans;
716
717 # it surprises me that the match below works since the first .* is greedy.
718 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
719
720 unless ( defined($num_answer) && $units ) {
721 # there is an error reading the input
722 if ( $ans =~ /\S/ ) { # the answer is not blank
723 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
724 "as a number or an arithmetic expression followed by a unit specification. " .
725 "Your answer must contain units." );
726 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
727 "as a number or an arithmetic expression followed by a unit specification. " .
728 "Your answer must contain units." );
729 }
730
731 return $rh_ans;
732 }
733
734 # we have been able to parse the answer into a numerical part and a unit part
735
736 # $num_answer = $1; #$1 and $2 from the regular expression above
737 # $units = $2;
738
739 my %units = Units::evaluate_units($units);
740 if ( defined( $units{'ERROR'} ) ) {
741 # handle error condition
742 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
743 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
744 return $rh_ans;
745 }
746
747 my $units_match = 1;
748 my $fund_unit;
749 foreach $fund_unit (keys %correct_units) {
750 next if $fund_unit eq 'factor';
751 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
752 }
753
754 if ( $units_match ) {
755 # units are ok. Evaluate the numerical part of the answer
756 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
757 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
758 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
759
760
761
762
763 $rh_ans->{student_ans} = $num_answer;
764 # return $rh_ans;
765 # my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
766 # 'tolerance' => $rh_ans->{'tolerance'},
767 # 'tolType' => $rh_ans->{'tolType'},
768 # 'format' => $options{'format'},
769 # 'mode' => $options{'mode'},
770 # 'zeroLevel' => $options{'zeroLevel'},
771 # 'zeroLevelTol' => $options{'zeroLevelTol'} );
772#
773# # because num_answer may contain an arithmetic expression rather than
774# # a number we can't multiply it by the $units{'factor'}
775# # instead we divide the correctanswer by this amount;
776# # this is also why the numerical_answer_evaluator is not defined outside this subroutine.
777#
778# # $ans_hash = &$numerical_answer_evaluator($num_answer);
779#
780# # now we need to doctor the correct answer in order to add units
781# # to it and correct for the division we did before
782# $ans_hash -> {correct_ans} =
783# prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
784# $options{'format'} ) . " $correct_units";
785# # we also need to doctor the submitted answer to get it back in its original format.
786#
787# # we don't add the units on if there is an error message from numerical_answer_evaluator
788# if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
789# $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
790# $ans_hash -> setKeys( original_student_ans => $ans );
791# }
792# else {
793# # error message from numerical_answer_evaluator doesn't have units tacked on
794# $ans_hash -> setKeys( original_student_ans => $ans );
795# }
796 } else {
797 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
798 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
799 }
800
801 return $rh_ans;
802 }
803
566sub numerical_compare_with_units { 804sub numerical_compare_with_units {
567 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 805 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 806 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 807
597 # Prepare the correct answer 808 # Prepare the correct answer
598 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' ); 809 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
599 810
600 # it surprises me that the match below works since the first .* is greedy. 811 # it surprises me that the match below works since the first .* is greedy.
601 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/; 812 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
602 813
814 $options{units} = $correct_units;
815
816
817 num_cmp($correct_num_answer, %options);
818}
819
820#sub numerical_compare_with_units {
821# my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
822# my %options = @_; # all of the other inputs are (key value) pairs
823#
824# # handle the defaults
825# $options{'mode'} = 'std' unless defined( $options{'mode'} );
826# $options{'format'} = $numFormatDefault unless defined( $options{'format'} );
827# $options{'zeroLevel'} = $numZeroLevelDefault unless defined( $options{'zeroLevel'} );
828# $options{'zeroLevelTol'} = $numZeroLevelTolDefault unless defined( $options{'zeroLevelTol'} );
829#
830# # both spellings are maintained for backward compatibility
831# # relTol is preferred
832# if( defined $options{'reltol'} ) {
833# $options{'relTol'} = $options{'reltol'};
834# delete $options{'reltol'};
835# }
836#
837# my ($tol, $tolerance_mode);
838# if ( defined $options{'tol'} ) {
839# $tol = $options{'tol'};
840# $tolerance_mode = 'absolute';
841# }
842# elsif( defined $options{'relTol'} ) {
843# $tol = $options{'relTol'};
844# $tolerance_mode = 'relative';
845# }
846# else { #the default is a relative tolerance
847# $tol = $numRelPercentTolDefault;
848# $tolerance_mode = 'relative';
849# }
850#
851# # Prepare the correct answer
852# $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
853#
854# # it surprises me that the match below works since the first .* is greedy.
855# my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
856#
603 my %correct_units = Units::evaluate_units($correct_units); 857# my %correct_units = Units::evaluate_units($correct_units);
604 if ( defined( $correct_units{'ERROR'} ) ) { 858# if ( defined( $correct_units{'ERROR'} ) ) {
605 die "ERROR: The answer \"$correct_answer\" in the problem definition cannot be parsed:\n" . 859# die "ERROR: The answer \"$correct_answer\" in the problem definition cannot be parsed:\n" .
606 "$correct_units{'ERROR'}\n"; 860# "$correct_units{'ERROR'}\n";
607 } 861# }
608 862#
609 my $ans_evaluator = sub { 863# my $ans_evaluator = sub {
610 864#
611 my $ans = shift; 865# my $ans = shift;
612 $ans = '' unless defined($ans); 866# $ans = '' unless defined($ans);
613 my $original_student_ans = $ans; 867# my $original_student_ans = $ans;
614 868#
615 $ans = str_filters( $ans, 'trim_whitespace' ); 869# $ans = str_filters( $ans, 'trim_whitespace' );
616 870#
617 my $ans_hash = new AnswerHash( 871# my $ans_hash = new AnswerHash(
618 'score' => 0, 872# 'score' => 0,
619 'correct_ans' => spf($correct_num_answer,$options{'format'}) . " $correct_units", 873# 'correct_ans' => spf($correct_num_answer,$options{'format'}) . " $correct_units",
620 'student_ans' => $ans, 874# 'student_ans' => $ans,
621 'ans_message' => '', 875# 'ans_message' => '',
622 'type' => 'num_cmp_with_units', 876# 'type' => 'num_cmp_with_units',
623 'preview_text_string' => '', 877# 'preview_text_string' => '',
624 'original_student_ans' => $original_student_ans 878# 'original_student_ans' => $original_student_ans
625 ); 879# );
626 880#
627 # it surprises me that the match below works since the first .* is greedy. 881# # it surprises me that the match below works since the first .* is greedy.
628 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/; 882# my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
629 883#
630 unless ( defined($num_answer) && $units ) { 884# unless ( defined($num_answer) && $units ) {
631 # there is an error reading the input 885# # there is an error reading the input
632 if ( $ans =~ /\S/ ) { # the answer is not blank 886# if ( $ans =~ /\S/ ) { # the answer is not blank
633 $ans_hash -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " . 887# $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. " . 888# "as a number or an arithmetic expression followed by a unit specification. " .
635 "Your answer must contain units." ); 889# "Your answer must contain units." );
636 } 890# }
637 891#
638 return $ans_hash; 892# return $ans_hash;
639 } 893# }
640 894#
641 # we have been able to parse the answer into a numerical part and a unit part 895# # we have been able to parse the answer into a numerical part and a unit part
642 896#
643 $num_answer = $1; #$1 and $2 from the regular expression above 897# $num_answer = $1; #$1 and $2 from the regular expression above
644 $units = $2; 898# $units = $2;
645 899#
646 my %units = Units::evaluate_units($units); 900# my %units = Units::evaluate_units($units);
647 if ( defined( $units{'ERROR'} ) ) { 901# if ( defined( $units{'ERROR'} ) ) {
648 # handle error condition 902# # handle error condition
649 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'}); 903# $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
650 904#
651 $ans_hash -> setKeys( 'ans_message' => "$units{'ERROR'}" ); 905# $ans_hash -> setKeys( 'ans_message' => "$units{'ERROR'}" );
652 906#
653 return $ans_hash; 907# return $ans_hash;
654 } 908# }
655 909#
656 my $units_match = 1; 910# my $units_match = 1;
657 my $fund_unit; 911# my $fund_unit;
658 foreach $fund_unit (keys %correct_units) { 912# foreach $fund_unit (keys %correct_units) {
659 next if $fund_unit eq 'factor'; 913# next if $fund_unit eq 'factor';
660 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit}; 914# $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
661 } 915# }
662 916#
663 if ( $units_match ) { 917# if ( $units_match ) {
664 918#
665 # units are ok. Evaluate the numerical part of the answer 919# # units are ok. Evaluate the numerical part of the answer
666 $tol = $tol * $correct_units{'factor'}/$units{'factor'} if 920# $tol = $tol * $correct_units{'factor'}/$units{'factor'} if
667 $tolerance_mode eq 'absolute'; # the tolerance is in the units specified by the instructor. 921# $tolerance_mode eq 'absolute'; # the tolerance is in the units specified by the instructor.
668 922#
669 my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'}, 923# my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
670 'tolerance' => $tol, 924# 'tolerance' => $tol,
671 'tolType' => $tolerance_mode, 925# 'tolType' => $tolerance_mode,
672 'format' => $options{'format'}, 926# 'format' => $options{'format'},
673 'mode' => $options{'mode'}, 927# 'mode' => $options{'mode'},
674 'zeroLevel' => $options{'zeroLevel'}, 928# 'zeroLevel' => $options{'zeroLevel'},
675 'zeroLevelTol' => $options{'zeroLevelTol'} ); 929# 'zeroLevelTol' => $options{'zeroLevelTol'} );
676 930#
677 # because num_answer may contain an arithmetic expression rather than 931# # because num_answer may contain an arithmetic expression rather than
678 # a number we can't multiply it by the $units{'factor'} 932# # a number we can't multiply it by the $units{'factor'}
679 # instead we divide the correct answer by this amount; 933# # instead we divide the correct answer by this amount;
680 # this is also why the numerical_answer_evaluator is not defined outside this subroutine. 934# # this is also why the numerical_answer_evaluator is not defined outside this subroutine.
681 935#
682 $ans_hash = &$numerical_answer_evaluator($num_answer); 936# $ans_hash = &$numerical_answer_evaluator($num_answer);
683 937#
684 # now we need to doctor the correct answer in order to add units 938# # now we need to doctor the correct answer in order to add units
685 # to it and correct for the division we did before 939# # to it and correct for the division we did before
686 $ans_hash -> {correct_ans} = 940# $ans_hash -> {correct_ans} =
687 prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'}, 941# prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
688 $options{'format'} ) . " $correct_units"; 942# $options{'format'} ) . " $correct_units";
689 # we also need to doctor the submitted answer to get it back in its original format. 943# # we also need to doctor the submitted answer to get it back in its original format.
690 944#
691 # we don't add the units on if there is an error message from numerical_answer_evaluator 945# # we don't add the units on if there is an error message from numerical_answer_evaluator
692 if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) { 946# if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
693 $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units"; 947# $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
694 $ans_hash -> setKeys( original_student_ans => $ans ); 948# $ans_hash -> setKeys( original_student_ans => $ans );
695 } 949# }
696 else { 950# else {
697 # error message from numerical_answer_evaluator doesn't have units tacked on 951# # error message from numerical_answer_evaluator doesn't have units tacked on
698 $ans_hash -> setKeys( original_student_ans => $ans ); 952# $ans_hash -> setKeys( original_student_ans => $ans );
699 } 953# }
700 } 954# }
701 else { 955# else {
702 $ans_hash -> setKeys( ans_message => 'There is an error in the units for this answer.' ); 956# $ans_hash -> setKeys( ans_message => 'There is an error in the units for this answer.' );
703 } 957# }
704 958#
705 return $ans_hash; 959# return $ans_hash;
706 }; 960# };
707 961#
708 $ans_evaluator; 962# $ans_evaluator;
709} 963# }
710 964
711=head3 std_num_str_cmp() 965=head3 std_num_str_cmp()
712 966
713NOTE: This function is maintained for compatibility. num_cmp() with the 967NOTE: This function is maintained for compatibility. num_cmp() with the
714 'strings' parameter is slightly preferred. 968 'strings' parameter is slightly preferred.
715 969
716std_num_str_cmp() is used when the correct answer could be either a number or a 970std_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 971string. For example, if you wanted the student to evaluate a function at number
… …
887=cut 1141=cut
888 1142
889sub num_cmp { 1143sub num_cmp {
890 my $correctAnswer = shift @_; 1144 my $correctAnswer = shift @_;
891 my @opt = @_; 1145 my @opt = @_;
1146 my %out_options;
1147
1148#########################################################################
1149# Retain this first check for backword compatibility. Allows input of the form
1150# num_cmp($ans, 1, '%0.5f') but warns against it
1151#########################################################################
892 1152
893 my %known_options = ( 'mode' => 'std', 1153 my %known_options = ( 'mode' => 'std',
894 'format' => $numFormatDefault, 1154 'format' => $numFormatDefault,
895 'tol' => $numAbsTolDefault, 1155 'tol' => $numAbsTolDefault,
896 'relTol' => $numRelPercentTolDefault, 1156 'relTol' => $numRelPercentTolDefault,
897 'units' => undef, 1157 'units' => undef,
898 'strings' => undef, 1158 'strings' => undef,
899 'zeroLevel' => $numZeroLevelDefault, 1159 'zeroLevel' => $numZeroLevelDefault,
900 'zeroLevelTol' => $numZeroLevelTolDefault, 1160 'zeroLevelTol' => $numZeroLevelTolDefault,
901 1161 'tolType' => 'relative',
1162 'tolerance' => 1,
902 'reltol' => undef, #alternate spelling 1163 'reltol' => undef, #alternate spelling
903 'unit' => undef #alternate spelling 1164 'unit' => undef); #alternate spelling
904 ); 1165
905 my %in_options;
906 my @output_list; 1166 my @output_list;
907 my %out_options; 1167
908
909 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 || 1168 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
910 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) { 1169 ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
911 # unless the first parameter is a list of arrays 1170 # unless the first parameter is a list of arrays
912 # or the second parameter is a known option or 1171 # or the second parameter is a known option or
913 # no options were used, 1172 # no options were used,
… …
916 warn "This method of using num_cmp() is deprecated. Please rewrite this" . 1175 warn "This method of using num_cmp() is deprecated. Please rewrite this" .
917 " problem using the options style of parameter passing (or" . 1176 " problem using the options style of parameter passing (or" .
918 " check that your first option is spelled correctly)."; 1177 " check that your first option is spelled correctly).";
919 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt; 1178 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
920 1179
921 %out_options = ( 'relTol' => $relPercentTol, 1180 @opt = ( 'relTol' => $relPercentTol,
922 'format' => $format, 1181 'format' => $format,
923 'zeroLevel' => $zeroLevel, 1182 'zeroLevel' => $numZeroLevelDefault,
924 'zeroLevelTol' => $zeroLevelTol, 1183 'zeroLevelTol' => $numZeroLevelTolDefault,
925 'mode' => 'std' 1184 'mode' => 'std'
926 ); 1185 );
927 } 1186 }
928 else { 1187#########################################################################
929 # handle options 1188# Now handle the options assuming they are entered in the form
930 1189# num_cmp($ans, relTol=>1, format=>'%0.5f')
931 check_option_list( @opt ); 1190#########################################################################
932 %in_options = @opt; 1191 %out_options = @opt;
1192 assign_option_aliases( \%out_options,
1193 'reltol' => 'relTol',
1194 'unit' => 'units',
1195 );
933 1196
934 # both spellings maintained for compatibility 1197
935 # relTol is preferred 1198 set_default_options( \%out_options,
936 if( defined( $in_options{'reltol'} ) ) { 1199 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative',
937 $in_options{'relTol'} = $in_options{'reltol'}; 1200 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault,
938 delete $in_options{'reltol'}; 1201 'mode' => 'std',
1202 'format' => $numFormatDefault,
1203 'tol' => $numAbsTolDefault,
1204 'relTol' => $numRelPercentTolDefault,
1205 'units' => undef,
1206 'strings' => undef,
1207 'zeroLevel' => $numZeroLevelDefault,
1208 'zeroLevelTol' => $numZeroLevelTolDefault,
1209 'debug' => 0,
939 } 1210
1211 );
940 1212
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 1213
1214
948 # can't use both units and strings 1215 # can't use both units and strings
949 if( defined( $in_options{'units'} ) && defined( $in_options{'strings'} ) ) { 1216 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
950 warn "Can't use both 'units' and 'strings' in the same problem " . 1217 warn "Can't use both 'units' and 'strings' in the same problem " .
951 "(check your parameters to num_cmp() )"; 1218 "(check your parameters to num_cmp() )";
952 } 1219 }
953 1220
954 #%out_options = %known_options;
955 foreach my $opt_name (keys %in_options) {
956 1221
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); 1222 # my ($tolType, $tol);
970 1223 if ($out_options{tolType} eq 'absolute') {
971 if ( defined( $out_options{'tol'} ) ) {
972 $tolType = 'absolute'; 1224 # $tolType = 'absolute';
1225 # $out_options{tolType} = 'absolute';
973 $tol = $out_options{'tol'}; 1226 # $tol = $out_options{'tol'};
974 } 1227 $out_options{'tolerance'}=$out_options{'tol'};
1228 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
975 else { 1229 } else {
976 $tolType = 'relative'; 1230 # $tolType = 'relative';
1231 # $out_options{tolType} = 'relative';
977 $tol = $out_options{'relTol'}; 1232 # $tol = $out_options{'relTol'};
1233 # $out_options{'tolType'} = $out_options{'relative'};
1234 $out_options{'tolerance'}=$out_options{'relTol'};
1235 # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
978 } 1236 }
1237
979 1238
980 # thread over lists 1239 # thread over lists
981 my @ans_list = (); 1240 my @ans_list = ();
982 1241
983 if ( ref($correctAnswer) eq 'ARRAY' ) { 1242 if ( ref($correctAnswer) eq 'ARRAY' ) {
984 @ans_list = @{$correctAnswer}; 1243 @ans_list = @{$correctAnswer};
985 } 1244 }
986 else { 1245 else {
987 push( @ans_list, $correctAnswer ); 1246 push( @ans_list, $correctAnswer );
988 } 1247 }
1248
989 # produce answer evaluators 1249 # produce answer evaluators
990 foreach my $ans (@ans_list) { 1250 foreach my $ans (@ans_list) {
991 if( defined( $out_options{'units'} ) ) { 1251 if( defined( $out_options{'units'} ) ) {
992 $ans = "$ans $out_options{'units'}"; 1252 $ans = "$ans $out_options{'units'}";
993 push( @output_list, numerical_compare_with_units($ans, %out_options) ); 1253
1254 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
1255 'tolerance' => $out_options{tolerance},
1256 'tolType' => $out_options{tolType},
1257 'format' => $out_options{'format'},
1258 'mode' => $out_options{'mode'},
1259 'zeroLevel' => $out_options{'zeroLevel'},
1260 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1261 'debug' => $out_options{'debug'},
1262 'units' => $out_options{'units'},
1263 )
1264 );
1265 }
1266 elsif( defined( $out_options{'strings'} ) ) {
1267 if( defined $out_options{'tol'} ) {
1268 warn "You are using 'tol' (for absolute tolerance) with a num/str " .
1269 "compare, which currently only uses relative tolerance. The default " .
1270 "tolerance will be used.";
994 } 1271 }
995 elsif( defined( $out_options{'strings'} ) ) { 1272
996 if( defined $out_options{'tol'} ) {
997 warn "You are using 'tol' (for absolute tolerance) with a num/str " .
998 "compare, which currently only uses relative tolerance. The default " .
999 "tolerance will be used.";
1000 }
1001
1002 push( @output_list, std_num_str_cmp( $ans, $out_options{'strings'}, 1273 push( @output_list, std_num_str_cmp( $ans, $out_options{'strings'},
1003 $out_options{'relTol'}, 1274 $out_options{'relTol'},
1004 $out_options{'format'}, 1275 $out_options{'format'},
1005 $out_options{'zeroLevel'}, 1276 $out_options{'zeroLevel'},
1006 $out_options{'zeroLevelTol'} 1277 $out_options{'zeroLevelTol'}
1007 ) 1278 )
1008 ); 1279 );
1009 } 1280 }
1010 else { 1281 else {
1282
1011 push(@output_list, 1283 push(@output_list,
1012 NUM_CMP( 'correctAnswer' => $ans, 1284 NUM_CMP( 'correctAnswer' => $ans,
1013 'tolerance' => $tol, 1285 'tolerance' => $out_options{tolerance},
1014 'tolType' => $tolType, 1286 'tolType' => $out_options{tolType},
1015 'format' => $out_options{'format'}, 1287 'format' => $out_options{'format'},
1016 'mode' => $out_options{'mode'}, 1288 'mode' => $out_options{'mode'},
1017 'zeroLevel' => $out_options{'zeroLevel'}, 1289 'zeroLevel' => $out_options{'zeroLevel'},
1018 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1290 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1291 'debug' => $out_options{'debug'}
1019 ), 1292 ),
1020 ); 1293 );
1294 }
1021 } 1295 }
1022 } 1296
1023
1024 return @output_list; 1297 return @output_list;
1025} 1298 }
1026 1299
1027#legacy code for compatability purposes 1300#legacy code for compatability purposes
1028sub num_rel_cmp { # compare numbers 1301sub num_rel_cmp { # compare numbers
1029 std_num_cmp( @_ ); 1302 std_num_cmp( @_ );
1030} 1303}
1031 1304
1032## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1305## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1033## 1306##
1034## IN: a hash containing the following items (error-checking to be added later?): 1307## IN: a hash containing the following items (error-checking to be added later?):
… …
1038## format -- the display format of the answer 1311## format -- the display format of the answer
1039## mode -- one of 'std', 'strict', 'arith', or 'frac'; 1312## mode -- one of 'std', 'strict', 'arith', or 'frac';
1040## determines allowable formats for the input 1313## determines allowable formats for the input
1041## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1314## 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 1315## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1043sub NUM_CMP { # low level numeric compare 1316#sub NUM_CMP { # low level numeric compare
1317# my %num_params = @_;
1318#
1319# my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol );
1320# foreach my $key (@keys) {
1321# warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1322# }
1323#
1324#
1325# my $correctAnswer = $num_params{'correctAnswer'};
1326# my $tol = $num_params{'tolerance'};
1327# my $tolType = $num_params{'tolType'};
1328# my $format = $num_params{'format'};
1329# my $mode = $num_params{'mode'};
1330# my $zeroLevel = $num_params{'zeroLevel'};
1331# my $zeroLevelTol = $num_params{'zeroLevelTol'};
1332#
1333# if( $tolType eq 'relative' ) {
1334# # $tol = $numRelPercentTolDefault unless defined $tol;
1335# $tol *= .01;
1336# }
1337## else {
1338## $tol = $numAbsTolDefault unless defined $tol;
1339## }
1340#
1341# #$format = $numFormatDefault unless defined $format;
1342# #$mode = 'std' unless defined $mode;
1343# #$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1344# #$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1345#
1346# my $formattedCorrectAnswer = prfmt( $correctAnswer, $format );
1347#
1348# my $answer_evaluator = sub {
1349# my $in = shift @_;
1350# $in = '' unless defined $in;
1351# my $score = 0;
1352# my $original_student_answer = $in;
1353# my $parser = new AlgParserWithImplicitExpand;
1354# my $ret = $parser -> parse($in);
1355# my $preview_text_string = '';
1356# my $preview_latex_string = '';
1357#
1358# if ( ref($ret) ) { ## parsed successfully
1359# $parser -> tostring();
1360# $parser -> normalize();
1361# $in = $parser -> tostring();
1362# $preview_text_string = $in;
1363# $preview_latex_string = $parser -> tolatex();
1364#
1365# }
1366# else { ## error in parsing
1367# my $ans_hash = new AnswerHash(
1368# 'score' => $score,
1369# 'correct_ans' => $formattedCorrectAnswer,
1370# 'student_ans' => "error: $parser->{htmlerror}",
1371# 'ans_message' => $parser -> {error_msg},
1372# 'type' => "${mode}_number",
1373# 'preview_text_string' => $preview_text_string,
1374# 'preview_latex_string' => $preview_latex_string,
1375# 'original_student_ans' => $original_student_answer
1376# );
1377#
1378# return $ans_hash;
1379# }
1380#
1381# my $PGanswerMessage = '';
1382#
1383# my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1384#
1385# $inVal = '';
1386# $correctAnswer = math_constants($correctAnswer);
1387# my $formattedSubmittedAnswer = '';
1388#
1389# #special variable $@ holds the last error from a Perl eval statement
1390# $@='';
1391#
1392# if ($correctAnswer =~ /\S/) {
1393# ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correctAnswer);
1394# }
1395# else {
1396# $PG_eval_errors = ' ';
1397# }
1398#
1399# if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above
1400# $formattedSubmittedAnswer = $PG_eval_errors;
1401# $formattedSubmittedAnswer = clean_up_error_msg($formattedSubmittedAnswer);
1402# $PGanswerMessage = 'Tell your professor that there is an error in this problem';
1403# my $ans_hash = new AnswerHash(
1404# 'score' => $score,
1405# 'correct_ans' => $formattedCorrectAnswer,
1406# 'student_ans' => $formattedSubmittedAnswer,
1407# 'ans_message' => $PGanswerMessage,
1408# 'type' => 'number',
1409# 'preview_text_string' => $preview_text_string,
1410# 'preview_latex_string' => $preview_latex_string,
1411# 'original_student_ans' => $original_student_answer
1412# );
1413#
1414# return $ans_hash;
1415# }
1416#
1417# $in = &math_constants($in);
1418#
1419# MODE_CASE: { ## bare block for "case" statement
1420# if ($mode eq 'std') {
1421# last MODE_CASE;
1422# }
1423# elsif ($mode eq 'strict') {
1424# unless (is_a_number($in)) {
1425# $PGanswerMessage = 'You must enter a number, e.g. -6, 5.3, or 6.12E-3';
1426# $formattedSubmittedAnswer = 'Incorrect number format';
1427# }
1428# else {
1429# last MODE_CASE;
1430# }
1431# }
1432# elsif ($mode eq 'arith') {
1433# unless (is_an_arithmetic_expression($in)) {
1434# $PGanswerMessage = 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2';
1435# $formattedSubmittedAnswer = 'Not an arithmetic expression';
1436# }
1437# else {
1438# last MODE_CASE;
1439# }
1440# }
1441# elsif ($mode eq 'frac') {
1442# unless (is_a_fraction($in)) {
1443# $PGanswerMessage = 'You must enter a number or fraction , e.g. -6 or 7/13';
1444# $formattedSubmittedAnswer = 'Not a number or fraction';
1445# }
1446# else {
1447# last MODE_CASE;
1448# }
1449# }
1450# else {
1451# $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1452# $formattedSubmittedAnswer = $in;
1453# }
1454#
1455# my $ans_hash = new AnswerHash(
1456# score => $score,
1457# correct_ans => $formattedCorrectAnswer,
1458# student_ans => $formattedSubmittedAnswer,
1459# ans_message => $PGanswerMessage,
1460# type => "${mode}_number",
1461# preview_text_string => $preview_text_string,
1462# preview_latex_string => $preview_latex_string,
1463# original_student_ans => $original_student_answer
1464# );
1465#
1466# return $ans_hash;
1467# } # end of MODE_CASES bare block
1468#
1469# $@ = '';
1470# if ($in =~ /\S/) {
1471#
1472# ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
1473# }
1474# else {
1475# $PG_eval_errors = ' ';
1476# }
1477#
1478# if ($PG_eval_errors) { ##error message from eval or above
1479# $formattedSubmittedAnswer = $PG_eval_errors;
1480# $formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer);
1481# $PGanswerMessage = 'There is a syntax error in your answer';
1482# $PGanswerMessage = '' if $PG_eval_errors eq ' ';
1483# my $ans_hash = new AnswerHash(
1484# 'score' => $score,
1485# 'correct_ans' => $formattedCorrectAnswer,
1486# 'student_ans' => $formattedSubmittedAnswer,
1487# 'ans_message' => $PGanswerMessage,
1488# 'type' => "${mode}_number",
1489# 'preview_text_string' => $preview_text_string,
1490# 'preview_latex_string' => $preview_latex_string,
1491# 'original_student_ans' => $original_student_answer
1492# );
1493#
1494# return $ans_hash;
1495# }
1496# else {
1497# $formattedSubmittedAnswer = prfmt($inVal,$format);
1498# }
1499#
1500# my $permitted_error;
1501# if (defined($tolType) && $tolType eq 'absolute') {
1502# $permitted_error = $tol;
1503# }
1504# elsif ( abs($correctVal) <= $zeroLevel) {
1505# $permitted_error = $zeroLevelTol; ## want $tol to be non zero
1506# }
1507# else {
1508# $permitted_error = abs($tol*$correctVal);
1509# }
1510#
1511# my $is_a_number = is_a_number($inVal);
1512# $score = 1 if ( ($is_a_number) and
1513# (abs( $inVal - $correctVal ) <= $permitted_error) );
1514# if ($PG_eval_errors) {
1515# $PGanswerMessage = 'There is a syntax error in your answer';
1516# }
1517# elsif (not $is_a_number) {
1518# $PGanswerMessage = 'Your answer does not evaluate to a number';
1519# }
1520#
1521# my $ans_hash = new AnswerHash(
1522# 'score' => $score,
1523# 'correct_ans' => $formattedCorrectAnswer,
1524# 'student_ans' => $formattedSubmittedAnswer,
1525# 'ans_message' => $PGanswerMessage,
1526# 'type' => "${mode}_number",
1527# 'preview_text_string' => $preview_text_string,
1528# 'preview_latex_string' => $preview_latex_string,
1529# 'original_student_ans' => $original_student_answer
1530# );
1531#
1532# return $ans_hash;
1533# };
1534#
1535# return $answer_evaluator;
1536
1537#}
1538
1539sub compare_numbers {
1540 my ($rh_ans, %options) = @_;
1541 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1542 if ($PG_eval_errors) {
1543 $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
1544 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
1545
1546
1547 } else {
1548 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
1549 }
1550
1551 my $permitted_error;
1552
1553 if ($rh_ans->{tolType} eq 'absolute') {
1554 $permitted_error = $rh_ans->{tolerance};
1555
1556 }
1557 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
1558 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
1559 }
1560 else {
1561 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
1562 }
1563
1564 my $is_a_number = is_a_number($inVal);
1565 $rh_ans->{score} = 1 if ( ($is_a_number) and
1566 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
1567 if (not $is_a_number) {
1568 $rh_ans->throw_error('EVAL','Your answer does not evaluate to a number');
1569 }
1570
1571 $rh_ans;
1572}
1573
1574sub NUM_CMP { # low level numeric compare
1044 my %num_params = @_; 1575 my %num_params = @_;
1045 1576
1577 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1578 foreach my $key (@keys) {
1579 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1580 }
1581
1046 my $correctAnswer = $num_params{'correctAnswer'}; 1582 my $correctAnswer = $num_params{'correctAnswer'};
1047 my $tol = $num_params{'tolerance'};
1048 my $tolType = $num_params{'tolType'};
1049 my $format = $num_params{'format'}; 1583 my $format = $num_params{'format'};
1050 my $mode = $num_params{'mode'}; 1584 my $mode = $num_params{'mode'};
1585
1586 # my $tol = $num_params{'tolerance'};
1587 # my $tolType = $num_params{'tolType'};
1051 my $zeroLevel = $num_params{'zeroLevel'}; 1588 # my $zeroLevel = $num_params{'zeroLevel'};
1052 my $zeroLevelTol = $num_params{'zeroLevelTol'}; 1589 # my $zeroLevelTol = $num_params{'zeroLevelTol'};
1053 1590
1054 if( $tolType eq 'relative' ) { 1591 if( $num_params{tolType} eq 'relative' ) {
1055 $tol = $numRelPercentTolDefault unless defined $tol; 1592 $num_params{'tolerance'} = .01*$num_params{'tolerance'};
1056 $tol *= .01; 1593 }
1594
1595 #$format = $numFormatDefault unless defined $format;
1596 #$mode = 'std' unless defined $mode;
1597 #$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1598 #$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1599
1600 my $formattedCorrectAnswer;
1601 my $correct_units;
1602 my $correct_num_answer;
1603 my %correct_units;
1604
1605 if (defined($num_params{units}) && $num_params{units}) {
1606 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1607 # units are in form stuff space units where units contains no spaces.
1608
1609 ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
1610 %correct_units = Units::evaluate_units($correct_units);
1611 if ( defined( $correct_units{'ERROR'} ) ) {
1612 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1613 "$correct_units{'ERROR'}\n");
1614 }
1615 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1616 $formattedCorrectAnswer = pfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1617
1618 } else {
1619 $correct_num_answer = $correctAnswer;
1620 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1621 }
1622
1623 $correct_num_answer = math_constants($correct_num_answer);
1624
1625 my $PGanswerMessage = '';
1626
1627 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1628
1629 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/) {
1630 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1057 } 1631 }
1058 else { 1632 else {
1059 $tol = $numAbsTolDefault unless defined $tol; 1633 $PG_eval_errors = ' ';
1060 } 1634 }
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 1635
1066 my $formattedCorrectAnswer = prfmt( $correctAnswer, $format ); 1636 if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above
1637 warn "Error in 'correct' answer: $PG_eval_errors<br>
1638 The answer $correctAnswer evaluates to $correctVal,
1639 which cannot be interpreted as a number. ";
1640
1641 }
1642 #########################################################################
1067 1643
1068 my $answer_evaluator = sub { 1644 #construct the answer evaluator
1069 my $in = shift @_; 1645 my $answer_evaluator = new AnswerEvaluator;
1070 $in = '' unless defined $in; 1646 $answer_evaluator->{debug} = $num_params{debug};
1071 my $score = 0; 1647 $answer_evaluator->ans_hash( correct_ans => $correct_num_answer,
1072 my $original_student_answer = $in; 1648 type => "${mode}_number",
1073 my $parser = new AlgParserWithImplicitExpand; 1649 tolerance => $num_params{tolerance},
1074 my $ret = $parser -> parse($in); 1650 tolType => $num_params{tolType},
1075 my $preview_text_string = ''; 1651 units => $correct_units,
1076 my $preview_latex_string = ''; 1652 original_correct_ans => $formattedCorrectAnswer,
1653 rh_correct_units => \%correct_units,
1654 );
1655 my ($in, $formattedSubmittedAnswer);
1656 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1657 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1658 );
1659 if (defined($num_params{units}) && $num_params{units}) {
1660 $answer_evaluator->install_pre_filter(\&check_units);
1661 }
1662
1663 $answer_evaluator->install_pre_filter(\&check_syntax);
1664
1665 $answer_evaluator->install_pre_filter(\&math_constants);
1666 if ($mode eq 'std') {
1667 # do nothing
1668 } elsif ($mode eq 'strict') {
1669 $answer_evaluator->install_pre_filter(\&is_a_number);
1670 } elsif ($mode eq 'arith') {
1671 $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
1672 } elsif ($mode eq 'frac') {
1673 $answer_evaluator->install_pre_filter(\&is_a_fraction);
1077 1674
1078 if ( ref($ret) ) { ## parsed successfully 1675 } else {
1079 $parser -> tostring(); 1676 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1080 $parser -> normalize(); 1677 $formattedSubmittedAnswer = $in;
1081 $in = $parser -> tostring();
1082 $preview_text_string = $in;
1083 $preview_latex_string = $parser -> tolatex();
1084
1085 } 1678 }
1086 else { ## error in parsing 1679
1087 my $ans_hash = new AnswerHash( 1680 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1088 'score' => $score,
1089 'correct_ans' => $formattedCorrectAnswer,
1090 'student_ans' => "error: $parser->{htmlerror}",
1091 'ans_message' => $parser -> {error_msg},
1092 'type' => "${mode}_number",
1093 'preview_text_string' => $preview_text_string,
1094 'preview_latex_string' => $preview_latex_string,
1095 'original_student_ans' => $original_student_answer
1096 );
1097 1681
1098 return $ans_hash; 1682 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1099 } 1683 $rh_ans->{foo} = 'There was one.';
1100 1684 $rh_ans->{student_ans} = $rh_ans->{original_student_ans};
1101 my $PGanswerMessage = ''; 1685 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
1102 1686 $rh_ans;}
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 }
1115 else {
1116 $PG_eval_errors = ' ';
1117 }
1118
1119 if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above
1120 $formattedSubmittedAnswer = $PG_eval_errors;
1121 $formattedSubmittedAnswer = clean_up_error_msg($formattedSubmittedAnswer);
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);
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) {
1235 $PGanswerMessage = 'There is a syntax error in your answer';
1236 }
1237 elsif (not $is_a_number) {
1238 $PGanswerMessage = 'Your answer does not evaluate to a number';
1239 }
1240
1241 my $ans_hash = new AnswerHash(
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 ); 1687 );
1251 1688
1252 return $ans_hash; 1689 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1253 }; 1690 return $rh_ans unless $rh_ans->catch_error('EVAL');
1254 1691 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1255 return $answer_evaluator; 1692 $rh_ans->clear_error('EVAL'); } );
1693 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
1694 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
1695 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
1696
1697
1698
1699 $answer_evaluator;
1256} 1700}
1257 1701
1702
1258## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION 1703### LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1259sub NUM_CMP_LIST { # low level numeric list compare 1704#sub NUM_CMP_LIST { # low level numeric list compare
1260 my %num_params = @_; 1705# my %num_params = @_;
1261 1706#
1262 my @outputList; 1707# my @outputList;
1263 my $ans; 1708# my $ans;
1264 1709#
1265 while ( @{$num_params{'answerList'}} ) { 1710# while ( @{$num_params{'answerList'}} ) {
1266 $ans = shift @{$num_params{'answerList'}}; 1711# $ans = shift @{$num_params{'answerList'}};
1267 push( @outputList, NUM_CMP( 'correctAnswer' => $ans, 1712# push( @outputList, NUM_CMP( 'correctAnswer' => $ans,
1268 'tolerance' => $num_params{'tolerance'}, 1713# 'tolerance' => $num_params{'tolerance'},
1269 'tolType' => $num_params{'tolType'}, 1714# 'tolType' => $num_params{'tolType'},
1270 'format' => $num_params{'format'}, 1715# 'format' => $num_params{'format'},
1271 'mode' => $num_params{'mode'}, 1716# 'mode' => $num_params{'mode'},
1272 'zeroLevel' => $num_params{'zeroLevel'}, 1717# 'zeroLevel' => $num_params{'zeroLevel'},
1273 'zeroLevelTol' => $num_params{'zeroLevelTol'} 1718# 'zeroLevelTol' => $num_params{'zeroLevelTol'}
1274 ) 1719# )
1275 ); 1720# );
1276 } 1721# }
1277 1722#
1278 return @outputList; 1723# return @outputList;
1279} 1724#}
1280 1725
1281 1726
1282 1727
1283########################################################################## 1728##########################################################################
1284########################################################################## 1729##########################################################################
… …
1468 'params' => [], 1913 'params' => [],
1469 'limits' => [ [0,1], [0,1]], 1914 'limits' => [ [0,1], [0,1]],
1470 'reltol' => $main::functRelPercentTolDefault, 1915 'reltol' => $main::functRelPercentTolDefault,
1471 'numPoints' => $main::functNumOfPoints, 1916 'numPoints' => $main::functNumOfPoints,
1472 'zeroLevel' => $main::functZeroLevelDefault, 1917 'zeroLevel' => $main::functZeroLevelDefault,
1473 'zeroLevelTol' => $main::functZeroLevelTolDefault, 1918 'zeroLevelTol' => $main::functZeroLevelTolDefault,
1474 'debug' => 0, 1919 'debug' => 0,
1475 ); 1920 );
1476 1921
1477 my $var_ref = $options{'vars'}; 1922 my $var_ref = $options{'vars'};
1478 my $ra_params = $options{ 'params'}; 1923 my $ra_params = $options{ 'params'};
… …
1480 my $relPercentTol= $options{'reltol'}; 1925 my $relPercentTol= $options{'reltol'};
1481 my $numPoints = $options{'numPoints'}; 1926 my $numPoints = $options{'numPoints'};
1482 my $zeroLevel = $options{'zeroLevel'}; 1927 my $zeroLevel = $options{'zeroLevel'};
1483 my $zeroLevelTol = $options{'zeroLevelTol'}; 1928 my $zeroLevelTol = $options{'zeroLevelTol'};
1484 1929
1485 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1930 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1486 'var' => $var_ref, 1931 'var' => $var_ref,
1487 'limits' => $limit_ref, 1932 'limits' => $limit_ref,
1488 'tolerance' => $relPercentTol, 1933 'tolerance' => $relPercentTol,
1489 'tolType' => 'relative', 1934 'tolType' => 'relative',
1490 'numPoints' => $numPoints, 1935 'numPoints' => $numPoints,
1491 'mode' => 'std', 1936 'mode' => 'std',
1492 'maxConstantOfIntegration' => 10**100, 1937 'maxConstantOfIntegration' => 10**100,
1493 'zeroLevel' => $zeroLevel, 1938 'zeroLevel' => $zeroLevel,
1494 'zeroLevelTol' => $zeroLevelTol, 1939 'zeroLevelTol' => $zeroLevelTol,
1495 'scale_norm' => 1, 1940 'scale_norm' => 1,
1496 'params' => $ra_params, 1941 'params' => $ra_params,
1497 'debug' => $options{debug} , 1942 'debug' => $options{debug} ,
1498 ); 1943 );
1499 1944
1500} 1945}
1501 1946
1502sub function_cmp { 1947sub function_cmp {
… …
1504 1949
1505 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) { 1950 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
1506 function_invalid_params( $correctEqn ); 1951 function_invalid_params( $correctEqn );
1507 } 1952 }
1508 else { 1953 else {
1509 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1954 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1510 'var' => $var, 1955 'var' => $var,
1511 'limits' => [$llimit, $ulimit], 1956 'limits' => [$llimit, $ulimit],
1512 'tolerance' => $relPercentTol, 1957 'tolerance' => $relPercentTol,
1513 'tolType' => 'relative', 1958 'tolType' => 'relative',
1514 'numPoints' => $numPoints, 1959 'numPoints' => $numPoints,
1515 'mode' => 'std', 1960 'mode' => 'std',
1516 'maxConstantOfIntegration' => 0, 1961 'maxConstantOfIntegration' => 0,
1517 'zeroLevel' => $zeroLevel, 1962 'zeroLevel' => $zeroLevel,
1518 'zeroLevelTol' => $zeroLevelTol 1963 'zeroLevelTol' => $zeroLevelTol
1519 ); 1964 );
1520 } 1965 }
1521} 1966}
1522 1967
1523sub function_cmp_up_to_constant { ## for antiderivative problems 1968sub function_cmp_up_to_constant { ## for antiderivative problems
… …
1525 1970
1526 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) { 1971 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
1527 function_invalid_params( $correctEqn ); 1972 function_invalid_params( $correctEqn );
1528 } 1973 }
1529 else { 1974 else {
1530 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1975 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1531 'var' => $var, 1976 'var' => $var,
1532 'limits' => [$llimit, $ulimit], 1977 'limits' => [$llimit, $ulimit],
1533 'tolerance' => $relPercentTol, 1978 'tolerance' => $relPercentTol,
1534 'tolType' => 'relative', 1979 'tolType' => 'relative',
1535 'numPoints' => $numPoints, 1980 'numPoints' => $numPoints,
1536 'mode' => 'antider', 1981 'mode' => 'antider',
1537 'maxConstantOfIntegration' => $maxConstantOfIntegration, 1982 'maxConstantOfIntegration' => $maxConstantOfIntegration,
1538 'zeroLevel' => $zeroLevel, 1983 'zeroLevel' => $zeroLevel,
1539 'zeroLevelTol' => $zeroLevelTol 1984 'zeroLevelTol' => $zeroLevelTol
1540 ); 1985 );
1541 } 1986 }
1542} 1987}
1543 1988
1544sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance 1989sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance
… …
1571 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) { 2016 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
1572 function_invalid_params( $correctEqn ); 2017 function_invalid_params( $correctEqn );
1573 } 2018 }
1574 2019
1575 else { 2020 else {
1576 FUNCTION_CMP( 'correctEqn' => $correctEqn, 2021 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1577 'var' => $var, 2022 'var' => $var,
1578 'limits' => [$llimit, $ulimit], 2023 'limits' => [$llimit, $ulimit],
1579 'tolerance' => $absTol, 2024 'tolerance' => $absTol,
1580 'tolType' => 'absolute', 2025 'tolType' => 'absolute',
1581 'numPoints' => $numPoints, 2026 'numPoints' => $numPoints,
1582 'mode' => 'antider', 2027 'mode' => 'antider',
1583 'maxConstantOfIntegration' => $maxConstantOfIntegration, 2028 'maxConstantOfIntegration' => $maxConstantOfIntegration,
1584 'zeroLevel' => 0, 2029 'zeroLevel' => 0,
1585 'zeroLevelTol' => 0 2030 'zeroLevelTol' => 0
1586 ); 2031 );
1587 } 2032 }
1588} 2033}
1589 2034
1590## The following answer evaluator for comparing multivarable functions was 2035## The following answer evaluator for comparing multivarable functions was
… …
1716sub fun_cmp { 2161sub fun_cmp {
1717 my $correctAnswer = shift @_; 2162 my $correctAnswer = shift @_;
1718 my %opt = @_; 2163 my %opt = @_;
1719 2164
1720 assign_option_aliases( \%opt, 2165 assign_option_aliases( \%opt,
1721 'vars' => 'var', # set the standard option 'var' to the one specified as vars 2166 '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 2167 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain
1723 'reltol' => 'relTol', 2168 'reltol' => 'relTol',
1724 'param' => 'params', 2169 'param' => 'params',
1725 ); 2170 );
1726 2171
1727 set_default_options( \%opt, 2172 set_default_options( \%opt,
1728 'var' => $functVarDefault, 2173 'var' => $functVarDefault,
1729 'params' => [], 2174 'params' => [],
1730 'limits' => [[$functLLimitDefault, $functULimitDefault]], 2175 'limits' => [[$functLLimitDefault, $functULimitDefault]],
1731 'mode' => 'std', 2176 'mode' => 'std',
1732 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative', 2177 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative',
1733 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined 2178 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined
1734 'relTol' => $functRelPercentTolDefault, 2179 'relTol' => $functRelPercentTolDefault,
1735 'numPoints' => $functNumOfPoints, 2180 'numPoints' => $functNumOfPoints,
1736 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 2181 'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
1737 'zeroLevel' => $functZeroLevelDefault, 2182 'zeroLevel' => $functZeroLevelDefault,
1738 'zeroLevelTol' => $functZeroLevelTolDefault, 2183 'zeroLevelTol' => $functZeroLevelTolDefault,
1739 'debug' => 0, 2184 'debug' => 0,
1740 ); 2185 );
1741 2186
1742 2187
1743 2188
1744 # allow var => 'x' as an abbreviation for var => ['x'] 2189 # allow var => 'x' as an abbreviation for var => ['x']
… …
1759 $tolType = 'relative'; 2204 $tolType = 'relative';
1760 $tol = $out_options{'relTol'}; 2205 $tol = $out_options{'relTol'};
1761 delete($out_options{'tol'}) if exists( $out_options{'tol'} ); 2206 delete($out_options{'tol'}) if exists( $out_options{'tol'} );
1762 } 2207 }
1763 2208
1764
1765
1766 my @output_list = (); 2209 my @output_list = ();
1767 # thread over lists 2210 # thread over lists
1768 my @ans_list = (); 2211 my @ans_list = ();
1769 2212
1770 if ( ref($correctAnswer) eq 'ARRAY' ) { 2213 if ( ref($correctAnswer) eq 'ARRAY' ) {
… …
1772 } 2215 }
1773 else { 2216 else {
1774 push( @ans_list, $correctAnswer ); 2217 push( @ans_list, $correctAnswer );
1775 } 2218 }
1776 2219
1777
1778
1779 # produce answer evaluators 2220 # produce answer evaluators
1780 foreach my $ans (@ans_list) { 2221 foreach my $ans (@ans_list) {
1781 push(@output_list, 2222 push(@output_list,
1782 FUNCTION_CMP( 'correctEqn' => $ans, 2223 FUNCTION_CMP( 'correctEqn' => $ans,
1783 'var' => $out_options{'var'}, 2224 'var' => $out_options{'var'},
1784 'limits' => $out_options{'limits'}, 2225 'limits' => $out_options{'limits'},
1785 'tolerance' => $tol, 2226 'tolerance' => $tol,
1786 'tolType' => $tolType, 2227 'tolType' => $tolType,
1787 'numPoints' => $out_options{'numPoints'}, 2228 'numPoints' => $out_options{'numPoints'},
1788 'mode' => $out_options{'mode'}, 2229 'mode' => $out_options{'mode'},
1789 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'}, 2230 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'},
1790 'zeroLevel' => $out_options{'zeroLevel'}, 2231 'zeroLevel' => $out_options{'zeroLevel'},
1791 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 2232 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1792 'params' => $out_options{'params'}, 2233 'params' => $out_options{'params'},
1793 'debug' => $out_options{'debug'}, 2234 'debug' => $out_options{'debug'},
1794 ), 2235 ),
1795 ); 2236 );
1796 } 2237 }
1797 2238
1798 return @output_list; 2239 return @output_list;
… …
1820 2261
1821sub FUNCTION_CMP { 2262sub FUNCTION_CMP {
1822 my %func_params = @_; 2263 my %func_params = @_;
1823 2264
1824 my $correctEqn = $func_params{'correctEqn'}; 2265 my $correctEqn = $func_params{'correctEqn'};
1825 my $var = $func_params{'var'}; 2266 my $var = $func_params{'var'};
1826 my $ra_limits = $func_params{'limits'}; 2267 my $ra_limits = $func_params{'limits'};
1827 my $tol = $func_params{'tolerance'}; 2268 my $tol = $func_params{'tolerance'};
1828 my $tolType = $func_params{'tolType'}; 2269 my $tolType = $func_params{'tolType'};
1829 my $numPoints = $func_params{'numPoints'}; 2270 my $numPoints = $func_params{'numPoints'};
1830 my $mode = $func_params{'mode'}; 2271 my $mode = $func_params{'mode'};
1831 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'}; 2272 my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
1832 my $zeroLevel = $func_params{'zeroLevel'}; 2273 my $zeroLevel = $func_params{'zeroLevel'};
1833 my $zeroLevelTol = $func_params{'zeroLevelTol'}; 2274 my $zeroLevelTol = $func_params{'zeroLevelTol'};
1834 2275
1835 2276
1836 # Check that everything is defined: 2277 # Check that everything is defined:
… …
1867 $numPoints = $functNumOfPoints unless defined $numPoints; 2308 $numPoints = $functNumOfPoints unless defined $numPoints;
1868 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration; 2309 $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
1869 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel; 2310 $zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
1870 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol; 2311 $zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
1871 2312
1872 $func_params{'var'} = $var; 2313 $func_params{'var'} = $var;
1873 $func_params{'limits'} = \@limits; 2314 $func_params{'limits'} = \@limits;
1874 $func_params{'tolerance'}= $tol; 2315 $func_params{'tolerance'} = $tol;
1875 $func_params{'tolType'} = $tolType; 2316 $func_params{'tolType'} = $tolType;
1876 $func_params{'numPoints'}= $numPoints; 2317 $func_params{'numPoints'} = $numPoints;
1877 $func_params{'mode'} = $mode; 2318 $func_params{'mode'} = $mode;
1878 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 2319 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
1879 $func_params{'zeroLevel'} = $zeroLevel; 2320 $func_params{'zeroLevel'} = $zeroLevel;
1880 $func_params{'zeroLevelTol'} = $zeroLevelTol; 2321 $func_params{'zeroLevelTol'} = $zeroLevelTol;
1881 2322
2323########################################################
2324# End of cleanup of calling parameters
2325########################################################
1882 my $i; #for use with loops 2326 my $i; #for use with loops
1883 my $PGanswerMessage = ""; 2327 my $PGanswerMessage = "";
1884 my $originalCorrEqn = $correctEqn; 2328 my $originalCorrEqn = $correctEqn;
1885 2329
1886#prepare the correct answer and check it's syntax 2330#prepare the correct answer and check it's syntax
1887 my $rh_correct_ans = new AnswerHash; 2331 my $rh_correct_ans = new AnswerHash;
1888 $rh_correct_ans->input($correctEqn); 2332 $rh_correct_ans->input($correctEqn);
1889 $rh_correct_ans = check_syntax($rh_correct_ans); 2333 $rh_correct_ans = check_syntax($rh_correct_ans);
1890 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2334 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1891 $rh_correct_ans->clear_error(); 2335 $rh_correct_ans->clear_error();
1892 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ], 2336 $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars => [ @VARS, @PARAMS ],
… …
1895 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans}; 2339 my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
1896 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag}; 2340 warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
1897 2341
1898#create the evaluation points 2342#create the evaluation points
1899 my $random_for_answers = new PGrandom($main::PG_original_problemSeed); 2343 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 2344 my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
1901 my (@evaluation_points); 2345 my (@evaluation_points);
1902 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) { 2346 for( my $count = 0; $count < @PARAMS+1+$numPoints; $count++ ) {
1903 my (@vars,$iteration_limit); 2347 my (@vars,$iteration_limit);
1904 for( my $i = 0; $i < @VARS; $i++ ) { 2348 for( my $i = 0; $i < @VARS; $i++ ) {
1905 my $iteration_limit = 10; 2349 my $iteration_limit = 10;
… …
1914 push(@evaluation_points,\@vars); 2358 push(@evaluation_points,\@vars);
1915 } 2359 }
1916 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points); 2360 my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
1917 2361
1918 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters); 2362 #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
1919 #warn "coeff", join(" | ", @{$COEFFS}); 2363 #warn "coeff", join(" | ", @{$COEFFS});
1920 2364
1921#construct the answer evaluator 2365#construct the answer evaluator
1922 my $answer_evaluator = new AnswerEvaluator; 2366 my $answer_evaluator = new AnswerEvaluator;
1923 $answer_evaluator->{debug} = $func_params{debug}; 2367 $answer_evaluator->{debug} = $func_params{debug};
1924 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn, 2368 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn,
… …
2077 push(@out, $temp_hash->input()); 2521 push(@out, $temp_hash->input());
2078 2522
2079 } 2523 }
2080 if ($PGanswerMessage) { 2524 if ($PGanswerMessage) {
2081 $rh_ans->input( "( " . join(", ", @out ) . " )" ); 2525 $rh_ans->input( "( " . join(", ", @out ) . " )" );
2082 $rh_ans->throw_error('SYTNAX', 'There is a syntax error in your answer.'); 2526 $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
2083 } else { 2527 } else {
2084 $rh_ans->input( [@out] ); 2528 $rh_ans->input( [@out] );
2085 } 2529 }
2086 $rh_ans; 2530 $rh_ans;
2087} 2531}
… …
2179 my $error = "WeBWorK was unable evaluate your function. Please check that your 2623 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."; 2624 expression doesn't take roots of negative numbers, or divide by zero.";
2181 $rh_ans->throw_error('EVAL',$error); 2625 $rh_ans->throw_error('EVAL',$error);
2182 } else { 2626 } else {
2183 my $tol = $options{tol} if defined($options{tol}); 2627 my $tol = $options{tol} if defined($options{tol});
2184 $tol = 0.01*$options{reltol} if defined($options{reltol}); 2628 #$tol = 0.01*$options{reltol} if defined($options{reltol});
2185 $tol = .000001 unless defined($tol); 2629 $tol = .000001 unless defined($tol);
2186 2630
2187 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0; 2631 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0;
2188 } 2632 }
2189 $rh_ans; 2633 $rh_ans;
… …
2273 my $rf_correct_fun = $rh_ans->{rf_correct_ans}; 2717 my $rf_correct_fun = $rh_ans->{rf_correct_ans};
2274 my $ra_vars_matrix = $rh_ans->{evaluation_points}; 2718 my $ra_vars_matrix = $rh_ans->{evaluation_points};
2275 my $dim_of_param_space = @{$options{param_vars}}; 2719 my $dim_of_param_space = @{$options{param_vars}};
2276 # Short cut. Bail if there are no param_vars 2720 # Short cut. Bail if there are no param_vars
2277 unless ($dim_of_param_space >0) { 2721 unless ($dim_of_param_space >0) {
2278 $rh_ans ->{ra_paramters} = []; 2722 $rh_ans ->{ra_parameters} = [];
2279 return $rh_ans; 2723 return $rh_ans;
2280 } 2724 }
2281 # inputs are row arrays in this case. 2725 # inputs are row arrays in this case.
2282 my @zero_params=(); 2726 my @zero_params=();
2283 2727
… …
2315 while(@coeff) { 2759 while(@coeff) {
2316 $matrix->assign($row_num,$col_num, shift(@coeff) ); 2760 $matrix->assign($row_num,$col_num, shift(@coeff) );
2317 $col_num++; 2761 $col_num++;
2318 } 2762 }
2319 } 2763 }
2320 # which might be useful for functions that are not defined at some points. 2764
2321 } 2765 }
2322 $row_num++; 2766 $row_num++;
2323 last if $errors; # break if there are any errors. 2767 last if $errors; # break if there are any errors.
2324 # This cuts down on the size of error messages. 2768 # This cuts down on the size of error messages.
2325 # However it impossible to check for equivalence at 95% of points 2769 # However it impossible to check for equivalence at 95% of points
2326 2770 # which might be useful for functions that are not defined at some points.
2327 } 2771 }
2328 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug}; 2772 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug};
2329 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug}; 2773 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug};
2330 2774
2331 # we have Matrix * parameter = data_vec + perpendicular vector 2775 # we have Matrix * parameter = data_vec + perpendicular vector
… …
2390 my $ra_parameters = $rh_ans ->{ra_parameters}; 2834 my $ra_parameters = $rh_ans ->{ra_parameters};
2391 my @evaluation_points = @{$rh_ans->{evaluation_points} }; 2835 my @evaluation_points = @{$rh_ans->{evaluation_points} };
2392 my @parameters = (); 2836 my @parameters = ();
2393 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY'; 2837 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY';
2394 my $errors = undef; 2838 my $errors = undef;
2839 my @zero_params=();
2840 for(my $i=1;$i<=@{$ra_parameters};$i++){push(@zero_params,0); }
2395 my @differences = (); 2841 my @differences = ();
2396 my $diff; 2842 my @student_values;
2843 my @correct_values;
2844 my @tol_values;
2845 my ($diff,$tol_val);
2397 # calculate the vector of differences between the test function and the comparison function. 2846 # calculate the vector of differences between the test function and the comparison function.
2398 while (@evaluation_points) { 2847 while (@evaluation_points) {
2399 my ($err1, $err2); 2848 my ($err1, $err2,$err3);
2400 my @vars = @{ shift(@evaluation_points) }; 2849 my @vars = @{ shift(@evaluation_points) };
2401 my @inputs = (@vars, @parameters); 2850 my @inputs = (@vars, @parameters);
2402 my ($inVal, $correctVal); 2851 my ($inVal, $correctVal);
2403 ($inVal, $err1) = &{$rf_fun}(@vars); 2852 ($inVal, $err1) = &{$rf_fun}(@vars);
2404 $errors .= " $err1 " if defined($err1); 2853 $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); 2854 $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); 2855 ($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); 2856 $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); 2857 $errors .= " Error detected evaluating correct answer at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2);
2858 ($tol_val,$err3)= &$rf_correct_fun(@vars, @zero_params);
2859 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
2860 $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) ) { 2861 unless (defined($err1) or defined($err2) or defined($err3) ) {
2410 $diff = $inVal - $correctVal; 2862 $diff = ( $inVal - ($correctVal -$tol_val ) ) - $tol_val; #prevents entering too high a number?
2411 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 2863 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
2412 2864
2413 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 2865 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance
2414 $diff = $diff/abs( &$rf_correct_fun(@inputs) ) if $correctVal > $options{zeroLevel}; 2866 #warn "diff = $diff";
2867
2868 $diff = ( $inVal - ($correctVal-$tol_val ) )/abs($tol_val) -1 if abs($tol_val) > $options{zeroLevel};
2869 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel};
2870 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
2415 } 2871 }
2416 } 2872 }
2417 last if $errors; # break if there are any errors. 2873 last if $errors; # break if there are any errors.
2418 # This cuts down on the size of error messages. 2874 # This cuts down on the size of error messages.
2419 # However it impossible to check for equivalence at 95% of points 2875 # 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. 2876 # which might be useful for functions that are not defined at some points.
2877 push(@student_values,$inVal);
2878 push(@correct_values,( $inVal - ($correctVal-$tol_val ) ));
2421 push(@differences, $diff); 2879 push(@differences, $diff);
2880 push(@tol_values,$tol_val);
2422 } 2881 }
2423 $rh_ans ->{ra_differences} = \@differences; 2882 $rh_ans ->{ra_differences} = \@differences;
2883 $rh_ans ->{ra_student_values} = \@student_values;
2884 $rh_ans ->{ra_adjusted_student_values} = \@correct_values;
2885 $rh_ans->{ra_tol_values}=\@tol_values;
2424 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 2886 $rh_ans->throw_error('EVAL', $errors) if defined($errors);
2425 $rh_ans; 2887 $rh_ans;
2426} 2888}
2427 2889
2428 2890
… …
3385## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]] 3847## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
3386## a reference to an array of limits -- [llim, ulim] 3848## a reference to an array of limits -- [llim, ulim]
3387## an array of array references -- ([llim,ulim], [llim,ulim]) 3849## an array of array references -- ([llim,ulim], [llim,ulim])
3388## an array of limits -- (llim,ulim) 3850## an array of limits -- (llim,ulim)
3389## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim]) 3851## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
3852
3390sub get_limits_array { 3853sub get_limits_array {
3391 my $in = shift @_; 3854 my $in = shift @_;
3392 my @out; 3855 my @out;
3393 3856
3394 if( not defined($in) ) { #if nothing defined, build default array and return 3857 if( not defined($in) ) { #if nothing defined, build default array and return
… …
3440 }; 3903 };
3441 3904
3442 return $error_response; 3905 return $error_response;
3443} 3906}
3444 3907
3445# outputs a hash to the screen 3908
3446# sub display_options { 3909#########################################################################
3447# my %options = @_; 3910# Filters for answer evaluators
3448# my $out_string = ""; 3911#########################################################################
3449# foreach my $key (keys %options) { 3912
3450# $out_string .= " $key => $options{$key},<BR>";
3451# }
3452# return $out_string;
3453# }
3454 3913
3455sub is_a_number { 3914sub is_a_number {
3456 my ($num) = @_; 3915 my ($num,%options) = @_;
3916 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3917 my ($rh_ans);
3918 if ($process_ans_hash) {
3919 $rh_ans = $num;
3920 $num = $rh_ans->{student_ans};
3921 }
3922
3457 my $is_a_number = 0; 3923 my $is_a_number = 0;
3458 return $is_a_number unless defined($num); 3924 return $is_a_number unless defined($num);
3459 $num =~ s/^\s*//; ## remove initial spaces 3925 $num =~ s/^\s*//; ## remove initial spaces
3460 $num =~ s/\s*$//; ## remove trailing spaces 3926 $num =~ s/\s*$//; ## remove trailing spaces
3461 3927
3462 ## the following is copied from the online perl manual 3928 ## the following is copied from the online perl manual
3463 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ 3929 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
3464 $is_a_number = 1; 3930 $is_a_number = 1;
3465 } 3931 }
3466 3932
3933 if ($process_ans_hash) {
3934 if ($is_a_number == 1 ) {
3935 $rh_ans->{student_ans}=$num;
3936 return $rh_ans;
3937 } else {
3938 $rh_ans->{student_ans} = "Incorrect number format: You must enter a number, e.g. -6, 5.3, or 6.12E-3";
3939 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3940 return $rh_ans;
3941 }
3942 } else {
3467 return $is_a_number; 3943 return $is_a_number;
3944 }
3468} 3945}
3469 3946
3470sub is_a_fraction { 3947sub is_a_fraction {
3471 3948 my ($num,%options) = @_;
3472 ## does not test for validity, just for allowed characters 3949 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3473 ## note that an integer will qualify as a fraction 3950 my ($rh_ans);
3474 my ($exp) = @_; 3951 if ($process_ans_hash) {
3952 $rh_ans = $num;
3953 $num = $rh_ans->{student_ans};
3954 }
3955
3475 my $is_a_fraction = 0; 3956 my $is_a_fraction = 0;
3476 return $is_a_fraction unless defined($exp); 3957 return $is_a_fraction unless defined($num);
3958 $num =~ s/^\s*//; ## remove initial spaces
3959 $num =~ s/\s*$//; ## remove trailing spaces
3960
3477 if ($exp =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) { 3961 if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
3478 $is_a_fraction = 1; 3962 $is_a_fraction = 1;
3479 } 3963 }
3480 3964
3965 if ($process_ans_hash) {
3966 if ($is_a_fraction == 1 ) {
3967 $rh_ans->{student_ans}=$num;
3968 return $rh_ans;
3969 } else {
3970 $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
3971 $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
3972 return $rh_ans;
3973 }
3974
3975 } else {
3481 return $is_a_fraction; 3976 return $is_a_fraction;
3977 }
3482} 3978}
3483 3979
3980
3484sub is_an_arithmetic_expression { 3981sub is_an_arithmetic_expression {
3485 ## does not test for validity, just for allowed characters 3982 my ($num,%options) = @_;
3486 my ($exp) = @_; 3983 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3984 my ($rh_ans);
3985 if ($process_ans_hash) {
3986 $rh_ans = $num;
3987 $num = $rh_ans->{student_ans};
3988 }
3989
3487 my $is_an_arithmetic_expression = 0; 3990 my $is_an_arithmetic_expression = 0;
3991 return $is_an_arithmetic_expression unless defined($num);
3992 $num =~ s/^\s*//; ## remove initial spaces
3993 $num =~ s/\s*$//; ## remove trailing spaces
3994
3488 if ($exp =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) { 3995 if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
3489 $is_an_arithmetic_expression = 1; 3996 $is_an_arithmetic_expression = 1;
3490 } 3997 }
3491 3998
3999 if ($process_ans_hash) {
4000 if ($is_an_arithmetic_expression == 1 ) {
4001 $rh_ans->{student_ans}=$num;
4002 return $rh_ans;
4003 } else {
4004
4005 $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
4006 $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
4007 return $rh_ans;
4008 }
4009
4010 } else {
3492 return $is_an_arithmetic_expression; 4011 return $is_an_arithmetic_expression;
4012 }
3493} 4013}
3494 4014
3495#replaces pi, e, and ^ with their Perl equivalents 4015#replaces pi, e, and ^ with their Perl equivalents
3496sub math_constants { 4016sub math_constants {
3497 my($in) = @_; 4017 my($in,%options) = @_;
4018 my $rh_ans;
4019 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
4020 if ($process_ans_hash) {
4021 $rh_ans = $in;
4022 $in = $rh_ans->{student_ans};
4023 }
4024
3498 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 4025 $in =~s/\bpi\b/(4*atan2(1,1))/ge;
3499 $in =~s/\be\b/(exp(1))/ge; 4026 $in =~s/\be\b/(exp(1))/ge;
3500 $in =~s/\^/**/g; 4027 $in =~s/\^/**/g;
3501 4028
4029 if ($process_ans_hash) {
4030 $rh_ans->{student_ans}=$in;
4031 return $rh_ans;
4032 } else {
3502 return $in; 4033 return $in;
4034 }
3503} 4035}
3504 4036
3505sub clean_up_error_msg { 4037sub clean_up_error_msg {
3506 my $msg = $_[0]; 4038 my $msg = $_[0];
3507 $msg =~ s/^\[[^\]]*\][^:]*://; 4039 $msg =~ s/^\[[^\]]*\][^:]*://;
… …
3579# Use this to set default options 4111# Use this to set default options
3580sub set_default_options { 4112sub set_default_options {
3581 my $rh_options = shift; 4113 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'; 4114 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 = @_; 4115 my %default_options = @_;
4116 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
3584 foreach my $key (keys %$rh_options) { 4117 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}); 4118 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
4119 }
3586 } 4120 }
3587 foreach my $key (keys %default_options) { 4121 foreach my $key (keys %default_options) {
3588 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) { 4122 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 4123 $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. 4124 # this key unless tol is explicitly defined.
Legend:
Removed from v.2  
changed lines
  Added in v.22
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9