[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 6248 - (download) (as text) (annotate)
Fri May 14 01:17:21 2010 UTC (9 years, 6 months ago) by gage
File size: 71181 byte(s)
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:

PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup  Tie::IxHash

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9