#!/usr/bin/perl
# This file is PGanswermacros.pl
# This includes the subroutines for the ANS macros, that
# is, macros allowing a more flexible answer checking
####################################################################
# Copyright @ 1995-2000 University of Rochester
# All Rights Reserved
####################################################################
=head1 NAME
PGanswermacros.pl -- located in the courseScripts directory
=head1 SYNPOSIS
Number Answer Evaluators:
num_cmp() -- uses an input hash to determine parameters
std_num_cmp(), std_num_cmp_list(), std_num_cmp_abs, std_num_cmp_abs_list()
frac_num_cmp(), frac_num_cmp_list(), frac_num_cmp_abs, frac_num_cmp_abs_list()
arith_num_cmp(), arith_num_cmp_list(), arith_num_cmp_abs, arith_num_cmp_abs_list()
strict_num_cmp(), strict_num_cmp_list(), strict_num_cmp_abs, strict_num_cmp_abs_list()
numerical_compare_with_units() -- requires units as part of the answer
std_num_str_cmp() -- also accepts a set of strings as possible answers
Function Answer Evaluators:
fun_cmp() -- uses an input hash to determine parameters
function_cmp(), function_cmp_abs()
function_cmp_up_to_constant(), function_cmp_up_to_constant_abs()
multivar_function_cmp()
String Answer Evaluators:
str_cmp() -- uses an input hash to determine parameters
std_str_cmp(), std_str_cmp_list(), std_cs_str_cmp(), std_cs_str_cmp_list()
strict_str_cmp(), strict_str_cmp_list()
ordered_str_cmp(), ordered_str_cmp_list(), ordered_cs_str_cmp(), ordered_cs_str_cmp_list()
unordered_str_cmp(), unordered_str_cmp_list(), unordered_cs_str_cmp(), unordered_cs_str_cmp_list()
Miscellaneous Answer Evaluators:
checkbox_cmp()
radio_cmp()
=cut
=head1 DESCRIPTION
This file adds subroutines which create "answer evaluators" for checking
answers. Each answer evaluator accepts a single input from a student answer,
checks it and creates an output hash %ans_hash with seven or eight entries
(the preview_latex_string is optional). The output hash is now being created
with the AnswerHash package "class", which is located at the end of this file.
This class is currently just a wrapper for the hash, but this might change in
the future as new capabilities are added.
score => $correctQ,
correct_ans => $originalCorrEqn,
student_ans => $modified_student_ans
original_student_ans => $original_student_answer,
ans_message => $PGanswerMessage,
type => 'typeString',
preview_text_string => $preview_text_string,
preview_latex_string => $preview_latex_string
$ans_hash{score} -- a number between 0 and 1 indicating
whether the answer is correct. Fractions
allow the implementation of partial
credit for incorrect answers.
$ans_hash{correct_ans} -- The correct answer, as supplied by the
instructor and then formatted. This can
be viewed by the student after the answer date.
$ans_hash{student_ans} -- This is the student answer, after reformatting;
for example the answer might be forced
to capital letters for comparison with
the instructors answer. For a numerical
answer, it gives the evaluated answer.
This is displayed in the section reporting
the results of checking the student answers.
$ans_hash{original_student_ans} -- This is the original student answer. This is displayed
on the preview page and may be used for sticky answers.
$ans_hash{ans_message} -- Any error message, or hint provided by the answer evaluator.
This is also displayed in the section reporting
the results of checking the student answers.
$ans_hash{type} -- A string indicating the type of answer evaluator. This
helps in preprocessing the student answer for errors.
Some examples:
'number_with_units'
'function'
'frac_number'
'arith_number'
$ans_hash{preview_text_string} -- This typically shows how the student answer was parsed. It is
displayed on the preview page. For a student answer of 2sin(3x)
this would be 2*sin(3*x). For string answers it is typically the
same as $ans_hash{student_ans}.
$ans_hash{preview_latex_string -- THIS IS OPTIONAL. This is latex version of the student answer
which is used to show a typeset view on the answer on the preview
page. For a student answer of 2/3, this would be \frac{2}{3}.
Technical note: the routines in this file are not actually answer evaluators. Instead, they create
answer evaluators. An answer evaluator is an anonymous subroutine, referenced by a named scalar. The
routines in this file build the subroutine and return a reference to it. Later, when the student
actually enters an answer, the problem processor feeds that answer to the referenced subroutine, which
evaluates it and returns a score (usually 0 or 1). For most users, this distinction is unimportant, but
if you plan on writing your own answer evaluators, you should understand this point.
=cut
BEGIN {
be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
}
my $BR = $main::BR; # convenient localizations.
my $PAR = $main::PAR;
# import defaults
# these are now imported from the %envir variable
my $numRelPercentTolDefault = $main::numRelPercentTolDefault;
my $numZeroLevelDefault = $main::numZeroLevelDefault;
my $numZeroLevelTolDefault = $main::numZeroLevelTolDefault;
my $numAbsTolDefault = $main::numAbsTolDefault;
my $numFormatDefault = $main::numFormatDefault;
my $functRelPercentTolDefault = $main::functRelPercentTolDefault;
my $functZeroLevelDefault = $main::functZeroLevelDefault;
my $functZeroLevelTolDefault = $main::functZeroLevelTolDefault;
my $functAbsTolDefault = $main::functAbsTolDefault;
my $functNumOfPoints = $main::functNumOfPoints;
my $functVarDefault = $main::functVarDefault;
my $functLLimitDefault = $main::functLLimitDefault;
my $functULimitDefault = $main::functULimitDefault;
my $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration;
##########################################################################
##########################################################################
## Number answer evaluators
=head2 Number Answer Evaluators
Number answer evaluators take in a numerical answer, compare it to the correct answer,
and return a score. In addition, they can choose to accept or reject an answer based on
its format, closeness to the correct answer, and other criteria. There are two types
of numerical answer evaluators: num_cmp(), which takes a hash of named options as parameters,
and the "mode"_num_cmp() variety, which use different functions to access different sets of
options. In addition, there is the special case of std_num_str_cmp(), which can evaluate
both numbers and strings.
Numerical Comparison Options
correctAnswer -- This is the correct answer that the student answer will
be compared to. However, this does not mean that the
student answer must match this exactly. How close the
student answer must be is determined by the other
options, especially tolerance and format.
tolerance -- These options determine how close the student answer
must be to the correct answer to qualify. There are two
types of tolerance: relative and absolute. Relative
tolerances are given in percentages. A relative
tolerance of 1 indicates that the student answer must
be within 1% of the correct answer to qualify as correct.
In other words, a student answer is correct when
abs(studentAnswer - correctAnswer) <= abs(.01*relpercentTol*correctAnswer)
Using absolute tolerance, the student answer must be a
fixed distance from the correct answer to qualify.
For example, an absolute tolerance of 5 means that any
number which is +-5 of the correct answer qualifies as correct.
Final (rarely used) tolerance options are zeroLevel
and zeroLevelTol, used in conjunction with relative
tolerance. if correctAnswer has absolute value less than
or equal to zeroLevel, then the student answer must be,
in absolute terms, within zeroLevelTol of correctAnswer, i.e.,
abs(studentAnswer - correctAnswer) <= zeroLevelTol.
In other words, if the correct answer is very near zero,
an absolute tolerance will be used. One must do this to
handle floating point answers very near zero, because of
the inaccuracy of floating point arithmetic. However, the
default values are almost always adequate.
mode -- This determines the allowable methods for entering an
answer. Answers which do not meet this requirement will
be graded as incorrect, regardless of their numerical
value. The recognized modes are:
'std' (default) -- allows any expression which evaluates
to a number, including those using
elementary functions like sin() and
exp(), as well as the operations of
arithmetic (+, -, *, /, ^)
'strict' -- only decimal numbers are allowed
'frac' -- whole numbers and fractions are allowed
'arith' -- arithmetic expressions are allowed, but
no functions
Note that all modes allow the use of "pi" and "e" as
constants, and also the use of "E" to represent scientific
notation.
format -- The format to use when displaying the correct and
submitted answers. This has no effect on how answers are
evaluated; it is only for cosmetic purposes. The
formatting syntax is the same as Perl uses for the sprintf()
function. Format strings are of the form '%m.nx' or '%m.nx#',
where m and n are described below, and x is a formatter.
Esentially, m is the minimum length of the field
(make this negative to left-justify). Note that the decimal
point counts as a character when determining the field width.
If m begins with a zero, the number will be padded with zeros
instead of spaces to fit the field.
The precision specifier (n) works differently, depending
on which formatter you are using. For d, i, o, u, x and X
formatters (non-floating point formatters), n is the minimum
number of digits to display. For e and f, it is the number of
digits that appear after the decimal point (extra digits will
be rounded; insufficient digits will be padded with spaces--see
'#' below). For g, it is the number of significant digits to
display.
The full list of formatters can be found in the manpage
for printf(3), or by typing "perldoc -f sprintf" at a
terminal prompt. The following is a brief summary of the
most frequent formatters:
d -- decimal number
ld -- long decimal number
u -- unsigned decimal number
lu -- long unsigned decimal number
x -- hexadecimal number
o -- octal number
e -- floating point number in scientific notation
f -- floating point number
g -- either e or f, whichever takes less space
Technically, g will use e if the exponent is less than -4 or
greater than or equal to the precision. Trailing zeros are
removed in this mode.
If the format string ends in '#', trailing zeros will be
removed in the decimal part. Note that this is not a standard
syntax; it is handled internally by WeBWorK and not by Perl
(although this should not be a concern to end users).
The default format is '%0.5f#', which displays as a floating
point number with 5 digits of precision and no trailing zeros.
Other useful format strings might be '%0.2f' for displaying
dollar amounts, or '%010d' to display an integer with leading
zeros. Setting format to an empty string ( '' ) means no
formatting will be used; this will show 'arbitrary' precision
floating points.
Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
Format -- $numFormatDefault -- "%0.5f#"
Relative Tolerance -- $numRelPercentTolDefault -- .1
Absolute Tolerance -- $numAbsTolDefault -- .001
Zero Level -- $numZeroLevelDefault -- 1E-14
Zero Level Tolerance -- $numZeroLevelTolDefault -- 1E-12
=cut
=head3 "mode"_num_cmp() functions
There are 16 functions total, 4 for each mode (std, frac, strict, arith). Each mode has
one "normal" function, one which accepts a list of answers, one which uses absolute
rather than relative tolerance, and one which uses absolute tolerance and accepts a list.
The "std" family is documented below; all others work precisely the same.
std_num_cmp($correctAnswer) OR
std_num_cmp($correctAnswer, $relPercentTol) OR
std_num_cmp($correctAnswer, $relPercentTol, $format) OR
std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel) OR
std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol)
$correctAnswer -- the correct answer
$relPercentTol -- the tolerance, as a percentage (optional)
$format -- the format of the displayed answer (optional)
$zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies (optional)
$zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero (optional)
std_num_cmp() uses standard mode (arithmetic operations and elementary
functions allowed) and relative tolerance. Options are specified by
one or more parameters. Note that if you wish to set an option which
is later in the parameter list, you must set all previous options.
std_num_cmp_abs($correctAnswer) OR
std_num_cmp_abs($correctAnswer, $absTol) OR
std_num_cmp_abs($correctAnswer, $absTol, $format)
$correctAnswer -- the correct answer
$absTol -- an absolute tolerance (optional)
$format -- the format of the displayed answer (optional)
std_num_cmp_abs() uses standard mode and absolute tolerance. Options
are set as with std_num_cmp(). Note that $zeroLevel and $zeroLevelTol
do not apply with absolute tolerance.
std_num_cmp_list($relPercentTol, $format, @answerList)
$relPercentTol -- the tolerance, as a percentage
$format -- the format of the displayed answer(s)
@answerList -- a list of one or more correct answers
std_num_cmp_list() uses standard mode and relative tolerance. There
is no way to set $zeroLevel or $zeroLevelTol. Note that no
parameters are optional. All answers in the list will be
evaluated with the same set of parameters.
std_num_cmp_abs_list($absTol, $format, @answerList)
$absTol -- an absolute tolerance
$format -- the format of the displayed answer(s)
@answerList -- a list of one or more correct answers
std_num_cmp_abs_list() uses standard mode and absolute tolerance.
Note that no parameters are optional. All answers in the list will be
evaluated with the same set of parameters.
arith_num_cmp(), arith_num_cmp_list(), arith_num_cmp_abs(), arith_num_cmp_abs_list()
strict_num_cmp(), strict_num_cmp_list(), strict_num_cmp_abs(), strict_num_cmp_abs_list()
frac_num_cmp(), frac_num_cmp_list(), frac_num_cmp_abs(), frac_num_cmp_abs_list()
Examples:
ANS( strict_num_cmp( 3.14159 ) ) -- The student answer must be a number
in decimal or scientific notation which is within .1 percent of 3.14159.
This assumes $numRelPercentTolDefault has been set to .1.
ANS( strict_num_cmp( $answer, .01 ) ) -- The student answer must be a
number within .01 percent of $answer (e.g. 3.14159 if $answer is 3.14159
or $answer is "pi" or $answer is 4*atan(1)).
ANS( frac_num_cmp( $answer) ) or ANS( frac_num_cmp( $answer,.01 )) --
The student answer can be a number or fraction, e.g. 2/3.
ANS( arith_num_cmp( $answer) ) or ANS( arith_num_cmp( $answer,.01 )) --
The student answer can be an arithmetic expression, e.g. (2+3)/7-2^.5 .
ANS( std_num_cmp( $answer) ) or ANS( std_num_cmp( $answer,.01 )) --
The student answer can contain elementary functions, e.g. sin(.3+pi/2)
=cut
sub std_num_cmp { # compare numbers allowing use of elementary functions
my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'std',
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
## Similar to std_num_cmp but accepts a list of numbers in the form
## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
## You must enter a format and tolerance
sub std_num_cmp_list {
my ( $relPercentTol, $format, @answerList) = @_;
NUM_CMP_LIST( 'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'std',
'zeroLevel' => $numZeroLevelDefault,
'zeroLevelTol' => $numZeroLevelTolDefault,
'answerList' => \@answerList
);
}
sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
my ( $correctAnswer, $absTol, $format) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'std',
'zeroLevel' => 0,
'zeroLevelTol' => 0
);
}
## See std_num_cmp_list for usage
sub std_num_cmp_abs_list {
my ( $absTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'std',
'zeroLevel' => 0,
'zeroLevelTol' => 0,
'answerList' => \@answerList
);
}
sub frac_num_cmp { # only allow fractions and numbers as submitted answer
my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'frac',
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
## See std_num_cmp_list for usage
sub frac_num_cmp_list {
my ( $relPercentTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'frac',
'zeroLevel' => $numZeroLevelDefault,
'zeroLevelTol' => $numZeroLevelTolDefault,
'answerList' => \@answerList
);
}
sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
my ( $correctAnswer, $absTol, $format ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'frac',
'zeroLevel' => 0,
'zeroLevelTol' => 0
);
}
## See std_num_cmp_list for usage
sub frac_num_cmp_abs_list {
my ( $absTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'frac',
'zeroLevel' => 0,
'zeroLevelTol' => 0,
'answerList' => \@answerList
);
}
sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'arith',
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
## See std_num_cmp_list for usage
sub arith_num_cmp_list {
my ( $relPercentTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'arith',
'zeroLevel' => $numZeroLevelDefault,
'zeroLevelTol' => $numZeroLevelTolDefault,
'answerList' => \@answerList
);
}
sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
my ( $correctAnswer, $absTol, $format ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'arith',
'zeroLevel' => 0,
'zeroLevelTol' => 0
);
}
## See std_num_cmp_list for usage
sub arith_num_cmp_abs_list {
my ( $absTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'arith',
'zeroLevel' => 0,
'zeroLevelTol' => 0,
'answerList' => \@answerList
);
}
sub strict_num_cmp { # only allow numbers as submitted answer
my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'strict',
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
## See std_num_cmp_list for usage
sub strict_num_cmp_list { # compare numbers
my ( $relPercentTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $relPercentTol,
'tolType' => 'relative',
'format' => $format,
'mode' => 'strict',
'zeroLevel' => $numZeroLevelDefault,
'zeroLevelTol' => $numZeroLevelTolDefault,
'answerList' => \@answerList
);
}
sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
my ( $correctAnswer, $absTol, $format ) = @_;
NUM_CMP( 'correctAnswer' => $correctAnswer,
'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'strict',
'zeroLevel' => 0,
'zeroLevelTol' => 0
);
}
## See std_num_cmp_list for usage
sub strict_num_cmp_abs_list { # compare numbers
my ( $absTol, $format, @answerList ) = @_;
NUM_CMP_LIST( 'tolerance' => $absTol,
'tolType' => 'absolute',
'format' => $format,
'mode' => 'strict',
'zeroLevel' => 0,
'zeroLevelTol' => 0,
'answerList' => \@answerList
);
}
## Compares a number with units
## Deprecated; use num_cmp()
##
## IN: a string which includes the numerical answer and the units
## a hash with the following keys (all optional):
## mode -- 'std', 'frac', 'arith', or 'strict'
## format -- the format to use when displaying the answer
## tol -- an absolute tolerance, or
## relTol -- a relative tolerance
## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
sub numerical_compare_with_units {
my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
my %options = @_; # all of the other inputs are (key value) pairs
# handle the defaults
$options{'mode'} = 'std' unless defined( $options{'mode'} );
$options{'format'} = $numFormatDefault unless defined( $options{'format'} );
$options{'zeroLevel'} = $numZeroLevelDefault unless defined( $options{'zeroLevel'} );
$options{'zeroLevelTol'} = $numZeroLevelTolDefault unless defined( $options{'zeroLevelTol'} );
# both spellings are maintained for backward compatibility
# relTol is preferred
if( defined $options{'reltol'} ) {
$options{'relTol'} = $options{'reltol'};
delete $options{'reltol'};
}
my ($tol, $tolerance_mode);
if ( defined $options{'tol'} ) {
$tol = $options{'tol'};
$tolerance_mode = 'absolute';
}
elsif( defined $options{'relTol'} ) {
$tol = $options{'relTol'};
$tolerance_mode = 'relative';
}
else { #the default is a relative tolerance
$tol = $numRelPercentTolDefault;
$tolerance_mode = 'relative';
}
# Prepare the correct answer
$correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
# it surprises me that the match below works since the first .* is greedy.
my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
my %correct_units = Units::evaluate_units($correct_units);
if ( defined( $correct_units{'ERROR'} ) ) {
die "ERROR: The answer \"$correct_answer\" in the problem definition cannot be parsed:\n" .
"$correct_units{'ERROR'}\n";
}
my $ans_evaluator = sub {
my $ans = shift;
$ans = '' unless defined($ans);
my $original_student_ans = $ans;
$ans = str_filters( $ans, 'trim_whitespace' );
my $ans_hash = new AnswerHash(
'score' => 0,
'correct_ans' => spf($correct_num_answer,$options{'format'}) . " $correct_units",
'student_ans' => $ans,
'ans_message' => '',
'type' => 'num_cmp_with_units',
'preview_text_string' => '',
'original_student_ans' => $original_student_ans
);
# it surprises me that the match below works since the first .* is greedy.
my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
unless ( defined($num_answer) && $units ) {
# there is an error reading the input
if ( $ans =~ /\S/ ) { # the answer is not blank
$ans_hash -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
"as a number or an arithmetic expression followed by a unit specification. " .
"Your answer must contain units." );
}
return $ans_hash;
}
# we have been able to parse the answer into a numerical part and a unit part
$num_answer = $1; #$1 and $2 from the regular expression above
$units = $2;
my %units = Units::evaluate_units($units);
if ( defined( $units{'ERROR'} ) ) {
# handle error condition
$units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
$ans_hash -> setKeys( 'ans_message' => "$units{'ERROR'}" );
return $ans_hash;
}
my $units_match = 1;
my $fund_unit;
foreach $fund_unit (keys %correct_units) {
next if $fund_unit eq 'factor';
$units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
}
if ( $units_match ) {
# units are ok. Evaluate the numerical part of the answer
$tol = $tol * $correct_units{'factor'}/$units{'factor'} if
$tolerance_mode eq 'absolute'; # the tolerance is in the units specified by the instructor.
my $numerical_answer_evaluator = NUM_CMP( 'correctAnswer' => $correct_num_answer*$correct_units{'factor'}/$units{'factor'},
'tolerance' => $tol,
'tolType' => $tolerance_mode,
'format' => $options{'format'},
'mode' => $options{'mode'},
'zeroLevel' => $options{'zeroLevel'},
'zeroLevelTol' => $options{'zeroLevelTol'} );
# because num_answer may contain an arithmetic expression rather than
# a number we can't multiply it by the $units{'factor'}
# instead we divide the correct answer by this amount;
# this is also why the numerical_answer_evaluator is not defined outside this subroutine.
$ans_hash = &$numerical_answer_evaluator($num_answer);
# now we need to doctor the correct answer in order to add units
# to it and correct for the division we did before
$ans_hash -> {correct_ans} =
prfmt( ( $ans_hash->{'correct_ans'} )*$units{'factor'}/$correct_units{'factor'},
$options{'format'} ) . " $correct_units";
# we also need to doctor the submitted answer to get it back in its original format.
# we don't add the units on if there is an error message from numerical_answer_evaluator
if ( ( $ans_hash -> {ans_message} ) =~ /^\s*$/ ) {
$ans_hash -> {student_ans} = $ans_hash -> {student_ans} . " $units";
$ans_hash -> setKeys( original_student_ans => $ans );
}
else {
# error message from numerical_answer_evaluator doesn't have units tacked on
$ans_hash -> setKeys( original_student_ans => $ans );
}
}
else {
$ans_hash -> setKeys( ans_message => 'There is an error in the units for this answer.' );
}
return $ans_hash;
};
$ans_evaluator;
}
=head3 std_num_str_cmp()
NOTE: This function is maintained for compatibility. num_cmp() with the
'strings' parameter is slightly preferred.
std_num_str_cmp() is used when the correct answer could be either a number or a
string. For example, if you wanted the student to evaluate a function at number
of points, but write "Inf" or "Minf" if the function is unbounded. This routine
will provide error messages that do not give a hint as to whether the correct
answer is a string or a number. For numerical comparisons, std_num_cmp() is
used internally; for string comparisons, std_str_cmp() is used.
std_num_str_cmp( $correctAnswer ) OR
std_num_str_cmp( $correctAnswer, $ra_legalStrings ) OR
std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol ) OR
std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format ) OR
std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format, $zeroLevel ) OR
std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format,
$zeroLevel, $zeroLevelTol )
$correctAnswer -- the correct answer
$ra_legalStrings -- a reference to an array of legal strings, e.g. ["str1", "str2"]
$relPercentTol -- the error tolerance as a percentage
$format -- the display format
$zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
$zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
Example:
ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
=cut
sub std_num_str_cmp {
my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
$ra_legalStrings = [''] unless defined $ra_legalStrings;
my @legalStrings = @{$ra_legalStrings};
my $ans_evaluator = sub {
my $ans = shift;
my $ans_hash;
my $corrAnswerIsString = 0;
# my $studAnswerIsString = 0; ## uses new incorrect logic
my $studAnswerIsString = 1;
my $legalString = '';
foreach $legalString (@legalStrings) {
if ( uc($correctAnswer) eq uc($legalString) ) {
$corrAnswerIsString = 1;
last;
}
} ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
# Neither of these is perfect; the first is more general, but
# has problems with certain special strings like "ee", while the
# second doesn't support arithmetic expressions.
#
# if( $ans !~ m/^\s*([\+\-\*\/\^\(\)\[\]\{\}\s\d\.Ee]*|e|pi)\s*$/ ) {
# $studAnswerIsString = 1;
# }
#if( $ans !~ m/^\s*([\d+\-*\/^()]|e|pi)\s*$/ ) {
# $studAnswerIsString = 1;
#}
## Both the above new versions are incorrect. We replace this by the original logic namely that
## an answer that contain any of the symbols
## a digit(0-9), +, -, *, /, ^, (, ), {, }, [, ]
## or an answer that consists of "pi" or "e" alone
## will be considered an arithmetic expression rather than a string answer.
if ($ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {$studAnswerIsString = 0;}
## at this point $studAnswerIsString = 0 iff correct answer is numeric
if( $studAnswerIsString ) {
$ans = str_filters( $ans, 'compress_whitespace' )
}
if ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 1) ) {
my $string_answer_evaluator = std_str_cmp( $correctAnswer );
$ans_hash = &$string_answer_evaluator( $ans );
if( ($ans_hash -> {score}) != 1 ) { ## find out if string makes sense
my $sensibleAnswer = 0;
foreach $legalString (@legalStrings) {
if ( uc($ans) eq uc($legalString) ) {
$sensibleAnswer = 1;
last;
}
}
$sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
$ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' )
unless ($sensibleAnswer);
$ans_hash -> setKeys( 'student_ans' => uc($ans) );
}
}
elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 0) ) {
my $numeric_answer_evaluator = std_num_cmp($correctAnswer,$relpercentTol,$format,$zeroLevel,$zeroLevelTol);
$ans_hash = &$numeric_answer_evaluator($ans);
}
elsif ( ($corrAnswerIsString == 1) and ($studAnswerIsString == 0) ) {
my $numeric_answer_evaluator = std_num_cmp(1);
$ans_hash = &$numeric_answer_evaluator($ans);
$ans_hash -> setKeys( 'score' => 0,
'correct_ans' => $correctAnswer
);
}
elsif ( ($corrAnswerIsString == 0) and ($studAnswerIsString == 1) ) {
my $string_answer_evaluator = std_str_cmp('bad');
$ans_hash = &$string_answer_evaluator($ans);
$ans_hash -> setKeys( 'score' => 0,
'correct_ans' => $correctAnswer
);
## find out if string makes sense
my $sensibleAnswer = 0;
foreach $legalString (@legalStrings) {
if ( uc($ans) eq uc($legalString) ) {
$sensibleAnswer = 1;
last;
}
}
$sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
$ans_hash -> setKeys( 'ans_message' => "Your answer is not a recognized answer" )
unless $sensibleAnswer;
}
return $ans_hash;
};
return $ans_evaluator;
}
=head3 num_cmp()
Compares a number or a list of numbers, using a named hash of options to set
parameters. This can make for more readable code than using the "mode"_num_cmp()
style, but some people find one or the other easier to remember.
ANS( num_cmp( answer or answer_array_ref, options_hash ) );
1. the correct answer, or a reference to an array of correct answers
2. a hash with the following keys (all optional):
mode -- 'std' (default) (allows any expression evaluating to a number)
'strict' (only numbers are allowed)
'frac' (fractions are allowed)
'arith' (arithmetic expressions allowed)
format -- '%0.5f#' (default); defines formatting for the correct answer
tol -- an absolute tolerance, or
relTol -- a relative tolerance
units -- the units to use for the answer(s)
strings -- a reference to an array of strings which are valid
answers (works like std_num_str_cmp() )
zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
zeroLevelTol -- absolute tolerance to allow when answer is close to zero
Returns an answer evaluator, or (if given a reference to an array of
answers), a list of answer evaluators. Note that a reference to an array of
answers results is just a shortcut to writing a separate cum_cmp() for each
answer. It does not mean that any of those answers are considered correct
for one question.
EXAMPLES:
num_cmp( 5 ) -- correct answer is 5, using defaults for all options
num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7, using defaults for all options
num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict
num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6, both with 5% relative tolerance
num_cmp( 6, strings => ["Inf", "Minf", "NaN"] ) -- correct answer is 6, "Inf", "Minf", and "NaN"
recognized as valid answers
=cut
sub num_cmp {
my $correctAnswer = shift @_;
my @opt = @_;
my %known_options = ( 'mode' => 'std',
'format' => $numFormatDefault,
'tol' => $numAbsTolDefault,
'relTol' => $numRelPercentTolDefault,
'units' => undef,
'strings' => undef,
'zeroLevel' => $numZeroLevelDefault,
'zeroLevelTol' => $numZeroLevelTolDefault,
'reltol' => undef, #alternate spelling
'unit' => undef #alternate spelling
);
my %in_options;
my @output_list;
my %out_options;
unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
# unless the first parameter is a list of arrays
# or the second parameter is a known option or
# no options were used,
# use the old num_cmp which does not use options, but has inputs
# $relPercentTol,$format,$zeroLevel,$zeroLevelTol
warn "This method of using num_cmp() is deprecated. Please rewrite this" .
" problem using the options style of parameter passing (or" .
" check that your first option is spelled correctly).";
my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
%out_options = ( 'relTol' => $relPercentTol,
'format' => $format,
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol,
'mode' => 'std'
);
}
else {
# handle options
check_option_list( @opt );
%in_options = @opt;
# both spellings maintained for compatibility
# relTol is preferred
if( defined( $in_options{'reltol'} ) ) {
$in_options{'relTol'} = $in_options{'reltol'};
delete $in_options{'reltol'};
}
# both spellings maintained for compatibility
# units is preferred
if( defined( $in_options{'unit'} ) ) {
$in_options{'units'} = $in_options{'unit'};
delete $in_options{'unit'};
}
# can't use both units and strings
if( defined( $in_options{'units'} ) && defined( $in_options{'strings'} ) ) {
warn "Can't use both 'units' and 'strings' in the same problem " .
"(check your parameters to num_cmp() )";
}
#%out_options = %known_options;
foreach my $opt_name (keys %in_options) {
if( exists( $known_options{$opt_name} ) ) {
$out_options{$opt_name} = $in_options{$opt_name};
}
else {
die "Option $opt_name is not defined for num_cmp. Answer is $correctAnswer; " .
"Default options are: ", display_options(%known_options);
}
}
}
# set tolerance flags -- note that the order of testing means that
# relative tolerance is the default
my ($tolType, $tol);
if ( defined( $out_options{'tol'} ) ) {
$tolType = 'absolute';
$tol = $out_options{'tol'};
}
else {
$tolType = 'relative';
$tol = $out_options{'relTol'};
}
# thread over lists
my @ans_list = ();
if ( ref($correctAnswer) eq 'ARRAY' ) {
@ans_list = @{$correctAnswer};
}
else {
push( @ans_list, $correctAnswer );
}
# produce answer evaluators
foreach my $ans (@ans_list) {
if( defined( $out_options{'units'} ) ) {
$ans = "$ans $out_options{'units'}";
push( @output_list, numerical_compare_with_units($ans, %out_options) );
}
elsif( defined( $out_options{'strings'} ) ) {
if( defined $out_options{'tol'} ) {
warn "You are using 'tol' (for absolute tolerance) with a num/str " .
"compare, which currently only uses relative tolerance. The default " .
"tolerance will be used.";
}
push( @output_list, std_num_str_cmp( $ans, $out_options{'strings'},
$out_options{'relTol'},
$out_options{'format'},
$out_options{'zeroLevel'},
$out_options{'zeroLevelTol'}
)
);
}
else {
push(@output_list,
NUM_CMP( 'correctAnswer' => $ans,
'tolerance' => $tol,
'tolType' => $tolType,
'format' => $out_options{'format'},
'mode' => $out_options{'mode'},
'zeroLevel' => $out_options{'zeroLevel'},
'zeroLevelTol' => $out_options{'zeroLevelTol'},
),
);
}
}
return @output_list;
}
#legacy code for compatability purposes
sub num_rel_cmp { # compare numbers
std_num_cmp( @_ );
}
## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
##
## IN: a hash containing the following items (error-checking to be added later?):
## correctAnswer -- the correct answer
## tolerance -- the allowable margin of error
## tolType -- 'relative' or 'absolute'
## format -- the display format of the answer
## mode -- one of 'std', 'strict', 'arith', or 'frac';
## determines allowable formats for the input
## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
sub NUM_CMP { # low level numeric compare
my %num_params = @_;
my $correctAnswer = $num_params{'correctAnswer'};
my $tol = $num_params{'tolerance'};
my $tolType = $num_params{'tolType'};
my $format = $num_params{'format'};
my $mode = $num_params{'mode'};
my $zeroLevel = $num_params{'zeroLevel'};
my $zeroLevelTol = $num_params{'zeroLevelTol'};
if( $tolType eq 'relative' ) {
$tol = $numRelPercentTolDefault unless defined $tol;
$tol *= .01;
}
else {
$tol = $numAbsTolDefault unless defined $tol;
}
$format = $numFormatDefault unless defined $format;
$mode = 'std' unless defined $mode;
$zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
$zeroLevelTol = $numZeroLevelTolDefault unless defined $zeroLevelTol;
my $formattedCorrectAnswer = prfmt( $correctAnswer, $format );
my $answer_evaluator = sub {
my $in = shift @_;
$in = '' unless defined $in;
my $score = 0;
my $original_student_answer = $in;
my $parser = new AlgParserWithImplicitExpand;
my $ret = $parser -> parse($in);
my $preview_text_string = '';
my $preview_latex_string = '';
if ( ref($ret) ) { ## parsed successfully
$parser -> tostring();
$parser -> normalize();
$in = $parser -> tostring();
$preview_text_string = $in;
$preview_latex_string = $parser -> tolatex();
}
else { ## error in parsing
my $ans_hash = new AnswerHash(
'score' => $score,
'correct_ans' => $formattedCorrectAnswer,
'student_ans' => "error: $parser->{htmlerror}",
'ans_message' => $parser -> {error_msg},
'type' => "${mode}_number",
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
}
my $PGanswerMessage = '';
my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
$inVal = '';
$correctAnswer = math_constants($correctAnswer);
my $formattedSubmittedAnswer = '';
#special variable $@ holds the last error from a Perl eval statement
$@='';
if ($correctAnswer =~ /\S/) {
($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correctAnswer);
}
else {
$PG_eval_errors = ' ';
}
if ( $PG_eval_errors or not is_a_number($correctVal) ) { ##error message from eval or above
$formattedSubmittedAnswer = $PG_eval_errors;
$formattedSubmittedAnswer = clean_up_error_msg($formattedSubmittedAnswer);
$PGanswerMessage = 'Tell your professor that there is an error in this problem';
my $ans_hash = new AnswerHash(
'score' => $score,
'correct_ans' => $formattedCorrectAnswer,
'student_ans' => $formattedSubmittedAnswer,
'ans_message' => $PGanswerMessage,
'type' => 'number',
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
}
$in = &math_constants($in);
MODE_CASE: { ## bare block for "case" statement
if ($mode eq 'std') {
last MODE_CASE;
}
elsif ($mode eq 'strict') {
unless (is_a_number($in)) {
$PGanswerMessage = 'You must enter a number, e.g. -6, 5.3, or 6.12E-3';
$formattedSubmittedAnswer = 'Incorrect number format';
}
else {
last MODE_CASE;
}
}
elsif ($mode eq 'arith') {
unless (is_an_arithmetic_expression($in)) {
$PGanswerMessage = 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2';
$formattedSubmittedAnswer = 'Not an arithmetic expression';
}
else {
last MODE_CASE;
}
}
elsif ($mode eq 'frac') {
unless (is_a_fraction($in)) {
$PGanswerMessage = 'You must enter a number or fraction , e.g. -6 or 7/13';
$formattedSubmittedAnswer = 'Not a number or fraction';
}
else {
last MODE_CASE;
}
}
else {
$PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
$formattedSubmittedAnswer = $in;
}
my $ans_hash = new AnswerHash(
score => $score,
correct_ans => $formattedCorrectAnswer,
student_ans => $formattedSubmittedAnswer,
ans_message => $PGanswerMessage,
type => "${mode}_number",
preview_text_string => $preview_text_string,
preview_latex_string => $preview_latex_string,
original_student_ans => $original_student_answer
);
return $ans_hash;
} # end of MODE_CASES bare block
$@ = '';
if ($in =~ /\S/) {
($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
}
else {
$PG_eval_errors = ' ';
}
if ($PG_eval_errors) { ##error message from eval or above
$formattedSubmittedAnswer = $PG_eval_errors;
$formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer);
$PGanswerMessage = 'There is a syntax error in your answer';
$PGanswerMessage = '' if $PG_eval_errors eq ' ';
my $ans_hash = new AnswerHash(
'score' => $score,
'correct_ans' => $formattedCorrectAnswer,
'student_ans' => $formattedSubmittedAnswer,
'ans_message' => $PGanswerMessage,
'type' => "${mode}_number",
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
}
else {
$formattedSubmittedAnswer = prfmt($inVal,$format);
}
my $permitted_error;
if (defined($tolType) && $tolType eq 'absolute') {
$permitted_error = $tol;
}
elsif ( abs($correctVal) <= $zeroLevel) {
$permitted_error = $zeroLevelTol; ## want $tol to be non zero
}
else {
$permitted_error = abs($tol*$correctVal);
}
my $is_a_number = is_a_number($inVal);
$score = 1 if ( ($is_a_number) and
(abs( $inVal - $correctVal ) <= $permitted_error) );
if ($PG_eval_errors) {
$PGanswerMessage = 'There is a syntax error in your answer';
}
elsif (not $is_a_number) {
$PGanswerMessage = 'Your answer does not evaluate to a number';
}
my $ans_hash = new AnswerHash(
'score' => $score,
'correct_ans' => $formattedCorrectAnswer,
'student_ans' => $formattedSubmittedAnswer,
'ans_message' => $PGanswerMessage,
'type' => "${mode}_number",
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
};
return $answer_evaluator;
}
## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
sub NUM_CMP_LIST { # low level numeric list compare
my %num_params = @_;
my @outputList;
my $ans;
while ( @{$num_params{'answerList'}} ) {
$ans = shift @{$num_params{'answerList'}};
push( @outputList, NUM_CMP( 'correctAnswer' => $ans,
'tolerance' => $num_params{'tolerance'},
'tolType' => $num_params{'tolType'},
'format' => $num_params{'format'},
'mode' => $num_params{'mode'},
'zeroLevel' => $num_params{'zeroLevel'},
'zeroLevelTol' => $num_params{'zeroLevelTol'}
)
);
}
return @outputList;
}
##########################################################################
##########################################################################
## Function answer evaluators
=head2 Function Answer Evaluators
Function answer evaluators take in a function, compare it numerically to a
correct function, and return a score. They can require an exactly equivalent
function, or one that is equal up to a constant. They can accept or reject an
answer based on specified tolerances for numerical deviation.
Function Comparison Options
correctEqn -- The correct equation, specified as a string. It may include
all basic arithmetic operations, as well as elementary
functions. Variable usage is described below.
Variables -- The independent variable(s). When comparing the correct
equation to the student equation, each variable will be
replaced by a certain number of numerical values. If
the student equation agrees numerically with the correct
equation, they are considered equal. Note that all
comparison is numeric; it is possible (although highly
unlikely and never a practical concern) for two unequal
functions to yield the same numerical results.
Limits -- The limits of evaluation for the independent variables.
Each variable is evaluated only in the half-open interval
[lower_limit, upper_limit). This is useful if the function
has a singularity or is not defined in a certain range.
For example, the function "sqrt(-1-x)" could be evaluated
in [-2,-1).
Tolerance -- Tolerance in function comparisons works exactly as in
numerical comparisons; see the numerical comparison
documentation for a complete description. Note that the
tolerance does applies to the function as a whole, not
each point individually.
Number of -- Specifies how many points to evaluate each variable at. This
Points is typically 3, but can be set higher if it is felt that
there is a strong possibility of "false positives."
Maximum -- Sets the maximum size of the constant of integration. For
Constant of technical reasons concerning floating point arithmetic, if
Integration the additive constant, i.e., the constant of integration, is
greater (in absolute value) than maxConstantOfIntegration
AND is greater than maxConstantOfIntegration times the
correct value, WeBWorK will give an error message saying
that it can not handle such a large constant of integration.
This is to prevent e.g. cos(x) + 1E20 or even 1E20 as being
accepted as a correct antiderivatives of sin(x) since
floating point arithmetic cannot tell the difference
between cos(x) + 1E20, 1E20, and -cos(x) + 1E20.
Technical note: if you examine the code for the function routines, you will see
that most subroutines are simply doing some basic error-checking and then
passing the parameters on to the low-level FUNCTION_CMP(). Because this routine
is set up to handle multivariable functions, with single-variable functions as
a special case, it is possible to pass multivariable parameters to single-
variable functions. This usage is strongly discouraged as unnecessarily
confusing. Avoid it.
Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
Variable -- $functVarDefault -- 'x'
Relative Tolerance -- $functRelPercentTolDefault -- .1
Absolute Tolerance -- $functAbsTolDefault -- .001
Lower Limit -- $functLLimitDefault -- .0000001
Upper Limit -- $functULimitDefault -- 1
Number of Points -- $functNumOfPoints -- 3
Zero Level -- $functZeroLevelDefault -- 1E-14
Zero Level Tolerance -- $functZeroLevelTolDefault -- 1E-12
Maximum Constant -- $functMaxConstantOfIntegration -- 1E8
of Integration
=cut
=head3 Single-variable Function Comparisons
There are four single-variable function answer evaluators: "normal," absolute
tolerance, antiderivative, and antiderivative with absolute tolerance. All
parameters (other than the correct equation) are optional.
function_cmp( $correctEqn ) OR
function_cmp( $correctEqn, $var ) OR
function_cmp( $correctEqn, $var, $llimit, $ulimit ) OR
function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol ) OR
function_cmp( $correctEqn, $var, $llimit, $ulimit,
$relPercentTol, $numPoints ) OR
function_cmp( $correctEqn, $var, $llimit, $ulimit,
$relPercentTol, $numPoints, $zeroLevel ) OR
function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol, $numPoints,
$zeroLevel,$zeroLevelTol )
$correctEqn -- the correct equation, as a string
$var -- the string representing the variable (optional)
$llimit -- the lower limit of the interval to evaluate the
variable in (optional)
$ulimit -- the upper limit of the interval to evaluate the
variable in (optional)
$relPercentTol -- the error tolerance as a percentage (optional)
$numPoints -- the number of points at which to evaluate the
variable (optional)
$zeroLevel -- if the correct answer is this close to zero, then
zeroLevelTol applies (optional)
$zeroLevelTol -- absolute tolerance to allow when answer is close to zero
function_cmp() uses standard comparison and relative tolerance. It takes a
string representing a single-variable function and compares the student
answer to that function numerically.
function_cmp_up_to_constant( $correctEqn ) OR
function_cmp_up_to_constant( $correctEqn, $var ) OR
function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit ) OR
function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
$relpercentTol ) OR
function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
$relpercentTol, $numOfPoints ) OR
function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
$relpercentTol, $numOfPoints,
$maxConstantOfIntegration ) OR
function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
$relpercentTol, $numOfPoints,
$maxConstantOfIntegration, $zeroLevel) OR
function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
$relpercentTol, $numOfPoints,
$maxConstantOfIntegration,
$zeroLevel, $zeroLevelTol )
$maxConstantOfIntegration -- the maximum size of the constant of
integration
function_cmp_up_to_constant() uses antiderivative compare and relative
tolerance. All options work exactly like function_cmp(), except of course
$maxConstantOfIntegration. It will accept as correct any function which
differs from $correctEqn by at most a constant; that is, if
$studentEqn = $correctEqn + C
the answer is correct.
function_cmp_abs( $correctFunction ) OR
function_cmp_abs( $correctFunction, $var ) OR
function_cmp_abs( $correctFunction, $var, $llimit, $ulimit ) OR
function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol ) OR
function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol,
$numOfPoints )
$absTol -- the tolerance as an absolute value
function_cmp_abs() uses standard compare and absolute tolerance. All
other options work exactly as for function_cmp().
function_cmp_up_to_constant_abs( $correctFunction ) OR
function_cmp_up_to_constant_abs( $correctFunction, $var ) OR
function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit ) OR
function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
$absTol ) OR
function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
$absTol, $numOfPoints ) OR
function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
$absTol, $numOfPoints,
$maxConstantOfIntegration )
function_cmp_up_to_constant_abs() uses antiderivative compare
and absolute tolerance. All other options work exactly as with
function_cmp_up_to_constant().
Examples:
ANS( function_cmp( "cos(x)" ) ) -- Accepts cos(x), sin(x+pi/2),
sin(x)^2 + cos(x) + cos(x)^2 -1, etc. This assumes
$functVarDefault has been set to "x".
ANS( function_cmp( $answer, "t" ) ) -- Assuming $answer is "cos(t)",
accepts cos(t), etc.
ANS( function_cmp_up_to_constant( "cos(x)" ) ) -- Accepts any
antiderivative of sin(x), e.g. cos(x) + 5.
ANS( function_cmp_up_to_constant( "cos(z)", "z" ) ) -- Accepts any
antiderivative of sin(z), e.g. sin(z+pi/2) + 5.
=cut
sub function_cmp {
my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
function_invalid_params( $correctEqn );
}
else {
FUNCTION_CMP( 'correctEqn' => $correctEqn,
'var' => $var,
'limits' => [$llimit, $ulimit],
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'numPoints' => $numPoints,
'mode' => 'std',
'maxConstantOfIntegration' => 0,
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
}
sub function_cmp_up_to_constant { ## for antiderivative problems
my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_;
if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
function_invalid_params( $correctEqn );
}
else {
FUNCTION_CMP( 'correctEqn' => $correctEqn,
'var' => $var,
'limits' => [$llimit, $ulimit],
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'numPoints' => $numPoints,
'mode' => 'antider',
'maxConstantOfIntegration' => $maxConstantOfIntegration,
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
}
sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance
my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_;
if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) {
function_invalid_params( $correctEqn );
}
else {
FUNCTION_CMP( 'correctEqn' => $correctEqn,
'var' => $var,
'limits' => [$llimit, $ulimit],
'tolerance' => $absTol,
'tolType' => 'absolute',
'numPoints' => $numPoints,
'mode' => 'std',
'maxConstantOfIntegration' => 0,
'zeroLevel' => 0,
'zeroLevelTol' => 0
);
}
}
sub function_cmp_up_to_constant_abs { ## for antiderivative problems
## similar to function_cmp_up_to_constant
## but uses absolute tolerance
my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_;
if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
function_invalid_params( $correctEqn );
}
else {
FUNCTION_CMP( 'correctEqn' => $correctEqn,
'var' => $var,
'limits' => [$llimit, $ulimit],
'tolerance' => $absTol,
'tolType' => 'absolute',
'numPoints' => $numPoints,
'mode' => 'antider',
'maxConstantOfIntegration' => $maxConstantOfIntegration,
'zeroLevel' => 0,
'zeroLevelTol' => 0
);
}
}
## The following answer evaluator for comparing multivarable functions was
## contributed by Professor William K. Ziemer
## (Note: most of the multivariable functionality provided by Professor Ziemer
## has now been integrated into fun_cmp and FUNCTION_CMP)
############################
# W.K. Ziemer, Sep. 1999
# Math Dept. CSULB
# email: wziemer@csulb.edu
############################
=head3 multivar_function_cmp
NOTE: this function is maintained for compatibility. fun_cmp() is
slightly preferred.
usage:
multivar_function_cmp( $answer, $var_reference, options)
$answer -- string, represents function of several variables
$var_reference -- number (of variables), or list reference (e.g. ["var1","var2"] )
options:
$limit_reference -- reference to list of lists (e.g. [[1,2],[3,4]])
$relPercentTol -- relative percent tolerance in answer
$numPoints -- number of points to sample in for each variable
$zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
$zeroLevelTol -- absolute tolerance to allow when answer is close to zero
=cut
sub multivar_function_cmp {
my ($correctEqn,$var_ref,$limit_ref,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
if ( (scalar(@_) > 7) or (scalar(@_) < 2) ) {
function_invalid_params( $correctEqn );
}
FUNCTION_CMP( 'correctEqn' => $correctEqn,
'var' => $var_ref,
'limits' => $limit_ref,
'tolerance' => $relPercentTol,
'tolType' => 'relative',
'numPoints' => $numPoints,
'mode' => 'std',
'maxConstantOfIntegration' => 0,
'zeroLevel' => $zeroLevel,
'zeroLevelTol' => $zeroLevelTol
);
}
=head3 fun_cmp()
Compares a function or a list of functions, using a named hash of options to set
parameters. This can make for more readable code than using the function_cmp()
style, but some people find one or the other easier to remember.
ANS( fun_cmp( answer or answer_array_ref, options_hash ) );
1. a string containing the correct function, or a reference to an
array of correct functions
2. a hash containing the following items (all optional):
var -- either the number of variables or a reference to an
array of variable names (see below)
limits -- reference to an array of arrays of limits (see below), or:
mode -- 'std' (default) (function must match exactly), or:
'antider' (function must match up to a constant)
relTol -- (default) a relative tolerance (as a percentage), or:
tol -- an absolute tolerance for error
numPoints -- the number of points to evaluate the function at
maxConstantOfIntegration -- maximum size of the constant of integration
zeroLevel -- if the correct answer is this close to zero, then
zeroLevelTol applies
zeroLevelTol -- absolute tolerance to allow when answer is close to zero
Returns an answer evaluator, or (if given a reference to an array
of answers), a list of answer evaluators
ANSWER:
The answer must be in the form of a string. The answer can contain
functions, pi, e, and arithmetic operations. However, the correct answer
string follows a slightly stricter syntax than student answers; specifically,
there is no implicit multiplication. So the correct answer must be "3*x" rather
than "3 x". Students can still enter "3 x".
VARIABLES:
The var parameter can contain either a number or a reference to an array of
variable names. If it contains a number, the variables are named automatically
as follows: 1 variable -- x
2 variables -- x, y
3 variables -- x, y, z
4 or more -- x_1, x_2, x_3, etc.
If the var parameter contains a reference to an array of variable names, then
the number of variables is determined by the number of items in the array. A
reference to an array is created with brackets, e.g. "var => ['r', 's', 't']".
If only one variable is being used, you can write either "var => ['t']" for
consistency or "var => 't'" as a shortcut. The default is one variable, x.
LIMITS:
Limits are specified with the limits parameter. You may NOT use llimit/ulimit.
If you specify limits for one variable, you must specify them for all variables.
The limit parameter must be a reference to an array of arrays of the form
[lower_limit. upper_limit], each array corresponding to the lower and upper
endpoints of the (half-open) domain of one variable. For example,
"vars => 2, limits => [[0,2], [-3,8]]" would cause x to be evaluated in [0,2) and
y to be evaluated in [-3,8). If only one variable is being used, you can write
either "limits => [[0,3]]" for consistency or "limits => [0,3]" as a shortcut.
EXAMPLES:
fun_cmp( "3*x" ) -- standard compare, variable is x
fun_cmp( ["3*x", "4*x+3", "3*x**2"] ) -- standard compare, defaults used for all three functions
fun_cmp( "3*t", var => 't' ) -- standard compare, variable is t
fun_cmp( "5*x*y*z", var => 3 ) -- x, y and z are the variables
fun_cmp( "5*x", mode => 'antider' ) -- student answer must match up to constant (i.e., 5x+C)
fun_cmp( ["3*x*y", "4*x*y"], limits => [[0,2], [5,7]] ) -- x evaluated in [0,2)
y evaluated in [5,7)
=cut
sub fun_cmp {
my $correctAnswer = shift @_;
my @opt = @_;
my %known_options = ( 'var' => $functVarDefault,
'limits' => [[$functLLimitDefault, $functULimitDefault]],
'mode' => 'std',
'tol' => $functAbsTolDefault,
'relTol' => $functRelPercentTolDefault,
'numPoints' => $functNumOfPoints,
'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
'zeroLevel' => $functZeroLevelDefault,
'zeroLevelTol' => $functZeroLevelTolDefault,
);
my @output_list = ();
my %out_options = ();
check_option_list( @opt );
my %in_options = @opt;
# both spellings maintained for compatibility
# relTol is preferred
if( defined( $in_options{'reltol'} ) ) {
$in_options{'relTol'} = $in_options{'reltol'};
delete $in_options{'reltol'};
}
# var is preferred
if( defined( $in_options{'vars'} ) ) {
$in_options{'var'} = $in_options{'vars'};
delete $in_options{'vars'};
}
#%out_options = %known_options;
foreach my $opt_name (keys %in_options) {
if( exists( $known_options{$opt_name} ) ) {
$out_options{$opt_name} = $in_options{$opt_name};
}
else {
die "Option $opt_name is not defined for fun_cmp. Answer is $correctAnswer; " .
"Default options are: ", display_options(%known_options);
}
}
# thread over lists
my @ans_list = ();
if ( ref($correctAnswer) eq 'ARRAY' ) {
@ans_list = @{$correctAnswer};
}
else {
push( @ans_list, $correctAnswer );
}
my ($tolType, $tol);
if ( defined( $out_options{'tol'} ) ) {
$tolType = 'absolute';
$tol = $out_options{'tol'};
}
else {
$tolType = 'relative';
$tol = $out_options{'relTol'};
}
# produce answer evaluators
foreach my $ans (@ans_list) {
push(@output_list,
FUNCTION_CMP( 'correctEqn' => $ans,
'var' => $out_options{'var'},
'limits' => $out_options{'limits'},
'tolerance' => $tol,
'tolType' => $tolType,
'numPoints' => $out_options{'numPoints'},
'mode' => $out_options{'mode'},
'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'},
'zeroLevel' => $out_options{'zeroLevel'},
'zeroLevelTol' => $out_options{'zeroLevelTol'},
),
);
}
return @output_list;
}
## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
## NOTE: PG_answer_eval is used instead of PG_restricted_eval in order to insure that the answer
## evaluated within the context of the package the problem was originally defined in.
## Includes multivariable modifications contributed by Professor William K. Ziemer
##
## IN: a hash consisting of the following keys (error checking to be added later?)
## correctEqn -- the correct equation as a string
## var -- the variable name as a string,
## or a reference to an array of variables
## limits -- reference to an array of arrays of type [lower,upper]
## tolerance -- the allowable margin of error
## tolType -- 'relative' or 'absolute'
## numPoints -- the number of points to evaluate the function at
## mode -- 'std' or 'antider'
## maxConstantOfIntegration -- maximum size of the constant of integration
## zeroLevel -- if the correct answer is this close to zero,
## then zeroLevelTol applies
## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
sub FUNCTION_CMP {
my %func_params = @_;
my $correctEqn = $func_params{'correctEqn'};
my $var = $func_params{'var'};
my $ra_limits = $func_params{'limits'};
my $tol = $func_params{'tolerance'};
my $tolType = $func_params{'tolType'};
my $numPoints = $func_params{'numPoints'};
my $mode = $func_params{'mode'};
my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
my $zeroLevel = $func_params{'zeroLevel'};
my $zeroLevelTol = $func_params{'zeroLevelTol'};
my @VARS = get_var_array( $var );
my @limits = get_limits_array( $ra_limits );
if( $tolType eq 'relative' ) {
$tol = $functRelPercentTolDefault unless defined $tol;
$tol *= .01;
}
else {
$tol = $functAbsTolDefault unless defined $tol;
}
#loop ensures that number of limits matches number of variables
for( my $i = 0; $i < scalar(@VARS); $i++ ) {
$limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
$limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
}
$numPoints = $functNumOfPoints unless defined $numPoints;
$mode = 'std' unless defined $mode;
$maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
$zeroLevel = $functZeroLevelDefault unless defined $zeroLevel;
$zeroLevelTol = $functZeroLevelTolDefault unless defined $zeroLevelTol;
my $i; #for use with loops
my $PGanswerMessage = "";
my $originalCorrEqn = $correctEqn;
#parse correct answer as student answer will be
my $correctParser = new AlgParserWithImplicitExpand;
my $correctRet = $correctParser -> parse($correctEqn);
if( ref($correctRet) ) {
$correctParser -> tostring();
$correctParser -> normalize();
$correctEqn = $correctParser -> tostring();
}
else { #error in parsing
my $error_sub = sub {
new AnswerHash(
'score' => 0,
'correct_ans' => "error in correct eqn: $correctParser->{htmlerror}",
'student_ans' => 0,
'ans_message' => $correctParser -> {error_msg},
'type' => 'function',
'preview_text_string' => '',
'preview_latex_string' => '',
'original_student_ans' => ''
);
};
return $error_sub;
}
for( $i = 0; $i < @VARS; $i++ ) {
$correctEqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
}
$correctEqn = &math_constants($correctEqn);
my $ans_evaluator = sub {
my $in = shift @_;
$in = '' unless defined $in;
my $original_student_answer = $in;
my $parser = new AlgParserWithImplicitExpand;
my $ret = $parser -> parse($in);
my $preview_text_string = '';
my $preview_latex_string = '';
my $i; #for use with loops
my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
if ( ref($ret) ) { ## parsed successfully
$parser -> tostring();
$parser -> normalize();
$in = $parser -> tostring();
$preview_text_string = $in;
$preview_latex_string = $parser -> tolatex();
}
else { ## error in parsing
my $ans_hash = new AnswerHash(
'score' => 0,
'correct_ans' => $originalCorrEqn,
'student_ans' => "error: $parser->{htmlerror}",
'ans_message' => $parser -> {error_msg},
'type' => 'function',
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
}
for( $i = 0; $i < @VARS; $i++ ) {
$in =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
}
$in = &math_constants($in);
my $correctQ = 1;
my $PGanswerMessage = '';
my ($inVal,$correctVal,$PG_eval_errors,$PG_full_errors);
my $count = 0;
my $constantDifference = 0;
my $varstr;
if ($mode eq 'antider') {
## find constant difference, e.g. constant of antidifferentiation
for( $i = 0; $i < @VARS; $i++ ) {
$VARS[$i] = $limits[$i][0] +
$random_for_answers -> rand(1) * ($limits[$i][1] - $limits[$i][0]);
}
$varstr = '';
for( $i = 0; $i < @VARS; $i++ ) {
$varstr .= "\$VARS[$i]=$VARS[$i]; ";
}
$varstr .= "$in";
if ($in =~ /\S/) {
($inVal, $PG_eval_errors, $PG_full_errors) = PG_answer_eval( qq{$varstr} );
}
else {
$PG_eval_errors = ' ';
}
if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) {
$PG_eval_errors = clean_up_error_msg($PG_eval_errors);
$correctQ = 0;
$PGanswerMessage = "There is an error in your equation $original_student_answer $PG_eval_errors";
my $ans_Hash = new AnswerHash(
'score' => 0,
'correct_ans' => $originalCorrEqn,
'student_ans' => $original_student_answer,
'ans_message' => $PGanswerMessage,
'type' => 'function',
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_Hash;
}
#special variable $@ holds the last error from a Perl eval statement
$@='';
$varstr = '';
for( $i = 0; $i < @VARS; $i++ ) {
$varstr .= "\$VARS[$i]=$VARS[$i]; ";
}
$varstr .= "$correctEqn";
($correctVal,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( qq{$varstr} );
if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) {
#$originalCorrEqn = $PG_eval_errors; ## error message from eval
$correctQ = 0;
$PGanswerMessage = "Tell your professor that there is an error in this problem. " .
"$PG_full_errors";
my $ans_hash = new AnswerHash(
'score' => 0,
'correct_ans' => $originalCorrEqn,
'student_ans' => "",
'ans_message' => $PGanswerMessage,
'type' => 'function',
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
}
if ( defined($inVal) ) {
$constantDifference = $inVal - $correctVal;
if ( (abs($constantDifference) > $maxConstantOfIntegration) and
(abs($constantDifference) > $maxConstantOfIntegration * abs($correctVal)) ) {
$PGanswerMessage = "Your constant of integration is too large for WeBWorK to deal with or there is some other error";
my $ans_hash = new AnswerHash(
'score' => 0,
'correct_ans' => $originalCorrEqn,
'student_ans' => "",
'ans_message' => $PGanswerMessage,
'type' => 'function',
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
}
}
}
else { # not using antiderivative mode
$constantDifference = 0;
}
for( $count = 0; $count < $numPoints; $count++ ) {
for( $i = 0; $i < @VARS; $i++ ) {
$VARS[$i] = $limits[$i][0] +
$random_for_answers -> rand(1) * ($limits[$i][1] - $limits[$i][0]);
}
$@='';
$varstr = '';
for( $i = 0; $i < @VARS; $i++ ) {
$varstr .= "\$VARS[$i]=$VARS[$i]; ";
}
$varstr .= "$in";
($inVal,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( qq{$varstr} );
if (defined($PG_eval_errors) and ($PG_eval_errors =~/\S/) ) {
$PG_eval_errors = clean_up_error_msg($PG_eval_errors);
$correctQ = 0;
$PGanswerMessage = "There is an error in your equation: $original_student_answer $PG_eval_errors";
last;
}
$@ = '';
$varstr = '';
for( $i = 0; $i < @VARS; $i++ ) {
$varstr .= "\$VARS[$i]=$VARS[$i]; ";
}
$varstr .= "; $correctEqn";
($correctVal,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( qq{$varstr} );
if (defined($PG_eval_errors) and $PG_eval_errors ne '' )
{
$correctQ = 0;
$PGanswerMessage = "Tell your professor that there is an error in this problem. $PG_full_errors";
last;
}
# determine the amount of error permitted between the answers.
my $permitted_error;
if ($tolType eq 'absolute') {
$permitted_error = abs($tol);
}
else { #relative tolerance
if ( abs($correctVal) <= $zeroLevel) {
$permitted_error = $zeroLevelTol; ## want $tol to be non zero
}
else {
$permitted_error = abs( $tol * $correctVal );
}
}
$correctQ = 0 unless abs($inVal - $correctVal -$constantDifference ) <= $permitted_error;
last unless ($correctQ);
}
my $ans_hash = new AnswerHash(
'score' => $correctQ,
'correct_ans' => $originalCorrEqn,
'student_ans' => $original_student_answer,
'ans_message' => $PGanswerMessage,
'type' => 'function',
'preview_text_string' => $preview_text_string,
'preview_latex_string' => $preview_latex_string,
'original_student_ans' => $original_student_answer
);
return $ans_hash;
};
$ans_evaluator;
}
##########################################################################
##########################################################################
## String answer evaluators
=head2 String Answer Evaluators
String answer evaluators compare a student string to the correct string.
Different filters can be applied to allow various degrees of variation.
Both the student and correct answers are subject to the same filters, to
ensure that there are no unexpected matches or rejections.
String Filters
remove_whitespace -- Removes all whitespace from the string.
It applies the following substitution
to the string:
$filteredAnswer =~ s/\s+//g;
compress_whitespace -- Removes leading and trailing whitespace, and
replaces all other blocks of whitespace by a
single space. Applies the following substitutions:
$filteredAnswer =~ s/^\s*//;
$filteredAnswer =~ s/\s*$//;
$filteredAnswer =~ s/\s+/ /g;
trim_whitespace -- Removes leading and trailing whitespace.
Applies the following substitutions:
$filteredAnswer =~ s/^\s*//;
$filteredAnswer =~ s/\s*$//;
ignore_case -- Ignores the case of the string. More accurately,
it converts the string to uppercase (by convention).
Applies the following function:
$filteredAnswer = uc $filteredAnswer;
ignore_order -- Ignores the order of the letters in the string.
This is used for problems of the form "Choose all
that apply." Specifically, it removes all
whitespace and lexically sorts the letters in
ascending alphabetical order. Applies the following
functions:
$filteredAnswer = join( "", lex_sort(
split( /\s*/, $filteredAnswer ) ) );
=cut
################################
## STRING ANSWER FILTERS
## IN: --the string to be filtered
## --a list of the filters to use
##
## OUT: --the modified string
##
## Use this subroutine instead of the
## individual filters below it
sub str_filters {
my $stringToFilter = shift @_;
my @filters_to_use = @_;
my %known_filters = ( 'remove_whitespace' => undef,
'compress_whitespace' => undef,
'trim_whitespace' => undef,
'ignore_case' => undef,
'ignore_order' => undef
);
#test for unknown filters
my $filter;
foreach $filter (@filters_to_use) {
die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
unless exists $known_filters{$filter};
}
if( grep( /remove_whitespace/i, @filters_to_use ) ) {
$stringToFilter = remove_whitespace( $stringToFilter );
}
if( grep( /compress_whitespace/i, @filters_to_use ) ) {
$stringToFilter = compress_whitespace( $stringToFilter );
}
if( grep( /trim_whitespace/i, @filters_to_use ) ) {
$stringToFilter = trim_whitespace( $stringToFilter );
}
if( grep( /ignore_case/i, @filters_to_use ) ) {
$stringToFilter = ignore_case( $stringToFilter );
}
if( grep( /ignore_order/i, @filters_to_use ) ) {
$stringToFilter = ignore_order( $stringToFilter );
}
return $stringToFilter;
}
sub remove_whitespace {
my $filteredAnswer = shift;
$filteredAnswer =~ s/\s+//g; # remove all whitespace
return $filteredAnswer;
}
sub compress_whitespace {
my $filteredAnswer = shift;
$filteredAnswer =~ s/^\s*//; # remove initial whitespace
$filteredAnswer =~ s/\s*$//; # remove trailing whitespace
$filteredAnswer =~ s/\s+/ /g; # replace spaces by single space
return $filteredAnswer;
}
sub trim_whitespace {
my $filteredAnswer = shift;
$filteredAnswer =~ s/^\s*//; # remove initial whitespace
$filteredAnswer =~ s/\s*$//; # remove trailing whitespace
return $filteredAnswer;
}
sub ignore_case {
my $filteredAnswer = shift;
$filteredAnswer = uc $filteredAnswer;
return $filteredAnswer;
}
sub ignore_order {
my $filteredAnswer = shift;
$filteredAnswer = join( "", lex_sort( split( /\s*/, $filteredAnswer ) ) );
return $filteredAnswer;
}
################################
## END STRING ANSWER FILTERS
=head3 "mode"_str_cmp functions
The functions of the the form "mode"_str_cmp() use different functions to
specify which filters to apply. They take no options except the correct
string. There are also versions which accept a list of strings.
std_str_cmp( $correctString )
std_str_cmp_list( @correctStringList )
Filters: compress_whitespace, ignore_case
std_cs_str_cmp( $correctString )
std_cs_str_cmp_list( @correctStringList )
Filters: compress_whitespace
strict_str_cmp( $correctString )
strict_str_cmp_list( @correctStringList )
Filters: trim_whitespace
unordered_str_cmp( $correctString )
unordered_str_cmp_list( @correctStringList )
Filters: ignore_order, ignore_case
unordered_cs_str_cmp( $correctString )
unordered_cs_str_cmp_list( @correctStringList )
Filters: ignore_order
ordered_str_cmp( $correctString )
ordered_str_cmp_list( @correctStringList )
Filters: remove_whitespace, ignore_case
ordered_cs_str_cmp( $correctString )
ordered_cs_str_cmp_list( @correctStringList )
Filters: remove_whitespace
Examples
ANS( std_str_cmp( "W. Mozart" ) ) -- Accepts "W. Mozart", "W. MOZarT",
and so forth. Case insensitive. All internal spaces treated
as single spaces.
ANS( std_cs_str_cmp( "Mozart" ) ) -- Rejects "mozart". Same as
std_str_cmp() but case sensitive.
ANS( strict_str_cmp( "W. Mozart" ) ) -- Accepts only the exact string.
ANS( unordered_str_cmp( "ABC" ) ) -- Accepts "a c B", "CBA" and so forth.
Unordered, case insensitive, spaces ignored.
ANS( unordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc". Same as
unordered_str_cmp() but case sensitive.
ANS( ordered_str_cmp( "ABC" ) ) -- Accepts "a b C", "A B C" and so forth.
Ordered, case insensitive, spaces ignored.
ANS( ordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc", accepts "A BC" and
so forth. Same as ordered_str_cmp() but case sensitive.
=cut
sub std_str_cmp { # compare strings
my $correctAnswer = shift @_;
my @filters = ( 'compress_whitespace', 'ignore_case' );
my $type = 'std_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub std_str_cmp_list { # alias for std_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, std_str_cmp(shift @answerList) );
}
@output;
}
sub std_cs_str_cmp { # compare strings case sensitive
my $correctAnswer = shift @_;
my @filters = ( 'compress_whitespace' );
my $type = 'std_cs_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub std_cs_str_cmp_list { # alias for std_cs_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, std_cs_str_cmp(shift @answerList) );
}
@output;
}
sub strict_str_cmp { # strict string compare
my $correctAnswer = shift @_;
my @filters = ( 'trim_whitespace' );
my $type = 'strict_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub strict_str_cmp_list { # alias for strict_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, strict_str_cmp(shift @answerList) );
}
@output;
}
sub unordered_str_cmp { # unordered, case insensitive, spaces ignored
my $correctAnswer = shift @_;
my @filters = ( 'ignore_order', 'ignore_case' );
my $type = 'unordered_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub unordered_str_cmp_list { # alias for unordered_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, unordered_str_cmp(shift @answerList) );
}
@output;
}
sub unordered_cs_str_cmp { # unordered, case sensitive, spaces ignored
my $correctAnswer = shift @_;
my @filters = ( 'ignore_order' );
my $type = 'unordered_cs_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub unordered_cs_str_cmp_list { # alias for unordered_cs_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, unordered_cs_str_cmp(shift @answerList) );
}
@output;
}
sub ordered_str_cmp { # ordered, case insensitive, spaces ignored
my $correctAnswer = shift @_;
my @filters = ( 'remove_whitespace', 'ignore_case' );
my $type = 'ordered_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub ordered_str_cmp_list { # alias for ordered_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, ordered_str_cmp(shift @answerList) );
}
@output;
}
sub ordered_cs_str_cmp { # ordered, case sensitive, spaces ignored
my $correctAnswer = shift @_;
my @filters = ( 'remove_whitespace' );
my $type = 'ordered_cs_str_cmp';
STR_CMP( 'correctAnswer' => $correctAnswer,
'filters' => \@filters,
'type' => $type
);
}
sub ordered_cs_str_cmp_list { # alias for ordered_cs_str_cmp
my @answerList = @_;
my @output;
while (@answerList) {
push( @output, ordered_cs_str_cmp(shift @answerList) );
}
@output;
}
=head3 str_cmp()
Compares a string or a list of strings, using a named hash of options to set
parameters. This can make for more readable code than using the "mode"_str_cmp()
style, but some people find one or the other easier to remember.
ANS( str_cmp( answer or answer_array_ref, options_hash ) );
1. the correct answer or a reference to an array of answers
2. either a list of filters, or:
a hash consisting of
filters - a reference to an array of filters
Returns an answer evaluator, or (if given a reference to an array of answers),
a list of answer evaluators
FILTERS:
remove_whitespace -- removes all whitespace
compress_whitespace -- removes whitespace from the beginning and end of the string,
and treats one or more whitespace characters in a row as a
single space (true by default)
trim_whitespace -- removes whitespace from the beginning and end of the string
ignore_case -- ignores the case of the letters (true by default)
ignore_order -- ignores the order in which letters are entered
EXAMPLES:
str_cmp( "Hello" ) -- matches "Hello", " hello" (same as std_str_cmp() )
str_cmp( ["Hello", "Goodbye"] ) -- same as std_str_cmp_list()
str_cmp( " hello ", trim_whitespace ) -- matches "hello", " hello "
str_cmp( "ABC", filters => 'ignore_order' ) -- matches "ACB", "A B C", but not "abc"
str_cmp( "D E F", remove_whitespace, ignore_case ) -- matches "def" and "d e f" but not "fed"
=cut
sub str_cmp {
my $correctAnswer = shift @_;
$correctAnswer = '' unless defined($correctAnswer);
my @options = @_;
my $ra_filters;
# error-checking for filters occurs in the filters() subroutine
if( not defined( $options[0] ) ) { # used with no filters as alias for std_str_cmp()
@options = ( 'compress_whitespace', 'ignore_case' );
}
if( $options[0] eq 'filters' ) { # using filters => [f1, f2, ...] notation
$ra_filters = $options[1];
}
else { # using a list of filters
$ra_filters = \@options;
}
# thread over lists
my @ans_list = ();
if ( ref($correctAnswer) eq 'ARRAY' ) {
@ans_list = @{$correctAnswer};
}
else {
push( @ans_list, $correctAnswer );
}
# final_answer;
my @output_list = ();
foreach my $ans (@ans_list) {
push(@output_list, STR_CMP( 'correctAnswer' => $ans,
'filters' => $ra_filters,
'type' => 'str_cmp'
)
);
}
return @output_list;
}
## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
##
## IN: a hashtable with the following entries (error-checking to be added later?):
## correctAnswer -- the correct answer, before filtering
## filters -- reference to an array containing the filters to be applied
## type -- a string containing the type of answer evaluator in use
## OUT: a reference to an answer evaluator subroutine
sub STR_CMP {
my %str_params = @_;
$str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} );
my $answer_evaluator = sub {
my $in = shift @_;
$in = '' unless defined $in;
my $original_student_ans = $in;
$in = str_filters( $in, @{$str_params{'filters'}} );
my $correctQ = ( $in eq $str_params{'correctAnswer'} ) ? 1: 0;
my $ans_hash = new AnswerHash(
'score' => $correctQ,
'correct_ans' => $str_params{'correctAnswer'},
'student_ans' => $in,
'ans_message' => '',
'type' => $str_params{'type'},
'preview_text_string' => $in,
'preview_latex_string' => $in,
'original_student_ans' => $original_student_ans
);
return $ans_hash;
};
return $answer_evaluator;
}
##########################################################################
##########################################################################
## Miscellaneous answer evaluators
=head2 Miscellaneous Answer Evaluators (Checkboxes and Radio Buttons)
These evaluators do not fit any of the other categories.
checkbox_cmp( $correctAnswer )
$correctAnswer -- a string containing the names of the correct boxes,
e.g. "ACD". Note that this means that individual
checkbox names can only be one character. Internally,
this is largely the same as unordered_cs_str_cmp().
radio_cmp( $correctAnswer )
$correctAnswer -- a string containing the name of the correct radio
button, e.g. "Choice1". This is case sensitive and
whitespace sensitive, so the correct answer must match
the name of the radio button exactly.
=cut
# added 6/14/2000 by David Etlinger
# because of the conversion of the answer
# string to an array, I thought it better not
# to force STR_CMP() to work with this
sub checkbox_cmp {
my $correctAnswer = shift @_;
$correctAnswer = str_filters( $correctAnswer, 'ignore_order' );
my $answer_evaluator = sub {
my $in = shift @_;
$in = '' unless defined $in; #in case no boxes checked
my @temp = split( "\0", $in ); #convert "\0"-delimited string to array...
$in = join( "", @temp ); #and then to a single no-delimiter string
my $original_student_ans = $in; #well, almost original
$in = str_filters( $in, 'ignore_order' );
my $correctQ = ($in eq $correctAnswer) ? 1: 0;
my $ans_hash = new AnswerHash(
'score' => $correctQ,
'correct_ans' => $correctAnswer,
'student_ans' => $in,
'ans_message' => "",
'type' => "checkbox_cmp",
'preview_text_string' => $in,
'original_student_ans' => $original_student_ans
);
return $ans_hash;
};
return $answer_evaluator;
}
#added 6/28/2000 by David Etlinger
#exactly the same as strict_str_cmp,
#but more intuitive to the user
sub radio_cmp {
strict_str_cmp( @_ );
}
##########################################################################
##########################################################################
## Text and e-mail routines
sub store_ans_at {
my $answerStringRef = shift;
my %options = @_;
my $ans_eval= '';
if ( ref($answerStringRef) eq 'SCALAR' ) {
$ans_eval= sub {
my $text = shift;
$text = '' unless defined($text);
$$answerStringRef = $$answerStringRef . $text;
my $ans_hash = new AnswerHash(
'score' => 1,
'correct_ans' => '',
'student_ans' => $text,
'ans_message' => '',
'type' => 'store_ans_at',
'original_student_ans' => $text,
'preview_text_string' => ''
);
return $ans_hash;
};
}
else {
die "Syntax error: \n The argument to store_ans_at() must be a pointer to a scalar.\n(e.g. store_ans_at(~~\$MSG) )\n\n";
}
return $ans_eval;
}
#### subroutines used in producing a questionnaire
#### these are at least good models for other answers of this type
my $QUESTIONNAIRE_ANSWERS=''; # stores the answers until it is time to send them
# this must be initialized before the answer evaluators are run
# but that happens long after all of the text in the problem is
# evaluated.
# this is a utility script for cleaning up the answer output for display in
#the answers.
sub DUMMY_ANSWER {
my $num = shift;
qq{}
}
sub escapeHTML {
my $string = shift;
$string =~ s/\n/$BR/ge;
$string;
}
# these next two subroutines show how to modify the "store_and_at()" answer
# evaluator to add extra information before storing the info
# They provide a good model for how to tweak answer evaluators in special cases.
sub anstext {
my $num = shift;
my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
my $ans_eval = sub {
my $text = shift;
$text = '' unless defined($text);
my $new_text = "\n$main::psvnNumber-Problem-$main::probNum-Question-$num:\n $text "; # modify entered text
my $out = &$ans_eval_template($new_text); # standard evaluator
#warn "$QUESTIONNAIRE_ANSWERS";
$out->{student_ans} = escapeHTML($text); # restore original entered text
$out->{correct_ans} = "Question $num answered";
$out->{original_student_ans} = escapeHTML($text);
$out;
};
$ans_eval;
}
sub ansradio {
my $num = shift;
my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
my $ans_eval = sub {
my $text = shift;
$text = '' unless defined($text);
my $new_text = "\n$main::psvnNumber-Problem-$main::probNum-RADIO-$num:\n $text "; # modify entered text
my $out = $ans_eval_template->($new_text); # standard evaluator
$out->{student_ans} =escapeHTML($text); # restore original entered text
$out->{original_student_ans} = escapeHTML($text);
$out;
};
$ans_eval;
}
# This is another example of how to modify an answer evaluator to obtain
# the desired behavior in a special case. Here the object is to have
# have the last answer trigger the send_mail_to subroutine which mails
# all of the answers to the designated address.
# (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
sub mail_answers_to { #accepts the last answer and mails off the result
my $user_address = shift;
my $ans_eval = sub {
# then mail out all of the answers, including this last one.
send_mail_to( $user_address,
'subject' => "$main::courseName WeBWorK questionnaire",
'body' => $QUESTIONNAIRE_ANSWERS,
'ALLOW_MAIL_TO' => $main::ALLOW_MAIL_TO
);
my $ans_hash = new AnswerHash( 'score' => 1,
'correct_ans' => '',
'student_ans' => 'Answer recorded',
'ans_message' => '',
'type' => 'send_mail_to',
);
return $ans_hash;
};
return $ans_eval;
}
sub mail_answers_to2 { #accepts the last answer and mails off the result
my $user_address = shift;
my $subject = shift;
$subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
send_mail_to($user_address,
'subject' => $subject,
'body' => $QUESTIONNAIRE_ANSWERS,
'ALLOW_MAIL_TO' => $main::ALLOW_MAIL_TO
);
}
##########################################################################
##########################################################################
## Problem Grader Subroutines
#####################################
# This is a model for plug-in problem graders
#####################################
sub install_problem_grader {
my $rf_problem_grader = shift;
$main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $rf_problem_grader;
}
#this is called std only for compatability purposes;
#almost everyone uses avg_problem_grader
sub std_problem_grader{
my $rh_evaluated_answers = shift;
my $rh_problem_state = shift;
my %form_options = @_;
my %evaluated_answers = %{$rh_evaluated_answers};
# The hash $rh_evaluated_answers typically contains:
# 'answer1' => 34, 'answer2'=> 'Mozart', etc.
# By default the old problem state is simply passed back out again.
my %problem_state = %$rh_problem_state;
# %form_options might include
# The user login name
# The permission level of the user
# The studentLogin name for this psvn.
# Whether the form is asking for a refresh or is submitting a new answer.
# initial setup of the answer
my %problem_result = ( score => 0,
errors => '',
type => 'std_problem_grader',
msg => '',
);
# Checks
my $ansCount = keys %evaluated_answers; # get the number of answers
unless ($ansCount > 0 ) {
$problem_result{msg} = "This problem did not ask any questions.";
return(\%problem_result,\%problem_state);
}
if ($ansCount > 1 ) {
$problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ;
}
unless ($form_options{answers_submitted} == 1) {
return(\%problem_result,\%problem_state);
}
my $allAnswersCorrectQ=1;
foreach my $ans_name (keys %evaluated_answers) {
# I'm not sure if this check is really useful.
if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) {
$allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} );
}
else {
die "Error at file ",__FILE__,"line ", __LINE__,": Answer |$ans_name| is not a hash reference\n".
$evaluated_answers{$ans_name} .
"This probably means that the answer evaluator for this answer\n" .
"is not working correctly.";
$problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
}
}
# report the results
$problem_result{score} = $allAnswersCorrectQ;
# I don't like to put in this bit of code.
# It makes it hard to construct error free problem graders
# I would prefer to know that the problem score was numeric.
unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
$problem_state{recorded_score} = 0; # This gets rid of non-numeric scores
}
#
if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
$problem_state{recorded_score} = 1;
}
else {
$problem_state{recorded_score} = 0;
}
$problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
$problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
(\%problem_result, \%problem_state);
}
#the only difference between the two versions
#is at the end of the subroutine, where std_problem_grader2
#records the attempt only if there have been no syntax errors,
#whereas std_problem_grader records it regardless
sub std_problem_grader2{
my $rh_evaluated_answers = shift;
my $rh_problem_state = shift;
my %form_options = @_;
my %evaluated_answers = %{$rh_evaluated_answers};
# The hash $rh_evaluated_answers typically contains:
# 'answer1' => 34, 'answer2'=> 'Mozart', etc.
# By default the old problem state is simply passed back out again.
my %problem_state = %$rh_problem_state;
# %form_options might include
# The user login name
# The permission level of the user
# The studentLogin name for this psvn.
# Whether the form is asking for a refresh or is submitting a new answer.
# initial setup of the answer
my %problem_result = ( score => 0,
errors => '',
type => 'std_problem_grader',
msg => '',
);
# syntax errors are not counted.
my $record_problem_attempt = 1;
# Checks
my $ansCount = keys %evaluated_answers; # get the number of answers
unless ($ansCount > 0 ) {
$problem_result{msg} = "This problem did not ask any questions.";
return(\%problem_result,\%problem_state);
}
if ($ansCount > 1 ) {
$problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ;
}
unless ($form_options{answers_submitted} == 1) {
return(\%problem_result,\%problem_state);
}
my $allAnswersCorrectQ=1;
foreach my $ans_name (keys %evaluated_answers) {
# I'm not sure if this check is really useful.
if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) {
$allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} );
}
else {
die "Error at file ",__FILE__,"line ", __LINE__,": Answer |$ans_name| is not a hash reference\n".
$evaluated_answers{$ans_name} .
"This probably means that the answer evaluator for this answer\n" .
"is not working correctly.";
$problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
}
}
# report the results
$problem_result{score} = $allAnswersCorrectQ;
# I don't like to put in this bit of code.
# It makes it hard to construct error free problem graders
# I would prefer to know that the problem score was numeric.
unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
$problem_state{recorded_score} = 0; # This gets rid of non-numeric scores
}
#
if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
$problem_state{recorded_score} = 1;
}
else {
$problem_state{recorded_score} = 0;
}
# record attempt only if there have been no syntax errors.
if ($record_problem_attempt == 1) {
$problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
$problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
}
else {
$problem_result{show_partial_correct_answers} = 0 ; # prevent partial correct answers from being shown for syntax errors.
}
(\%problem_result, \%problem_state);
}
sub avg_problem_grader{
my $rh_evaluated_answers = shift;
my $rh_problem_state = shift;
my %form_options = @_;
my %evaluated_answers = %{$rh_evaluated_answers};
# The hash $rh_evaluated_answers typically contains:
# 'answer1' => 34, 'answer2'=> 'Mozart', etc.
# By default the old problem state is simply passed back out again.
my %problem_state = %$rh_problem_state;
# %form_options might include
# The user login name
# The permission level of the user
# The studentLogin name for this psvn.
# Whether the form is asking for a refresh or is submitting a new answer.
# initial setup of the answer
my $total=0;
my %problem_result = ( score => 0,
errors => '',
type => 'avg_problem_grader',
msg => '',
);
my $count = keys %evaluated_answers;
$problem_result{msg} = 'You can earn partial credit on this problem.' if $count >1;
# Return unless answers have been submitted
unless ($form_options{answers_submitted} == 1) {
return(\%problem_result,\%problem_state);
}
# Answers have been submitted -- process them.
foreach my $ans_name (keys %evaluated_answers) {
# I'm not sure if this check is really useful.
if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) ) {
$total += $evaluated_answers{$ans_name}->{score};
}
else {
die "Error: Answer |$ans_name| is not a hash reference\n".
$evaluated_answers{$ans_name} .
"This probably means that the answer evaluator for this answer\n" .
"is not working correctly.";
$problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
}
}
# Calculate score rounded to three places to avoid roundoff problems
$problem_result{score} = $total/$count if $count;
# increase recorded score if the current score is greater.
$problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
$problem_state{num_of_correct_ans}++ if $total == $count;
$problem_state{num_of_incorrect_ans}++ if $total < $count ;
warn "Error in grading this problem the total $total is larger than $count" if $total > $count;
(\%problem_result, \%problem_state);
}
###########################################################################
### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT.
## Internal routine that converts variables into the standard array format
##
## IN: one of the following:
## an undefined value (i.e., no variable was specified)
## a reference to an array of variable names -- [var1, var2]
## a number (the number of variables desired) -- 3
## one or more variable names -- (var1, var2)
## OUT: an array of variable names
sub get_var_array {
my $in = shift @_;
my @out;
if( not defined($in) ) { #if nothing defined, build default array and return
@out = ( $functVarDefault );
return @out;
}
elsif( ref( $in ) eq 'ARRAY' ) { #if given an array ref, dereference and return
return @{$in};
}
elsif( $in =~ /^\d+/ ) { #if given a number, set up the array and return
if( $in == 1 ) {
$out[0] = 'x';
}
elsif( $in == 2 ) {
$out[0] = 'x';
$out[1] = 'y';
}
elsif( $in == 3 ) {
$out[0] = 'x';
$out[1] = 'y';
$out[2] = 'z';
}
else { #default to the x_1, x_2, ... convention
my ($i, $tag);
for( $i=0; $i < $in; $i++ ) {
## akp the above seems to be off by one 1/4/00
$tag = $i + 1; ## akp 1/4/00
$out[$i] = "${functVarDefault}_" . $tag; ## akp 1/4/00
}
}
return @out;
}
else { #if given one or more names, return as an array
unshift( @_, $in );
return @_;
}
}
## Internal routine that converts limits into the standard array of arrays format
## Some of the cases are probably unneccessary, but better safe than sorry
##
## IN: one of the following:
## an undefined value (i.e., no limits were specified)
## a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
## a reference to an array of limits -- [llim, ulim]
## an array of array references -- ([llim,ulim], [llim,ulim])
## an array of limits -- (llim,ulim)
## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
sub get_limits_array {
my $in = shift @_;
my @out;
if( not defined($in) ) { #if nothing defined, build default array and return
@out = ( [$functLLimitDefault, $functULimitDefault] );
return @out;
}
elsif( ref($in) eq 'ARRAY' ) { #$in is either ref to array, or ref to array of refs
my @deref = @{$in};
if( ref( $in->[0] ) eq 'ARRAY' ) { #$in is a ref to an array of array refs
return @deref;
}
else { #$in was just a ref to an array of numbers
@out = ( $in );
return @out;
}
}
else { #$in was an array of references or numbers
unshift( @_, $in );
if( ref($_[0]) eq 'ARRAY' ) { #$in was an array of references, so just return it
return @_;
}
else { #$in was an array of numbers
@out = ( \@_ );
return @out;
}
}
}
sub check_option_list {
my $size = scalar(@_);
if( ( $size % 2 ) != 0 ) {
warn "ERROR in answer evaluator generator:\n" .
"Usage: str_cmp([\$ans1, \$ans2],%options)
or num_cmp([\$num1, \$num2], %options)
A list of inputs must be inclosed in square brackets [\$ans1, \$ans2]";
}
}
# simple subroutine to display an error message when
# function compares are called with invalid parameters
sub function_invalid_params {
my $correctEqn = shift @_;
my $error_response = sub {
my $PGanswerMessage = "Tell your professor that there is an error with the parameters " .
"to the function answer evaluator";
return ( 0, $correctEqn, "", $PGanswerMessage );
};
return $error_response;
}
# outputs a hash to the screen
sub display_options {
my %options = @_;
my $out_string = "";
foreach my $key (keys %options) {
$out_string .= " $key => $options{$key}, ";
}
return $out_string;
}
sub is_a_number {
my ($num) = @_;
my $is_a_number = 0;
return $is_a_number unless defined($num);
$num =~ s/^\s*//; ## remove initial spaces
$num =~ s/\s*$//; ## remove trailing spaces
## the following is copied from the online perl manual
if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
$is_a_number = 1;
}
return $is_a_number;
}
sub is_a_fraction {
## does not test for validity, just for allowed characters
## note that an integer will qualify as a fraction
my ($exp) = @_;
my $is_a_fraction = 0;
return $is_a_fraction unless defined($exp);
if ($exp =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
$is_a_fraction = 1;
}
return $is_a_fraction;
}
sub is_an_arithmetic_expression {
## does not test for validity, just for allowed characters
my ($exp) = @_;
my $is_an_arithmetic_expression = 0;
if ($exp =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
$is_an_arithmetic_expression = 1;
}
return $is_an_arithmetic_expression;
}
#replaces pi, e, and ^ with their Perl equivalents
sub math_constants {
my($in) = @_;
$in =~s/\bpi\b/(4*atan2(1,1))/ge;
$in =~s/\be\b/(exp(1))/ge;
$in =~s/\^/**/g;
return $in;
}
sub clean_up_error_msg {
my $msg = $_[0];
$msg =~ s/^\[[^\]]*\][^:]*://;
$msg =~ s/Unquoted string//g;
$msg =~ s/may\s+clash.*/does not make sense here/;
$msg =~ s/\sat.*line [\d]*//g;
$msg = 'error: '. $msg;
return $msg;
}
#formats the student and correct answer as specified
#format must be of a form suitable for sprintf (e.g. '%0.5g'),
#with the exception that a '#' at the end of the string
#will cause trailing zeros in the decimal part to be removed
sub prfmt {
my($number,$format) = @_; # attention, the order of format and number are reversed
my $out;
if ($format) {
warn "Incorrect format used: $format. Format should look something like %4.5g "
unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/;
if( $format =~ s/#\s*$// ) { # remove trailing zeros in the decimal
$out = sprintf( $format, $number );
$out =~ s/(\.\d*?)0+$/$1/;
$out =~ s/\.$//; # in case all decimal digits were zero, remove the decimal
}
else {
$out = sprintf( $format, $number );
}
$out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
}
else {
$out = $number;
}
return $out;
}
1;