#############################################################
#
# Implements the ->cmp method for Value objects. This produces
# an answer checker appropriate for the type of object.
# Additional options can be passed to the checker to
# modify its action.
#
# The individual Value packages are modified below to add the
# needed methods.
#
#############################################################
package Value;
#
# Create an answer checker for the given type of object
#
sub cmp_defaults {(
showTypeWarnings => 1,
showEqualErrors => 1,
ignoreStrings => 1,
studentsMustReduceUnions => 1,
showUnionReduceWarnings => 1,
)}
sub cmp {
my $self = shift;
my $ans = new AnswerEvaluator;
my $correct = protectHTML($self->{correct_ans});
$correct = $self->correct_ans unless defined($correct);
$ans->ans_hash(
type => "Value (".$self->class.")",
correct_ans => $correct,
correct_value => $self,
$self->cmp_defaults(@_),
@_
);
$ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
$ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
$self->{context} = $$Value::context unless defined($self->{context});
return $ans;
}
sub correct_ans {protectHTML(shift->string)}
#
# Parse the student answer and compute its value,
# produce the preview strings, and then compare the
# student and professor's answers for equality.
#
sub cmp_parse {
my $self = shift; my $ans = shift;
#
# Do some setup
#
my $current = $$Value::context; # save it for later
my $context = $ans->{correct_value}{context} || $current;
Parser::Context->current(undef,$context); # change to correct answser's context
my $flags = contextSet($context, # save old context flags for the below
StringifyAsTeX => 0, # reset this, just in case.
no_parameters => 1, # don't let students enter parameters
showExtraParens => 1, # make student answer painfully unambiguous
reduceConstants => 0, # don't combine student constants
reduceConstantFunctions => 0, # don't reduce constant functions
($ans->{studentsMustReduceUnions} ?
(reduceUnions => 0, reduceSets => 0,
reduceUnionsForComparison => $ans->{showUnionReduceWarnings},
reduceSetsForComparison => $ans->{showUnionReduceWarnings}) :
(reduceUnions => 1, reduceSets => 1,
reduceUnionsForComparison => 1, reduceSetsForComparison => 1)),
($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals
$self->cmp_contextFlags($ans), # any additional ones from the object itself
);
my $inputs = $self->getPG('$inputs_ref',{action=>""});
$ans->{isPreview} = $inputs->{previewAnswers} || ($inputs->{action} =~ m/^Preview/);
$ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
$ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
$ans->{preview_latex_string} = $ans->{preview_text_string} = '';
#
# Parse and evaluate the student answer
#
$ans->score(0); # assume failure
$ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
$ans->{student_value} = Parser::Evaluate($ans->{student_formula})
if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
#
# If it parsed OK, save the output forms and check if it is correct
# otherwise report an error
#
if (defined $ans->{student_value}) {
$ans->{student_value} = Value::Formula->new($ans->{student_value})
unless Value::isValue($ans->{student_value});
$ans->{preview_latex_string} = $ans->{student_formula}->TeX;
$ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
$ans->{student_ans} = $ans->{preview_text_string};
if ($self->cmp_collect($ans)) {
$self->cmp_equal($ans);
$self->cmp_postprocess($ans) if !$ans->{error_message};
}
} else {
$self->cmp_error($ans);
$self->cmp_collect($ans); ## FIXME: why is this here a second time?
}
contextSet($context,%{$flags}); # restore context values
Parser::Context->current(undef,$current); # put back the old context
return $ans;
}
#
# Check if the object has an answer array and collect the results
# Build the combined student answer and set the preview values
#
sub cmp_collect {
my $self = shift; my $ans = shift;
return 1 unless $self->{ans_name};
$ans->{preview_latex_string} = $ans->{preview_text_string} = "";
my $OK = $self->ans_collect($ans);
$ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
return 0 unless $OK;
my $array = $ans->{student_formula};
if ($self->{ColumnVector}) {
my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
$array = [@V];
} elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
my $type = $self;
$type = "Value::".$self->{tree}->type if $self->class eq 'Formula';
$ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag})
{Parser::reportEvalError($@); return 0}
$ans->{student_value} = $ans->{student_formula};
$ans->{preview_text_string} = $ans->{student_ans};
$ans->{preview_latex_string} = $ans->{student_formula}->TeX;
if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
$ans->{student_value} = Parser::Evaluate($ans->{student_formula});
return 0 unless $ans->{student_value};
}
return 1;
}
#
# Check if the parsed student answer equals the professor's answer
#
sub cmp_equal {
my $self = shift; my $ans = shift;
my $correct = $ans->{correct_value};
my $student = $ans->{student_value};
if ($correct->typeMatch($student,$ans)) {
my $equal = $correct->cmp_compare($student,$ans);
if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
$self->cmp_error($ans);
} else {
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
$ans->{ans_message} = $ans->{error_message} =
"Your answer isn't ".lc($ans->{cmp_class})."\n".
"(it looks like ".lc($student->showClass).")"
if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
}
}
#
# Perform the comparison, either using the checker supplied
# by the answer evaluator, or the overloaded == operator.
#
our $CMP_ERROR = 2; # a fatal error was detected
our $CMP_WARNING = 3; # a warning was produced
sub cmp_compare {
my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || '';
return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
my $equal = eval {&{$ans->{checker}}($self,$other,$ans,$nth,@_)};
if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
$$Value::context->setError(["An error occurred while checking your$nth answer:\n".
'
%s
',$@],'',undef,undef,$CMP_ERROR);
warn "Please inform your instructor that an error occurred while checking your answer";
}
return $equal;
}
sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
#
# Check if types are compatible for equality check
#
sub typeMatch {
my $self = shift; my $other = shift;
return 1 unless ref($other);
$self->type eq $other->type && $other->class ne 'Formula';
}
#
# Class name for cmp error messages
#
sub cmp_class {
my $self = shift; my $ans = shift;
my $class = $self->showClass; $class =~ s/Real //;
return $class if $class =~ m/Formula/;
return "an Interval, Set or Union" if $self->isSetOfReals;
return $class;
}
#
# Student answer evaluation failed.
# Report the error, with formatting, if possible.
#
sub cmp_error {
my $self = shift; my $ans = shift;
my $error = $$Value::context->{error};
my $message = $error->{message};
if ($error->{pos}) {
my $string = $error->{string};
my ($s,$e) = @{$error->{pos}};
$message =~ s/; see.*//; # remove the position from the message
$ans->{student_ans} =
protectHTML(substr($string,0,$s)) .
'' .
protectHTML(substr($string,$s,$e-$s)) .
'' .
protectHTML(substr($string,$e));
}
$self->cmp_Error($ans,$message);
}
#
# Set the error message
#
sub cmp_Error {
my $self = shift; my $ans = shift;
return unless scalar(@_) > 0;
$ans->score(0);
$ans->{ans_message} = $ans->{error_message} = join("\n",@_);
}
#
# filled in by sub-classes
#
sub cmp_postprocess {}
sub cmp_contextFlags {return ()}
#
# Check for unreduced reduced Unions and Sets
#
sub cmp_checkUnionReduce {
my $self = shift; my $student = shift; my $ans = shift; my $nth = shift || '';
return unless $ans->{studentsMustReduceUnions} &&
$ans->{showUnionReduceWarnings} &&
!$ans->{isPreview} && !Value::isFormula($student);
if ($student->type eq 'Union' && $student->length >= 2) {
my $reduced = $student->reduce;
return "Your$nth union can be written in a simpler form"
unless $reduced->type eq 'Union' && $reduced->length == $student->length;
my @R = $reduced->sort->value;
my @S = $student->sort->value;
foreach my $i (0..$#R) {
return "Your$nth union can be written in a simpler form"
unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length;
}
} elsif ($student->type eq 'Set' && $student->length >= 2) {
return "Your$nth set should have no repeated elements"
unless $student->reduce->length == $student->length;
}
return;
}
#
# create answer rules of various types
#
sub ans_rule {shift; pgCall('ans_rule',@_)}
sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
sub ans_array {shift->ans_rule(@_)};
sub named_ans_array {shift->named_ans_rule(@_)};
sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
our $answerPrefix = "MaTrIx";
#
# Lay out a matrix of answer rules
#
sub ans_matrix {
my $self = shift;
my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
my $new_name = pgRef('RECORD_FORM_LABEL');
my $HTML = ""; my $ename = $name;
if ($name eq '') {
my $n = pgCall('inc_ans_rule_count');
$name = pgCall('NEW_ANS_NAME',$n);
$ename = $answerPrefix.$n;
}
$self->{ans_name} = $ename;
$self->{ans_rows} = $rows;
$self->{ans_cols} = $cols;
my @array = ();
foreach my $i (0..$rows-1) {
my @row = ();
foreach my $j (0..$cols-1) {
if ($i == 0 && $j == 0) {
if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
} else {
push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
}
}
push(@array,[@row]);
}
$self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
}
sub ANS_NAME {
my ($name,$i,$j) = @_;
$name.'_'.$i.'_'.$j;
}
#
# Lay out an arbitrary matrix
#
sub format_matrix {
my $self = shift;
my $displayMode = $self->getPG('$displayMode');
return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX');
return $self->format_matrix_HTML(@_);
}
sub format_matrix_tex {
my $self = shift; my $array = shift;
my %options = (open=>'.',close=>'.',sep=>'',@_);
$self->{format_options} = [%options] unless $self->{format_options};
my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
my $tex = "";
$open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
$tex .= '\(\left'.$open;
$tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
$tex .= '\begin{array}{'.('c'x$cols).'}';
foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"}
$tex .= '\end{array}\right'.$close.'\)';
return $tex;
}
sub format_matrix_HTML {
my $self = shift; my $array = shift;
my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
$self->{format_options} = [%options] unless $self->{format_options};
my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
my $HTML = "";
if ($sep) {$sep = ''.$sep.' | '}
else {$sep = ' | | '}
foreach my $i (0..$rows-1) {
$HTML .= ' | |
' if $i;
$HTML .= '| '.join($sep,@{$array->[$i]}).' |
'."\n";
}
$open = $self->format_delimiter($open,$rows,$options{tth_delims});
$close = $self->format_delimiter($close,$rows,$options{tth_delims});
if ($open ne '' || $close ne '') {
$HTML = ''
. '| '.$open.' | '
. ' | '
. ' | '
. ' | '
. ''.$close.' | '
. '
'."\n";
}
return '';
}
sub VERBATIM {
my $string = shift;
my $displayMode = Value->getPG('$displayMode');
$string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
return $string;
}
#
# Create a tall delimiter to match the line height
#
sub format_delimiter {
my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
return '' if $delim eq '' || $delim eq '.';
my $displayMode = $self->getPG('$displayMode');
return $self->format_delimiter_tth($delim,$rows,$tth)
if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
$rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
$delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
return '\(\left'.$delim.$rule.'\right.\)';
}
#
# Data for tth delimiters [top,mid,bot,rep]
#
my %tth_delim = (
'[' => ['','','',''],
']' => ['','','',''],
'(' => ['','','',''],
')' => ['','','',''],
'{' => ['','','',''],
'}' => ['','','',''],
'|' => ['|','','|','|'],
'<' => ['<'],
'>' => ['>'],
'\lgroup' => ['','','',''],
'\rgroup' => ['','','',''],
);
#
# Make delimiters as stacks of characters
#
sub format_delimiter_tth {
my $self = shift;
my $delim = shift; my $rows = shift; my $tth = shift;
return '' if $delim eq '' || !defined($tth_delim{$delim});
my $c = $delim; $delim = $tth_delim{$delim};
$c = $delim->[0] if scalar(@{$delim}) == 1;
my $size = ($tth? "": "font-size:175%; ");
return ''.$c.''
if $rows == 1 || scalar(@{$delim}) == 1;
my $HTML = "";
if ($delim->[1] eq '') {
$HTML = join('
',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
} else {
$HTML = join('
',$delim->[0],($delim->[3])x($rows-1),
$delim->[1],($delim->[3])x($rows-1),
$delim->[2]);
}
return ''.$HTML.'
';
}
#
# Look up the values of the answer array entries, and check them
# for syntax and other errors. Build the student answer
# based on these, and keep track of error messages.
#
my @ans_defaults = (showCoodinateHints => 0, checker => sub {0});
sub ans_collect {
my $self = shift; my $ans = shift;
my $inputs = $self->getPG('$inputs_ref');
my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
$data = [$data] unless ref($data->[0]) eq 'ARRAY';
foreach my $i (0..$rows-1) {
my @row = ();
foreach my $j (0..$cols-1) {
if ($i || $j) {
my $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
$OK &= entryCheck($result,$blank);
push(@row,$result->{student_formula});
entryMessage($result->{ans_message},$errors,$i,$j,$rows);
} else {
$ans->{student_formula} = $ans->{student_value} = undef unless $ans->{student_ans} =~ m/\S/;
$OK &= entryCheck($ans,$blank);
push(@row,$ans->{student_formula});
entryMessage($ans->{ans_message},$errors,$i,$j,$rows);
}
}
push(@array,[@row]);
}
$ans->{student_formula} = [@array];
$ans->{ans_message} = $ans->{error_message} = join("
",@{$errors});
return $OK && scalar(@{$errors}) == 0;
}
sub entryMessage {
my $message = shift; return unless $message;
my ($errors,$i,$j,$rows) = @_; $i++; $j++;
if ($rows == 1) {$message = "Coordinate $j: $message"}
else {$message = "Entry ($i,$j): $message"}
push(@{$errors},$message);
}
sub entryCheck {
my $ans = shift; my $blank = shift;
return 1 if defined($ans->{student_value});
if (!defined($ans->{student_formula})) {
$ans->{student_formula} = $ans->{student_ans};
$ans->{student_formula} = $blank unless $ans->{student_formula};
}
return 0
}
#
# Get and Set values in context
#
sub contextSet {
my $context = shift; my %set = (@_);
my $flags = $context->{flags}; my $get = {};
foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}}
return $get;
}
#
# Quote HTML characters
#
sub protectHTML {
my $string = shift;
return unless defined($string);
return $string if eval ('$main::displayMode') eq 'TeX';
$string =~ s/&/\&/g;
$string =~ s/\</g;
$string =~ s/>/\>/g;
$string;
}
#
# names for numbers
#
sub NameForNumber {
my $self = shift; my $n = shift;
my $name = ('zeroth','first','second','third','fourth','fifth',
'sixth','seventh','eighth','ninth','tenth')[$n];
$name = "$n-th" if ($n > 10);
return $name;
}
#
# Get a value from the safe compartment
#
sub getPG {
my $self = shift;
# (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
eval ('package main; '.shift); # faster
}
#############################################################
#############################################################
package Value::Real;
sub cmp_defaults {(
shift->SUPER::cmp_defaults(@_),
ignoreInfinity => 1,
)}
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return 1 unless ref($other);
return 0 if Value::isFormula($other);
return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
$self->type eq $other->type;
}
#############################################################
package Value::Infinity;
sub cmp_class {'a Number'};
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return 1 unless ref($other);
return 0 if Value::isFormula($other);
return 1 if $other->type eq 'Number';
$self->type eq $other->type;
}
#############################################################
package Value::String;
sub cmp_defaults {(
Value::Real->cmp_defaults(@_),
typeMatch => 'Value::Real',
)}
sub cmp_class {
my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
return $typeMatch->cmp_class;
};
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return 0 if ref($other) && Value::isFormula($other);
my $typeMatch = $ans->{typeMatch};
return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' ||
$self->type eq $other->type;
return $typeMatch->typeMatch($other,$ans);
}
#############################################################
package Value::Point;
sub cmp_defaults {(
shift->SUPER::cmp_defaults(@_),
showDimensionHints => 1,
showCoordinateHints => 1,
)}
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
}
#
# Check for dimension mismatch and incorrect coordinates
#
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 && !$ans->{isPreview};
my $student = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
if ($ans->{showDimensionHints} && $self->length != $student->length) {
$self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
}
if ($ans->{showCoordinateHints}) {
my @errors;
foreach my $i (1..$self->length) {
push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
if ($self->{data}[$i-1] != $student->{data}[$i-1]);
}
$self->cmp_Error($ans,@errors); return;
}
}
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
}
sub ANS_MATRIX {
my $self = shift;
my $extend = shift; my $name = shift;
my $size = shift || 5;
my $def = ($self->{context} || $$Value::context)->lists->get('Point');
my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
$self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
}
sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
#############################################################
package Value::Vector;
sub cmp_defaults {(
shift->SUPER::cmp_defaults(@_),
showDimensionHints => 1,
showCoordinateHints => 1,
promotePoints => 0,
parallel => 0,
sameDirection => 0,
)}
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return 0 unless ref($other) && $other->class ne 'Formula';
return $other->type eq 'Vector' ||
($ans->{promotePoints} && $other->type eq 'Point');
}
#
# check for dimension mismatch
# for parallel vectors, and
# for incorrect coordinates
#
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0;
my $student = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
$self->length != $student->length) {
$self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
}
if ($ans->{parallel} &&
$self->isParallel($student,$ans->{sameDirection})) {
$ans->score(1); return;
}
if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) {
my @errors;
foreach my $i (1..$self->length) {
push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
if ($self->{data}[$i-1] != $student->{data}[$i-1]);
}
$self->cmp_Error($ans,@errors); return;
}
}
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
unless $self->{ColumnVector};
my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
}
sub ANS_MATRIX {
my $self = shift;
my $extend = shift; my $name = shift;
my $size = shift || 5; my ($def,$open,$close);
$def = ($self->{context} || $$Value::context)->lists->get('Matrix');
$open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
if ($self->{ColumnVector});
$def = ($self->{context} || $$Value::context)->lists->get('Vector');
$open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
$self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
}
sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
#############################################################
package Value::Matrix;
sub cmp_defaults {(
shift->SUPER::cmp_defaults(@_),
showDimensionHints => 1,
showEqualErrors => 0,
)}
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return 0 unless ref($other) && $other->class ne 'Formula';
return $other->type eq 'Matrix' ||
($other->type =~ m/^(Point|list)$/ &&
$other->{open}.$other->{close} eq $self->{open}.$self->{close});
}
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 &&
!$ans->{isPreview} && $ans->{showDimensionHints};
my $student = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
my @d1 = $self->dimensions; my @d2 = $student->dimensions;
if (scalar(@d1) != scalar(@d2)) {
$self->cmp_Error($ans,"Matrix dimension is not correct");
return;
} else {
foreach my $i (0..scalar(@d1)-1) {
if ($d1[$i] != $d2[$i]) {
$self->cmp_Error($ans,"Matrix dimension is not correct");
return;
}
}
}
}
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
my @array = $self->value; @array = ([@array]) if $self->isRow;
Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
}
sub ANS_MATRIX {
my $self = shift;
my $extend = shift; my $name = shift;
my $size = shift || 5;
my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
my @d = $self->dimensions;
Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
if (scalar(@d) > 2);
@d = (1,@d) if (scalar(@d) == 1);
$self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
}
sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
#############################################################
package Value::Interval;
sub cmp_defaults {(
shift->SUPER::cmp_defaults(@_),
showEndpointHints => 1,
showEndTypeHints => 1,
requireParenMatch => 1,
)}
sub typeMatch {
my $self = shift; my $other = shift;
return 0 if !Value::isValue($other) || $other->isFormula;
return $other->canBeInUnion;
}
#
# Check for unreduced sets and unions
#
sub cmp_compare {
my $self = shift; my $student = shift; my $ans = shift;
my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
$self->SUPER::cmp_compare($student,$ans,@_);
}
#
# Check for wrong enpoints and wrong type of endpoints
#
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 && !$ans->{isPreview};
my $other = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
return unless $other->class eq 'Interval';
my @errors;
if ($ans->{showEndpointHints}) {
push(@errors,"Your left endpoint is incorrect")
if ($self->{data}[0] != $other->{data}[0]);
push(@errors,"Your right endpoint is incorrect")
if ($self->{data}[1] != $other->{data}[1]);
}
if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) {
push(@errors,"The type of interval is incorrect")
if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
}
$self->cmp_Error($ans,@errors);
}
#############################################################
package Value::Set;
sub typeMatch {
my $self = shift; my $other = shift;
return 0 if !Value::isValue($other) || $other->isFormula;
return $other->canBeInUnion;
}
#
# Use the List checker for sets, in order to get
# partial credit. Set the various types for error
# messages.
#
sub cmp_defaults {(
Value::List::cmp_defaults(@_),
typeMatch => 'Value::Real',
list_type => 'a set',
entry_type => 'a number',
removeParens => 0,
showParenHints => 1,
)}
#
# Use the list checker if the student answer is a set
# otherwise use the standard compare (to get better
# error messages).
#
sub cmp_equal {
my ($self,$ans) = @_;
return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
$self->SUPER::cmp_equal($ans);
}
#
# Check for unreduced sets and unions
#
sub cmp_compare {
my $self = shift; my $student = shift; my $ans = shift;
my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
$self->SUPER::cmp_compare($student,$ans,@_);
}
#############################################################
package Value::Union;
sub typeMatch {
my $self = shift; my $other = shift;
return 0 unless ref($other) && $other->class ne 'Formula';
return $other->length == 2 &&
($other->{open} eq '(' || $other->{open} eq '[') &&
($other->{close} eq ')' || $other->{close} eq ']')
if $other->type =~ m/^(Point|List)$/;
$other->isSetOfReals;
}
#
# Use the List checker for unions, in order to get
# partial credit. Set the various types for error
# messages.
#
sub cmp_defaults {(
Value::List::cmp_defaults(@_),
typeMatch => 'Value::Interval',
list_type => 'an interval, set or union',
short_type => 'a union',
entry_type => 'an interval or set',
)}
sub cmp_equal {
my $self = shift; my $ans = shift;
my $error = $self->cmp_checkUnionReduce($ans->{student_value},$ans);
if ($error) {$self->cmp_Error($ans,$error); return}
Value::List::cmp_equal($self,$ans);
}
#
# Check for unreduced sets and unions
#
sub cmp_compare {
my $self = shift; my $student = shift; my $ans = shift;
my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
$self->SUPER::cmp_compare($student,$ans,@_);
}
#############################################################
package Value::List;
sub cmp_defaults {
my $self = shift;
my %options = (@_);
my $element = Value::makeValue($self->{data}[0]);
$element = Value::Formula->new($element) unless Value::isValue($element);
return (
Value::Real->cmp_defaults(@_),
showHints => undef,
showLengthHints => undef,
showParenHints => undef,
partialCredit => undef,
ordered => 0,
entry_type => undef,
list_type => undef,
typeMatch => $element,
extra => $element,
requireParenMatch => 1,
removeParens => 1,
);
}
#
# Match anything but formulas
#
sub typeMatch {return !ref($other) || $other->class ne 'Formula'}
#
# Handle removal of outermost parens in correct answer.
#
sub cmp {
my $self = shift;
my $cmp = $self->SUPER::cmp(@_);
if ($cmp->{rh_ans}{removeParens}) {
$self->{open} = $self->{close} = '';
$cmp->ans_hash(correct_ans => $self->stringify)
unless defined($self->{correct_ans});
}
return $cmp;
}
sub cmp_equal {
my $self = shift; my $ans = shift;
$ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
#
# get the paramaters
#
my $showHints = getOption($ans,'showHints');
my $showLengthHints = getOption($ans,'showLengthHints');
my $showParenHints = getOption($ans,'showParenHints');
my $partialCredit = getOption($ans,'partialCredit');
my $requireParenMatch = $ans->{requireParenMatch};
my $typeMatch = $ans->{typeMatch};
my $value = $ans->{entry_type};
my $ltype = $ans->{list_type} || lc($self->type);
my $stype = $ans->{short_type} || $ltype;
$value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value')
unless defined($value);
$value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
$value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
$ltype =~ s/^an? //; $stype =~ s/^an? //;
$showHints = $showLengthHints = 0 if $ans->{isPreview};
#
# Get the lists of correct and student answers
# (split formulas that return lists or unions)
#
my @correct = (); my ($cOpen,$cClose);
if ($self->class ne 'Formula') {
@correct = $self->value;
$cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
} else {
@correct = Value::List->splitFormula($self,$ans);
$cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
}
my $student = $ans->{student_value}; my @student = ($student);
my ($sOpen,$sClose) = ('','');
if (Value::isFormula($student) && $student->type eq $self->type) {
@student = Value::List->splitFormula($student,$ans);
$sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
} elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
@student = @{$student->{data}};
$sOpen = $student->{open}; $sClose = $student->{close};
}
return if $ans->{split_error};
#
# Check for parenthesis match
#
if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
my $message = "The parentheses for your $ltype ";
if (($cOpen || $cClose) && ($sOpen || $sClose))
{$message .= "are of the wrong type"}
elsif ($sOpen || $sClose) {$message .= "should be removed"}
else {$message .= "seem to be missing"}
$self->cmp_Error($ans,$message) unless $ans->{isPreview};
}
return;
}
#
# Determine the maximum score
#
my $M = scalar(@correct);
my $m = scalar(@student);
my $maxscore = ($m > $M)? $m : $M;
#
# Compare the two lists
# (Handle errors in user-supplied functions)
#
my ($score,@errors);
if (ref($ans->{list_checker}) eq 'CODE') {
eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)};
if (!defined($score)) {
die $@ if $@ ne '' && $self->{context}{error}{flag} == 0;
$self->cmp_error($ans) if $self->{context}{error}{flag};
}
} else {
($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value);
}
return unless defined($score);
#
# Give hints about extra or missing answers
#
if ($showLengthHints) {
$value =~ s/( or|,) /s$1 /g; # fix "interval or union"
push(@errors,"There should be more ${value}s in your $stype")
if ($score < $maxscore && $score == $m);
push(@errors,"There should be fewer ${value}s in your $stype")
if ($score < $maxscore && $score == $M && !$showHints);
}
#
# If all the entries are in error, don't give individual messages
#
if ($score == 0) {
my $i = 0;
while ($i <= $#errors) {
if ($errors[$i++] =~ m/^Your .* is incorrect$/)
{splice(@errors,--$i,1)}
}
}
#
# Finalize the score
#
$score = 0 if ($score != $maxscore && !$partialCredit);
$ans->score($score/$maxscore);
push(@errors,"Score = $ans->{score}") if $ans->{debug};
my $error = join("\n",@errors); $error =~ s!\n!!g;
$ans->{error_message} = $ans->{ans_message} = $error;
}
#
# Compare the contents of the list to see of they are equal
#
sub cmp_list_compare {
my $self = shift;
my $correct = shift; my $student = shift; my $ans = shift; my $value = shift;
my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student);
my $ordered = $ans->{ordered};
my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview};
my $typeMatch = $ans->{typeMatch};
my $extra = $ans->{extra};
my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
my $error = $$Value::context->{error};
my $score = 0; my @errors; my $i = 0;
#
# Check for empty lists
#
if (scalar(@correct) == 0) {$ans->score($m == 0); return}
#
# Loop through student answers looking for correct ones
#
ENTRY: foreach my $entry (@student) {
$i++; $$Value::context->clearError;
$entry = Value::makeValue($entry);
$entry = Value::Formula->new($entry) if !Value::isValue($entry);
#
# Some words differ if ther eis only one entry in the student's list
#
my $nth = ''; my $answer = 'answer';
my $class = $ans->{list_type} || $self->cmp_class;
if ($m > 1) {
$nth = ' '.$self->NameForNumber($i);
$class = $ans->{cmp_class};
$answer = 'value';
}
#
# See if the entry matches the correct answer
# and perform syntax checking if not
#
if ($ordered) {
if (scalar(@correct)) {
if (shift(@correct)->cmp_compare($entry,$ans,$nth,$value)) {$score++; next ENTRY}
} else {
$extra->cmp_compare($entry,$ans,$nth,$value); # do syntax check
}
if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
} else {
foreach my $k (0..$#correct) {
if ($correct[$k]->cmp_compare($entry,$ans,$nth,$value)) {
splice(@correct,$k,1);
$score++; next ENTRY;
}
if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
}
$$Value::context->clearError;
$extra->cmp_compare($entry,$ans,$nth,$value); # do syntax check
}
#
# Give messages about incorrect answers
#
if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
!($ans->{ignoreStrings} && $entry->class eq 'String')) {
push(@errors,"Your$nth $answer isn't ".lc($class).
" (it looks like ".lc($entry->showClass).")");
} elsif ($error->{flag} && $ans->{showEqualErrors}) {
my $message = $error->{message}; $message =~ s/\s+$//;
if ($m > 1 && $error->{flag} != $CMP_WARNING) {
push(@errors,"There is a problem with your$nth $value:",
''.$message.'
');
} else {push(@errors,$message)}
} elsif ($showHints && $m > 1) {
push(@errors,"Your$nth $value is incorrect");
}
}
#
# Return the score and errors
#
return ($score,@errors);
}
#
# Split a formula that is a list or union into a
# list of formulas (or Value objects).
#
sub splitFormula {
my $self = shift; my $formula = shift; my $ans = shift;
my @formula; my @entries;
if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion}
else {@entries = @{$formula->{tree}{coords}}}
foreach my $entry (@entries) {
my $v = Parser::Formula($entry);
$v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
push(@formula,$v);
#
# There shouldn't be an error evaluating the formula,
# but you never know...
#
if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
}
return @formula;
}
#
# Return the value if it is defined, otherwise use a default
#
sub getOption {
my $ans = shift; my $name = shift;
my $value = $ans->{$name};
return $value if defined($value);
return $ans->{showPartialCorrectAnswers};
}
#############################################################
package Value::Formula;
sub cmp_defaults {
my $self = shift;
return (
Value::Union::cmp_defaults($self,@_),
typeMatch => Value::Formula->new("(1,2]"),
showDomainErrors => 1,
) if $self->type eq 'Union';
my $type = $self->type;
$type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
$type = 'Value::'.$type.'::';
return (
&{$type.'cmp_defaults'}($self,@_),
upToConstant => 0,
showDomainErrors => 1,
) if defined(%$type) && $self->type ne 'List';
return (
Value::List::cmp_defaults($self,@_),
removeParens => $self->{autoFormula},
typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]),
showDomainErrors => 1,
);
}
#
# Get the types from the values of the formulas
# and compare those.
#
sub typeMatch {
my $self = shift; my $other = shift; my $ans = shift;
return 1 if $self->type eq $other->type;
my $typeMatch = ($self->createRandomPoints(1))[1]->[0];
$other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
return 1 unless defined($other); # can't really tell, so don't report type mismatch
$typeMatch->typeMatch($other,$ans);
}
#
# Handle removal of outermost parens in a list.
#
sub cmp {
my $self = shift;
my $cmp = $self->SUPER::cmp(@_);
if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
$self->{tree}{open} = $self->{tree}{close} = '';
$cmp->ans_hash(correct_ans => $self->stringify)
unless defined($self->{correct_ans});
}
if ($cmp->{rh_ans}{eval} && $self->isConstant) {
$cmp->ans_hash(correct_value => $self->eval);
return $cmp;
}
if ($cmp->{rh_ans}{upToConstant}) {
my $current = Parser::Context->current();
my $context = $self->{context} = $self->{context}->copy;
Parser::Context->current(undef,$context);
$context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
'C0|' . $context->{_variables}->{pattern};
$context->update; $context->variables->add('C0' => 'Parameter');
my $f = Value::Formula->new('C0')+$self;
for ('limits','test_points','test_values','num_points','granularity','resolution',
'checkUndefinedPoints','max_undefined')
{$f->{$_} = $self->{$_} if defined($self->{$_})}
$cmp->ans_hash(correct_value => $f);
Parser::Context->current(undef,$current);
}
return $cmp;
}
sub cmp_equal {
my $self = shift; my $ans = shift;
#
# Get the problem's seed
#
$self->{context}->flags->set(
random_seed => $self->getPG('$PG_original_problemSeed')
);
#
# Use the list checker if the formula is a list or union
# Otherwise use the normal checker
#
if ($self->type =~ m/^(List|Union|Set)$/) {
Value::List::cmp_equal($self,$ans);
} else {
$self->SUPER::cmp_equal($ans);
}
}
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 && !$ans->{isPreview};
return if $ans->{ans_message};
if ($self->{domainMismatch} && $ans->{showDomainErrors}) {
$self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer");
return;
}
return if !$ans->{showDimensionHints};
my $other = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
return unless $self->type =~ m/^(Point|Vector|Matrix)$/;
return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
$self->cmp_Error($ans,"The dimension of your result is incorrect");
}
#
# If an answer array was used, get the data from the
# Matrix, Vector or Point, and format the array of
# data using the original parameter
#
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
my @array = ();
if ($self->{tree}->type eq 'Matrix') {
foreach my $row (@{$self->{tree}{coords}}) {
my @row = ();
foreach my $x (@{$row->coords}) {push(@row,$x->string)}
push(@array,[@row]);
}
} else {
foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
else {@array = [@array]}
}
Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
}
#
# Get the size of the array and create the appropriate answer array
#
sub ANS_MATRIX {
my $self = shift;
my $extend = shift; my $name = shift;
my $size = shift || 5; my $type = $self->type;
my $cols = $self->length; my $rows = 1; my $sep = ',';
if ($type eq 'Matrix') {
$sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
}
if ($self->{tree}{ColumnVector}) {
$sep = ""; $type = "Matrix";
my $tmp = $rows; $rows = $cols; $cols = $tmp;
$self->{ColumnVector} = 1;
}
my $def = ($self->{context} || $$Value::context)->lists->get($type);
my $open = $self->{open} || $self->{tree}{open} || $def->{open};
my $close = $self->{close} || $self->{tree}{close} || $def->{close};
$self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
}
sub ans_array {
my $self = shift;
return $self->SUPER::ans_array(@_) unless $self->array_OK;
$self->ANS_MATRIX(0,'',@_);
}
sub named_ans_array {
my $self = shift;
return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
$self->ANS_MATRIX(0,@_);
}
sub named_ans_array_extension {
my $self = shift;
return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
$self->ANS_MATRIX(1,@_);
}
sub array_OK {
my $self = shift; my $tree = $self->{tree};
return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List';
}
#
# Get an array of values from a Matrix, Vector or Point
#
sub value {
my $self = shift;
my @array = ();
if ($self->{tree}->type eq 'Matrix') {
foreach my $row (@{$self->{tree}->coords}) {
my @row = ();
foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))}
push(@array,[@row]);
}
} else {
foreach my $x (@{$self->{tree}->coords}) {
push(@array,Value::Formula->new($x));
}
}
return @array;
}
#############################################################
1;