[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 4795 - (download) (as text) (annotate)
Sun Feb 25 20:59:09 2007 UTC (12 years, 9 months ago) by dpvc
File size: 59902 byte(s)
Avoid an infinite loop when string-values formulas are used in a List.
Allow diagonstics to work for complex-valued functions.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9