[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 34 Revision 35
… …
753## relTol -- a relative tolerance 753## relTol -- a relative tolerance
754## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 754## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
755## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero 755## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
756 756
757 757
758sub check_strings {
759 my ($rh_ans, %options) = @_;
760
761 # if the student's answer is a number, simply return the answer hash (unchanged).
762
763 if ( $rh_ans->{student_ans} =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
764 if ( $rh_ans->{answerIsString} == 1) {
765 $rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
766 }
767 return $rh_ans;
768 }
769 # the student's answer is recognized as a string
770 my $ans = $rh_ans->{student_ans};
771
772# OVERVIEW of remindar of function:
773# if answer is correct, return correct. (adjust score to 1)
774# if answer is incorect:
775# 1) determine if the answer is sensible. if it is, return incorrect.
776# 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
777# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
778# last: 'STRING' post_filter will clear the error (avoiding pink screen.)
779
780 my $sensibleAnswer = 0;
781 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
782 my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
783 my $temp_ans_hash = &$ans_eval($ans);
784 $rh_ans->{test} = $temp_ans_hash;
785 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
786 $rh_ans->{score} = 1;
787 $sensibleAnswer = 1;
788 } else { # students answer does not match the correct answer.
789 ## find out if string makes sense
790 my $legalString = '';
791 my @legalStrings = @{$options{strings}};
792 foreach $legalString (@legalStrings) {
793 if ( uc($ans) eq uc($legalString) ) {
794 $sensibleAnswer = 1;
795 last;
796 }
797 }
798 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
799 $rh_ans->throw_error('EVAL', "$BR Your answer is not a recognized answer") unless ($sensibleAnswer);
800 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
801 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
802 }
803 $rh_ans->{student_ans} = $ans;
804 if ($sensibleAnswer) {
805 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
806 }
807 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
808
809 $rh_ans;
810
811}
812
758 813
759 814
760sub check_units { 815sub check_units {
761 my ($rh_ans, %options) = @_; 816 my ($rh_ans, %options) = @_;
762 817
763 my %correct_units = %{$rh_ans-> {rh_correct_units}}; 818 my %correct_units = %{$rh_ans-> {rh_correct_units}};
764 819
765 my $ans = $rh_ans->{student_ans}; 820 my $ans = $rh_ans->{student_ans};
766 # $ans = '' unless defined ($ans); 821 # $ans = '' unless defined ($ans);
822 $ans = str_filters ($ans, 'trim_whitespace');
767 my $original_student_ans = $ans; 823 my $original_student_ans = $ans;
768 824
769 # $ans = str_filters ($ans, 'trim_whitespace');
770 $rh_ans->{original_student_ans} = $original_student_ans; 825 $rh_ans->{original_student_ans} = $original_student_ans;
771 826
772 # it surprises me that the match below works since the first .* is greedy. 827 # it surprises me that the match below works since the first .* is greedy.
773 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/; 828 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
774 829
… …
809 if ( $units_match ) { 864 if ( $units_match ) {
810 # units are ok. Evaluate the numerical part of the answer 865 # units are ok. Evaluate the numerical part of the answer
811 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if 866 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
812 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor. 867 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
813 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'}); 868 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
814
815
816
817
818 $rh_ans->{student_ans} = $num_answer; 869 $rh_ans->{student_ans} = $num_answer;
819 # return $rh_ans; 870
820 # my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
821 # 'tolerance' => $rh_ans->{'tolerance'},
822 # 'tolType' => $rh_ans->{'tolType'},
823 # 'format' => $options{'format'},
824 # 'mode' => $options{'mode'},
825 # 'zeroLevel' => $options{'zeroLevel'},
826 # 'zeroLevelTol' => $options{'zeroLevelTol'} );
827#
828# # because num_answer may contain an arithmetic expression rather than
829# # a number we can't multiply it by the $units{'factor'}
830# # instead we divide the correctanswer by this amount;
831# # this is also why the numerical_answer_evaluator is not defined outside this subroutine.
832#
833# # $ans_hash = &$numerical_answer_evaluator($num_answer);
834#
835# # now we need to doctor the correct answer in order to add units
836# # to it and correct for the division we did before
837# $ans_hash -> {correct_ans} =
838# prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
839# $options{'format'} ) . " $correct_units";
840# # we also need to doctor the submitted answer to get it back in its original format.
841#
842# # we don't add the units on if there is an error message from numerical_answer_evaluator
843# if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
844# $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
845# $ans_hash -> setKeys( original_student_ans => $ans );
846# }
847# else {
848# # error message from numerical_answer_evaluator doesn't have units tacked on
849# $ans_hash -> setKeys( original_student_ans => $ans );
850# }
851 } else { 871 } else {
852 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' ); 872 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
853 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' ); 873 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
854 } 874 }
855 875
856 return $rh_ans; 876 return $rh_ans;
857 } 877 }
858 878
879
880# This mode is depricated. send input through num_cmp -- it can handle units.
859sub numerical_compare_with_units { 881sub numerical_compare_with_units {
860 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 882 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
861 my %options = @_; # all of the other inputs are (key value) pairs 883 my %options = @_; # all of the other inputs are (key value) pairs
862 884
863 # Prepare the correct answer 885 # Prepare the correct answer
… …
870 892
871 893
872 num_cmp($correct_num_answer, %options); 894 num_cmp($correct_num_answer, %options);
873} 895}
874 896
875#sub numerical_compare_with_units {
876# my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
877# my %options = @_; # all of the other inputs are (key value) pairs
878#
879# # handle the defaults
880# $options{'mode'} = 'std' unless defined( $options{'mode'} );
881# $options{'format'} = $numFormatDefault unless defined( $options{'format'} );
882# $options{'zeroLevel'} = $numZeroLevelDefault unless defined( $options{'zeroLevel'} );
883# $options{'zeroLevelTol'} = $numZeroLevelTolDefault unless defined( $options{'zeroLevelTol'} );
884#
885# # both spellings are maintained for backward compatibility
886# # relTol is preferred
887# if( defined $options{'reltol'} ) {
888# $options{'relTol'} = $options{'reltol'};
889# delete $options{'reltol'};
890# }
891#
892# my ($tol, $tolerance_mode);
893# if ( defined $options{'tol'} ) {
894# $tol = $options{'tol'};
895# $tolerance_mode = 'absolute';
896# }
897# elsif( defined $options{'relTol'} ) {
898# $tol = $options{'relTol'};
899# $tolerance_mode = 'relative';
900# }
901# else { #the default is a relative tolerance
902# $tol = $numRelPercentTolDefault;
903# $tolerance_mode = 'relative';
904# }
905#
906# # Prepare the correct answer
907# $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
908#
909# # it surprises me that the match below works since the first .* is greedy.
910# my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
911#
912# my %correct_units = Units::evaluate_units($correct_units);
913# if ( defined( $correct_units{'ERROR'} ) ) {
914# die "ERROR: The answer \"$correct_answer\" in the problem definition cannot be parsed:\n" .
915# "$correct_units{'ERROR'}\n";
916# }
917#
918# my $ans_evaluator = sub {
919#
920# my $ans = shift;
921# $ans = '' unless defined($ans);
922# my $original_student_ans = $ans;
923#
924# $ans = str_filters( $ans, 'trim_whitespace' );
925#
926# my $ans_hash = new AnswerHash(
927# 'score' => 0,
928# 'correct_ans' => spf($correct_num_answer,$options{'format'}) . " $correct_units",
929# 'student_ans' => $ans,
930# 'ans_message' => '',
931# 'type' => 'num_cmp_with_units',
932# 'preview_text_string' => '',
933# 'original_student_ans' => $original_student_ans
934# );
935#
936# # it surprises me that the match below works since the first .* is greedy.
937# my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
938#
939# unless ( defined($num_answer) && $units ) {
940# # there is an error reading the input
941# if ( $ans =~ /\S/ ) { # the answer is not blank
942# $ans_hash -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
943# "as a number or an arithmetic expression followed by a unit specification. " .
944# "Your answer must contain units." );
945# }
946#
947# return $ans_hash;
948# }
949#
950# # we have been able to parse the answer into a numerical part and a unit part
951#
952# $num_answer = $1; #$1 and $2 from the regular expression above
953# $units = $2;
954#
955# my %units = Units::evaluate_units($units);
956# if ( defined( $units{'ERROR'} ) ) {
957# # handle error condition
958# $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
959#
960# $ans_hash -> setKeys( 'ans_message' => "$units{'ERROR'}" );
961#
962# return $ans_hash;
963# }
964#
965# my $units_match = 1;
966# my $fund_unit;
967# foreach $fund_unit (keys %correct_units) {
968# next if $fund_unit eq 'factor';
969# $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
970# }
971#
972# if ( $units_match ) {
973#
974# # units are ok. Evaluate the numerical part of the answer
975# $tol = $tol * $correct_units{'factor'}/$units{'factor'} if
976# $tolerance_mode eq 'absolute'; # the tolerance is in the units specified by the instructor.
977#
978# my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
979# 'tolerance' => $tol,
980# 'tolType' => $tolerance_mode,
981# 'format' => $options{'format'},
982# 'mode' => $options{'mode'},
983# 'zeroLevel' => $options{'zeroLevel'},
984# 'zeroLevelTol' => $options{'zeroLevelTol'} );
985#
986# # because num_answer may contain an arithmetic expression rather than
987# # a number we can't multiply it by the $units{'factor'}
988# # instead we divide the correct answer by this amount;
989# # this is also why the numerical_answer_evaluator is not defined outside this subroutine.
990#
991# $ans_hash = &$numerical_answer_evaluator($num_answer);
992#
993# # now we need to doctor the correct answer in order to add units
994# # to it and correct for the division we did before
995# $ans_hash -> {correct_ans} =
996# prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
997# $options{'format'} ) . " $correct_units";
998# # we also need to doctor the submitted answer to get it back in its original format.
999#
1000# # we don't add the units on if there is an error message from numerical_answer_evaluator
1001# if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
1002# $ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
1003# $ans_hash -> setKeys( original_student_ans => $ans );
1004# }
1005# else {
1006# # error message from numerical_answer_evaluator doesn't have units tacked on
1007# $ans_hash -> setKeys( original_student_ans => $ans );
1008# }
1009# }
1010# else {
1011# $ans_hash -> setKeys( ans_message => 'There is an error in the units for this answer.' );
1012# }
1013#
1014# return $ans_hash;
1015# };
1016#
1017# $ans_evaluator;
1018# }
1019 897
1020=head3 std_num_str_cmp() 898=head3 std_num_str_cmp()
1021 899
1022NOTE: This function is maintained for compatibility. num_cmp() with the 900NOTE: This function is maintained for compatibility. num_cmp() with the
1023 'strings' parameter is slightly preferred. 901 'strings' parameter is slightly preferred.
… …
1047Example: 925Example:
1048 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) ); 926 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
1049 927
1050=cut 928=cut
1051 929
1052sub std_num_str_cmp { 930sub std_num_str_cmp {
1053 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 931 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
932 # warn ('This method is depreciated. Use num_cmp instead.');
933 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
934 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
935}
1054 936
937#sub old_std_num_str_cmp {
938# my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
939#
1055 $ra_legalStrings = [''] unless defined $ra_legalStrings; 940# $ra_legalStrings = [''] unless defined $ra_legalStrings;
1056 my @legalStrings = @{$ra_legalStrings}; 941# my @legalStrings = @{$ra_legalStrings};
1057 942#
1058 my $ans_evaluator = sub { 943# my $ans_evaluator = sub {
1059 944#
1060 my $ans = shift; 945# my $ans = shift;
1061 my $ans_hash; 946# my $ans_hash;
1062 my $corrAnswerIsString = 0; 947# my $corrAnswerIsString = 0;
1063# my $studAnswerIsString = 0; ## uses new incorrect logic 948## my $studAnswerIsString = 0; ## uses new incorrect logic
1064 my $studAnswerIsString = 1; 949# my $studAnswerIsString = 1;
1065 950#
1066 my $legalString = ''; 951# my $legalString = '';
1067 foreach $legalString (@legalStrings) { 952# foreach $legalString (@legalStrings) {
1068 if ( uc($correctAnswer) eq uc($legalString) ) { 953# if ( uc($correctAnswer) eq uc($legalString) ) {
1069 $corrAnswerIsString = 1; 954# $corrAnswerIsString = 1;
1070 last; 955# last;
1071 } 956# }
1072 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 957# } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1073 958#
1074 # Neither of these is perfect; the first is more general, but 959# # Neither of these is perfect; the first is more general, but
1075 # has problems with certain special strings like "ee", while the 960# # has problems with certain special strings like "ee", while the
1076 # second doesn't support arithmetic expressions. 961# # second doesn't support arithmetic expressions.
1077 # 962# #
1078# if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) { 963## if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) {
1079# $studAnswerIsString = 1; 964## $studAnswerIsString = 1;
965## }
966# #if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) {
967# # $studAnswerIsString = 1;
968# #}
969#
970# ## Both the above new versions are incorrect. We replace this by the original logic namely that
971# ## an answer that contain any of the symbols
972# ## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ]
973# ## or an answer that consists of "pi" or "e" alone
974# ## will be considered an arithmetic expression rather than a string answer.
975#
976# if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;}
977#
978#
979# ## at this point $studAnswerIsString = 0 iff correct answer is numeric
980#
981# if( $studAnswerIsString ) {
982# $ans = str_filters( $ans, 'compress_whitespace' )
1080# } 983# }
1081 #if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) { 984#
1082 # $studAnswerIsString = 1; 985#
1083 #} 986#
1084 987#
1085 ## Both the above new versions are incorrect. We replace this by the original logic namely that
1086 ## an answer that contain any of the symbols
1087 ## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ]
1088 ## or an answer that consists of "pi" or "e" alone
1089 ## will be considered an arithmetic expression rather than a string answer.
1090
1091 if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;}
1092
1093
1094 ## at this point $studAnswerIsString = 0 iff correct answer is numeric
1095
1096 if( $studAnswerIsString ) {
1097 $ans = str_filters( $ans, 'compress_whitespace' )
1098 }
1099
1100 if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) { 988# if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) {
1101 my $string_answer_evaluator = std_str_cmp( $correctAnswer ); 989# my $string_answer_evaluator = std_str_cmp( $correctAnswer );
1102 $ans_hash = &$string_answer_evaluator( $ans ); 990# $ans_hash = &$string_answer_evaluator( $ans );
1103 991#
1104 if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense 992# if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense
1105 my $sensibleAnswer = 0; 993# my $sensibleAnswer = 0;
1106 foreach $legalString (@legalStrings) { 994# foreach $legalString (@legalStrings) {
1107 if ( uc($ans) eq uc($legalString) ) { 995# if ( uc($ans) eq uc($legalString) ) {
1108 $sensibleAnswer = 1; 996# $sensibleAnswer = 1;
1109 last; 997# last;
1110 } 998# }
1111 } 999# }
1112 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 1000# $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
1113 1001#
1114 $ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) 1002# $ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' )
1115 unless ($sensibleAnswer); 1003# unless ($sensibleAnswer);
1116 $ans_hash -> setKeys( 'student_ans' => uc($ans) ); 1004# $ans_hash -> setKeys( 'student_ans' => uc($ans) );
1117 } 1005# }
1118 } 1006# }
1119 elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) { 1007# elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) {
1120 my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol); 1008# my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol);
1121 $ans_hash = &$numeric_answer_evaluator($ans); 1009# $ans_hash = &$numeric_answer_evaluator($ans);
1122 } 1010# }
1123 elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) { 1011# elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) {
1124 my $numeric_answer_evaluator = std_num_cmp(1); 1012# my $numeric_answer_evaluator = std_num_cmp(1);
1125 $ans_hash = &$numeric_answer_evaluator($ans); 1013# $ans_hash = &$numeric_answer_evaluator($ans);
1126 $ans_hash -> setKeys( 'score' => 0, 1014# $ans_hash -> setKeys( 'score' => 0,
1127 'correct_ans' => $correctAnswer 1015# 'correct_ans' => $correctAnswer
1128 ); 1016# );
1129 } 1017# }
1130 elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) { 1018# elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) {
1131 my $string_answer_evaluator = std_str_cmp('bad'); 1019# my $string_answer_evaluator = std_str_cmp('bad');
1132 $ans_hash = &$string_answer_evaluator($ans); 1020# $ans_hash = &$string_answer_evaluator($ans);
1133 1021#
1134 $ans_hash -> setKeys( 'score' => 0, 1022# $ans_hash -> setKeys( 'score' => 0,
1135 'correct_ans' => $correctAnswer 1023# 'correct_ans' => $correctAnswer
1136 ); 1024# );
1137 1025#
1138 ## find out if string makes sense 1026# ## find out if string makes sense
1139 my $sensibleAnswer = 0; 1027# my $sensibleAnswer = 0;
1140 foreach $legalString (@legalStrings) { 1028# foreach $legalString (@legalStrings) {
1141 if ( uc($ans) eq uc($legalString) ) { 1029# if ( uc($ans) eq uc($legalString) ) {
1142 $sensibleAnswer = 1; 1030# $sensibleAnswer = 1;
1143 last; 1031# last;
1144 } 1032# }
1145 } 1033# }
1146 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible 1034# $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
1147 1035#
1148 $ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" ) 1036# $ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" )
1149 unless $sensibleAnswer; 1037# unless $sensibleAnswer;
1150 } 1038# }
1151 1039#
1152 return $ans_hash; 1040# return $ans_hash;
1153 }; 1041# };
1154 1042#
1155 return $ans_evaluator; 1043# return $ans_evaluator;
1156} 1044#}
1157 1045
1158=head3 num_cmp() 1046=head3 num_cmp()
1159 1047
1160Compares a number or a list of numbers, using a named hash of options to set 1048Compares a number or a list of numbers, using a named hash of options to set
1161parameters. This can make for more readable code than using the "mode"_num_cmp() 1049parameters. This can make for more readable code than using the "mode"_num_cmp()
… …
1267 set_default_options( \%out_options, 1155 set_default_options( \%out_options,
1268 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative', 1156 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative',
1269 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault, 1157 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault,
1270 'mode' => 'std', 1158 'mode' => 'std',
1271 'format' => $numFormatDefault, 1159 'format' => $numFormatDefault,
1272 'tol' => $numAbsTolDefault, 1160 'tol' => $numAbsTolDefault,
1273 'relTol' => $numRelPercentTolDefault, 1161 'relTol' => $numRelPercentTolDefault,
1274 'units' => undef, 1162 'units' => undef,
1275 'strings' => undef, 1163 'strings' => undef,
1276 'zeroLevel' => $numZeroLevelDefault, 1164 'zeroLevel' => $numZeroLevelDefault,
1277 'zeroLevelTol' => $numZeroLevelTolDefault, 1165 'zeroLevelTol' => $numZeroLevelTolDefault,
… …
1334 'units' => $out_options{'units'}, 1222 'units' => $out_options{'units'},
1335 ) 1223 )
1336 ); 1224 );
1337 } 1225 }
1338 elsif( defined( $out_options{'strings'} ) ) { 1226 elsif( defined( $out_options{'strings'} ) ) {
1339 if( defined $out_options{'tol'} ) { 1227 #if( defined $out_options{'tol'} ) {
1340 warn "You are using 'tol' (for absolute tolerance) with a num/str " . 1228 # warn "You are using 'tol' (for absolute tolerance) with a num/str " .
1341 "compare, which currently only uses relative tolerance. The default " . 1229 # "compare, which currently only uses relative tolerance. The default " .
1342 "tolerance will be used."; 1230 # "tolerance will be used.";
1343 } 1231 #}
1344 1232
1345 push( @output_list, std_num_str_cmp( $ans, $out_options{'strings'}, 1233 push( @output_list, NUM_CMP( 'correctAnswer' => $ans,
1346 $out_options{'relTol'}, 1234 'tolerance' => $out_options{tolerance},
1235 'tolType' => $out_options{tolType},
1347 $out_options{'format'}, 1236 'format' => $out_options{'format'},
1237 'mode' => $out_options{'mode'},
1348 $out_options{'zeroLevel'}, 1238 'zeroLevel' => $out_options{'zeroLevel'},
1349 $out_options{'zeroLevelTol'} 1239 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1240 'debug' => $out_options{'debug'},
1241 'strings' => $out_options{'strings'},
1242
1350 ) 1243 )
1351 ); 1244 );
1352 } 1245 }
1353 else { 1246 else {
1354 1247
1355 push(@output_list, 1248 push(@output_list,
… …
1358 'tolType' => $out_options{tolType}, 1251 'tolType' => $out_options{tolType},
1359 'format' => $out_options{'format'}, 1252 'format' => $out_options{'format'},
1360 'mode' => $out_options{'mode'}, 1253 'mode' => $out_options{'mode'},
1361 'zeroLevel' => $out_options{'zeroLevel'}, 1254 'zeroLevel' => $out_options{'zeroLevel'},
1362 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1255 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1363 'debug' => $out_options{'debug'} 1256 'debug' => $out_options{'debug'},
1257
1364 ), 1258 ),
1365 ); 1259 );
1366 } 1260 }
1367 } 1261 }
1368 1262
… …
1383## format -- the display format of the answer 1277## format -- the display format of the answer
1384## mode -- one of 'std', 'strict', 'arith', or 'frac'; 1278## mode -- one of 'std', 'strict', 'arith', or 'frac';
1385## determines allowable formats for the input 1279## determines allowable formats for the input
1386## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 1280## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
1387## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1281## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1388#sub NUM_CMP { # low level numeric compare
1389# my %num_params = @_;
1390#
1391# my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol );
1392# foreach my $key (@keys) {
1393# warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
1394# }
1395#
1396#
1397# my $correctAnswer = $num_params{'correctAnswer'};
1398# my $tol = $num_params{'tolerance'};
1399# my $tolType = $num_params{'tolType'};
1400# my $format = $num_params{'format'};
1401# my $mode = $num_params{'mode'};
1402# my $zeroLevel = $num_params{'zeroLevel'};
1403# my $zeroLevelTol = $num_params{'zeroLevelTol'};
1404#
1405# if( $tolType eq 'relative' ) {
1406# # $tol = $numRelPercentTolDefault unless defined $tol;
1407# $tol *= .01;
1408# }
1409## else {
1410## $tol = $numAbsTolDefault unless defined $tol;
1411## }
1412#
1413# #$format = $numFormatDefault unless defined $format;
1414# #$mode = 'std' unless defined $mode;
1415# #$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
1416# #$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
1417#
1418# my $formattedCorrectAnswer = prfmt( $correctAnswer, $format );
1419#
1420# my $answer_evaluator = sub {
1421# my $in = shift @_;
1422# $in = '' unless defined $in;
1423# my $score = 0;
1424# my $original_student_answer = $in;
1425# my $parser = new AlgParserWithImplicitExpand;
1426# my $ret = $parser -> parse($in);
1427# my $preview_text_string = '';
1428# my $preview_latex_string = '';
1429#
1430# if ( ref($ret) ) { ## parsed successfully
1431# $parser -> tostring();
1432# $parser -> normalize();
1433# $in = $parser -> tostring();
1434# $preview_text_string = $in;
1435# $preview_latex_string = $parser -> tolatex();
1436#
1437# }
1438# else { ## error in parsing
1439# my $ans_hash = new AnswerHash(
1440# 'score' => $score,
1441# 'correct_ans' => $formattedCorrectAnswer,
1442# 'student_ans' => "error: $parser->{htmlerror}",
1443# 'ans_message' => $parser -> {error_msg},
1444# 'type' => "${mode}_number",
1445# 'preview_text_string' => $preview_text_string,
1446# 'preview_latex_string' => $preview_latex_string,
1447# 'original_student_ans' => $original_student_answer
1448# );
1449#
1450# return $ans_hash;
1451# }
1452#
1453# my $PGanswerMessage = '';
1454#
1455# my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1456#
1457# $inVal = '';
1458# $correctAnswer = math_constants($correctAnswer);
1459# my $formattedSubmittedAnswer = '';
1460#
1461# #special variable $@ holds the last error from a Perl eval statement
1462# $@='';
1463#
1464# if ($correctAnswer =~ /\S/) {
1465# ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correctAnswer);
1466# }
1467# else {
1468# $PG_eval_errors = ' ';
1469# }
1470#
1471# if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above
1472# $formattedSubmittedAnswer = $PG_eval_errors;
1473# $formattedSubmittedAnswer = clean_up_error_msg($formattedSubmittedAnswer);
1474# $PGanswerMessage = 'Tell your professor that there is an error in this problem';
1475# my $ans_hash = new AnswerHash(
1476# 'score' => $score,
1477# 'correct_ans' => $formattedCorrectAnswer,
1478# 'student_ans' => $formattedSubmittedAnswer,
1479# 'ans_message' => $PGanswerMessage,
1480# 'type' => 'number',
1481# 'preview_text_string' => $preview_text_string,
1482# 'preview_latex_string' => $preview_latex_string,
1483# 'original_student_ans' => $original_student_answer
1484# );
1485#
1486# return $ans_hash;
1487# }
1488#
1489# $in = &math_constants($in);
1490#
1491# MODE_CASE: { ## bare block for "case" statement
1492# if ($mode eq 'std') {
1493# last MODE_CASE;
1494# }
1495# elsif ($mode eq 'strict') {
1496# unless (is_a_number($in)) {
1497# $PGanswerMessage = 'You must enter a number, e.g. -6, 5.3, or 6.12E-3';
1498# $formattedSubmittedAnswer = 'Incorrect number format';
1499# }
1500# else {
1501# last MODE_CASE;
1502# }
1503# }
1504# elsif ($mode eq 'arith') {
1505# unless (is_an_arithmetic_expression($in)) {
1506# $PGanswerMessage = 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2';
1507# $formattedSubmittedAnswer = 'Not an arithmetic expression';
1508# }
1509# else {
1510# last MODE_CASE;
1511# }
1512# }
1513# elsif ($mode eq 'frac') {
1514# unless (is_a_fraction($in)) {
1515# $PGanswerMessage = 'You must enter a number or fraction , e.g. -6 or 7/13';
1516# $formattedSubmittedAnswer = 'Not a number or fraction';
1517# }
1518# else {
1519# last MODE_CASE;
1520# }
1521# }
1522# else {
1523# $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1524# $formattedSubmittedAnswer = $in;
1525# }
1526#
1527# my $ans_hash = new AnswerHash(
1528# score => $score,
1529# correct_ans => $formattedCorrectAnswer,
1530# student_ans => $formattedSubmittedAnswer,
1531# ans_message => $PGanswerMessage,
1532# type => "${mode}_number",
1533# preview_text_string => $preview_text_string,
1534# preview_latex_string => $preview_latex_string,
1535# original_student_ans => $original_student_answer
1536# );
1537#
1538# return $ans_hash;
1539# } # end of MODE_CASES bare block
1540#
1541# $@ = '';
1542# if ($in =~ /\S/) {
1543#
1544# ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
1545# }
1546# else {
1547# $PG_eval_errors = ' ';
1548# }
1549#
1550# if ($PG_eval_errors) { ##error message from eval or above
1551# $formattedSubmittedAnswer = $PG_eval_errors;
1552# $formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer);
1553# $PGanswerMessage = 'There is a syntax error in your answer';
1554# $PGanswerMessage = '' if $PG_eval_errors eq ' ';
1555# my $ans_hash = new AnswerHash(
1556# 'score' => $score,
1557# 'correct_ans' => $formattedCorrectAnswer,
1558# 'student_ans' => $formattedSubmittedAnswer,
1559# 'ans_message' => $PGanswerMessage,
1560# 'type' => "${mode}_number",
1561# 'preview_text_string' => $preview_text_string,
1562# 'preview_latex_string' => $preview_latex_string,
1563# 'original_student_ans' => $original_student_answer
1564# );
1565#
1566# return $ans_hash;
1567# }
1568# else {
1569# $formattedSubmittedAnswer = prfmt($inVal,$format);
1570# }
1571#
1572# my $permitted_error;
1573# if (defined($tolType) && $tolType eq 'absolute') {
1574# $permitted_error = $tol;
1575# }
1576# elsif ( abs($correctVal) <= $zeroLevel) {
1577# $permitted_error = $zeroLevelTol; ## want $tol to be non zero
1578# }
1579# else {
1580# $permitted_error = abs($tol*$correctVal);
1581# }
1582#
1583# my $is_a_number = is_a_number($inVal);
1584# $score = 1 if ( ($is_a_number) and
1585# (abs( $inVal - $correctVal ) <= $permitted_error) );
1586# if ($PG_eval_errors) {
1587# $PGanswerMessage = 'There is a syntax error in your answer';
1588# }
1589# elsif (not $is_a_number) {
1590# $PGanswerMessage = 'Your answer does not evaluate to a number';
1591# }
1592#
1593# my $ans_hash = new AnswerHash(
1594# 'score' => $score,
1595# 'correct_ans' => $formattedCorrectAnswer,
1596# 'student_ans' => $formattedSubmittedAnswer,
1597# 'ans_message' => $PGanswerMessage,
1598# 'type' => "${mode}_number",
1599# 'preview_text_string' => $preview_text_string,
1600# 'preview_latex_string' => $preview_latex_string,
1601# 'original_student_ans' => $original_student_answer
1602# );
1603#
1604# return $ans_hash;
1605# };
1606#
1607# return $answer_evaluator;
1608
1609#}
1610 1282
1611sub compare_numbers { 1283sub compare_numbers {
1612 my ($rh_ans, %options) = @_; 1284 my ($rh_ans, %options) = @_;
1613 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans}); 1285 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1614 if ($PG_eval_errors) { 1286 if ($PG_eval_errors) {
… …
1671 1343
1672 my $formattedCorrectAnswer; 1344 my $formattedCorrectAnswer;
1673 my $correct_units; 1345 my $correct_units;
1674 my $correct_num_answer; 1346 my $correct_num_answer;
1675 my %correct_units; 1347 my %correct_units;
1348 my $corrAnswerIsString = 0;
1349
1676 1350
1677 if (defined($num_params{units}) && $num_params{units}) { 1351 if (defined($num_params{units}) && $num_params{units}) {
1678 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' ); 1352 $correctAnswer = str_filters( $correctAnswer, 'trim_whitespace' );
1679 # units are in form stuff space units where units contains no spaces. 1353 # units are in form stuff space units where units contains no spaces.
1680 1354
… …
1683 if ( defined( $correct_units{'ERROR'} ) ) { 1357 if ( defined( $correct_units{'ERROR'} ) ) {
1684 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" . 1358 warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
1685 "$correct_units{'ERROR'}\n"); 1359 "$correct_units{'ERROR'}\n");
1686 } 1360 }
1687 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1361 # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
1688 $formattedCorrectAnswer = pfmt($correct_num_answer,$num_params{'format'}) . " $correct_units"; 1362 $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
1689 1363
1364 } elsif (defined($num_params{strings}) && $num_params{strings}) {
1365
1366 my $legalString = '';
1367 my @legalStrings = @{$num_params{strings}};
1368 $correct_num_answer = $correctAnswer;
1369 $formattedCorrectAnswer = $correctAnswer;
1370 foreach $legalString (@legalStrings) {
1371 if ( uc($correctAnswer) eq uc($legalString) ) {
1372 $corrAnswerIsString = 1;
1373 last;
1374 }
1375 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1376
1377
1690 } else { 1378 } else {
1691 $correct_num_answer = $correctAnswer; 1379 $correct_num_answer = $correctAnswer;
1692 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} ); 1380 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1693 } 1381 }
1694 1382
… …
1696 1384
1697 my $PGanswerMessage = ''; 1385 my $PGanswerMessage = '';
1698 1386
1699 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report); 1387 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1700 1388
1701 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/) { 1389 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1702 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer); 1390 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1703 } 1391 }
1704 else { 1392 else {
1705 $PG_eval_errors = ' '; 1393 $PG_eval_errors = ' ';
1706 } 1394 }
1707 1395
1708 if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above 1396 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1397 ##error message from eval or above
1709 warn "Error in 'correct' answer: $PG_eval_errors<br> 1398 warn "Error in 'correct' answer: $PG_eval_errors<br>
1710 The answer $correctAnswer evaluates to $correctVal, 1399 The answer $correctAnswer evaluates to $correctVal,
1711 which cannot be interpreted as a number. "; 1400 which cannot be interpreted as a number. ";
1712 1401
1713 } 1402 }
… …
1721 tolerance => $num_params{tolerance}, 1410 tolerance => $num_params{tolerance},
1722 tolType => $num_params{tolType}, 1411 tolType => $num_params{tolType},
1723 units => $correct_units, 1412 units => $correct_units,
1724 original_correct_ans => $formattedCorrectAnswer, 1413 original_correct_ans => $formattedCorrectAnswer,
1725 rh_correct_units => \%correct_units, 1414 rh_correct_units => \%correct_units,
1415 answerIsString => $corrAnswerIsString,
1726 ); 1416 );
1727 my ($in, $formattedSubmittedAnswer); 1417 my ($in, $formattedSubmittedAnswer);
1728 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift; 1418 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
1729 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;} 1419 $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
1730 ); 1420 );
1731 if (defined($num_params{units}) && $num_params{units}) { 1421 if (defined($num_params{units}) && $num_params{units}) {
1732 $answer_evaluator->install_pre_filter(\&check_units); 1422 $answer_evaluator->install_pre_filter(\&check_units);
1733 } 1423 }
1424 if (defined($num_params{strings}) && $num_params{strings}) {
1425 $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
1426 }
1427
1734 1428
1735 $answer_evaluator->install_pre_filter(\&check_syntax); 1429 $answer_evaluator->install_pre_filter(\&check_syntax);
1736 1430
1737 $answer_evaluator->install_pre_filter(\&math_constants); 1431 $answer_evaluator->install_pre_filter(\&math_constants);
1432
1433
1434
1738 if ($mode eq 'std') { 1435 if ($mode eq 'std') {
1739 # do nothing 1436 # do nothing
1740 } elsif ($mode eq 'strict') { 1437 } elsif ($mode eq 'strict') {
1741 $answer_evaluator->install_pre_filter(\&is_a_number); 1438 $answer_evaluator->install_pre_filter(\&is_a_number);
1742 } elsif ($mode eq 'arith') { 1439 } elsif ($mode eq 'arith') {
… …
1747 } else { 1444 } else {
1748 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.'; 1445 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
1749 $formattedSubmittedAnswer = $in; 1446 $formattedSubmittedAnswer = $in;
1750 } 1447 }
1751 1448
1449 if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
1752 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params); 1450 $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
1451 }
1753 1452
1754 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 1453 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
1755 $rh_ans->{foo} = 'There was one.'; 1454
1756 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}; 1455 $rh_ans->{student_ans} = $rh_ans->{original_student_ans};
1757 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans}; 1456 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
1758 $rh_ans;} 1457 $rh_ans;}
1759 ); 1458 );
1760 1459
… …
1763 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message}; 1462 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
1764 $rh_ans->clear_error('EVAL'); } ); 1463 $rh_ans->clear_error('EVAL'); } );
1765 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } ); 1464 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
1766 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } ); 1465 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
1767 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } ); 1466 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
1768 1467 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
1769 1468
1770 1469
1771 $answer_evaluator; 1470 $answer_evaluator;
1772} 1471}
1773 1472
1774 1473
1775### LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1776#sub NUM_CMP_LIST { # low level numeric list compare
1777# my %num_params = @_;
1778#
1779# my @outputList;
1780# my $ans;
1781#
1782# while ( @{$num_params{'answerList'}} ) {
1783# $ans = shift @{$num_params{'answerList'}};
1784# push( @outputList, NUM_CMP( 'correctAnswer' => $ans,
1785# 'tolerance' => $num_params{'tolerance'},
1786# 'tolType' => $num_params{'tolType'},
1787# 'format' => $num_params{'format'},
1788# 'mode' => $num_params{'mode'},
1789# 'zeroLevel' => $num_params{'zeroLevel'},
1790# 'zeroLevelTol' => $num_params{'zeroLevelTol'}
1791# )
1792# );
1793# }
1794#
1795# return @outputList;
1796#}
1797 1474
1798 1475
1799 1476
1800########################################################################## 1477##########################################################################
1801########################################################################## 1478##########################################################################
… …
3018## individual filters below it 2695## individual filters below it
3019sub str_filters { 2696sub str_filters {
3020 my $stringToFilter = shift @_; 2697 my $stringToFilter = shift @_;
3021 my @filters_to_use = @_; 2698 my @filters_to_use = @_;
3022 my %known_filters = ( 'remove_whitespace' => undef, 2699 my %known_filters = ( 'remove_whitespace' => undef,
3023 'compress_whitespace' => undef, 2700 'compress_whitespace' => undef,
3024 'trim_whitespace' => undef, 2701 'trim_whitespace' => undef,
3025 'ignore_case' => undef, 2702 'ignore_case' => undef,
3026 'ignore_order' => undef 2703 'ignore_order' => undef
3027 ); 2704 );
3028 2705
3029 #test for unknown filters 2706 #test for unknown filters
3030 my $filter; 2707 my $filter;
3031 foreach $filter (@filters_to_use) { 2708 foreach $filter (@filters_to_use) {
… …
3153sub std_str_cmp { # compare strings 2830sub std_str_cmp { # compare strings
3154 my $correctAnswer = shift @_; 2831 my $correctAnswer = shift @_;
3155 my @filters = ( 'compress_whitespace', 'ignore_case' ); 2832 my @filters = ( 'compress_whitespace', 'ignore_case' );
3156 my $type = 'std_str_cmp'; 2833 my $type = 'std_str_cmp';
3157 STR_CMP( 'correctAnswer' => $correctAnswer, 2834 STR_CMP( 'correctAnswer' => $correctAnswer,
3158 'filters' => \@filters, 2835 'filters' => \@filters,
3159 'type' => $type 2836 'type' => $type
3160 ); 2837 );
3161} 2838}
3162 2839
3163sub std_str_cmp_list { # alias for std_str_cmp 2840sub std_str_cmp_list { # alias for std_str_cmp
3164 my @answerList = @_; 2841 my @answerList = @_;
… …
3367## IN: a hashtable with the following entries (error-checking to be added later?): 3044## IN: a hashtable with the following entries (error-checking to be added later?):
3368## correctAnswer -- the correct answer, before filtering 3045## correctAnswer -- the correct answer, before filtering
3369## filters -- reference to an array containing the filters to be applied 3046## filters -- reference to an array containing the filters to be applied
3370## type -- a string containing the type of answer evaluator in use 3047## type -- a string containing the type of answer evaluator in use
3371## OUT: a reference to an answer evaluator subroutine 3048## OUT: a reference to an answer evaluator subroutine
3049
3372sub STR_CMP { 3050sub STR_CMP {
3373 my %str_params = @_; 3051 my %str_params = @_;
3374
3375 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} ); 3052 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} );
3376
3377 my $answer_evaluator = sub { 3053 my $answer_evaluator = sub {
3378 my $in = shift @_; 3054 my $in = shift @_;
3379 $in = '' unless defined $in; 3055 $in = '' unless defined $in;
3380 my $original_student_ans = $in; 3056 my $original_student_ans = $in;
3381
3382 $in = str_filters( $in, @{$str_params{'filters'}} ); 3057 $in = str_filters( $in, @{$str_params{'filters'}} );
3383
3384 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0; 3058 my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0;
3385 my $ans_hash = new AnswerHash( 3059 my $ans_hash = new AnswerHash( 'score' => $correctQ,
3386 'score' => $correctQ,
3387 'correct_ans' => $str_params{'correctAnswer'}, 3060 'correct_ans' => $str_params{'correctAnswer'},
3388 'student_ans' => $in, 3061 'student_ans' => $in,
3389 'ans_message' => '', 3062 'ans_message' => '',
3390 'type' => $str_params{'type'}, 3063 'type' => $str_params{'type'},
3391 'preview_text_string' => $in, 3064 'preview_text_string' => $in,
3392 'preview_latex_string' => $in, 3065 'preview_latex_string' => $in,
3393 'original_student_ans' => $original_student_ans 3066 'original_student_ans' => $original_student_ans
3394 ); 3067 );
3395
3396 return $ans_hash; 3068 return $ans_hash;
3397 }; 3069 };
3398
3399 return $answer_evaluator; 3070 return $answer_evaluator;
3400} 3071}
3401
3402
3403 3072
3404########################################################################## 3073##########################################################################
3405########################################################################## 3074##########################################################################
3406## Miscellaneous answer evaluators 3075## Miscellaneous answer evaluators
3407 3076
Legend:
Removed from v.34  
changed lines
  Added in v.35
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9