[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 5060 - (download) (as text) (annotate)
Thu Jun 28 20:42:53 2007 UTC (12 years, 7 months ago) by dpvc
File size: 66747 byte(s)
Use Value->context rather than $$Value::context.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9