[system] / trunk / pg / lib / Value / AnswerChecker.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Value/AnswerChecker.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6898 - (download) (as text) (annotate)
Sat Jun 25 20:36:58 2011 UTC (8 years, 8 months ago) by dpvc
File size: 72868 byte(s)
Fix HTML-based delimiters for Entered column for matrices

    1 
    2 =head1 DESCRIPTION
    3 
    4  #############################################################
    5  #
    6  #  Implements the ->cmp method for Value objects.
    7  #  Otherwise known as MathObjects.  This produces
    8  #  an answer checker appropriate for the type of object.
    9  #  Additional options can be passed to the cmp method to
   10  #  modify its action.
   11  #
   12  #   Usage:  $num = Real(3.45); # Real can be replaced by any other MathObject
   13  #       ANS($num->cmp(compareOptionName => compareOptionValue, ... ))
   14  #
   15  #  The individual Value packages are modified below to add the
   16  #  needed methods.
   17  #
   18  #############################################################
   19 
   20 =cut
   21 
   22 package Value;
   23 use PGcore;
   24 
   25 #
   26 #  Context can add default values to the answer checkers by class;
   27 #
   28 $Value::defaultContext->{cmpDefaults} = {};
   29 
   30 =head5 $mathObject->cmp_defaults()
   31 
   32 #  Internal use.
   33 #  Set default flags for the answer checker in this object
   34 #       showTypeWarnings         => 1
   35 #       showEqualErrors          => 1
   36 #       ignoreStrings            => 1
   37 #       studentsMustReduceUnions => 1
   38 #       showUnionReduceWarnings  => 1
   39 #
   40 
   41 =cut
   42 
   43 sub cmp_defaults {(
   44   showTypeWarnings => 1,
   45   showEqualErrors  => 1,
   46   ignoreStrings    => 1,
   47   studentsMustReduceUnions => 1,
   48   showUnionReduceWarnings => 1,
   49 )}
   50 
   51 
   52 #
   53 #  Special Context flags to be set for the student answer
   54 #
   55 
   56 sub cmp_contextFlags {
   57   my $self = shift; my $ans = shift;
   58   return (
   59     StringifyAsTeX => 0,                 # reset this, just in case.
   60     no_parameters => 1,                  # don't let students enter parameters
   61     showExtraParens => 2,                # make student answer painfully unambiguous
   62     reduceConstants => 0,                # don't combine student constants
   63     reduceConstantFunctions => 0,        # don't reduce constant functions
   64     ($ans->{studentsMustReduceUnions} ?
   65       (reduceUnions => 0, reduceSets => 0,
   66        reduceUnionsForComparison => $ans->{showUnionReduceWarnings},
   67        reduceSetsForComparison => $ans->{showUnionReduceWarnings}) :
   68       (reduceUnions => 1, reduceSets => 1,
   69        reduceUnionsForComparison => 1, reduceSetsForComparison => 1)),
   70     ($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1),  # for Intervals
   71   );
   72 }
   73 
   74 
   75 #
   76 #  Create an answer checker for the given type of object
   77 #
   78 
   79 sub cmp {
   80   my $self = shift;
   81   my $ans = new AnswerEvaluator;
   82   my $correct = preformat($self->{correct_ans});
   83   $correct = $self->correct_ans unless defined($correct);
   84   $self->{context} = Value->context unless defined($self->{context});
   85   $ans->ans_hash(
   86     type => "Value (".$self->class.")",
   87     correct_ans => $correct,
   88     correct_value => $self,
   89     $self->cmp_defaults(@_),
   90     %{$self->{context}{cmpDefaults}{$self->class} || {}},  # context-specified defaults
   91     @_,
   92   );
   93   $ans->{debug} = $ans->{rh_ans}{debug};
   94   $ans->install_evaluator(sub {
   95      my $ans = shift;
   96      $ans->{_filter_name} = "MathObjects answer checker";
   97      $ans->{correct_value}->cmp_parse($ans);
   98   });
   99   $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
  100   $self->cmp_diagnostics($ans);
  101   return $ans;
  102 }
  103 
  104 sub correct_ans {preformat(shift->string)}
  105 sub cmp_diagnostics {}
  106 
  107 #
  108 #  Parse the student answer and compute its value,
  109 #    produce the preview strings, and then compare the
  110 #    student and professor's answers for equality.
  111 #
  112 sub cmp_parse {
  113   my $self = shift; my $ans = shift;
  114   #
  115   #  Do some setup
  116   #
  117   my $current = Value->context; # save it for later
  118   my $context = $ans->{correct_value}{context} || $current;
  119   Parser::Context->current(undef,$context); # change to correct answser's context
  120   my $flags = contextSet($context,$self->cmp_contextFlags($ans)); # save old context flags
  121   my $inputs = $self->getPG('$inputs_ref');
  122   $ans->{isPreview} = $inputs->{previewAnswers} || ($inputs->{action} =~ m/^Preview/);
  123   $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
  124   $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
  125   $ans->{preview_latex_string} = $ans->{preview_text_string} = '';
  126   $context->clearError();
  127   $context->{answerHash} = $ans; # values here can override context flags
  128 
  129   #
  130   #  Parse and evaluate the student answer
  131   #
  132   $ans->score(0);  # assume failure
  133   $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
  134   $ans->{student_value} = Parser::Evaluate($ans->{student_formula})
  135     if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
  136 
  137   #
  138   #  If it parsed OK, save the output forms and check if it is correct
  139   #   otherwise report an error
  140   #
  141   if (defined $ans->{student_value}) {
  142     $ans->{student_value} = $self->Package("Formula")->new($ans->{student_value})
  143        unless Value::isValue($ans->{student_value});
  144     $ans->{student_value}{isStudent} = 1;
  145     $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
  146     $ans->{preview_text_string}  = preformat($ans->{student_formula}->string);
  147     #FIXME
  148     # Kludge to calculate a latex representation of the correct answer string
  149     # It would be better to calculate this when the MathObject is created.
  150     # the attempt to calculate the latex version may fail because the
  151     # context has changed since the creation of the original MathObject.
  152     # In that case the {correct_ans_latex_string} will be blank.
  153     # We could try to reset that context temporarily, but a better fix would
  154     # be to consistently create latex_string versions of the correct answer
  155     # when the math object is created.
  156 #     if ($ans->{correct_value} ) {
  157 #       $ans->{correct_ans_latex_string} = $ans->{correct_value}->TeX; # answer is a MathObject
  158 #     } else {  # case where there is no math object
  159 #       my $mathobject = Parser::Formula($ans->{correct_ans});
  160 #       $ans->{correct_ans_latex_string} = ($mathobject)? $mathobject->TeX : '';
  161 #     }
  162   unless (PGcore::not_null($ans->{correct_ans_latex_string}) ) { # don't alter the latex string if it's defined
  163     my $mathobject = Parser::Formula($ans->{correct_ans});
  164     if ($mathobject) {
  165       $ans->{correct_ans_latex_string} = $mathobject->TeX;
  166     } elsif( $ans->{correct_value} ) {
  167       $ans->{correct_ans_latex_string} = $ans->{correct_value}->TeX; # answer is a MathObject
  168     } else {
  169       $ans->{correct_ans_latex_string}='';
  170     }
  171   }
  172     #
  173     #  Get the string for the student answer
  174     #
  175     for ($self->getFlag('formatStudentAnswer')) {
  176       /evaluated/i  and do {$ans->{student_ans} = preformat($ans->{student_value}->string); last};
  177       /parsed/i     and do {$ans->{student_ans} = $ans->{preview_text_string}; last};
  178       /reduced/i    and do {
  179   my $oldFlags = contextSet($context,reduceConstants=>1,reduceConstantFunctions=>0);
  180   $ans->{student_ans} = preformat($ans->{student_formula}->substitute()->string);
  181   contextSet($context,%{$oldFags}); last;
  182       };
  183       warn "Unkown student answer format |$ans->{formatStudentAnswer}|";
  184     }
  185     if ($self->cmp_collect($ans)) {
  186       $self->cmp_preprocess($ans);
  187       $self->cmp_equal($ans);
  188       $self->cmp_postprocess($ans) if !$ans->{error_message} && !$ans->{typeError};
  189       $self->cmp_diagnostics($ans);
  190     }
  191   } else {
  192     $self->cmp_collect($ans);
  193     $self->cmp_error($ans);
  194   }
  195   $context->{answerHash} = undef;
  196   contextSet($context,%{$flags});            # restore context values
  197   Parser::Context->current(undef,$current);  # put back the old context
  198   return $ans;
  199 }
  200 
  201 #
  202 #  Check if the object has an answer array and collect the results
  203 #  Build the combined student answer and set the preview values
  204 #
  205 sub cmp_collect {
  206   my $self = shift; my $ans = shift;
  207   return 1 unless $self->{ans_name};
  208   $ans->{preview_latex_string} = $ans->{preview_text_string} = "";
  209   my $OK = $self->ans_collect($ans);
  210   $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
  211   return 0 unless $OK;
  212   my $array = $ans->{student_formula};
  213   if ($self->{ColumnVector}) {
  214     my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
  215     $array = [@V];
  216   } elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
  217   my $type = $self;
  218   $type = $self->Package($self->{tree}->type) if $self->isFormula;
  219   $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
  220   if (!defined($ans->{student_formula}) || $self->context->{error}{flag})
  221     {Parser::reportEvalError($@); $self->cmp_error($ans); return 0}
  222   $ans->{student_value} = $ans->{student_formula};
  223   $ans->{preview_text_string} = $ans->{student_ans};
  224   $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
  225   if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
  226     $ans->{student_value} = Parser::Evaluate($ans->{student_formula});
  227     return 0 unless $ans->{student_value};
  228   }
  229   return 1;
  230 }
  231 
  232 #
  233 #  Check if the parsed student answer equals the professor's answer
  234 #
  235 sub cmp_equal {
  236   my $self = shift; my $ans = shift;
  237   my $correct = $ans->{correct_value};
  238   my $student = $ans->{student_value};
  239   if ($correct->typeMatch($student,$ans)) {
  240     $self->context->clearError();
  241     my $equal = $correct->cmp_compare($student,$ans);
  242     if ($self->context->{error}{flag} != $CMP_MESSAGE &&
  243         (defined($equal) || !$ans->{showEqualErrors})) {$ans->score(1) if $equal; return}
  244     $self->cmp_error($ans);
  245   } else {
  246     return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  247     $ans->{typeError} = 1;
  248     $ans->{ans_message} = $ans->{error_message} =
  249       "Your answer isn't ".lc($ans->{cmp_class})."\n".
  250         "(it looks like ".lc($student->showClass).")"
  251      if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
  252   }
  253 }
  254 
  255 #
  256 #  Perform the comparison, either using the checker supplied
  257 #  by the answer evaluator, or the overloaded == operator.
  258 #
  259 
  260 our $CMP_ERROR = 2;   # a fatal error was detected
  261 our $CMP_WARNING = 3; # a warning was produced
  262 our $CMP_MESSAGE = 4; # an message should be reported for this check
  263 
  264 sub cmp_compare {
  265   my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || '';
  266   my $context = (Value::isValue($self) ? $self->context : Value->context);
  267   return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
  268   my @equal = eval {&{$ans->{checker}}($self,$other,$ans,$nth,@_)};
  269   if (!defined($equal) && $@ ne '' && (!$context->{error}{flag} || $ans->{showAllErrors})) {
  270     $nth = "" if ref($nth) eq 'AnswerHash';
  271     $context->setError(["<I>An error occurred while checking your$nth answer:</I>\n".
  272       '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'',undef,undef,$CMP_ERROR);
  273     warn "Please inform your instructor that an error occurred while checking your answer";
  274   }
  275   return (wantarray ? @equal : $equal[0]);
  276 }
  277 
  278 sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
  279 
  280 #
  281 #  Check if types are compatible for equality check
  282 #
  283 sub typeMatch {
  284   my $self = shift;  my $other = shift;
  285   return 1 unless ref($other);
  286   $self->type eq $other->type && !$other->isFormula;
  287 }
  288 
  289 #
  290 #  Class name for cmp error messages
  291 #
  292 sub cmp_class {
  293   my $self = shift; my $ans = shift;
  294   my $class = $self->showClass; $class =~ s/Real //;
  295   return $class if $class =~ m/Formula/;
  296   return "an Interval, Set or Union" if $self->isSetOfReals;
  297   return $class;
  298 }
  299 
  300 #
  301 #  Student answer evaluation failed.
  302 #  Report the error, with formatting, if possible.
  303 #
  304 sub cmp_error {
  305   my $self = shift; my $ans = shift;
  306   my $error = $self->context->{error};
  307   my $message = $error->{message};
  308   if ($error->{pos}) {
  309     my $string = $error->{string};
  310     my ($s,$e) = @{$error->{pos}};
  311     $message =~ s/; see.*//;  # remove the position from the message
  312     $ans->{student_ans} =
  313        protectHTML(substr($string,0,$s)) .
  314        '<SPAN CLASS="parsehilight">' .
  315          protectHTML(substr($string,$s,$e-$s)) .
  316        '</SPAN>' .
  317        protectHTML(substr($string,$e));
  318   }
  319   $self->cmp_Error($ans,$message);
  320 }
  321 
  322 #
  323 #  Set the error message
  324 #
  325 sub cmp_Error {
  326   my $self = shift; my $ans = shift;
  327   return unless scalar(@_) > 0;
  328   $ans->score(0);
  329   $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
  330 }
  331 
  332 #
  333 #  Force a message into the results message column and die
  334 #  (To be used when overriding Parser classes that need
  335 #  to report errors to the student but can't do it in
  336 #  the overridden == since errors are trapped.)
  337 #
  338 sub cmp_Message {
  339   my $message = shift; my $context = Value->context;
  340   $message = [$message,@_] if scalar(@_) > 0;
  341   $context->setError($message,'',undef,undef,$CMP_MESSAGE);
  342   $message = $context->{error}{message};
  343   die $message . traceback() if $context->flags('showTraceback');
  344   die $message . getCaller();
  345 }
  346 
  347 #
  348 #  filled in by sub-classes
  349 #
  350 sub cmp_preprocess {}
  351 sub cmp_postprocess {}
  352 
  353 #
  354 #  Check for unreduced reduced Unions and Sets
  355 #
  356 sub cmp_checkUnionReduce {
  357   my $self = shift; my $student = shift; my $ans = shift; my $nth = shift || '';
  358   return unless $ans->{studentsMustReduceUnions} &&
  359                 $ans->{showUnionReduceWarnings} &&
  360                 !$ans->{isPreview} && !Value::isFormula($student);
  361   return unless $student->isSetOfReals;
  362   my ($result,$error) = $student->isReduced;
  363   return unless $error;
  364   return {
  365     "overlaps" => "Your$nth union contains overlapping intervals",
  366     "overlaps in sets" => "Your$nth union contains sets and intervals that overlap",
  367     "uncombined intervals" => "Your$nth union can be simplified by combining intervals",
  368     "uncombined sets" => "Your$nth union can be simplified by combining some sets",
  369     "repeated elements in set" => "Your$nth union contains sets with repeated elements",
  370     "repeated elements" => "Your$nth set should have no repeated elements",
  371   }->{$error};
  372 }
  373 
  374 #
  375 #  create answer rules of various types
  376 #
  377 sub ans_rule {shift; pgCall('ans_rule',@_)}
  378 sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
  379 sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
  380 sub ans_array {shift->ans_rule(@_)};
  381 sub named_ans_array {shift->named_ans_rule(@_)};
  382 sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
  383 
  384 sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
  385 sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
  386 
  387 our $answerPrefix = "MaTrIx";
  388 
  389 #
  390 #  Lay out a matrix of answer rules
  391 #
  392 sub ans_matrix {
  393   my $self = shift;
  394   my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
  395   #my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
  396   my $named_extension = pgRef('NAMED_ANS_ARRAY_EXTENSION');
  397   my $new_name = sub {@_}; # pgRef('RECORD_EXTRA_ANSWERS');
  398   my $HTML = ""; my $ename = $name;
  399   if ($name eq '') {
  400     #my $n = pgCall('inc_ans_rule_count');
  401     $name = pgCall('NEW_ANS_NAME',$n);
  402     #$name = pgCall('NEW_ARRAY_NAME',$n);
  403     $ename = "${answerPrefix}_${name}_";
  404   }
  405   $self->{ans_name} = $ename;
  406   $self->{ans_rows} = $rows;
  407   $self->{ans_cols} = $cols;
  408   my @array = ();
  409   foreach my $i (0..$rows-1) {
  410     my @row = ();
  411     foreach my $j (0..$cols-1) {
  412       if ($i == 0 && $j == 0) {
  413        if ($extend) {
  414         push(@row,&$named_extension(&$new_name($name),$size,ans_label=>$name));
  415         #push(@row,&$named_extension(&$new_name($name),$size))
  416        }else {
  417         push(@row,pgCall('NAMED_ANS_RULE',$name,$size))
  418        }
  419       } else {
  420     push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size,ans_label=>$name));
  421     #push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size,ans_label=>$name));
  422       }
  423     }
  424     push(@array,[@row]);
  425   }
  426   $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
  427 }
  428 
  429 sub ANS_NAME {
  430   my ($name,$i,$j) = @_;
  431   $name.'_'.$i.'_'.$j;
  432 }
  433 
  434 
  435 #
  436 #  Lay out an arbitrary matrix
  437 #
  438 sub format_matrix {
  439   my $self = shift; my $array = shift;
  440   my $displayMode = $self->getPG('$displayMode');
  441   $array = [$array] unless ref($array->[0]) eq 'ARRAY';
  442   return $self->format_matrix_tex($array,@_) if ($displayMode eq 'TeX');
  443   return $self->format_matrix_HTML($array,@_);
  444 }
  445 
  446 sub format_matrix_tex {
  447   my $self = shift; my $array = shift;
  448   my %options = (open=>'.',close=>'.',sep=>'',@_);
  449   $self->{format_options} = [%options] unless $self->{format_options};
  450   my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
  451   my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
  452   my $tex = ""; my @rows = ();
  453   $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
  454   $tex .= '\(\left'.$open;
  455   $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
  456   $tex .= '\begin{array}{'.('c'x$cols).'}';
  457   foreach my $i (0..$rows-1) {push(@rows,join($sep.'&',@{$array->[$i]}))}
  458   $tex .= join('\cr'."\n",@rows);
  459   $tex .= '\end{array}\right'.$close.'\)';
  460   return $tex;
  461 }
  462 
  463 sub format_matrix_HTML {
  464   my $self = shift; my $array = shift;
  465   my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
  466   $self->{format_options} = [%options] unless $self->{format_options};
  467   my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
  468   my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
  469   my $HTML = "";
  470   if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'}
  471        else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'}
  472   foreach my $i (0..$rows-1) {
  473     $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i;
  474     $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,EVALUATE(@{$array->[$i]})).'</TD></TR>'."\n";
  475   }
  476   $open = $self->format_delimiter($open,$rows,$options{tth_delims});
  477   $close = $self->format_delimiter($close,$rows,$options{tth_delims});
  478   if ($open ne '' || $close ne '') {
  479     $HTML = '<TR ALIGN="MIDDLE">'
  480           . '<TD>'.$open.'</TD>'
  481           . '<TD WIDTH="2"></TD>'
  482           . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'
  483           .   $HTML
  484           . '</TABLE></TD>'
  485           . '<TD WIDTH="4"></TD>'
  486           . '<TD>'.$close.'</TD>'
  487           . '</TR>'."\n";
  488   }
  489   return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"'
  490           . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">'
  491           . $HTML
  492           . '</TABLE>';
  493 }
  494 
  495 sub EVALUATE {map {(Value::isFormula($_) && $_->isConstant? $_->eval: $_)} @_}
  496 
  497 sub VERBATIM {
  498   my $string = shift;
  499   my $displayMode = Value->getPG('$displayMode');
  500   $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
  501   return $string;
  502 }
  503 
  504 #
  505 #  Create a tall delimiter to match the line height
  506 #
  507 sub format_delimiter {
  508   my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
  509   return '' if $delim eq '' || $delim eq '.';
  510   my $displayMode = $self->getPG('$displayMode');
  511   return $self->format_delimiter_tth($delim,$rows,$tth)
  512     if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
  513   my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
  514   $rule = '\Rule{0pt}{'.(.8*$rows).'em}{0pt}' if $displayMode eq 'HTML_MathJax';
  515   $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
  516   $delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
  517   return '\(\left'.$delim.$rule.'\right.\)';
  518 }
  519 
  520 #
  521 #  Data for tth delimiters [top,mid,bot,rep]
  522 #
  523 $tth_family = "symbol";
  524 my %tth_delim = (
  525   '[' => ['&#x23A1;','','&#x23A3;','&#x23A2;'],
  526   ']' => ['&#x23A4;','','&#x23A6;','&#x23A5;'],
  527   '(' => ['&#x239B;','','&#x239D;','&#x239C;'],
  528   ')' => ['&#x239E;','','&#x23A0;','&#x239F;'],
  529   '{' => ['&#x23A7;','&#x23A8;','&#x23A9;','&#x23AA;'],
  530   '}' => ['&#x23AB;','&#x23AC;','&#x23AD;','&#x23AA;'],
  531   '|' => ['|','','|','|'],
  532   '<' => ['&#x27E8;'],
  533   '>' => ['&#x27E9;'],
  534   '\lgroup' => ['&#x23A7;','','&#x23A9;','&#x23AA;'],
  535   '\rgroup' => ['&#x23AB;','','&#x23AD;','&#x23AA;'],
  536 );
  537 
  538 #
  539 #  Make delimiters as stacks of characters
  540 #
  541 sub format_delimiter_tth {
  542   my $self = shift;
  543   my $delim = shift; my $rows = shift; my $tth = shift;
  544   return '' if $delim eq '' || !defined($tth_delim{$delim});
  545   my $c = $delim; $delim = $tth_delim{$delim};
  546   $c = $delim->[0] if scalar(@{$delim}) == 1;
  547   my $size = ($tth? "": "font-size:175%; ");
  548   return '<SPAN STYLE="font-family: '.$tth_family.'; '.$size.'margin:0px 2px">'.$c.'</SPAN>'
  549     if $rows == 1 || scalar(@{$delim}) == 1;
  550   my $HTML = "";
  551   if ($delim->[1] eq '') {
  552     $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
  553   } else {
  554     $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1),
  555             $delim->[1],($delim->[3])x($rows-1),
  556             $delim->[2]);
  557   }
  558   return '<DIV STYLE="font-family: '.$tth_family.'; line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>';
  559 }
  560 
  561 
  562 #
  563 #  Look up the values of the answer array entries, and check them
  564 #  for syntax and other errors.  Build the student answer
  565 #  based on these, and keep track of error messages.
  566 #
  567 
  568 my @ans_cmp_defaults = (showCoodinateHints => 0, checker => sub {0});
  569 
  570 sub ans_collect {
  571   my $self = shift; my $ans = shift;
  572   my $inputs = $self->getPG('$inputs_ref');
  573   my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
  574   my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
  575   my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
  576   if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
  577   $data = [$data] unless ref($data->[0]) eq 'ARRAY';
  578   foreach my $i (0..$rows-1) {
  579     my @row = (); my $entry;
  580     foreach my $j (0..$cols-1) {
  581       if ($i || $j) {
  582   $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
  583       } else {
  584   $entry = $ans->{original_student_ans};
  585   $ans->{student_formula} = $ans->{student_value} = undef unless $entry =~ m/\S/;
  586       }
  587       my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
  588       $OK &= entryCheck($result,$blank);
  589       push(@row,$result->{student_formula});
  590       entryMessage($result->{ans_message},$errors,$i,$j,$rows,$cols);
  591     }
  592     push(@array,[@row]);
  593   }
  594   $ans->{student_formula} = [@array];
  595   $ans->{ans_message} = $ans->{error_message} = "";
  596   if (scalar(@{$errors})) {
  597     $ans->{ans_message} = $ans->{error_message} =
  598       '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'.
  599       join('<TR><TD HEIGHT="4"></TD></TR>',@{$errors}).
  600       '</TABLE>';
  601     $OK = 0;
  602   }
  603   return $OK;
  604 }
  605 
  606 sub entryMessage {
  607   my $message = shift; return unless $message;
  608   my ($errors,$i,$j,$rows,$cols) = @_; $i++; $j++;
  609   my $title;
  610   if ($rows == 1) {$title = "In entry $j"}
  611   elsif ($cols == 1) {$title = "In entry $i"}
  612   else {$title = "In entry ($i,$j)"}
  613   push(@{$errors},"<TR VALIGN=\"TOP\"><TD NOWRAP STYLE=\"text-align:right; border:0px\"><I>$title</I>:&nbsp;</TD>".
  614                   "<TD STYLE=\"text-align:left; border:0px\">$message</TD></TR>");
  615 }
  616 
  617 sub entryCheck {
  618   my $ans = shift; my $blank = shift;
  619   return 1 if defined($ans->{student_value});
  620   if (!defined($ans->{student_formula})) {
  621     $ans->{student_formula} = $ans->{student_ans};
  622     $ans->{student_formula} = $blank unless $ans->{student_formula};
  623   }
  624   return 0
  625 }
  626 
  627 
  628 #
  629 #  Get and Set values in context
  630 #
  631 sub contextSet {
  632   my $context = shift; my %set = (@_);
  633   my $flags = $context->{flags}; my $get = {};
  634   foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}}
  635   return $get;
  636 }
  637 
  638 #
  639 #  Quote HTML characters
  640 #
  641 sub protectHTML {
  642   my $string = shift;
  643   return unless defined($string);
  644   return $string if eval ('$main::displayMode') eq 'TeX';
  645   $string =~ s/&/\&amp;/g;
  646   $string =~ s/</\&lt;/g;
  647   $string =~ s/>/\&gt;/g;
  648   $string;
  649 }
  650 
  651 #
  652 #  Convert newlines to <BR>
  653 #
  654 sub preformat {
  655   my $string = protectHTML(shift);
  656   $string =~ s!\n!<br />!g unless eval('$main::displayMode') eq 'TeX';
  657   $string;
  658 }
  659 
  660 #
  661 #  names for numbers
  662 #
  663 sub NameForNumber {
  664   my $self = shift; my $n = shift;
  665   my $name =  ('zeroth','first','second','third','fourth','fifth',
  666                'sixth','seventh','eighth','ninth','tenth')[$n];
  667   $name = "$n-th" if ($n > 10);
  668   return $name;
  669 }
  670 
  671 #
  672 #  Get a value from the safe compartment
  673 #
  674 sub getPG {
  675   my $self = shift;
  676 #  (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
  677   eval ('package main; '.shift);  # faster
  678 }
  679 
  680 #############################################################
  681 #############################################################
  682 
  683 =head3 Value::Real
  684 
  685   Usage ANS( Real(3.56)->cmp() )
  686     Compares response to a real value using 'fuzzy' comparison
  687     compareOptions and default values:
  688         showTypeWarnings => 1,
  689         showEqualErrors  => 1,
  690         ignoreStrings    => 1,
  691 
  692 =cut
  693 
  694 
  695 package Value::Real;
  696 
  697 sub cmp_defaults {(
  698   shift->SUPER::cmp_defaults(@_),
  699   ignoreInfinity => 1,
  700 )}
  701 
  702 sub typeMatch {
  703   my $self = shift; my $other = shift; my $ans = shift;
  704   return 1 unless ref($other);
  705   return 0 if Value::isFormula($other);
  706   return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
  707   $self->type eq $other->type;
  708 }
  709 
  710 #############################################################
  711 
  712 package Value::Infinity;
  713 
  714 sub cmp_class {'a Number'};
  715 
  716 sub typeMatch {
  717   my $self = shift; my $other = shift; my $ans = shift;
  718   return 1 unless ref($other);
  719   return 0 if Value::isFormula($other);
  720   return 1 if $other->type eq 'Number';
  721   $self->type eq $other->type;
  722 }
  723 
  724 #############################################################
  725 
  726 =head3 Value::String
  727 
  728   Usage:  $s = String("pole");
  729     ANS($s->cmp(typeMatch => Complex("4+i")));
  730         # compare to response 'pole', don't complain about complex number responses.
  731 
  732     compareOptions and default values:
  733       showTypeWarnings => 1,
  734       showEqualErrors  => 1,
  735       ignoreStrings    => 1   # don't complain about string-valued responses
  736       typeMatch        => 'Value::Real'
  737 
  738   Initial and final spaces are ignored when comparing strings.
  739 
  740 =cut
  741 
  742 package Value::String;
  743 
  744 sub cmp_defaults {(
  745   Value::Real->cmp_defaults(@_),
  746   typeMatch => 'Value::Real',
  747 )}
  748 
  749 sub cmp_class {
  750   my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
  751   return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->classMatch('String');
  752   return $typeMatch->cmp_class;
  753 };
  754 
  755 sub typeMatch {
  756   my $self = shift; my $other = shift; my $ans = shift;
  757   my $typeMatch = $ans->{typeMatch};
  758   return &$typeMatch($other,$ans) if ref($typeMatch) eq 'CODE';
  759   return 1 if !Value::isValue($typeMatch) || $typeMatch->classMatch('String') ||
  760                  $self->type eq $other->type;
  761   return $typeMatch->typeMatch($other,$ans);
  762 }
  763 
  764 #
  765 #  Remove the blank-check prefilter when the string is empty,
  766 #  and add a filter that removes leading and trailing whitespace.
  767 #
  768 sub cmp {
  769   my $self = shift;
  770   my $cmp = $self->SUPER::cmp(@_);
  771   if ($self->value =~ m/^\s*$/) {
  772     $cmp->install_pre_filter('erase');
  773     $cmp->install_pre_filter(sub {
  774       my $ans = shift;
  775       $ans->{student_ans} =~ s/^\s+//g;
  776       $ans->{student_ans} =~ s/\s+$//g;
  777       return $ans;
  778     });
  779   }
  780   return $cmp;
  781 }
  782 
  783 #############################################################
  784 
  785 =head3 Value::Point
  786 
  787   Usage: $pt = Point("(3,6)"); # preferred
  788          or $pt = Point(3,6);
  789          or $pt = Point([3,6]);
  790          ANS($pt->cmp());
  791 
  792     compareOptions:
  793       showTypeWarnings => 1,   # warns if student response is of incorrect type
  794       showEqualErrors  => 1,
  795       ignoreStrings    => 1,
  796       showDimensionHints => 1, # reports incorrect number of coordinates
  797       showCoordinateHints =>1, # flags individual coordinates that are incorrect
  798 
  799 =cut
  800 
  801 package Value::Point;
  802 
  803 sub cmp_defaults {(
  804   shift->SUPER::cmp_defaults(@_),
  805   showDimensionHints => 1,
  806   showCoordinateHints => 1,
  807 )}
  808 
  809 sub typeMatch {
  810   my $self = shift; my $other = shift; my $ans = shift;
  811   return ref($other) && $other->type eq 'Point' && !$other->isFormula;
  812 }
  813 
  814 #
  815 #  Check for dimension mismatch and incorrect coordinates
  816 #
  817 sub cmp_postprocess {
  818   my $self = shift; my $ans = shift;
  819   return unless $ans->{score} == 0 && !$ans->{isPreview};
  820   my $student = $ans->{student_value};
  821   return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  822   if ($ans->{showDimensionHints} && $self->length != $student->length) {
  823     $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
  824   }
  825   if ($ans->{showCoordinateHints}) {
  826     my @errors;
  827     foreach my $i (1..$self->length) {
  828       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  829   if ($self->{data}[$i-1] != $student->{data}[$i-1]);
  830     }
  831     $self->cmp_Error($ans,@errors); return;
  832   }
  833 }
  834 
  835 sub correct_ans {
  836   my $self = shift;
  837   return $self->SUPER::correct_ans unless $self->{ans_name};
  838   Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
  839 }
  840 
  841 sub ANS_MATRIX {
  842   my $self = shift;
  843   my $extend = shift; my $name = shift;
  844   my $size = shift || 5;
  845   my $def = $self->context->lists->get('Point');
  846   my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
  847   $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
  848 }
  849 
  850 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
  851 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
  852 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
  853 
  854 #############################################################
  855 
  856 =head3 Value::Vector
  857 
  858   Usage:  $vec = Vector("<3,6,7>");
  859           or $vec = Vector(3,6,7);
  860           or $vec = Vector([3,6,7]);
  861           ANS($vec->cmp());
  862 
  863     compareOptions:
  864       showTypeWarnings    => 1,   # warns if student response is of incorrect type
  865       showEqualErrors     => 1,
  866       ignoreStrings       => 1,
  867       showDimensionHints  => 1, # reports incorrect number of coordinates
  868       showCoordinateHints => 1, # flags individual coordinates which are incorrect
  869       promotePoints       => 0, # allow students to enter vectors as points (3,5,6)
  870       parallel            => 1, # response is correct if it is parallel to correct answer
  871       sameDirection       => 1, # response is correct if it has same orientation as correct answer
  872                                 #  (only has an effect when parallel => 1 is specified)
  873 
  874 
  875 =cut
  876 
  877 package Value::Vector;
  878 
  879 sub cmp_defaults {(
  880   shift->SUPER::cmp_defaults(@_),
  881   showDimensionHints => 1,
  882   showCoordinateHints => 1,
  883   promotePoints => 0,
  884   parallel => 0,
  885   sameDirection => 0,
  886 )}
  887 
  888 sub typeMatch {
  889   my $self = shift; my $other = shift; my $ans = shift;
  890   return 0 unless ref($other) && !$other->isFormula;
  891   return $other->type eq 'Vector' ||
  892      ($ans->{promotePoints} && $other->type eq 'Point');
  893 }
  894 
  895 #
  896 #  check for dimension mismatch
  897 #        for parallel vectors, and
  898 #        for incorrect coordinates
  899 #
  900 sub cmp_postprocess {
  901   my $self = shift; my $ans = shift;
  902   return unless $ans->{score} == 0 && !$ans->{isPreview};
  903   my $student = $ans->{student_value};
  904   return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  905   if ($self->length != $student->length) {
  906     ($self,$student) = $self->cmp_pad($student);
  907     if ($ans->{showDimensionHints} && $self->length != $student->length) {
  908       $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
  909     }
  910   }
  911   if ($ans->{parallel} && !$student->isFormula && !$student->classMatch('String') &&
  912       $self->isParallel($student,$ans->{sameDirection})) {
  913     $ans->score(1); return;
  914   }
  915   if ($ans->{showCoordinateHints} && !$ans->{parallel}) {
  916     my @errors;
  917     foreach my $i (1..$self->length) {
  918       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  919   if ($self->{data}[$i-1] != $student->{data}[$i-1]);
  920     }
  921     $self->cmp_Error($ans,@errors); return;
  922   }
  923 }
  924 
  925 #
  926 #  Pad the student or correct answer if either is in ijk notation
  927 #  and they are not the same dimension.  Only add zeros when the other one
  928 #  also has zeros in those places.
  929 #
  930 sub cmp_pad {
  931   my $self = shift; my $student = shift;
  932   if (($self->getFlag("ijk") || $student->getFlag("ijk")) && $self->getFlag("ijkAnyDimension")) {
  933     $self = $self->copy; $student = $student->copy;
  934     while ($self->length > $student->length && $self->{data}[$student->length] == 0)
  935       {push(@{$student->{data}},Value::Real->new(0))}
  936     while ($self->length < $student->length && $student->{data}[$self->length] == 0)
  937       {push(@{$self->{data}},Value::Real->new(0))}
  938   }
  939   return ($self,$student);
  940 }
  941 
  942 sub correct_ans {
  943   my $self = shift;
  944   return $self->SUPER::correct_ans unless $self->{ans_name};
  945   return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
  946     unless $self->{ColumnVector};
  947   my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
  948   return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
  949 }
  950 
  951 sub ANS_MATRIX {
  952   my $self = shift;
  953   my $extend = shift; my $name = shift;
  954   my $size = shift || 5; my ($def,$open,$close);
  955   $def = $self->context->lists->get('Matrix');
  956   $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
  957   return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
  958     if ($self->{ColumnVector});
  959   $def = $self->context->lists->get('Vector');
  960   $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
  961   $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
  962 }
  963 
  964 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
  965 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
  966 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
  967 
  968 
  969 #############################################################
  970 
  971 =head3 Value::Matrix
  972 
  973   Usage   $ma = Matrix([[3,6],[2,5]]) or $ma =Matrix([3,6],[2,5])
  974           ANS($ma->cmp());
  975 
  976     compareOptions:
  977 
  978       showTypeWarnings    => 1, # warns if student response is of incorrect type
  979       showEqualErrors     => 1, # reports messages that occur during element comparisons
  980       ignoreStrings       => 1,
  981       showDimensionHints  => 1, # reports incorrect number of coordinates
  982       showCoordinateHints => 1, # flags individual coordinates which are incorrect
  983 
  984 
  985 =cut
  986 
  987 package Value::Matrix;
  988 
  989 sub cmp_defaults {(
  990   shift->SUPER::cmp_defaults(@_),
  991   showDimensionHints => 1,
  992   showEqualErrors => 0,
  993 )}
  994 
  995 sub typeMatch {
  996   my $self = shift; my $other = shift; my $ans = shift;
  997   return 0 unless ref($other) && !$other->isFormula;
  998   return $other->type eq 'Matrix' ||
  999     ($other->type =~ m/^(Point|list)$/ &&
 1000      $other->{open}.$other->{close} eq $self->{open}.$self->{close});
 1001 }
 1002 
 1003 sub cmp_preprocess {
 1004   my $self = shift; my $ans = shift;
 1005   my $student = $ans->{student_value};
 1006   return if $student->type ne 'Matrix';
 1007   my @d1 = $self->dimensions; my @d2 = $student->dimensions;
 1008   $ans->{student_value} = $student->make([$student->value])
 1009     if (scalar(@d2) == 1 && scalar(@d1) == 2);
 1010 }
 1011 
 1012 sub cmp_postprocess {
 1013   my $self = shift; my $ans = shift;
 1014   return unless $ans->{score} == 0 &&
 1015     !$ans->{isPreview} && $ans->{showDimensionHints};
 1016   my $student = $ans->{student_value};
 1017   return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
 1018   my @d1 = $self->dimensions; my @d2 = $student->dimensions;
 1019   if (scalar(@d1) != scalar(@d2)) {
 1020     $self->cmp_Error($ans,"Matrix dimension is not correct");
 1021     return;
 1022   } else {
 1023     foreach my $i (0..scalar(@d1)-1) {
 1024       if ($d1[$i] != $d2[$i]) {
 1025   $self->cmp_Error($ans,"Matrix dimension is not correct");
 1026   return;
 1027       }
 1028     }
 1029   }
 1030 }
 1031 
 1032 sub correct_ans {
 1033   my $self = shift;
 1034   return $self->SUPER::correct_ans unless $self->{ans_name};
 1035   my @array = $self->value; @array = ([@array]) if $self->isRow;
 1036   Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
 1037 }
 1038 
 1039 sub ANS_MATRIX {
 1040   my $self = shift;
 1041   my $extend = shift; my $name = shift;
 1042   my $size = shift || 5;
 1043   my $def = $self->context->lists->get('Matrix');
 1044   my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
 1045   my @d = $self->dimensions;
 1046   Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
 1047     if (scalar(@d) > 2);
 1048   @d = (1,@d) if (scalar(@d) == 1);
 1049   $self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
 1050 }
 1051 
 1052 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
 1053 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
 1054 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
 1055 
 1056 #############################################################
 1057 
 1058 =head3   Value::Interval
 1059 
 1060   Usage:    $interval = Interval("(1,2]");
 1061             or $interval = Interval('(',1,2,']');
 1062             ANS($inteval->cmp);
 1063 
 1064       compareOptions and defaults:
 1065       showTypeWarnings  => 1,
 1066       showEqualErrors   => 1,
 1067       ignoreStrings     => 1,
 1068       showEndpointHints => 1, # show hints about which end point values are correct
 1069       showEndTypeHints  => 1, # show hints about endpoint types
 1070       requireParenMatch => 1,
 1071 
 1072 
 1073 =cut
 1074 
 1075 package Value::Interval;
 1076 
 1077 sub cmp_defaults {(
 1078   shift->SUPER::cmp_defaults(@_),
 1079   showEndpointHints => 1,
 1080   showEndTypeHints => 1,
 1081   requireParenMatch => 1,
 1082 )}
 1083 
 1084 sub typeMatch {
 1085   my $self = shift; my $other = shift;
 1086   return 0 if !Value::isValue($other) || $other->isFormula;
 1087   return $other->canBeInUnion;
 1088 }
 1089 
 1090 #
 1091 #  Check for unreduced sets and unions
 1092 #
 1093 sub cmp_compare {
 1094   my $self = shift; my $student = shift; my $ans = shift;
 1095   my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
 1096   if ($error) {$self->context->setError($error,'',undef,undef,$CMP_WARNING); return}
 1097   $self->SUPER::cmp_compare($student,$ans,@_);
 1098 }
 1099 
 1100 #
 1101 #  Check for wrong enpoints and wrong type of endpoints
 1102 #
 1103 sub cmp_postprocess {
 1104   my $self = shift; my $ans = shift;
 1105   return unless $ans->{score} == 0 && !$ans->{isPreview};
 1106   my $other = $ans->{student_value};
 1107   return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
 1108   return unless $other->classMatch('Interval');
 1109   my @errors;
 1110   if ($ans->{showEndpointHints}) {
 1111     push(@errors,"Your left endpoint is incorrect")
 1112       if ($self->{data}[0] != $other->{data}[0]);
 1113     push(@errors,"Your right endpoint is incorrect")
 1114       if ($self->{data}[1] != $other->{data}[1]);
 1115   }
 1116   if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) {
 1117     push(@errors,"The type of interval is incorrect")
 1118       if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
 1119   }
 1120   $self->cmp_Error($ans,@errors);
 1121 }
 1122 
 1123 #############################################################
 1124 
 1125 =head3 Value::Set
 1126 
 1127   Usage:   $set = Set(5,6,'a', 'b')
 1128         or $set = Set("{5, 6, a, b}")
 1129 
 1130         The object is a finite set of real numbers. It can be used with Union and
 1131         Interval.
 1132 
 1133   Examples:  Interval("(-inf,inf)") - Set(0)
 1134              Compute("R-{0}")   # in Interval context: Context("Interval");
 1135 
 1136 =cut
 1137 
 1138 package Value::Set;
 1139 
 1140 sub typeMatch {
 1141   my $self = shift; my $other = shift;
 1142   return 0 if !Value::isValue($other) || $other->isFormula;
 1143   return $other->canBeInUnion;
 1144 }
 1145 
 1146 #
 1147 #  Use the List checker for sets, in order to get
 1148 #  partial credit.  Set the various types for error
 1149 #  messages.
 1150 #
 1151 sub cmp_defaults {(
 1152   Value::List::cmp_defaults(@_),
 1153   typeMatch => 'Value::Real',
 1154   list_type => 'a set',
 1155   entry_type => 'a number',
 1156   removeParens => 0,
 1157   showParenHints => 1,
 1158   implicitList => 0,
 1159 )}
 1160 
 1161 #
 1162 #  Use the list checker if the student answer is a set
 1163 #    otherwise use the standard compare (to get better
 1164 #    error messages).
 1165 #
 1166 sub cmp_equal {
 1167   my ($self,$ans) = @_;
 1168   return $self->SUPER::cmp_equal($ans) unless $ans->{student_value}->type eq 'Set';
 1169   my $error = $self->cmp_checkUnionReduce($ans->{student_value},$ans);
 1170   if ($error) {$self->cmp_Error($ans,$error); return}
 1171   return Value::List::cmp_equal(@_);
 1172 }
 1173 
 1174 #
 1175 #  Check for unreduced sets and unions
 1176 #
 1177 sub cmp_compare {
 1178   my $self = shift; my $student = shift; my $ans = shift;
 1179   my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
 1180   if ($error) {$self->context->setError($error,'',undef,undef,$CMP_WARNING); return}
 1181   $self->SUPER::cmp_compare($student,$ans,@_);
 1182 }
 1183 
 1184 #############################################################
 1185 
 1186 =head3 Value::Union
 1187 
 1188   Usage: $union = Union("[4,5] U [6,7]");
 1189          or $union = Union(Interval("[4,5]",Interval("[6,7]"));
 1190          ANS($union->cmp());
 1191 
 1192 
 1193 =cut
 1194 
 1195 package Value::Union;
 1196 
 1197 sub typeMatch {
 1198   my $self = shift; my $other = shift;
 1199   return 0 unless ref($other) && !$other->isFormula;
 1200   return $other->length == 2 &&
 1201          ($other->{open} eq '(' || $other->{open} eq '[') &&
 1202          ($other->{close} eq ')' || $other->{close} eq ']')
 1203      if $other->type =~ m/^(Point|List)$/;
 1204   $other->isSetOfReals;
 1205 }
 1206 
 1207 #
 1208 #  Use the List checker for unions, in order to get
 1209 #  partial credit.  Set the various types for error
 1210 #  messages.
 1211 #
 1212 my $typeMatchInterval = Value::Interval->make(0,1);
 1213 sub cmp_defaults {(
 1214   Value::List::cmp_defaults(@_),
 1215   typeMatch => $typeMatchInterval,
 1216   list_type => 'an interval, set or union',
 1217   short_type => 'a union',
 1218   entry_type => 'an interval or set',
 1219 )}
 1220 
 1221 sub cmp_equal {
 1222   my $self = shift; my $ans = shift;
 1223   my $error = $self->cmp_checkUnionReduce($ans->{student_value},$ans);
 1224   if ($error) {$self->cmp_Error($ans,$error); return}
 1225   Value::List::cmp_equal($self,$ans);
 1226 }
 1227 
 1228 #
 1229 #  Check for unreduced sets and unions
 1230 #
 1231 sub cmp_compare {
 1232   my $self = shift; my $student = shift; my $ans = shift;
 1233   my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
 1234   if ($error) {$self->context->setError($error,'',undef,undef,$CMP_WARNING); return}
 1235   $self->SUPER::cmp_compare($student,$ans,@_);
 1236 }
 1237 
 1238 #############################################################
 1239 
 1240 =head3 Value::List
 1241 
 1242   Usage:  $lst = List("1, x, <4,5,6>"); # list of a real, a formula and a vector.
 1243           or $lst = List(Real(1), Formula("x"), Vector(4,5,6));
 1244           ANS($lst->cmp(showHints=>1));
 1245 
 1246     compareOptions and defaults:
 1247       showTypeWarnings => 1,
 1248       showEqualErrors  => 1,         # show errors produced when checking equality of entries
 1249       ignoreStrings    => 1,         # don't show type warnings for strings
 1250       studentsMustReduceUnions => 1,
 1251       showUnionReduceWarnings => 1,
 1252       showHints => undef,            # automatically set to 1 if $showPartialCorrectAnswers == 1
 1253       showLengthHints => undef,      # automatically set to 1 if $showPartialCorrectAnswers == 1
 1254       showParenHints => undef,       # automatically set to 1 if $showPartialCorrectAnswers == 1
 1255       partialCredit => undef,        # automatically set to 1 if $showPartialCorrectAnswers == 1
 1256       ordered => 0,                  # 1 = must be in same order as correct answer
 1257       entry_type => undef,           # determined from first entry
 1258       list_type => undef,            # determined automatically
 1259       typeMatch => $element,         # used for type checking the entries
 1260       firstElement => $element,
 1261       extra => undef,                # used to check syntax of incorrect answers
 1262       requireParenMatch => 1,        # student parens must match correct parens
 1263       removeParens => 1,             # remove outermost parens, if any
 1264       implicitList => 1,             # force single answers to be lists (even if they ARE lists)
 1265 
 1266 
 1267 =cut
 1268 
 1269 package Value::List;
 1270 
 1271 sub cmp_defaults {
 1272   my $self = shift;
 1273   my %options = (@_);
 1274   my $element = Value::makeValue($self->{data}[0],context=>$self->context);
 1275   $element = $self->Package("Formula")->new($element) unless Value::isValue($element);
 1276   return (
 1277     Value::Real->cmp_defaults(@_),
 1278     showHints => undef,
 1279     showLengthHints => undef,
 1280     showParenHints => undef,
 1281     partialCredit => undef,
 1282     ordered => 0,
 1283     entry_type => undef,
 1284     list_type => undef,
 1285     typeMatch => $element,
 1286     firstElement => $element,
 1287     extra => undef,
 1288     requireParenMatch => 1,
 1289     removeParens => 1,
 1290     implicitList => 1,
 1291   );
 1292 }
 1293 
 1294 #
 1295 #  Match anything but formulas
 1296 #
 1297 sub typeMatch {return !ref($other) || !$other->isFormula}
 1298 
 1299 #
 1300 #  Handle removal of outermost parens in correct answer.
 1301 #
 1302 sub cmp {
 1303   my $self = shift;
 1304   my %params = @_;
 1305   my $cmp = $self->SUPER::cmp(@_);
 1306   if ($cmp->{rh_ans}{removeParens}) {
 1307     $self->{open} = $self->{close} = '';
 1308     $cmp->ans_hash(correct_ans => $self->stringify)
 1309       unless defined($self->{correct_ans}) || defined($params{correct_ans});
 1310   }
 1311   return $cmp;
 1312 }
 1313 
 1314 sub cmp_equal {
 1315   my $self = shift; my $ans = shift;
 1316   $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
 1317 
 1318   #
 1319   #  get the paramaters
 1320   #
 1321   my $showHints         = getOption($ans,'showHints');
 1322   my $showLengthHints   = getOption($ans,'showLengthHints');
 1323   my $showParenHints    = getOption($ans,'showParenHints');
 1324   my $partialCredit     = getOption($ans,'partialCredit');
 1325   my $requireParenMatch = $ans->{requireParenMatch};
 1326   my $implicitList      = $ans->{implicitList};
 1327   my $typeMatch         = $ans->{typeMatch};
 1328   my $value             = $ans->{entry_type};
 1329   my $ltype             = $ans->{list_type} || lc($self->type);
 1330   my $stype             = $ans->{short_type} || $ltype;
 1331 
 1332   $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'a value')
 1333     unless defined($value);
 1334   $value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
 1335   $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
 1336   $ltype =~ s/^an? //; $stype =~ s/^an? //;
 1337   $showHints = $showLengthHints = 0 if $ans->{isPreview};
 1338 
 1339   #
 1340   #  Get the lists of correct and student answers
 1341   #   (split formulas that return lists or unions)
 1342   #
 1343   my @correct = (); my ($cOpen,$cClose);
 1344   if (!$self->isFormula) {
 1345     @correct = $self->value;
 1346     $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
 1347   } else {
 1348     @correct = Value::List->splitFormula($self,$ans);
 1349     $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
 1350   }
 1351   my $student = $ans->{student_value}; my @student = ($student);
 1352   my ($sOpen,$sClose) = ('','');
 1353   if (Value::isFormula($student) && $student->type eq $self->type) {
 1354     if ($implicitList && $student->{tree}{open} ne '') {
 1355       @student = ($student);
 1356     } else {
 1357       @student = Value::List->splitFormula($student,$ans);
 1358       $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
 1359     }
 1360   } elsif (!$student->isFormula && $student->classMatch($self->type)) {
 1361     if ($implicitList && $student->{open} ne '') {
 1362       @student = ($student);
 1363     } else {
 1364       @student = @{$student->{data}};
 1365       $sOpen = $student->{open}; $sClose = $student->{close};
 1366     }
 1367   }
 1368   return if $ans->{split_error};
 1369   foreach my $x (@correct) {$x->{equation} = $self};
 1370   foreach my $x (@student) {$x->{equation} = $self};
 1371   #
 1372   #  Check for parenthesis match
 1373   #
 1374   if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
 1375     if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
 1376       my $message = "The parentheses for your $ltype ";
 1377       if (($cOpen || $cClose) && ($sOpen || $sClose))
 1378                                 {$message .= "are of the wrong type"}
 1379       elsif ($sOpen || $sClose) {$message .= "should be removed"}
 1380       else                      {$message .= "seem to be missing"}
 1381       $self->cmp_Error($ans,$message) unless $ans->{isPreview};
 1382     }
 1383     return;
 1384   }
 1385 
 1386   #
 1387   #  Determine the maximum score
 1388   #
 1389   my $M = scalar(@correct);
 1390   my $m = scalar(@student);
 1391   my $maxscore = ($m > $M)? $m : $M;
 1392 
 1393   #
 1394   #  Compare the two lists
 1395   #  (Handle errors in user-supplied functions)
 1396   #
 1397   my ($score,@errors);
 1398   if (ref($ans->{list_checker}) eq 'CODE') {
 1399     eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)};
 1400     if (!defined($score)) {
 1401       die $@ if $@ ne '' && $self->{context}{error}{flag} == 0;
 1402       $self->cmp_error($ans) if $self->{context}{error}{flag};
 1403     }
 1404   } else {
 1405     ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value);
 1406   }
 1407   return unless defined($score);
 1408 
 1409   #
 1410   #  Give hints about extra or missing answers
 1411   #
 1412   if ($showLengthHints) {
 1413     $value =~ s/( or|,) /s$1 /g; # fix "interval or union"
 1414     push(@errors,"There should be more ${value}s in your $stype")
 1415       if ($score < $maxscore && $score == $m);
 1416     push(@errors,"There should be fewer ${value}s in your $stype")
 1417       if ($score < $maxscore && $score == $M && !$showHints);
 1418   }
 1419 
 1420   #
 1421   #  If all the entries are in error, don't give individual messages
 1422   #
 1423   if ($score == 0) {
 1424     my $i = 0;
 1425     while ($i <= $#errors) {
 1426       if ($errors[$i++] =~ m/^Your .* is incorrect$/)
 1427         {splice(@errors,--$i,1)}
 1428     }
 1429   }
 1430 
 1431   #
 1432   #  Finalize the score
 1433   #
 1434   $score = 0 if ($score != $maxscore && !$partialCredit);
 1435   $ans->score($score/$maxscore);
 1436   push(@errors,"Score = $ans->{score}") if $ans->{debug};
 1437   my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g;
 1438   $ans->{error_message} = $ans->{ans_message} = $error;
 1439 }
 1440 
 1441 #
 1442 #  Compare the contents of the list to see of they are equal
 1443 #
 1444 sub cmp_list_compare {
 1445   my $self = shift; my $context = $self->context;
 1446   my $correct = shift; my $student = shift; my $ans = shift; my $value = shift;
 1447   my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student);
 1448   my $ordered = $ans->{ordered};
 1449   my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview};
 1450   my $typeMatch = $ans->{typeMatch};
 1451   my $extra = defined($ans->{extra}) ? $ans->{extra} :
 1452               (Value::isValue($typeMatch) ? $typeMatch: $ans->{firstElement});
 1453   $extra = $self->Package("List")->new() unless defined($extra);
 1454   my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
 1455   my $error = $context->{error};
 1456   my $score = 0; my @errors; my $i = 0;
 1457 
 1458   #
 1459   #  Check for empty lists
 1460   #
 1461   if (scalar(@correct) == 0) {$ans->score($m == 0); return}
 1462 
 1463   #
 1464   #  Loop through student answers looking for correct ones
 1465   #
 1466   ENTRY: foreach my $entry (@student) {
 1467     $i++; $context->clearError;
 1468     $entry = Value::makeValue($entry,$context);
 1469     $entry = $self->Package("Formula")->new($entry) if !Value::isValue($entry);
 1470 
 1471     #
 1472     #  Some words differ if there is only one entry in the student's list
 1473     #
 1474     my $nth = ''; my $answer = 'answer';
 1475     my $class = $ans->{list_type} || $ans->{cmp_class};
 1476     if ($m > 1) {
 1477       $nth = ' '.$self->NameForNumber($i);
 1478       $class = $ans->{cmp_class};
 1479       $answer = 'value';
 1480     }
 1481 
 1482     #
 1483     #  See if the entry matches the correct answer
 1484     #  and perform syntax checking if not
 1485     #
 1486     if ($ordered) {
 1487       if (scalar(@correct)) {
 1488   if (shift(@correct)->cmp_compare($entry,$ans,$nth,$value)) {$score++; next ENTRY}
 1489       } else {
 1490   # do syntax check
 1491   if (ref($extra) eq 'CODE') {&$extra($entry,$ans,$nth,$value)}
 1492     else {$extra->cmp_compare($entry,$ans,$nth,$value)}
 1493       }
 1494       if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
 1495     } else {
 1496       foreach my $k (0..$#correct) {
 1497   if ($correct[$k]->cmp_compare($entry,$ans,$nth,$value)) {
 1498     splice(@correct,$k,1);
 1499     $score++; next ENTRY;
 1500   }
 1501   if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
 1502       }
 1503       $context->clearError;
 1504       # do syntax check
 1505       if (ref($extra) eq 'CODE') {&$extra($entry,$ans,$nth,$value)}
 1506         else {$extra->cmp_compare($entry,$ans,$nth,$value)}
 1507     }
 1508     #
 1509     #  Give messages about incorrect answers
 1510     #
 1511     my $match = (ref($typeMatch) eq 'CODE')? &$typeMatch($entry,$ans) :
 1512                                              $typeMatch->typeMatch($entry,$ans);
 1513     if ($showTypeWarnings && !$match &&
 1514   !($ans->{ignoreStrings} && $entry->classMatch('String'))) {
 1515       push(@errors,"Your$nth $answer isn't ".lc($class).
 1516      " (it looks like ".lc($entry->showClass).")");
 1517     } elsif ($error->{flag} && $ans->{showEqualErrors}) {
 1518       my $message = $error->{message}; $message =~ s/\s+$//;
 1519       if ($m > 1 && $error->{flag} != $CMP_WARNING) {
 1520         push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
 1521                '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
 1522       } else {push(@errors,$message)}
 1523     } elsif ($showHints && $m > 1) {
 1524       push(@errors,"Your$nth $value is incorrect");
 1525     }
 1526   }
 1527 
 1528   #
 1529   #  Return the score and errors
 1530   #
 1531   return ($score,@errors);
 1532 }
 1533 
 1534 
 1535 
 1536 #
 1537 #  Split a formula that is a list or union into a
 1538 #    list of formulas (or Value objects).
 1539 #
 1540 sub splitFormula {
 1541   my $self = shift; my $formula = shift; my $ans = shift;
 1542   my @formula; my @entries;
 1543   if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion}
 1544     else {@entries = @{$formula->{tree}{coords}}}
 1545   foreach my $entry (@entries) {
 1546     my $v = Parser::Formula($entry);
 1547        $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
 1548     if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error($ans); return}
 1549     $v->{equation} = $self;
 1550     push(@formula,$v);
 1551   }
 1552   return @formula;
 1553 }
 1554 
 1555 #  Override for List ?
 1556 #  Return the value if it is defined, otherwise use a default
 1557 #
 1558 sub getOption {
 1559   my $ans = shift; my $name = shift;
 1560   my $value = $ans->{$name};
 1561   return $value if defined($value);
 1562   return $ans->{showPartialCorrectAnswers};
 1563 }
 1564 
 1565 #############################################################
 1566 
 1567 =head3  Value::Formula
 1568 
 1569   Usage: $fun = Formula("x^2-x+1");
 1570          $set = Formula("[-1, x) U (x, 2]");
 1571 
 1572   A formula can have any of the other math object types as its range.
 1573     Union, List, Number (Complex or Real),
 1574 
 1575 
 1576 =cut
 1577 
 1578 package Value::Formula;
 1579 
 1580 sub cmp_defaults {
 1581   my $self = shift;
 1582 
 1583   return (
 1584     Value::Union::cmp_defaults($self,@_),
 1585     typeMatch => $self->Package("Formula")->new("(1,2]"),
 1586     showDomainErrors => 1,
 1587   ) if $self->type eq 'Union';
 1588 
 1589   my $type = $self->type;
 1590   $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
 1591   $type = $self->Package($type).'::';
 1592 
 1593   return (
 1594     &{$type.'cmp_defaults'}($self,@_),
 1595     upToConstant => 0,
 1596     showDomainErrors => 1,
 1597 #  ) if defined(%$type) && $self->type ne 'List'; #causes errors in newest perl
 1598 # ) if ( ref($type)=~/HASH/ ) && $self->type ne 'List'; # does NOT work --causes FortLewis error
 1599    ) if %$type && $self->type ne 'List';
 1600   my $element;
 1601   if ($self->{tree}->class eq 'List') {$element = $self->Package("Formula")->new($self->{tree}{coords}[0])}
 1602     else {$element = $self->Package("Formula")->new(($self->createRandomPoints(1))[1]->[0]{data}[0])}
 1603   return (
 1604     Value::List::cmp_defaults($self,@_),
 1605     removeParens => $self->{autoFormula},
 1606     typeMatch => $element,
 1607     showDomainErrors => 1,
 1608   );
 1609 }
 1610 
 1611 #
 1612 #  Get the types from the values of the formulas
 1613 #     and compare those.
 1614 #
 1615 sub typeMatch {
 1616   my $self = shift; my $other = shift; my $ans = shift;
 1617   return 1 if $self->type eq $other->type;
 1618   my $typeMatch = $self->getTypicalValue($self);
 1619   $other = $self->getTypicalValue($other,1) if Value::isFormula($other);
 1620   return 1 unless defined($other); # can't really tell, so don't report type mismatch
 1621   return 1 if $typeMatch->classMatch('String') && Value::isFormula($ans->{typeMatch});  # avoid infinite loop
 1622   $typeMatch->typeMatch($other,$ans);
 1623 }
 1624 
 1625 #
 1626 #  Create a value from the formula (so we know the output type)
 1627 #
 1628 sub getTypicalValue {
 1629   my $self = shift; my $f = shift; my $noError = shift;
 1630   return $f->{test_values}[0] if $f->{test_values};
 1631   my $points = $f->{test_points} || $self->{test_points};
 1632   return ($f->createPointValues($points)||[])->[0] if $points;
 1633   return ((($f->createRandomPoints(1,undef,$noError))[1])||[])->[0];
 1634 }
 1635 
 1636 #
 1637 #  Handle removal of outermost parens in a list.
 1638 #  Evaluate answer, if the eval option is used.
 1639 #  Handle the UpToConstant option.
 1640 #
 1641 sub cmp {
 1642   my $self = shift;
 1643   my $cmp = $self->SUPER::cmp(@_);
 1644   if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
 1645     $self->{tree}{open} = $self->{tree}{close} = '';
 1646     $cmp->ans_hash(correct_ans => $self->stringify)
 1647       unless defined($self->{correct_ans});
 1648   }
 1649   if ($cmp->{rh_ans}{eval} && $self->isConstant) {
 1650     $cmp->ans_hash(correct_value => $self->eval);
 1651     return $cmp;
 1652   }
 1653   if ($cmp->{rh_ans}{upToConstant}) {
 1654     my $current = Parser::Context->current();
 1655     my $context = $self->{context} = $self->{context}->copy;
 1656     Parser::Context->current(undef,$context);
 1657     $context->variables->add('C0' => 'Parameter');
 1658     my $f = $self->Package("Formula")->new('C0')+$self;
 1659     for ('limits','test_points','test_values','num_points','granularity','resolution',
 1660    'checkUndefinedPoints','max_undefined')
 1661       {$f->{$_} = $self->{$_} if defined($self->{$_})}
 1662     $cmp->ans_hash(correct_value => $f);
 1663     Parser::Context->current(undef,$current);
 1664   }
 1665   $cmp->install_pre_filter(\&Value::Formula::cmp_call_filter,"cmp_prefilter");
 1666   $cmp->install_post_filter(\&Value::Formula::cmp_call_filter,"cmp_postfilter");
 1667   return $cmp;
 1668 }
 1669 
 1670 sub cmp_call_filter {
 1671   my $ans = shift; my $method = shift;
 1672   return $ans->{correct_value}->$method($ans,@_);
 1673 }
 1674 
 1675 sub cmp_prefilter {
 1676   my $self = shift; my $ans = shift;
 1677   $ans->{_filter_name} = "fetch_previous_answer";
 1678   $ans->{prev_ans} = undef;
 1679   if (defined($ans->{ans_label})) {
 1680     my $label = "previous_".$ans->{ans_label};
 1681     my $inputs = $self->getPG('$inputs_ref');
 1682     if (defined $inputs->{$label} and $inputs->{$label} =~ /\S/) {
 1683       $ans->{prev_ans} = $inputs->{$label};
 1684       #FIXME -- previous answer item is not always being updated in inputs_ref (which comes from formField)
 1685     }
 1686   }
 1687   return $ans;
 1688 }
 1689 
 1690 sub cmp_postfilter {
 1691   my $self = shift; my $ans = shift;
 1692   $ans->{_filter_name} = "produce_equivalence_message";
 1693   return $ans if $ans->{ans_message}; # don't overwrite other messages
 1694   return $ans unless defined($ans->{prev_ans}); # if prefilters are erased, don't do this check
 1695   my $context = $self->context;
 1696   $ans->{prev_formula} = Parser::Formula($context,$ans->{prev_ans});
 1697   if (defined($ans->{prev_formula}) && defined($ans->{student_formula})) {
 1698     my $prev = eval {$self->promote($ans->{prev_formula})->inherit($self)}; # inherit limits, etc.
 1699     break unless defined($prev);
 1700     $context->{answerHash} = $ans; # values here can override context flags
 1701     $ans->{prev_equals_current} = Value::cmp_compare($prev,$ans->{student_formula},$ans);
 1702     $context->{answerHash} = undef;
 1703     if (   !$ans->{isPreview}                                 # not preview mode
 1704   and $ans->{prev_equals_current}                       # equivalent
 1705   and $ans->{prev_ans} ne $ans->{original_student_ans}) # but not identical
 1706       {$ans->{ans_message} = "This answer is equivalent to the one you just submitted."}
 1707   }
 1708   return $ans;
 1709 }
 1710 
 1711 
 1712 sub cmp_equal {
 1713   my $self = shift; my $ans = shift;
 1714   #
 1715   #  Get the problem's seed
 1716   #
 1717   $self->{context}->flags->set(
 1718     random_seed => $self->getPG('$PG_original_problemSeed')
 1719   );
 1720 
 1721   #
 1722   #  Use the list checker if the formula is a list or union
 1723   #    Otherwise use the normal checker
 1724   #
 1725   if ($self->type =~ m/^(List|Union|Set)$/) {
 1726     Value::List::cmp_equal($self,$ans);
 1727   } else {
 1728     $self->SUPER::cmp_equal($ans);
 1729   }
 1730 }
 1731 
 1732 sub cmp_postprocess {
 1733   my $self = shift; my $ans = shift;
 1734   return unless $ans->{score} == 0;
 1735   $self->{context}->clearError;
 1736   eval {$ans->{student_formula}->reduce} if defined($ans->{student_formula}); # check for bad function calls
 1737   $self->cmp_error($ans) if $self->{context}{error}{flag};                    #  and report the error
 1738   return if $ans->{ans_message} || $ans->{isPreview};
 1739   if ($self->{domainMismatch} && $ans->{showDomainErrors}) {
 1740     $self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer");
 1741     return;
 1742   }
 1743   return if !$ans->{showDimensionHints};
 1744   my $other = $ans->{student_value};
 1745   return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
 1746   return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
 1747   return unless $self->type  =~ m/^(Point|Vector|Matrix)$/;
 1748   return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
 1749   $self->cmp_Error($ans,"The dimension of your result is incorrect");
 1750 }
 1751 
 1752 #
 1753 #  Diagnostics for Formulas
 1754 #
 1755 sub cmp_diagnostics {
 1756   my $self = shift;  my $ans = shift;
 1757   my $isEvaluator = (ref($ans) =~ /Evaluator/)? 1: 0;
 1758   my $hash = $isEvaluator? $ans->rh_ans : $ans;
 1759   my $diagnostics = $self->{context}->diagnostics->merge("formulas",$self,$hash);
 1760   my $formulas = $diagnostics->{formulas};
 1761   return unless $formulas->{show};
 1762 
 1763   my $output = "";
 1764   if ($isEvaluator) {
 1765     #
 1766     #  The tests to be performed when the answer checker is created
 1767     #
 1768     $self->getPG('loadMacros("PGgraphmacros.pl")');
 1769     my ($inputs) = $self->getPG('$inputs_ref');
 1770     my $process = $inputs->{checkAnswers} || $inputs->{previewAnswers} || $inputs->{submitAnswers};
 1771     if ($formulas->{checkNumericStability} && !$process) {
 1772       ### still needs to be written
 1773     }
 1774   } else {
 1775     #
 1776     #  The checks to be performed when an answer is submitted
 1777     #
 1778     my $student = $ans->{student_formula};
 1779     #
 1780     #  Get the test points
 1781     #
 1782     my @names = $self->{context}->variables->names;
 1783     my $vx = (keys(%{$self->{variables}}))[0];
 1784     my $vi = 0; while ($names[$vi] ne $vx) {$vi++}
 1785     my $points = [map {$_->[$vi]} @{$self->{test_points}}];
 1786     my @params = $self->{context}->variables->parameters;
 1787        @names = $self->{context}->variables->variables;
 1788 
 1789     #
 1790     #  The graphs of the functions and errors
 1791     #
 1792     if ($formulas->{showGraphs}) {
 1793       my @G = ();
 1794       if ($formulas->{combineGraphs}) {
 1795   push(@G,$self->cmp_graph($diagnostics,[$student,$self],
 1796          title=>'Student Answer (red)<BR>Correct Answer (green)<BR>',
 1797          points=>$points,showDomain=>1));
 1798       } else {
 1799   push(@G,$self->cmp_graph($diagnostics,$self,title=>'Correct Answer'));
 1800   push(@G,$self->cmp_graph($diagnostics,$student,title=>'Student Answer'));
 1801       }
 1802       my $cutoff = $self->Package("Formula")->new($self->getFlag('tolerance'));
 1803       if ($formulas->{graphAbsoluteErrors}) {
 1804   push(@G,$self->cmp_graph($diagnostics,[abs($self-$student),$cutoff],
 1805          clip=>$formulas->{clipAbsoluteError},
 1806          title=>'Absolute Error',points=>$points));
 1807       }
 1808       if ($formulas->{graphRelativeErrors}) {
 1809   push(@G,$self->cmp_graph($diagnostics,[abs(($self-$student)/$self),$cutoff],
 1810          clip=>$formulas->{clipRelativeError},
 1811          title=>'Relative Error',points=>$points));
 1812       }
 1813       $output .= '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
 1814   . '<TR VALIGN="TOP">'.join('<TD WIDTH="20"></TD>',@G).'</TR></TABLE>';
 1815     }
 1816 
 1817     #
 1818     #  The adaptive parameters
 1819     #
 1820     if ($formulas->{showParameters} && scalar(@params) > 0) {
 1821       $output .= '<HR><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0"><TR><TD>Adaptive Parameters:<BR>';
 1822       $output .= join("<BR>",map {"&nbsp;&nbsp;$params[$_]: ".$self->{parameters}[$_]} (0..$#params));
 1823       $output .= '</TD></TR></TABLE>';
 1824     }
 1825 
 1826     #
 1827     #  The test points and values
 1828     #
 1829     my @rows = (); my $colsep = '</TD><TD WIDTH="20"></TD><TD ALIGN="RIGHT">';
 1830     my @P = (map {(scalar(@{$_}) == 1)? $_->[0]: $self->Package("Point")->make(@{$_})} @{$self->{test_points}});
 1831     my @i = sort {$P[$a] <=> $P[$b]} (0..$#P);
 1832     foreach $p (@P) {if (Value::isValue($p) && $p->length > 2) {$p = $p->string; $p =~ s|,|,<br />|g}}
 1833     my $zeroLevelTol = $self->{context}{flags}{zeroLevelTol};
 1834     $self->{context}{flags}{zeroLevelTol} = 0; # always show full resolution in the tables below
 1835     my $names = join(',',@names); $names = '('.$names.')' if scalar(@names) > 1;
 1836 
 1837     $student->createPointValues($self->{test_points},0,1,1) unless $student->{test_values};
 1838 
 1839     my $cv = $self->{test_values};
 1840     my $sv = $student->{test_values};
 1841     my $av = $self->{test_adapt} || $cv;
 1842 
 1843     if ($formulas->{showTestPoints}) {
 1844       my @p = ("$names:", (map {$P[$i[$_]]} (0..$#P)));
 1845       push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
 1846       push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,("<HR>")x scalar(@p)).'</TD></TR>');
 1847       push(@rows,'<TR><TD ALIGN="RIGHT">'
 1848      .join($colsep,($av == $cv)? "Correct Answer:" : "Adapted Answer:",
 1849      map {Value::isNumber($av->[$i[$_]])? $av->[$i[$_]]: "undefined"} (0..$#P))
 1850      .'</TD></TR>');
 1851       push(@rows,'<TR><TD ALIGN="RIGHT">'
 1852      .join($colsep,"Student Answer:",
 1853      map {Value::isNumber($sv->[$i[$_]])? $sv->[$i[$_]]: "undefined"} (0..$#P))
 1854      .'</TD></TR>');
 1855     }
 1856     #
 1857     #  The absolute errors (colored by whether they are ok or too big)
 1858     #
 1859     if ($formulas->{showAbsoluteErrors}) {
 1860       my @p = ("Absolute Error:");
 1861       my $tolerance = $self->getFlag('tolerance');
 1862       my $tolType = $self->getFlag('tolType'); my $error;
 1863       foreach my $j (0..$#P) {
 1864   if (Value::isNumber($sv->[$i[$j]])) {
 1865     $error = abs($av->[$i[$j]] - $sv->[$i[$j]]);
 1866     $error = '<SPAN STYLE="color:#'.($error->value<$tolerance ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
 1867       if $tolType eq 'absolute';
 1868   } else {$error = "---"}
 1869   push(@p,$error);
 1870       }
 1871       push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
 1872     }
 1873     #
 1874     #  The relative errors (colored by whether they are OK or too big)
 1875     #
 1876     if ($formulas->{showRelativeErrors}) {
 1877       my @p = ("Relative Error:");
 1878       my $tolerance = $self->getFlag('tolerance'); my $tol;
 1879       my $tolType = $self->getFlag('tolType'); my $error;
 1880       my $zeroLevel = $self->getFlag('zeroLevel');
 1881       foreach my $j (0..$#P) {
 1882   if (Value::isNumber($sv->[$i[$j]])) {
 1883     my $c = $av->[$i[$j]]; my $s = $sv->[$i[$j]];
 1884     if (abs($cv->[$i[$j]]->value) < $zeroLevel || abs($s->value) < $zeroLevel)
 1885             {$error = abs($c-$s); $tol = $zeroLevelTol} else
 1886             {$error = abs(($c-$s)/($c||1E-10)); $tol = $tolerance}
 1887     $error = '<SPAN STYLE="color:#'.($error < $tol ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
 1888       if $tolType eq 'relative';
 1889   } else {$error = "---"}
 1890   push(@p,$error);
 1891       }
 1892       push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
 1893     }
 1894     $self->{context}{flags}{zeroLevelTol} = $zeroLevelTol;
 1895     #
 1896     #  Put the data into a table
 1897     #
 1898     if (scalar(@rows)) {
 1899       $output .= '<p><HR><p><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
 1900   . join('<TR><TD HEIGHT="3"></TD>',@rows)
 1901   . '</TABLE>';
 1902     }
 1903   }
 1904   #
 1905   #  Put all the diagnostic output into a frame
 1906   #
 1907   return unless $output;
 1908   $output
 1909     = '<TABLE BORDER="1" CELLSPACING="2" CELLPADDING="20" BGCOLOR="#F0F0F0">'
 1910     . '<TR><TD ALIGN="LEFT"><B>Diagnostics for '.$self->string .':</B>'
 1911     . '<P><CENTER>' . $output . '</CENTER></TD></TR></TABLE><P>';
 1912   warn $output;
 1913 }
 1914 
 1915 #
 1916 #  Draw a graph from a given Formula object
 1917 #
 1918 sub cmp_graph {
 1919   my $self = shift; my $diagnostics = shift;
 1920   my $F1 = shift; my $F2; ($F1,$F2) = @{$F1} if (ref($F1) eq 'ARRAY');
 1921   #
 1922   #  Get the various options
 1923   #
 1924   my %options = (title=>'',points=>[],@_);
 1925   my $graphs = $diagnostics->{graphs};
 1926   my $limits = $graphs->{limits}; $limits = $self->getFlag('limits',[-2,2]) unless $limits;
 1927   $limits = $limits->[0] while ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY';
 1928   my $size = $graphs->{size}; $size = [$size,$size] unless ref($size) eq 'ARRAY';
 1929   my $steps = $graphs->{divisions};
 1930   my $points = $options{points}; my $clip = $options{clip};
 1931   my ($my,$My) = (0,0); my ($mx,$Mx) = @{$limits};
 1932   my $dx = ($Mx-$mx)/$steps; my $f; my $y;
 1933 
 1934   my @pnames = $self->{context}->variables->parameters;
 1935   my @pvalues = ($self->{parameters} ? @{$self->{parameters}} : (0) x scalar(@pnames));
 1936   my $x = "";
 1937 
 1938   #
 1939   #  Find the max and min values of the function
 1940   #
 1941   foreach $f ($F1,$F2) {
 1942     next unless defined($f);
 1943     foreach my $v (keys(%{$f->{variables}})) {
 1944       if ($v ne $x && !$f->{context}->variables->get($v)->{parameter}) {
 1945   if ($x) {
 1946     warn "Only formulas with one variable can be graphed" unless $self->{graphWarning};
 1947     $self->{graphWarning} = 1;
 1948     return "";
 1949   }
 1950   $x = $v;
 1951       }
 1952     }
 1953     unless ($f->typeRef->{length} == 1) {
 1954       warn "Only real-valued functions can be graphed" unless $self->{graphWarning};
 1955       $self->{graphWarning} = 1;
 1956       return "";
 1957     }
 1958     unless ($f->typeRef->{length} == 1) {
 1959       warn "Only real-valued functions can be graphed";
 1960       return "";
 1961     }
 1962     if ($f->isConstant) {
 1963       $y = $f->eval;
 1964       $my = $y if $y < $my; $My = $y if $y > $My;
 1965     } else {
 1966       my $F = $f->perlFunction(undef,[$x,@pnames]);
 1967       foreach my $i (0..$steps-1) {
 1968         $y = eval {&{$F}($mx+$i*$dx,@pvalues)};
 1969   next unless defined($y) && Value::isNumber($y);
 1970         $my = $y if $y < $my; $My = $y if $y > $My;
 1971       }
 1972     }
 1973   }
 1974   $My = 1 if abs($My - $my) < 1E-5;
 1975   $my *= 1.1; $My *= 1.1;
 1976   if ($clip) {
 1977     $my = -$clip if $my < -$clip;
 1978     $My = $clip if $My > $clip;
 1979   }
 1980   $my = -$My/10 if $my > -$My/10; $My = -$my/10 if $My < -$my/10;
 1981   my $a = $self->Package("Real")->new(($My-$my)/($Mx-$mx));
 1982 
 1983   #
 1984   #  Create the graph itself, with suitable title
 1985   #
 1986   my $grf = $self->getPG('$_grf_ = {n => 0}');
 1987   $grf->{Goptions} = [
 1988      $mx,$my,$Mx,$My,
 1989      axes => $graphs->{axes},
 1990      grid => $graphs->{grid},
 1991      size => $size,
 1992   ];
 1993   $grf->{params} = {
 1994     names => [$x,@pnames],
 1995     values => {map {$pnames[$_] => $pvalues[$_]} (0..scalar(@pnames)-1)},
 1996   };
 1997   $grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})');
 1998   $grf->{G}->imageName($grf->{G}->imageName.'-'.time()); # avoid browser cache
 1999   $self->cmp_graph_function($grf,$F2,"green",$steps,$points) if defined($F2);
 2000   $self->cmp_graph_function($grf,$F1,"red",$steps,$points);
 2001   my $image = $self->getPG('alias(insertGraph($_grf_->{G}))');
 2002   $image = '<IMG SRC="'.$image.'" WIDTH="'.$size->[0].'" HEIGHT="'.$size->[1].'" BORDER="0" STYLE="margin-bottom:5px">';
 2003   my $title = $options{title}; $title .= '<DIV STYLE="margin-top:5px"></DIV>' if $title;
 2004   $title .= "<SMALL>Domain: [$mx,$Mx]</SMALL><BR>" if $options{showDomain};
 2005   $title .= "<SMALL>Range: [$my,$My]<BR>Aspect ratio: $a:1</SMALL>";
 2006   return '<TD ALIGN="CENTER" VALIGN="TOP" NOWRAP>'.$image.'<BR>'.$title.'</TD>';
 2007 }
 2008 
 2009 #
 2010 #  Add a function to a graph object, and plot the points
 2011 #  that are used to test the function
 2012 #
 2013 sub cmp_graph_function {
 2014   my $self = shift; my $grf = shift; my $F = shift;
 2015   my $color = shift; my $steps = shift; my $points = shift;
 2016   $grf->{n}++; my $Fn = "F".$grf->{n}; $grf->{$Fn} = $F; my $f;
 2017   if ($F->isConstant) {
 2018     my $y = $F->eval;
 2019     $f = $self->getPG('new Fun(sub {'.$y.'},$_grf_->{G})');
 2020   } else {
 2021     my $X = $grf->{params}{names}[0];
 2022     $f = $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{'.$Fn.'},'
 2023            .$X.'=>shift,%{$_grf_->{params}{values}})},$_grf_->{G})');
 2024     foreach my $x (@{$points}) {
 2025       my $y = Parser::Evaluate($F,($X)=>$x,%{$grf->{params}{values}});
 2026       next unless defined($y) && Value::isNumber($y);
 2027       $grf->{x} = $x; $grf->{'y'} = $y;
 2028       my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"'.$color.'","'.$color.'")');
 2029       $grf->{G}->stamps($C);
 2030     }
 2031   }
 2032   $f->color($color); $f->weight(2); $f->steps($steps);
 2033 }
 2034 
 2035 #
 2036 #  If an answer array was used, get the data from the
 2037 #  Matrix, Vector or Point, and format the array of
 2038 #  data using the original parameter
 2039 #
 2040 sub correct_ans {
 2041   my $self = shift;
 2042   return $self->SUPER::correct_ans unless $self->{ans_name};
 2043   my @array = ();
 2044   if ($self->{tree}->type eq 'Matrix') {
 2045     foreach my $row (@{$self->{tree}{coords}}) {
 2046       my @row = ();
 2047       foreach my $x (@{$row->coords}) {push(@row,$x->string)}
 2048       push(@array,[@row]);
 2049     }
 2050   } else {
 2051     foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
 2052     if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
 2053       else {@array = [@array]}
 2054   }
 2055   Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
 2056 }
 2057 
 2058 #
 2059 #  Get the size of the array and create the appropriate answer array
 2060 #
 2061 sub ANS_MATRIX {
 2062   my $self = shift;
 2063   my $extend = shift; my $name = shift;
 2064   my $size = shift || 5; my $type = $self->type;
 2065   my $cols = $self->length; my $rows = 1; my $sep = ',';
 2066   if ($type eq 'Matrix') {
 2067     $sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
 2068   }
 2069   if ($self->{tree}{ColumnVector}) {
 2070     $sep = ""; $type = "Matrix";
 2071     my $tmp = $rows; $rows = $cols; $cols = $tmp;
 2072     $self->{ColumnVector} = 1;
 2073   }
 2074   my $def = $self->context->lists->get($type);
 2075   my $open = $self->{open} || $self->{tree}{open} || $def->{open};
 2076   my $close = $self->{close} || $self->{tree}{close} || $def->{close};
 2077   $self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
 2078 }
 2079 
 2080 sub ans_array {
 2081   my $self = shift;
 2082   return $self->SUPER::ans_array(@_) unless $self->array_OK;
 2083   $self->ANS_MATRIX(0,'',@_);
 2084 }
 2085 sub named_ans_array {
 2086   my $self = shift;
 2087   return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
 2088   $self->ANS_MATRIX(0,@_);
 2089 }
 2090 sub named_ans_array_extension {
 2091   my $self = shift;
 2092   return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
 2093   $self->ANS_MATRIX(1,@_);
 2094 }
 2095 
 2096 sub array_OK {
 2097   my $self = shift; my $tree = $self->{tree};
 2098   return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List';
 2099 }
 2100 
 2101 #
 2102 #  Get an array of values from a Matrix, Vector or Point
 2103 #  (this needs to be made more general)
 2104 #
 2105 sub value {
 2106   my $self = shift;
 2107   return $self unless defined $self->{tree}{coords};
 2108   my $context = $self->context;
 2109   my @array = ();
 2110   if ($self->{tree}->type eq 'Matrix') {
 2111     foreach my $row (@{$self->{tree}->coords}) {
 2112       my @row = ();
 2113       foreach my $x (@{$row->coords}) {push(@row,$context->Package("Formula")->new($context,$x))}
 2114       push(@array,[@row]);
 2115     }
 2116   } else {
 2117     foreach my $x (@{$self->{tree}->coords}) {
 2118       push(@array,$context->Package("Formula")->new($context,$x));
 2119     }
 2120   }
 2121   return @array;
 2122 }
 2123 
 2124 #############################################################
 2125 
 2126 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9