[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 3868 - (download) (as text) (annotate)
Sat Dec 31 02:42:46 2005 UTC (13 years, 11 months ago) by dpvc
File size: 56753 byte(s)
Now that the Parser allows multi-letter variable names, there is no
need to handle C0 specially.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9