=head1 DESCRIPTION ############################################################# # # Implements the ->cmp method for Value objects. # Otherwise known as MathObjects. This produces # an answer checker appropriate for the type of object. # Additional options can be passed to the cmp method to # modify its action. # # Usage: $num = Real(3.45); # Real can be replaced by any other MathObject # ANS($num->cmp(compareOptionName => compareOptionValue, ... )) # # The individual Value packages are modified below to add the # needed methods. # ############################################################# =cut package Value; use PGcore; # # Context can add default values to the answer checkers by class; # $Value::defaultContext->{cmpDefaults} = {}; =head4 $mathObject->cmp_defaults() # Internal use. # Set default flags for the answer checker in this object # showTypeWarnings => 1 # showEqualErrors => 1 # ignoreStrings => 1 # studentsMustReduceUnions => 1 # showUnionReduceWarnings => 1 # =cut sub cmp_defaults { ( showTypeWarnings => 1, showEqualErrors => 1, ignoreStrings => 1, studentsMustReduceUnions => 1, showUnionReduceWarnings => 1, ) } # # Special Context flags to be set for the student answer # sub cmp_contextFlags { my $self = shift; my $ans = shift; return ( StringifyAsTeX => 0, # reset this, just in case. no_parameters => 1, # don't let students enter parameters showExtraParens => 2, # 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 ); } # # Create an answer checker for the given type of object # sub cmp { my $self = shift; my $ans = new AnswerEvaluator; my $correct = preformat($self->{correct_ans}); $correct = $self->correct_ans unless defined($correct); my $correct_latex = $self->{correct_ans_latex_string}; $correct_latex = $self->correct_ans_latex unless defined($correct_latex); $self->{context} = Value->context unless defined($self->{context}); $ans->ans_hash( type => "Value (" . $self->class . ")", correct_ans => $correct, correct_ans_latex_string => $correct_latex, correct_value => $self, $self->cmp_defaults(@_), %{ $self->{context}{cmpDefaults}{ $self->class } || {} }, # context-specified defaults @_, ); $ans->{debug} = $ans->{rh_ans}{debug}; $ans->install_evaluator(sub { my $ans = shift; $ans->{_filter_name} = "MathObjects answer checker"; $ans->{correct_value}->cmp_parse($ans); }); $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array $self->cmp_diagnostics($ans); return $ans; } sub correct_ans { preformat(shift->string) } sub correct_ans_latex { shift->TeX } sub cmp_diagnostics { } # # 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 $context = $ans->{correct_value}{context} || $current; Parser::Context->current(undef, $context); # change to correct answser's context my $flags = contextSet($context, $self->cmp_contextFlags($ans)); # save old context flags my $inputs = $self->getPG('$inputs_ref'); $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} = ''; $context->clearError(); $context->{answerHash} = $ans; # values here can override context flags # # Parse and evaluate the student answer # $ans->score(0); # assume failure $context->flags->set( parseMathQuill => $context->flag("useMathQuill") && (!defined $context->{answerHash}{mathQuillOpts} || $context->{answerHash}{mathQuillOpts} !~ /^\s*disabled\s*$/i) ); $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; $context->flags->set(parseMathQuill => 0); # # 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} = $self->Package("Formula")->new($ans->{student_value}) unless Value::isValue($ans->{student_value}); $ans->{student_value}{isStudent} = 1; $ans->{preview_latex_string} = $ans->{student_formula}->TeX; $ans->{preview_text_string} = preformat($ans->{student_formula}->string); # # Get the string for the student answer # for ($self->getFlag('formatStudentAnswer')) { /evaluated/i and do { $ans->{student_ans} = preformat($ans->{student_value}->string); last }; /parsed/i and do { $ans->{student_ans} = $ans->{preview_text_string}; last }; /reduced/i and do { my $oldFlags = contextSet($context, reduceConstants => 1, reduceConstantFunctions => 0); $ans->{student_ans} = preformat($ans->{student_formula}->substitute()->string); contextSet($context, %{$oldFags}); last; }; warn "Unknown student answer format |$ans->{formatStudentAnswer}|"; } if ($self->cmp_collect($ans)) { $self->cmp_preprocess($ans); $self->cmp_equal($ans); $self->cmp_postprocess($ans) if !$ans->{error_message} && !$ans->{typeError}; $self->cmp_diagnostics($ans); } } else { $ans->{student_ans} = protectHTML($ans->{student_ans}); $self->cmp_collect($ans); $self->cmp_error($ans); } $context->{answerHash} = undef; contextSet($context, %{$flags}); # restore context values 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) { my @d = ($self->classMatch("Matrix") ? $self->dimensions : (1)); $array = $array->[0] if scalar(@d) == 1; } my $type = $self; $type = $self->Package($self->{tree}->type) if $self->isFormula; $ans->{student_formula} = eval { $type->new($array)->with(ColumnVector => $self->{ColumnVector}) }; if (!defined($ans->{student_formula}) || $self->context->{error}{flag}) { Parser::reportEvalError($@); $self->cmp_error($ans); return 0; } $ans->{student_formula}{tree}{open} = $self->{open} if $self->{open}; $ans->{student_formula}{tree}{close} = $self->{close} if $self->{close}; $ans->{student_value} = $ans->{student_formula}; $ans->{preview_text_string} = $ans->{student_ans}; $ans->{preview_latex_string} = $ans->{student_formula}->TeX; return 0 if $ans->{typeError}; 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)) { $self->context->clearError(); my $equal = $correct->cmp_compare($student, $ans); if ($self->context->{error}{flag} != $CMP_MESSAGE && (defined($equal) || !$ans->{showEqualErrors})) { $ans->score(0 + $equal) if $equal; return; } $self->cmp_error($ans); } else { return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); $ans->{typeError} = 1; $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 our $CMP_MESSAGE = 4; # a message should be reported for this check sub cmp_compare { my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || ''; my $context = (Value::isValue($self) ? $self->context : Value->context); return eval { $self == $other } unless ref($ans->{checker}) eq 'CODE'; my @equal = eval { &{ $ans->{checker} }($self, $other, $ans, $nth, @_) }; if (!defined($equal) && $@ ne '' && (!$context->{error}{flag} || $ans->{showAllErrors})) { $nth = "" if ref($nth) eq 'AnswerHash'; $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 (wantarray ? @equal : $equal[0]); } 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->isFormula; } # # 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 = $self->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", @_); } # # Force a message into the results message column and die # (To be used when overriding Parser classes that need # to report errors to the student but can't do it in # the overridden == since errors are trapped.) # sub cmp_Message { my $message = shift; my $context = Value->context; $message = [ $message, @_ ] if scalar(@_) > 0; $context->setError($message, '', undef, undef, $CMP_MESSAGE); $message = $context->{error}{message}; die $message . traceback() if $context->flags('showTraceback'); die $message . getCaller(); } # # filled in by sub-classes # sub cmp_preprocess { } sub cmp_postprocess { } # # Used to call an object's method as a pre- or post-filter. # E.g., # $cmp->install_pre_filter(\&Value::cmp_call_filter,"cmp_prefilter"); # sub cmp_call_filter { my $ans = shift; my $method = shift; return $ans->{correct_value}->$method($ans, @_); } # # 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); return unless $student->isSetOfReals; my ($result, $error) = $student->isReduced; return unless $error; return { "overlaps" => "Your$nth union contains overlapping intervals", "overlaps in sets" => "Your$nth union contains sets and intervals that overlap", "uncombined intervals" => "Your$nth union can be simplified by combining intervals", "uncombined sets" => "Your$nth union can be simplified by combining some sets", "repeated elements in set" => "Your$nth union contains sets with repeated elements", "repeated elements" => "Your$nth set should have no repeated elements", }->{$error}; } # # 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 = shift; my $name = shift; my $rows = shift; my $cols = shift; my $size = shift; my $open = shift; my $close = shift; my $sep = shift; my $toplabels = shift; my %options = @_; #die(join(';',map {"$_ and $options{$_}"} keys %options)); my $named_extension = pgRef('NAMED_ANS_ARRAY_EXTENSION'); my $named_ans_rule = pgRef('NAMED_ANS_RULE'); my $HTML = ""; pgCall('RECORD_IMPLICIT_ANS_NAME', $name = pgCall('NEW_ANS_NAME')) unless $name; my $ename = "${answerPrefix}_${name}"; $self->{ans_name} = $ename; $self->{ans_rows} = $rows; $self->{ans_cols} = $cols; # warn "ans_matrix: ename=$ename answer_group_name=$options{answer_group_name}"; my @array = (); foreach my $i (0 .. $rows - 1) { my @row = (); foreach my $j (0 .. $cols - 1) { my $label; if ($options{aria_label}) { $label = $options{aria_label} . 'row ' . ($i + 1) . ' col ' . ($j + 1); } else { $label = pgCall('generate_aria_label', ANS_NAME($ename, $i, $j)); } my $answer_group_name = $options{answer_group_name} // $name; if ($i == 0 && $j == 0) { if ($extend) { push( @row, &$named_extension( $name, $size, answer_group_name => $answer_group_name, aria_label => $label ) ); } else { push(@row, &$named_ans_rule($name, $size, aria_label => $label)); } } else { push( @row, &$named_extension( ANS_NAME($ename, $i, $j), $size, answer_group_name => $answer_group_name, aria_label => $label ) ); } } push(@array, [@row]); } $self->format_matrix( [@array], open => $open, close => $close, sep => $sep, top_labels => $toplabels, ans_last_name => ANS_NAME($ename, $rows - 1, $cols - 1) ); } sub ANS_NAME { my ($name, $i, $j) = @_; $name . '_' . $i . '_' . $j; } # # Lay out an arbitrary matrix # sub format_matrix { my $self = shift; my $array = shift; my $displayMode = $self->getPG('$displayMode'); $array = [$array] unless ref($array->[0]) eq 'ARRAY'; return $self->format_matrix_tex($array, @_) if ($displayMode eq 'TeX'); return $self->format_matrix_PTX($array, @_) if ($displayMode eq 'PTX'); return $self->format_matrix_HTML($array, @_); } 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 = ""; my @rows = (); $open = '\\' . $open if $open =~ m/[{}]/; $close = '\\' . $close if $close =~ m/[{}]/; $tex .= '\(\left' . $open . '\let\quad=\relax'; # WHY is there a \quad in the answer rule extension? $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,' . $sep if $sep; $tex .= '\begin{array}{' . ('c' x $cols) . '}'; if ($options{top_labels}) { push @rows, join($sep . '&', @{ $options{top_labels} }); } foreach my $i (0 .. $rows - 1) { push(@rows, join($sep . '&', @{ $array->[$i] })) } $tex .= join('\cr' . "\n", @rows); $tex .= '\end{array}\right' . $close . '\)'; return $tex; } sub format_matrix_PTX { my $self = shift; my $array = shift; my ($rows, $cols) = (scalar(@{$array}), scalar(@{ $array->[0] })); my $ptx = ' 1; $ptx .= qq( cols="$cols") if $cols > 1; $ptx .= '/>'; return $ptx; } 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 = ""; my $class = 'class="ans_array_cell"'; my $cell = "display:table-cell;vertical-align:middle;"; my $pad = "padding:4px 0;"; if ($sep) { $sep = '' . $sep . '' } else { $sep = '' } $sep = '' . $sep . ''; if ($options{top_labels}) { $HTML .= '' . join($sep, @{ $options{top_labels} }) . ''; } foreach my $i (0 .. $rows - 1) { $HTML .= '' . join($sep, EVALUATE(@{ $array->[$i] })) . ''; } $HTML = '' . $HTML . ''; $open = $self->format_delimiter($open, $rows, $options{tth_delims}); $close = $self->format_delimiter($close, $rows, $options{tth_delims}); if ($open ne '' || $close ne '') { my $delim = "display:inline-block; vertical-align:middle;"; $HTML = '' . $open . '' . $HTML . '' . $close . ''; } return '' . $HTML . ''; } sub EVALUATE { map { (Value::isFormula($_) && $_->isConstant ? $_->eval : $_) } @_; } 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 ' . $rows . 'em depth 0pt'; $rule = '\Rule{0pt}{' . (1.2 * $rows) . 'em}{0pt}' if $displayMode eq 'HTML_MathJax'; $rule = '\rule 0pt ' . (1.2 * $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] # $tth_family = "symbol"; 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_cmp_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 = (); my $entry; foreach my $j (0 .. $cols - 1) { if ($i || $j) { $entry = $inputs->{ ANS_NAME($self->{ans_name}, $i, $j) }; } else { $entry = $ans->{original_student_ans}; $ans->{student_formula} = $ans->{student_value} = undef unless $entry =~ m/\S/; } # Pass the mathQuillOpts on to each entry to ensure that the correct parsing is used for each entry. # This really only needs to know if MathQuill is disabled or not, but it is more efficient to just pass on the reference. # The value is safely ignored if $ans->{mathQuillOpts} does not match /^\s*disabled\s*$/i. my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults, mathQuillOpts => $ans->{mathQuillOpts})->evaluate($entry); $OK &= entryCheck($result, $blank); $ans->{typeError} = 1 if $result->{typeError}; push(@row, $result->{student_formula}); entryMessage($result->{ans_message}, $errors, $i, $j, $rows, $cols); } push(@array, [@row]); } $ans->{student_formula} = [@array]; $ans->{ans_message} = $ans->{error_message} = ""; if (scalar(@{$errors})) { $ans->{ans_message} = $ans->{error_message} = '' . join('', @{$errors}) . '
'; $OK = 0; } return $OK; } sub entryMessage { my $message = shift; return unless $message; my ($errors, $i, $j, $rows, $cols) = @_; $i++; $j++; my $title; if ($rows == 1) { $title = "In entry $j" } elsif ($cols == 1) { $title = "In entry $i" } else { $title = "In entry ($i,$j)" } push( @{$errors}, "$title: " . "$message" ); } sub entryCheck { my $ans = shift; my $blank = shift; return 1 if defined($ans->{student_value}) || $ans->{typeError}; 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; } # # Convert newlines to
# sub preformat { my $string = protectHTML(shift); return unless defined $string; $string =~ s!\n!
!g unless eval('$main::displayMode') eq 'TeX'; $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 } ############################################################# ############################################################# =head3 Value::Real Usage ANS( Real(3.56)->cmp() ) Compares response to a real value using 'fuzzy' comparison compareOptions and default values: showTypeWarnings => 1, showEqualErrors => 1, ignoreStrings => 1, =cut 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; } ############################################################# =head3 Value::String Usage: $s = String("pole"); ANS($s->cmp(typeMatch => Complex("4+i"))); # compare to response 'pole', don't complain about complex number responses. compareOptions and default values: showTypeWarnings => 1, showEqualErrors => 1, ignoreStrings => 1, # don't complain about string-valued responses typeMatch => 'Value::Real' Initial and final spaces are ignored when comparing strings. =cut 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->classMatch('String'); return $typeMatch->cmp_class; } sub typeMatch { my $self = shift; my $other = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch}; return &$typeMatch($other, $ans) if ref($typeMatch) eq 'CODE'; return 1 if !Value::isValue($typeMatch) || $typeMatch->classMatch('String') || $self->type eq $other->type; return $typeMatch->typeMatch($other, $ans); } # # Remove the blank-check prefilter when the string is empty, # and add a filter that removes leading and trailing whitespace. # Also, properly quote the correct answer string. # sub cmp { my $self = shift; my $correct = ($self->{correct_ans} || $self->string); my $cmp = $self->SUPER::cmp( correct_ans => $self->quoteHTML($correct), correct_ans_latex_string => $self->quoteTeX($correct), @_ ); if ($self->value =~ m/^\s*$/) { $cmp->install_pre_filter('erase'); $cmp->install_pre_filter(sub { my $ans = shift; $ans->{student_ans} =~ s/^\s+//g; $ans->{student_ans} =~ s/\s+$//g; return $ans; }); } return $cmp; } # # Adjust student preview and anser strings so they display properly # sub cmp_preprocess { my $self = shift; my $ans = shift; if (defined $ans->{student_value}) { $ans->{preview_latex_string} = $ans->{student_value}->TeX; $ans->{student_ans} = $self->quoteHTML($ans->{student_value}->string); } } ############################################################# =head3 Value::Point Usage: $pt = Point("(3,6)"); # preferred or $pt = Point(3,6); or $pt = Point([3,6]); ANS($pt->cmp()); compareOptions: showTypeWarnings => 1, # warns if student response is of incorrect type showEqualErrors => 1, ignoreStrings => 1, showDimensionHints => 1, # reports incorrect number of coordinates showCoordinateHints =>1, # flags individual coordinates that are incorrect =cut 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->isFormula; } # # 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 %options = @_; my $def = $self->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, ',', '', %options); } 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, @_) } ############################################################# =head3 Value::Vector Usage: $vec = Vector("<3,6,7>"); or $vec = Vector(3,6,7); or $vec = Vector([3,6,7]); ANS($vec->cmp()); compareOptions: showTypeWarnings => 1, # warns if student response is of incorrect type showEqualErrors => 1, ignoreStrings => 1, showDimensionHints => 1, # reports incorrect number of coordinates showCoordinateHints => 1, # flags individual coordinates which are incorrect promotePoints => 0, # allow students to enter vectors as points (3,5,6) parallel => 1, # response is correct if it is parallel to correct answer sameDirection => 1, # response is correct if it has same orientation as correct answer # (only has an effect when parallel => 1 is specified) =cut 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->isFormula; 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 && !$ans->{isPreview}; my $student = $ans->{student_value}; return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); if ($self->length != $student->length) { ($self, $student) = $self->cmp_pad($student); if ($ans->{showDimensionHints} && $self->length != $student->length) { $self->cmp_Error($ans, "The number of coordinates is incorrect"); return; } } if ($ans->{parallel} && !$student->isFormula && !$student->classMatch('String') && $self->isParallel($student, $ans->{sameDirection})) { $ans->score(1); return; } if ($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; } } # # Pad the student or correct answer if either is in ijk notation # and they are not the same dimension. Only add zeros when the other one # also has zeros in those places. # sub cmp_pad { my $self = shift; my $student = shift; if (($self->getFlag("ijk") || $student->getFlag("ijk")) && $self->getFlag("ijkAnyDimension")) { $self = $self->copy; $student = $student->copy; while ($self->length > $student->length && $self->{data}[ $student->length ] == 0) { push(@{ $student->{data} }, Value::Real->new(0)); } while ($self->length < $student->length && $student->{data}[ $self->length ] == 0) { push(@{ $self->{data} }, Value::Real->new(0)); } } return ($self, $student); } 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 %options = @_; my ($def, $open, $close); $def = $self->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, '',, '', %options) if ($self->{ColumnVector}); $def = $self->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, ',', '', %options); } 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, @_) } ############################################################# =head3 Value::Matrix Usage $ma = Matrix([[3,6],[2,5]]) or $ma =Matrix([3,6],[2,5]) ANS($ma->cmp()); compareOptions: showTypeWarnings => 1, # warns if student response is of incorrect type showEqualErrors => 1, # reports messages that occur during element comparisons ignoreStrings => 1, showDimensionHints => 1, # reports incorrect number of coordinates showCoordinateHints => 1, # flags individual coordinates which are incorrect =cut 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->isFormula; return $other->type eq 'Matrix' || ($other->type =~ m/^(Point|List)$/ && $other->{open} . $other->{close} eq $self->{open} . $self->{close}); } sub cmp_preprocess { my $self = shift; my $ans = shift; my $student = $ans->{student_value}; return if $student->type ne 'Matrix'; my @d1 = $self->dimensions; my @d2 = $student->dimensions; $ans->{student_value} = $student->make([ $student->value ]) if (scalar(@d2) == 1 && scalar(@d1) == 2); } 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 %options = @_; my $def = $self->context->lists->get('Matrix'); my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close}; my $sep = ''; my $toplabels = ($self->{top_labels}) ? $self->{top_labels} : ''; 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, $sep, $toplabels, %options); } 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, @_) } ############################################################# =head3 Value::Interval Usage: $interval = Interval("(1,2]"); or $interval = Interval('(',1,2,']'); ANS($inteval->cmp); compareOptions and defaults: showTypeWarnings => 1, showEqualErrors => 1, ignoreStrings => 1, showEndpointHints => 1, # show hints about which end point values are correct showEndTypeHints => 1, # show hints about endpoint types requireParenMatch => 1, =cut 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) { $self->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->classMatch('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); } ############################################################# =head3 Value::Set Usage: $set = Set(5,6,'a', 'b') or $set = Set("{5, 6, a, b}") The object is a finite set of real numbers. It can be used with Union and Interval. Examples: Interval("(-inf,inf)") - Set(0) Compute("R-{0}") # in Interval context: Context("Interval"); =cut 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, implicitList => 0, ) } # # 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 $self->SUPER::cmp_equal($ans) unless $ans->{student_value}->type eq 'Set'; my $error = $self->cmp_checkUnionReduce($ans->{student_value}, $ans); if ($error) { $self->cmp_Error($ans, $error); return } return Value::List::cmp_equal(@_); } # # 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) { $self->context->setError($error, '', undef, undef, $CMP_WARNING); return } $self->SUPER::cmp_compare($student, $ans, @_); } ############################################################# =head3 Value::Union Usage: $union = Union("[4,5] U [6,7]"); or $union = Union(Interval("[4,5]",Interval("[6,7]")); ANS($union->cmp()); =cut package Value::Union; sub typeMatch { my $self = shift; my $other = shift; return 0 unless ref($other) && !$other->isFormula; 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. # my $typeMatchInterval = Value::Interval->make(0, 1); sub cmp_defaults { ( Value::List::cmp_defaults(@_), typeMatch => $typeMatchInterval, 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 } if ($self->typeMatch($ans->{student_value})) { Value::List::cmp_equal($self, $ans); } else { $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) { $self->context->setError($error, '', undef, undef, $CMP_WARNING); return } $self->SUPER::cmp_compare($student, $ans, @_); } ############################################################# =head3 Value::List Usage: $lst = List("1, x, <4,5,6>"); # list of a real, a formula and a vector. or $lst = List(Real(1), Formula("x"), Vector(4,5,6)); ANS($lst->cmp(showHints=>1)); compareOptions and defaults: showTypeWarnings => 1, showEqualErrors => 1, # show errors produced when checking equality of entries ignoreStrings => 1, # don't show type warnings for strings studentsMustReduceUnions => 1, showUnionReduceWarnings => 1, showHints => undef, # automatically set to 1 if $showPartialCorrectAnswers == 1 showLengthHints => undef, # automatically set to 1 if $showPartialCorrectAnswers == 1 showParenHints => undef, # automatically set to 1 if $showPartialCorrectAnswers == 1 partialCredit => undef, # automatically set to 1 if $showPartialCorrectAnswers == 1 ordered => 0, # 1 = must be in same order as correct answer entry_type => undef, # determined from first entry list_type => undef, # determined automatically typeMatch => $element, # used for type checking the entries firstElement => $element, extra => undef, # used to check syntax of incorrect answers requireParenMatch => 1, # student parens must match correct parens removeParens => 1, # remove outermost parens, if any implicitList => 1, # force single answers to be lists (even if they ARE lists) =cut package Value::List; sub cmp_defaults { my $self = shift; my %options = (@_); my $element = Value::makeValue($self->{data}[0], context => $self->context); $element = $self->Package("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, firstElement => $element, extra => undef, requireParenMatch => 1, removeParens => 1, implicitList => 1, ); } # # Match anything but formulas # sub typeMatch { return !ref($other) || !$other->isFormula } # # Handle removal of outermost parens in correct answer. # sub cmp { my $self = shift; my %params = @_; my $cmp = $self->SUPER::cmp(@_); if ($cmp->{rh_ans}{removeParens} && ($self->{open} || $self->{close})) { $self->{open} = $self->{close} = ''; $cmp->ans_hash(correct_ans => $self->stringify) unless defined($self->{correct_ans}) || defined($params{correct_ans}); $cmp->ans_hash(correct_ans_latex_string => $self->TeX) unless defined($self->{correct_ans_latex_string}) || defined($params{correct_ans_latex_string}); } 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 $implicitList = $ans->{implicitList}; 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) : 'a 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->isFormula) { @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) { if ($implicitList && $student->{tree}{open} ne '') { @student = ($student); } else { @student = Value::List->splitFormula($student, $ans); $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close}; } } elsif (!$student->isFormula && $student->classMatch($self->type)) { if ($implicitList && $student->{open} ne '') { @student = ($student); } else { @student = @{ $student->{data} }; $sOpen = $student->{open}; $sClose = $student->{close}; } } return if $ans->{split_error}; foreach my $x (@correct) { $x->{equation} = $self } foreach my $x (@student) { $x->{equation} = $self } # # 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 $context = $self->context; 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 = defined($ans->{extra}) ? $ans->{extra} : (Value::isValue($typeMatch) ? $typeMatch : $ans->{firstElement}); $extra = $self->Package("List")->new() unless defined($extra); my $showHints = getOption($ans, 'showHints') && !$ans->{isPreview}; my $error = $context->{error}; my $score = 0; my @errors; my $i = 0; # # Check for empty lists # if (scalar(@correct) == 0) { $ans->score($m == 0 ? 1 : 0); return } # # Loop through student answers looking for correct ones # ENTRY: foreach my $entry (@student) { $i++; $context->clearError; $entry = Value::makeValue($entry, $context); $entry = $self->Package("Formula")->new($entry) if !Value::isValue($entry); # # Some words differ if there is only one entry in the student's list # my $nth = ''; my $answer = 'answer'; my $class = $ans->{list_type} || $ans->{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)) { my $correct = shift(@correct); if ($correct->typeMatch($entry) && $correct->cmp_compare($entry, $ans, $nth, $value)) { $score++; next ENTRY; } } else { # do syntax check if (ref($extra) eq 'CODE') { &$extra($entry, $ans, $nth, $value) } else { $extra->cmp_compare($entry, $ans, $nth, $value) } } if ($error->{flag} == $CMP_ERROR) { $self->cmp_error($ans); return } } else { foreach my $k (0 .. $#correct) { if ($correct[$k]->typeMatch($entry) && $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 } } $context->clearError; # do syntax check if (ref($extra) eq 'CODE') { &$extra($entry, $ans, $nth, $value) } else { $extra->cmp_compare($entry, $ans, $nth, $value) } } # # Give messages about incorrect answers # my $match = (ref($typeMatch) eq 'CODE') ? &$typeMatch($entry, $ans) : $typeMatch->typeMatch($entry, $ans); if ($showTypeWarnings && !$match && !($ans->{ignoreStrings} && $entry->classMatch('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); if (!defined($v)) { $ans->{split_error} = 1; $self->cmp_error($ans); return } $v->{equation} = $self; push(@formula, $v); } return @formula; } # # Override for List ? # 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}; } ############################################################# =head3 Value::Formula Usage: $fun = Formula("x^2-x+1"); $set = Formula("[-1, x) U (x, 2]"); A formula can have any of the other math object types as its range. Union, List, Number (Complex or Real), =cut package Value::Formula; sub cmp_defaults { my $self = shift; return ( Value::Union::cmp_defaults($self, @_), typeMatch => $self->Package("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 = $self->Package($type) . '::'; return ( &{ $type . 'cmp_defaults' }($self, @_), upToConstant => 0, showDomainErrors => 1, ) if %$type && $self->type ne 'List'; my $element; if ($self->{tree}->class eq 'List') { $element = $self->Package("Formula")->new($self->{tree}{coords}[0]) } else { $element = $self->Package("Formula")->new(($self->createRandomPoints(1))[1]->[0]{data}[0]) } return ( Value::List::cmp_defaults($self, @_), removeParens => $self->{autoFormula}, typeMatch => $element, 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->getTypicalValue($self); $other = $self->getTypicalValue($other, 1) if Value::isFormula($other); return 1 unless defined($other); # can't really tell, so don't report type mismatch return 1 if $typeMatch->classMatch('String') && Value::isFormula($ans->{typeMatch}); # avoid infinite loop $typeMatch->typeMatch($other, $ans); } # # Create a value from the formula (so we know the output type) # sub getTypicalValue { my $self = shift; my $f = shift; my $noError = shift; return $f->{test_values}[0] if $f->{test_values}; my $points = $f->{test_points} || $self->{test_points}; return ($f->createPointValues($points) || [])->[0] if $points; return ((($f->createRandomPoints(1, undef, $noError))[1]) || [])->[0]; } # # Handle removal of outermost parens in a list. # Evaluate answer, if the eval option is used. # Handle the UpToConstant option. # sub cmp { my $self = shift; my %params = @_; my $cmp = $self->SUPER::cmp(@_); if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List' && ($self->{tree}{open} || $self->{tree}{close})) { $self->{tree}{open} = $self->{tree}{close} = ''; $cmp->ans_hash(correct_ans => $self->stringify) unless defined($self->{correct_ans}) || defined($params{correct_ans}); $cmp->ans_hash(correct_ans_latex_string => $self->stringify) unless defined($self->{correct_ans_latex_string}) || defined($params{correct_ans_latex_string}); } 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->add('C0' => 'Parameter'); my $f = $self->Package("Formula")->new('C0') + $self; for ( 'limits', 'test_points', 'test_values', 'test_at', 'num_points', 'granularity', 'resolution', 'checkUndefinedPoints', 'max_undefined' ) { $f->{$_} = $self->{$_} if defined($self->{$_}); } $cmp->ans_hash(correct_value => $f); Parser::Context->current(undef, $current); } $cmp->install_pre_filter(\&Value::cmp_call_filter, "cmp_prefilter"); $cmp->install_post_filter(\&Value::cmp_call_filter, "cmp_postfilter"); return $cmp; } sub cmp_prefilter { my $self = shift; my $ans = shift; $ans->{_filter_name} = "fetch_previous_answer"; $ans->{prev_ans} = undef; if (defined($ans->{ans_label})) { my $label = "previous_" . $ans->{ans_label}; my $inputs = $self->getPG('$inputs_ref'); if (defined $inputs->{$label} and $inputs->{$label} =~ /\S/) { $ans->{prev_ans} = $inputs->{$label}; #FIXME -- previous answer item is not always being updated in inputs_ref (which comes from formField) } } return $ans; } sub cmp_postfilter { my $self = shift; my $ans = shift; $ans->{_filter_name} = "produce_equivalence_message"; return $ans if $ans->{ans_message}; # don't overwrite other messages return $ans unless defined($ans->{prev_ans}); # if prefilters are erased, don't do this check return $ans if ($ans->{bypass_equivalence_test}); my $context = $self->context; Parser::Context->current(undef, $context); my $flags = Value::contextSet($context, $self->cmp_contextFlags($ans)); # save old context flags $ans->{prev_formula} = Parser::Formula($ans->{prev_ans}); if (defined($ans->{prev_formula}) && defined($ans->{student_formula})) { my $prev = eval { $self->promote($ans->{prev_formula})->inherit($self) }; # inherit limits, etc. next unless defined($prev); $context->{answerHash} = $ans; # values here can override context flags $ans->{prev_equals_current} = $prev->typeMatch($ans->{student_formula}) && $prev->cmp_compare($ans->{student_formula}, $ans); $context->{answerHash} = undef; if ( !$ans->{isPreview} # not preview mode and $ans->{prev_equals_current} # equivalent and $ans->{prev_ans} ne $ans->{original_student_ans} ) # but not identical { $ans->{ans_message} = "This answer is equivalent to the one you just submitted." } } Value::contextSet($context, %{$flags}); # restore context values return $ans; } sub cmp_equal { my $self = shift; my $ans = shift; # # Get the problem's seed # $self->{context}->flags->set(random_seed => $self->getPG('$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; $self->{context}->clearError; eval { $ans->{student_formula}->reduce } if defined($ans->{student_formula}); # check for bad function calls $self->cmp_error($ans) if $self->{context}{error}{flag}; # and report the error return if $ans->{ans_message} || $ans->{isPreview}; 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"); } # # Diagnostics for Formulas # sub cmp_diagnostics { my $self = shift; my $ans = shift; my $isEvaluator = (ref($ans) =~ /Evaluator/) ? 1 : 0; my $hash = $isEvaluator ? $ans->rh_ans : $ans; my $diagnostics = $self->{context}->diagnostics->merge("formulas", $self, $hash); my $formulas = $diagnostics->{formulas}; return unless $formulas->{show}; my $output = ""; if ($isEvaluator) { # # The tests to be performed when the answer checker is created # $self->getPG('loadMacros("PGgraphmacros.pl")'); my ($inputs) = $self->getPG('$inputs_ref'); my $process = $inputs->{checkAnswers} || $inputs->{previewAnswers} || $inputs->{submitAnswers}; if ($formulas->{checkNumericStability} && !$process) { ### still needs to be written } } else { # # The checks to be performed when an answer is submitted # my $student = $ans->{student_formula}; # # Get the test points # my @names = $self->{context}->variables->names; my $vx = (keys(%{ $self->{variables} }))[0]; my $vi = 0; while ($names[$vi] ne $vx) { $vi++ } my $points = [ map { $_->[$vi] } @{ $self->{test_points} } ]; my @params = $self->{context}->variables->parameters; @names = $self->{context}->variables->variables; # # The graphs of the functions and errors # if ($formulas->{showGraphs}) { my @G = (); if ($formulas->{combineGraphs}) { push( @G, $self->cmp_graph( $diagnostics, [ $student, $self ], title => 'Student Answer (red)
Correct Answer (green)
', points => $points, showDomain => 1 ) ); } else { push(@G, $self->cmp_graph($diagnostics, $self, title => 'Correct Answer')); push(@G, $self->cmp_graph($diagnostics, $student, title => 'Student Answer')); } my $cutoff = $self->Package("Formula")->new($self->getFlag('tolerance')); if ($formulas->{graphAbsoluteErrors}) { push( @G, $self->cmp_graph( $diagnostics, [ CORE::abs($self - $student), $cutoff ], clip => $formulas->{clipAbsoluteError}, title => 'Absolute Error', points => $points ) ); } if ($formulas->{graphRelativeErrors}) { push( @G, $self->cmp_graph( $diagnostics, [ CORE::abs(($self - $student) / $self), $cutoff ], clip => $formulas->{clipRelativeError}, title => 'Relative Error', points => $points ) ); } $output .= '' . '' . join('', @G) . '
'; } # # The adaptive parameters # if ($formulas->{showParameters} && scalar(@params) > 0) { $output .= '
Adaptive Parameters:
'; $output .= join("
", map { "  $params[$_]: " . $self->{parameters}[$_] } (0 .. $#params)); $output .= '
'; } # # The test points and values # my @rows = (); my $colsep = ''; my @P = (map { (scalar(@{$_}) == 1) ? $_->[0] : $self->Package("Point")->make(@{$_}) } @{ $self->{test_points} }); my @i = sort { $P[$a] <=> $P[$b] } (0 .. $#P); foreach $p (@P) { if (Value::isValue($p) && $p->length > 2) { $p = $p->string; $p =~ s|,|,
|g } } my $zeroLevelTol = $self->{context}{flags}{zeroLevelTol}; $self->{context}{flags}{zeroLevelTol} = 0; # always show full resolution in the tables below my $names = join(',', @names); $names = '(' . $names . ')' if scalar(@names) > 1; $student->createPointValues($self->{test_points}, 0, 1, 1) unless $student->{test_values}; my $cv = $self->{test_values}; my $sv = $student->{test_values}; my $av = $self->{test_adapt} || $cv; if ($formulas->{showTestPoints}) { my @p = ("$names:", (map { $P[ $i[$_] ] } (0 .. $#P))); push(@rows, '' . join($colsep, @p) . ''); push(@rows, '' . join($colsep, ("
") x scalar(@p)) . ''); push( @rows, '' . join($colsep, ($av == $cv) ? "Correct Answer:" : "Adapted Answer:", map { Value::isNumber($av->[ $i[$_] ]) ? $av->[ $i[$_] ] : "undefined" } (0 .. $#P)) . '' ); push( @rows, '' . join($colsep, "Student Answer:", map { Value::isNumber($sv->[ $i[$_] ]) ? $sv->[ $i[$_] ] : "undefined" } (0 .. $#P)) . '' ); } # # The absolute errors (colored by whether they are ok or too big) # if ($formulas->{showAbsoluteErrors}) { my @p = ("Absolute Error:"); my $tolerance = $self->getFlag('tolerance'); my $tolType = $self->getFlag('tolType'); my $error; foreach my $j (0 .. $#P) { if (Value::isNumber($sv->[ $i[$j] ])) { $error = CORE::abs($av->[ $i[$j] ] - $sv->[ $i[$j] ]); $error = '' . $error . '' if $tolType eq 'absolute'; } else { $error = "---"; } push(@p, $error); } push(@rows, '' . join($colsep, @p) . ''); } # # The relative errors (colored by whether they are OK or too big) # if ($formulas->{showRelativeErrors}) { my @p = ("Relative Error:"); my $tolerance = $self->getFlag('tolerance'); my $tol; my $tolType = $self->getFlag('tolType'); my $error; my $zeroLevel = $self->getFlag('zeroLevel'); foreach my $j (0 .. $#P) { if (Value::isNumber($sv->[ $i[$j] ])) { my $c = $av->[ $i[$j] ]; my $s = $sv->[ $i[$j] ]; if (CORE::abs($cv->[ $i[$j] ]->value) < $zeroLevel || CORE::abs($s->value) < $zeroLevel) { $error = CORE::abs($c - $s); $tol = $zeroLevelTol; } else { $error = CORE::abs(($c - $s) / ($c || 1E-10)); $tol = $tolerance; } $error = '' . $error . '' if $tolType eq 'relative'; } else { $error = "---"; } push(@p, $error); } push(@rows, '' . join($colsep, @p) . ''); } $self->{context}{flags}{zeroLevelTol} = $zeroLevelTol; # # Put the data into a table # if (scalar(@rows)) { $output .= '


' . join('', @rows) . '
'; } } # # Put all the diagnostic output into a frame # return unless $output; $output = '' . '
Diagnostics for ' . $self->string . ':' . '

' . $output . '

'; $self->getPG('$PG')->debug_message($output); } # # Draw a graph from a given Formula object # sub cmp_graph { my $self = shift; my $diagnostics = shift; my $F1 = shift; my $F2; ($F1, $F2) = @{$F1} if (ref($F1) eq 'ARRAY'); # # Get the various options # my %options = (title => '', points => [], @_); my $graphs = $diagnostics->{graphs}; my $limits = $graphs->{limits}; my $size = $graphs->{size}; $size = [ $size, $size ] unless ref($size) eq 'ARRAY'; my $steps = $graphs->{divisions}; my $points = $options{points}; my $clip = $options{clip}; my ($my, $My) = (0, 0); my ($mx, $Mx); my $dx; my $f; my $y; my @pnames = $self->{context}->variables->parameters; my @pvalues = ($self->{parameters} ? @{ $self->{parameters} } : (0) x scalar(@pnames)); my $x = ""; # # Find the max and min values of the function # foreach $f ($F1, $F2) { next unless defined($f); foreach my $v (keys(%{ $f->{variables} })) { if ($v ne $x && !$f->{context}->variables->get($v)->{parameter}) { if ($x) { warn "Only formulas with one variable can be graphed" unless $self->{graphWarning}; $self->{graphWarning} = 1; return ""; } $x = $v; } } unless ($f->typeRef->{length} == 1) { warn "Only real-valued functions can be graphed" unless $self->{graphWarning}; $self->{graphWarning} = 1; return ""; } $x = ($f->{context}->variables->names)[0] unless $x; $limits = [ $self->getVariableLimits($x) ] unless $limits; $limits = $limits->[0] while ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY'; ($mx, $Mx) = @{$limits}; $dx = ($Mx - $mx) / $steps; if ($f->isConstant) { $y = $f->eval; $my = $y if $y < $my; $My = $y if $y > $My; } else { my $F = $f->perlFunction(undef, [ $x, @pnames ]); foreach my $i (0 .. $steps - 1) { $y = eval { &{$F}($mx + $i * $dx, @pvalues) }; next unless defined($y) && Value::isNumber($y); $my = $y if $y < $my; $My = $y if $y > $My; } } } $My = 1 if CORE::abs($My - $my) < 1E-5; $my *= 1.1; $My *= 1.1; if ($clip) { $my = -$clip if $my < -$clip; $My = $clip if $My > $clip; } $my = -$My / 10 if $my > -$My / 10; $My = -$my / 10 if $My < -$my / 10; my $a = $self->Package("Real")->new(($My - $my) / ($Mx - $mx)); # # Create the graph itself, with suitable title # my $grf = $self->getPG('$_grf_ = {n => 0}'); $grf->{Goptions} = [ $mx, $my, $Mx, $My, axes => $graphs->{axes}, grid => $graphs->{grid}, size => $size, ]; $grf->{params} = { names => [ $x, @pnames ], values => { map { $pnames[$_] => $pvalues[$_] } (0 .. scalar(@pnames) - 1) }, }; $grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})'); $grf->{G}->imageName($grf->{G}->imageName . '-' . time()); # avoid browser cache $self->cmp_graph_function($grf, $F2, "green", $steps, $points) if defined($F2); $self->cmp_graph_function($grf, $F1, "red", $steps, $points); my $image = $self->getPG('alias(insertGraph($_grf_->{G}))'); $image = ''; my $title = $options{title}; $title .= '

' if $title; $title .= "Domain: [$mx,$Mx]
" if $options{showDomain}; $title .= "Range: [$my,$My]
Aspect ratio: $a:1
"; return '' . $image . '
' . $title . ''; } # # Add a function to a graph object, and plot the points # that are used to test the function # sub cmp_graph_function { my $self = shift; my $grf = shift; my $F = shift; my $color = shift; my $steps = shift; my $points = shift; $grf->{n}++; my $Fn = "F" . $grf->{n}; $grf->{$Fn} = $F; my $f; if ($F->isConstant) { my $y = $F->eval; $f = $self->getPG('new Fun(sub {' . $y . '},$_grf_->{G})'); } else { my $X = $grf->{params}{names}[0]; $f = $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{' . $Fn . '},' . $X . '=>shift,%{$_grf_->{params}{values}})},$_grf_->{G})'); foreach my $x (@{$points}) { my $y = Parser::Evaluate($F, ($X) => $x, %{ $grf->{params}{values} }); next unless defined($y) && Value::isNumber($y); $grf->{x} = $x; $grf->{'y'} = $y; my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"' . $color . '","' . $color . '")'); $grf->{G}->stamps($C); } } $f->color($color); $f->weight(2); $f->steps($steps); } # # 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 %options = @_; 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->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, '', %options); } 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 # (this needs to be made more general) # sub value { my $self = shift; return $self unless defined $self->{tree}{coords}; my $context = $self->context; my @array = (); if ($self->{tree}->type eq 'Matrix') { foreach my $row (@{ $self->{tree}->coords }) { my @row = (); foreach my $x (@{ $row->coords }) { push(@row, $context->Package("Formula")->new($context, $x)) } push(@array, [@row]); } } else { foreach my $x (@{ $self->{tree}->coords }) { push(@array, $context->Package("Formula")->new($context, $x)); } } return @array; } ############################################################# 1;