[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 3469 - (download) (as text) (annotate)
Thu Aug 11 14:23:16 2005 UTC (14 years, 4 months ago) by dpvc
File size: 43255 byte(s)
Added changes needed for the new Set object.

    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 #  Create an answer checker for the given type of object
   18 #
   19 
   20 sub cmp_defaults {(
   21   showTypeWarnings => 1,
   22   showEqualErrors  => 1,
   23   ignoreStrings    => 1,
   24 )}
   25 
   26 sub cmp {
   27   my $self = shift;
   28   my $ans = new AnswerEvaluator;
   29   my $correct = protectHTML($self->{correct_ans});
   30   $correct = $self->correct_ans unless defined($correct);
   31   $ans->ans_hash(
   32     type => "Value (".$self->class.")",
   33     correct_ans => $correct,
   34     correct_value => $self,
   35     $self->cmp_defaults(@_),
   36     @_
   37   );
   38   $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
   39   $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
   40   $self->{context} = $$Value::context unless defined($self->{context});
   41   return $ans;
   42 }
   43 
   44 sub correct_ans {protectHTML(shift->string)}
   45 
   46 #
   47 #  Parse the student answer and compute its value,
   48 #    produce the preview strings, and then compare the
   49 #    student and professor's answers for equality.
   50 #
   51 sub cmp_parse {
   52   my $self = shift; my $ans = shift;
   53   #
   54   #  Do some setup
   55   #
   56   my $current = $$Value::context; # save it for later
   57   my $context = $ans->{correct_value}{context} || $current;
   58   Parser::Context->current(undef,$context); # change to correct answser's context
   59   my $flags = contextSet($context, # save old context flags for the below
   60     StringifyAsTeX => 0,             # reset this, just in case.
   61     no_parameters => 1,              # don't let students enter parameters
   62     showExtraParens => 1,            # make student answer painfully unambiguous
   63     reduceConstants => 0,            # don't combine student constants
   64     reduceConstantFunctions => 0,    # don't reduce constant functions
   65   );
   66   $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
   67   $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
   68   $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
   69   $ans->{preview_latex_string} = $ans->{preview_text_string} = '';
   70 
   71   #
   72   #  Parse and evaluate the student answer
   73   #
   74   $ans->score(0);  # assume failure
   75   $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
   76   $ans->{student_value} = Parser::Evaluate($ans->{student_formula})
   77     if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
   78 
   79   #
   80   #  If it parsed OK, save the output forms and check if it is correct
   81   #   otherwise report an error
   82   #
   83   if (defined $ans->{student_value}) {
   84     $ans->{student_value} = Value::Formula->new($ans->{student_value})
   85        unless Value::isValue($ans->{student_value});
   86     $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
   87     $ans->{preview_text_string}  = protectHTML($ans->{student_formula}->string);
   88     $ans->{student_ans}          = $ans->{preview_text_string};
   89     if ($self->cmp_collect($ans)) {
   90       $self->cmp_equal($ans);
   91       $self->cmp_postprocess($ans) if !$ans->{error_message};
   92     }
   93   } else {
   94     $self->cmp_error($ans);
   95     $self->cmp_collect($ans);
   96   }
   97   contextSet($context,%{$flags});            # restore context values
   98   Parser::Context->current(undef,$current);  # put back the old context
   99   return $ans;
  100 }
  101 
  102 #
  103 #  Check if the object has an answer array and collect the results
  104 #  Build the combined student answer and set the preview values
  105 #
  106 sub cmp_collect {
  107   my $self = shift; my $ans = shift;
  108   return 1 unless $self->{ans_name};
  109   $ans->{preview_latex_string} = $ans->{preview_text_string} = "";
  110   my $OK = $self->ans_collect($ans);
  111   $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
  112   return 0 unless $OK;
  113   my $array = $ans->{student_formula};
  114   if ($self->{ColumnVector}) {
  115     my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
  116     $array = [@V];
  117   } elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
  118   my $type = $self;
  119   $type = "Value::".$self->{tree}->type if $self->class eq 'Formula';
  120   $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
  121   if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag})
  122     {Parser::reportEvalError($@); return 0}
  123   $ans->{student_value} = $ans->{student_formula};
  124   $ans->{preview_text_string} = $ans->{student_ans};
  125   $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
  126   if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
  127     $ans->{student_value} = Parser::Evaluate($ans->{student_formula});
  128     return 0 unless $ans->{student_value};
  129   }
  130   return 1;
  131 }
  132 
  133 #
  134 #  Check if the parsed student answer equals the professor's answer
  135 #
  136 sub cmp_equal {
  137   my $self = shift; my $ans = shift;
  138   my $correct = $ans->{correct_value};
  139   my $student = $ans->{student_value};
  140   if ($correct->typeMatch($student,$ans)) {
  141     my $equal = $correct->cmp_compare($student,$ans);
  142     if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
  143     $self->cmp_error($ans);
  144   } else {
  145     return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  146     $ans->{ans_message} = $ans->{error_message} =
  147       "Your answer isn't ".lc($ans->{cmp_class})."\n".
  148         "(it looks like ".lc($student->showClass).")"
  149      if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
  150   }
  151 }
  152 
  153 #
  154 #  Perform the comparison, either using the checker supplied
  155 #  by the answer evaluator, or the overloaded == operator.
  156 #
  157 
  158 our $CMP_ERROR = 2; # a fatal error was detected
  159 
  160 sub cmp_compare {
  161   my $self = shift; my $other = shift; my $ans = shift;
  162   return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
  163   my $equal = eval {&{$ans->{checker}}($self,$other,$ans)};
  164   if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
  165     $$Value::context->setError(["<I>An error occurred while checking your answer:</I>\n".
  166       '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'');
  167     $$Value::context->{error}{flag} = $CMP_ERROR;
  168     warn "Please inform your instructor that an error occurred while checking your answer";
  169   }
  170   return $equal;
  171 }
  172 
  173 sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
  174 
  175 #
  176 #  Check if types are compatible for equality check
  177 #
  178 sub typeMatch {
  179   my $self = shift;  my $other = shift;
  180   return 1 unless ref($other);
  181   $self->type eq $other->type && $other->class ne 'Formula';
  182 }
  183 
  184 #
  185 #  Class name for cmp error messages
  186 #
  187 sub cmp_class {
  188   my $self = shift; my $ans = shift;
  189   my $class = $self->showClass; $class =~ s/Real //;
  190   return $class if $class =~ m/Formula/;
  191   return "an Interval, Set or Union" if $class =~ m/Interval|Set|Union/i;
  192   return $class;
  193 }
  194 
  195 #
  196 #  Student answer evaluation failed.
  197 #  Report the error, with formatting, if possible.
  198 #
  199 sub cmp_error {
  200   my $self = shift; my $ans = shift;
  201   my $error = $$Value::context->{error};
  202   my $message = $error->{message};
  203   if ($error->{pos}) {
  204     my $string = $error->{string};
  205     my ($s,$e) = @{$error->{pos}};
  206     $message =~ s/; see.*//;  # remove the position from the message
  207     $ans->{student_ans} =
  208        protectHTML(substr($string,0,$s)) .
  209        '<SPAN CLASS="parsehilight">' .
  210          protectHTML(substr($string,$s,$e-$s)) .
  211        '</SPAN>' .
  212        protectHTML(substr($string,$e));
  213   }
  214   $self->cmp_Error($ans,$message);
  215 }
  216 
  217 #
  218 #  Set the error message
  219 #
  220 sub cmp_Error {
  221   my $self = shift; my $ans = shift;
  222   return unless scalar(@_) > 0;
  223   $ans->score(0);
  224   $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
  225 }
  226 
  227 #
  228 #  filled in by sub-classes
  229 #
  230 sub cmp_postprocess {}
  231 
  232 #
  233 #  create answer rules of various types
  234 #
  235 sub ans_rule {shift; pgCall('ans_rule',@_)}
  236 sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
  237 sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
  238 sub ans_array {shift->ans_rule(@_)};
  239 sub named_ans_array {shift->named_ans_rule(@_)};
  240 sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
  241 
  242 sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
  243 sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
  244 
  245 our $answerPrefix = "MaTrIx";
  246 
  247 #
  248 #  Lay out a matrix of answer rules
  249 #
  250 sub ans_matrix {
  251   my $self = shift;
  252   my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
  253   my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
  254   my $new_name = pgRef('RECORD_FORM_LABEL');
  255   my $HTML = ""; my $ename = $name;
  256   if ($name eq '') {
  257     my $n = pgCall('inc_ans_rule_count');
  258     $name = pgCall('NEW_ANS_NAME',$n);
  259     $ename = $answerPrefix.$n;
  260   }
  261   $self->{ans_name} = $ename;
  262   $self->{ans_rows} = $rows;
  263   $self->{ans_cols} = $cols;
  264   my @array = ();
  265   foreach my $i (0..$rows-1) {
  266     my @row = ();
  267     foreach my $j (0..$cols-1) {
  268       if ($i == 0 && $j == 0) {
  269   if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
  270           else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
  271       } else {
  272   push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
  273       }
  274     }
  275     push(@array,[@row]);
  276   }
  277   $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
  278 }
  279 
  280 sub ANS_NAME {
  281   my ($name,$i,$j) = @_;
  282   $name.'_'.$i.'_'.$j;
  283 }
  284 
  285 
  286 #
  287 #  Lay out an arbitrary matrix
  288 #
  289 sub format_matrix {
  290   my $self = shift;
  291   my $displayMode = $self->getPG('$displayMode');
  292   return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX');
  293   return $self->format_matrix_HTML(@_);
  294 }
  295 
  296 sub format_matrix_tex {
  297   my $self = shift; my $array = shift;
  298   my %options = (open=>'.',close=>'.',sep=>'',@_);
  299   $self->{format_options} = [%options] unless $self->{format_options};
  300   my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
  301   my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
  302   my $tex = "";
  303   $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
  304   $tex .= '\(\left'.$open;
  305   $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
  306   $tex .= '\begin{array}{'.('c'x$cols).'}';
  307   foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"}
  308   $tex .= '\end{array}\right'.$close.'\)';
  309   return $tex;
  310 }
  311 
  312 sub format_matrix_HTML {
  313   my $self = shift; my $array = shift;
  314   my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
  315   $self->{format_options} = [%options] unless $self->{format_options};
  316   my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
  317   my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
  318   my $HTML = "";
  319   if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'}
  320        else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'}
  321   foreach my $i (0..$rows-1) {
  322     $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i;
  323     $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,@{$array->[$i]}).'</TD></TR>'."\n";
  324   }
  325   $open = $self->format_delimiter($open,$rows,$options{tth_delims});
  326   $close = $self->format_delimiter($close,$rows,$options{tth_delims});
  327   if ($open ne '' || $close ne '') {
  328     $HTML = '<TR ALIGN="MIDDLE">'
  329           . '<TD>'.$open.'</TD>'
  330           . '<TD WIDTH="2"></TD>'
  331           . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'
  332           .   $HTML
  333           . '</TABLE></TD>'
  334           . '<TD WIDTH="4"></TD>'
  335           . '<TD>'.$close.'</TD>'
  336           . '</TR>'."\n";
  337   }
  338   return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"'
  339           . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">'
  340           . $HTML
  341           . '</TABLE>';
  342 }
  343 
  344 sub VERBATIM {
  345   my $string = shift;
  346   my $displayMode = Value->getPG('$displayMode');
  347   $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
  348   return $string;
  349 }
  350 
  351 #
  352 #  Create a tall delimiter to match the line height
  353 #
  354 sub format_delimiter {
  355   my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
  356   return '' if $delim eq '' || $delim eq '.';
  357   my $displayMode = $self->getPG('$displayMode');
  358   return $self->format_delimiter_tth($delim,$rows,$tth)
  359     if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
  360   my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
  361   $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
  362   $delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
  363   return '\(\left'.$delim.$rule.'\right.\)';
  364 }
  365 
  366 #
  367 #  Data for tth delimiters [top,mid,bot,rep]
  368 #
  369 my %tth_delim = (
  370   '[' => ['&#xF8EE;','','&#xF8F0;','&#xF8EF;'],
  371   ']' => ['&#xF8F9;','','&#xF8FB;','&#xF8FA;'],
  372   '(' => ['&#xF8EB;','','&#xF8ED;','&#xF8EC;'],
  373   ')' => ['&#xF8F6;','','&#xF8F8;','&#xF8F7;'],
  374   '{' => ['&#xF8F1;','&#xF8F2;','&#xF8F3;','&#xF8F4;'],
  375   '}' => ['&#xF8FC;','&#xF8FD;','&#xF8FE;','&#xF8F4;'],
  376   '|' => ['|','','|','|'],
  377   '<' => ['&lt;'],
  378   '>' => ['&gt;'],
  379   '\lgroup' => ['&#xF8F1;','','&#xF8F3;','&#xF8F4;'],
  380   '\rgroup' => ['&#xF8FC;','','&#xF8FE;','&#xF8F4;'],
  381 );
  382 
  383 #
  384 #  Make delimiters as stacks of characters
  385 #
  386 sub format_delimiter_tth {
  387   my $self = shift;
  388   my $delim = shift; my $rows = shift; my $tth = shift;
  389   return '' if $delim eq '' || !defined($tth_delim{$delim});
  390   my $c = $delim; $delim = $tth_delim{$delim};
  391   $c = $delim->[0] if scalar(@{$delim}) == 1;
  392   my $size = ($tth? "": "font-size:175%; ");
  393   return '<SPAN STYLE="'.$size.'margin:0px 2px">'.$c.'</SPAN>'
  394     if $rows == 1 || scalar(@{$delim}) == 1;
  395   my $HTML = "";
  396   if ($delim->[1] eq '') {
  397     $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
  398   } else {
  399     $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1),
  400             $delim->[1],($delim->[3])x($rows-1),
  401             $delim->[2]);
  402   }
  403   return '<DIV STYLE="line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>';
  404 }
  405 
  406 
  407 #
  408 #  Look up the values of the answer array entries, and check them
  409 #  for syntax and other errors.  Build the student answer
  410 #  based on these, and keep track of error messages.
  411 #
  412 
  413 my @ans_defaults = (showCoodinateHints => 0, checker => sub {0});
  414 
  415 sub ans_collect {
  416   my $self = shift; my $ans = shift;
  417   my $inputs = $self->getPG('$inputs_ref');
  418   my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
  419   my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
  420   my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
  421   if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
  422   $data = [$data] unless ref($data->[0]) eq 'ARRAY';
  423   foreach my $i (0..$rows-1) {
  424     my @row = ();
  425     foreach my $j (0..$cols-1) {
  426       if ($i || $j) {
  427   my $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
  428   my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
  429   $OK &= entryCheck($result,$blank);
  430   push(@row,$result->{student_formula});
  431   entryMessage($result->{ans_message},$errors,$i,$j,$rows);
  432       } else {
  433   $ans->{student_formula} = $ans->{student_value} = undef unless $ans->{student_ans} =~ m/\S/;
  434   $OK &= entryCheck($ans,$blank);
  435   push(@row,$ans->{student_formula});
  436   entryMessage($ans->{ans_message},$errors,$i,$j,$rows);
  437       }
  438     }
  439     push(@array,[@row]);
  440   }
  441   $ans->{student_formula} = [@array];
  442   $ans->{ans_message} = $ans->{error_message} = join("<BR>",@{$errors});
  443   return $OK && scalar(@{$errors}) == 0;
  444 }
  445 
  446 sub entryMessage {
  447   my $message = shift; return unless $message;
  448   my ($errors,$i,$j,$rows) = @_; $i++; $j++;
  449   if ($rows == 1) {$message = "Coordinate $j: $message"}
  450     else {$message = "Entry ($i,$j): $message"}
  451   push(@{$errors},$message);
  452 }
  453 
  454 sub entryCheck {
  455   my $ans = shift; my $blank = shift;
  456   return 1 if defined($ans->{student_value});
  457   if (!defined($ans->{student_formula})) {
  458     $ans->{student_formula} = $ans->{student_ans};
  459     $ans->{student_formula} = $blank unless $ans->{student_formula};
  460   }
  461   return 0
  462 }
  463 
  464 
  465 #
  466 #  Get and Set values in context
  467 #
  468 sub contextSet {
  469   my $context = shift; my %set = (@_);
  470   my $flags = $context->{flags}; my $get = {};
  471   foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}}
  472   return $get;
  473 }
  474 
  475 #
  476 #  Quote HTML characters
  477 #
  478 sub protectHTML {
  479     my $string = shift;
  480     return $string if eval ('$main::displayMode') eq 'TeX';
  481     $string =~ s/&/\&amp;/g;
  482     $string =~ s/</\&lt;/g;
  483     $string =~ s/>/\&gt;/g;
  484     $string;
  485 }
  486 
  487 #
  488 #  names for numbers
  489 #
  490 sub NameForNumber {
  491   my $self = shift; my $n = shift;
  492   my $name =  ('zeroth','first','second','third','fourth','fifth',
  493                'sixth','seventh','eighth','ninth','tenth')[$n];
  494   $name = "$n-th" if ($n > 10);
  495   return $name;
  496 }
  497 
  498 #
  499 #  Get a value from the safe compartment
  500 #
  501 sub getPG {
  502   my $self = shift;
  503 #  (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
  504   eval ('package main; '.shift);  # faster
  505 }
  506 
  507 #############################################################
  508 #############################################################
  509 
  510 package Value::Real;
  511 
  512 sub cmp_defaults {(
  513   shift->SUPER::cmp_defaults(@_),
  514   ignoreInfinity => 1,
  515 )}
  516 
  517 sub typeMatch {
  518   my $self = shift; my $other = shift; my $ans = shift;
  519   return 1 unless ref($other);
  520   return 0 if Value::isFormula($other);
  521   return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
  522   $self->type eq $other->type;
  523 }
  524 
  525 #############################################################
  526 
  527 package Value::Infinity;
  528 
  529 sub cmp_class {'a Number'};
  530 
  531 sub typeMatch {
  532   my $self = shift; my $other = shift; my $ans = shift;
  533   return 1 unless ref($other);
  534   return 0 if Value::isFormula($other);
  535   return 1 if $other->type eq 'Number';
  536   $self->type eq $other->type;
  537 }
  538 
  539 #############################################################
  540 
  541 package Value::String;
  542 
  543 sub cmp_defaults {(
  544   Value::Real->cmp_defaults(@_),
  545   typeMatch => 'Value::Real',
  546 )}
  547 
  548 sub cmp_class {
  549   my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
  550   return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
  551   return $typeMatch->cmp_class;
  552 };
  553 
  554 sub typeMatch {
  555   my $self = shift; my $other = shift; my $ans = shift;
  556   return 0 if ref($other) && Value::isFormula($other);
  557   my $typeMatch = $ans->{typeMatch};
  558   return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' ||
  559                  $self->type eq $other->type;
  560   return $typeMatch->typeMatch($other,$ans);
  561 }
  562 
  563 #############################################################
  564 
  565 package Value::Point;
  566 
  567 sub cmp_defaults {(
  568   shift->SUPER::cmp_defaults(@_),
  569   showDimensionHints => 1,
  570   showCoordinateHints => 1,
  571 )}
  572 
  573 sub typeMatch {
  574   my $self = shift; my $other = shift; my $ans = shift;
  575   return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
  576 }
  577 
  578 #
  579 #  Check for dimension mismatch and incorrect coordinates
  580 #
  581 sub cmp_postprocess {
  582   my $self = shift; my $ans = shift;
  583   return unless $ans->{score} == 0 && !$ans->{isPreview};
  584   my $student = $ans->{student_value};
  585   return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  586   if ($ans->{showDimensionHints} && $self->length != $student->length) {
  587     $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
  588   }
  589   if ($ans->{showCoordinateHints}) {
  590     my @errors;
  591     foreach my $i (1..$self->length) {
  592       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  593   if ($self->{data}[$i-1] != $student->{data}[$i-1]);
  594     }
  595     $self->cmp_Error($ans,@errors); return;
  596   }
  597 }
  598 
  599 sub correct_ans {
  600   my $self = shift;
  601   return $self->SUPER::correct_ans unless $self->{ans_name};
  602   Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
  603 }
  604 
  605 sub ANS_MATRIX {
  606   my $self = shift;
  607   my $extend = shift; my $name = shift;
  608   my $size = shift || 5;
  609   my $def = ($self->{context} || $$Value::context)->lists->get('Point');
  610   my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
  611   $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
  612 }
  613 
  614 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
  615 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
  616 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
  617 
  618 #############################################################
  619 
  620 package Value::Vector;
  621 
  622 sub cmp_defaults {(
  623   shift->SUPER::cmp_defaults(@_),
  624   showDimensionHints => 1,
  625   showCoordinateHints => 1,
  626   promotePoints => 0,
  627   parallel => 0,
  628   sameDirection => 0,
  629 )}
  630 
  631 sub typeMatch {
  632   my $self = shift; my $other = shift; my $ans = shift;
  633   return 0 unless ref($other) && $other->class ne 'Formula';
  634   return $other->type eq 'Vector' ||
  635      ($ans->{promotePoints} && $other->type eq 'Point');
  636 }
  637 
  638 #
  639 #  check for dimension mismatch
  640 #        for parallel vectors, and
  641 #        for incorrect coordinates
  642 #
  643 sub cmp_postprocess {
  644   my $self = shift; my $ans = shift;
  645   return unless $ans->{score} == 0;
  646   my $student = $ans->{student_value};
  647   return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  648   if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
  649       $self->length != $student->length) {
  650     $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
  651   }
  652   if ($ans->{parallel} &&
  653       $self->isParallel($student,$ans->{sameDirection})) {
  654     $ans->score(1); return;
  655   }
  656   if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) {
  657     my @errors;
  658     foreach my $i (1..$self->length) {
  659       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  660   if ($self->{data}[$i-1] != $student->{data}[$i-1]);
  661     }
  662     $self->cmp_Error($ans,@errors); return;
  663   }
  664 }
  665 
  666 sub correct_ans {
  667   my $self = shift;
  668   return $self->SUPER::correct_ans unless $self->{ans_name};
  669   return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
  670     unless $self->{ColumnVector};
  671   my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
  672   return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
  673 }
  674 
  675 sub ANS_MATRIX {
  676   my $self = shift;
  677   my $extend = shift; my $name = shift;
  678   my $size = shift || 5; my ($def,$open,$close);
  679   $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
  680   $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
  681   return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
  682     if ($self->{ColumnVector});
  683   $def = ($self->{context} || $$Value::context)->lists->get('Vector');
  684   $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
  685   $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
  686 }
  687 
  688 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
  689 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
  690 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
  691 
  692 
  693 #############################################################
  694 
  695 package Value::Matrix;
  696 
  697 sub cmp_defaults {(
  698   shift->SUPER::cmp_defaults(@_),
  699   showDimensionHints => 1,
  700   showEqualErrors => 0,
  701 )}
  702 
  703 sub typeMatch {
  704   my $self = shift; my $other = shift; my $ans = shift;
  705   return 0 unless ref($other) && $other->class ne 'Formula';
  706   return $other->type eq 'Matrix' ||
  707     ($other->type =~ m/^(Point|list)$/ &&
  708      $other->{open}.$other->{close} eq $self->{open}.$self->{close});
  709 }
  710 
  711 sub cmp_postprocess {
  712   my $self = shift; my $ans = shift;
  713   return unless $ans->{score} == 0 &&
  714     !$ans->{isPreview} && $ans->{showDimensionHints};
  715   my $student = $ans->{student_value};
  716   return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  717   my @d1 = $self->dimensions; my @d2 = $student->dimensions;
  718   if (scalar(@d1) != scalar(@d2)) {
  719     $self->cmp_Error($ans,"Matrix dimension is not correct");
  720     return;
  721   } else {
  722     foreach my $i (0..scalar(@d1)-1) {
  723       if ($d1[$i] != $d2[$i]) {
  724   $self->cmp_Error($ans,"Matrix dimension is not correct");
  725   return;
  726       }
  727     }
  728   }
  729 }
  730 
  731 sub correct_ans {
  732   my $self = shift;
  733   return $self->SUPER::correct_ans unless $self->{ans_name};
  734   my @array = $self->value; @array = ([@array]) if $self->isRow;
  735   Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
  736 }
  737 
  738 sub ANS_MATRIX {
  739   my $self = shift;
  740   my $extend = shift; my $name = shift;
  741   my $size = shift || 5;
  742   my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
  743   my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
  744   my @d = $self->dimensions;
  745   Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
  746     if (scalar(@d) > 2);
  747   @d = (1,@d) if (scalar(@d) == 1);
  748   $self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
  749 }
  750 
  751 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
  752 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
  753 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
  754 
  755 #############################################################
  756 
  757 package Value::Interval;
  758 
  759 sub cmp_defaults {(
  760   shift->SUPER::cmp_defaults(@_),
  761   showEndpointHints => 1,
  762   showEndTypeHints => 1,
  763   requireParenMatch => 1,
  764 )}
  765 
  766 sub typeMatch {
  767   my $self = shift; my $other = shift;
  768   return 0 unless ref($other) && $other->class ne 'Formula';
  769   return $other->length == 2 &&
  770          ($other->{open} eq '(' || $other->{open} eq '[') &&
  771          ($other->{close} eq ')' || $other->{close} eq ']')
  772      if $other->type =~ m/^(Point|List)$/;
  773   $other->type =~ m/^(Interval|Union|Set)$/;
  774 }
  775 
  776 sub cmp_compare {
  777   my $self = shift; my $other = shift; my $ans = shift;
  778   my $oldignore = $self->{requireParenMatch};
  779   $self->{ignoreEndpointTypes} = !$ans->{requireParenMatch};
  780   my $equal = $self->SUPER::cmp_compare($other,$ans);
  781   $self->{ignoreEndpointTypes} = $oldignore;
  782   return $equal;
  783 }
  784 
  785 #
  786 #  Check for wrong enpoints and wrong type of endpoints
  787 #
  788 sub cmp_postprocess {
  789   my $self = shift; my $ans = shift;
  790   return unless $ans->{score} == 0 && !$ans->{isPreview};
  791   my $other = $ans->{student_value};
  792   return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
  793   return unless $other->class eq 'Interval';
  794   my @errors;
  795   if ($ans->{showEndpointHints}) {
  796     push(@errors,"Your left endpoint is incorrect")
  797       if ($self->{data}[0] != $other->{data}[0]);
  798     push(@errors,"Your right endpoint is incorrect")
  799       if ($self->{data}[1] != $other->{data}[1]);
  800   }
  801   if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) {
  802     push(@errors,"The type of interval is incorrect")
  803       if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
  804   }
  805   $self->cmp_Error($ans,@errors);
  806 }
  807 
  808 #############################################################
  809 
  810 package Value::Set;
  811 
  812 sub typeMatch {
  813   my $self = shift; my $other = shift;
  814   return 0 unless ref($other) && $other->class ne 'Formula';
  815   return $other->length == 2 &&
  816          ($other->{open} eq '(' || $other->{open} eq '[') &&
  817          ($other->{close} eq ')' || $other->{close} eq ']')
  818      if $other->type =~ m/^(Point|List)$/;
  819   $other->type =~ m/^(Interval|Union|Set)/;
  820 }
  821 
  822 #
  823 #  Use the List checker for sets, in order to get
  824 #  partial credit.  Set the various types for error
  825 #  messages.
  826 #
  827 sub cmp_defaults {(
  828   Value::List::cmp_defaults(@_),
  829   typeMatch => 'Value::Real',
  830   list_type => 'a set',
  831   entry_type => 'a number',
  832   removeParens => 0,
  833   showParenHints => 1,
  834 )}
  835 
  836 #
  837 #  Use the list checker if the student answer is a set
  838 #    otherwise use the standard compare (to get better
  839 #    error messages
  840 #
  841 sub cmp_equal {
  842   my ($self,$ans) = @_;
  843   Value::List::cmp_equal(@_)
  844     if $ans->{student_value}->type eq 'Set';
  845   Value::cmp_equal(@_);
  846 }
  847 
  848 #############################################################
  849 
  850 package Value::Union;
  851 
  852 sub typeMatch {
  853   my $self = shift; my $other = shift;
  854   return 0 unless ref($other) && $other->class ne 'Formula';
  855   return $other->length == 2 &&
  856          ($other->{open} eq '(' || $other->{open} eq '[') &&
  857          ($other->{close} eq ')' || $other->{close} eq ']')
  858      if $other->type =~ m/^(Point|List)$/;
  859   $other->type =~ m/^(Interval|Union|Set)/;
  860 }
  861 
  862 #
  863 #  Use the List checker for unions, in order to get
  864 #  partial credit.  Set the various types for error
  865 #  messages.
  866 #
  867 sub cmp_defaults {(
  868   Value::List::cmp_defaults(@_),
  869   typeMatch => 'Value::Interval',
  870   list_type => 'an interval, set or union',
  871   short_type => 'a union',
  872   entry_type => 'an interval or set',
  873 )}
  874 
  875 sub cmp_equal {Value::List::cmp_equal(@_)}
  876 
  877 #############################################################
  878 
  879 package Value::List;
  880 
  881 sub cmp_defaults {
  882   my $self = shift;
  883   my %options = (@_);
  884   my $element = Value::makeValue($self->{data}[0]);
  885   $element = Value::Formula->new($element) unless Value::isValue($element);
  886   return (
  887     Value::Real->cmp_defaults(@_),
  888     showHints => undef,
  889     showLengthHints => undef,
  890     showParenHints => undef,
  891     partialCredit => undef,
  892     ordered => 0,
  893     showEqualErrors => $options{ordered},
  894     entry_type => undef,
  895     list_type => undef,
  896     typeMatch => $element,
  897     extra => $element,
  898     requireParenMatch => 1,
  899     removeParens => 1,
  900    );
  901 }
  902 
  903 #
  904 #  Match anything but formulas
  905 #
  906 sub typeMatch {return !ref($other) || $other->class ne 'Formula'}
  907 
  908 #
  909 #  Handle removal of outermost parens in correct answer.
  910 #
  911 sub cmp {
  912   my $self = shift;
  913   my $cmp = $self->SUPER::cmp(@_);
  914   if ($cmp->{rh_ans}{removeParens}) {
  915     $self->{open} = $self->{close} = '';
  916     $cmp->ans_hash(correct_ans => $self->stringify)
  917       unless defined($self->{correct_ans});
  918   }
  919   return $cmp;
  920 }
  921 
  922 sub cmp_equal {
  923   my $self = shift; my $ans = shift;
  924   $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
  925 
  926   #
  927   #  get the paramaters
  928   #
  929   my $showHints         = getOption($ans,'showHints');
  930   my $showLengthHints   = getOption($ans,'showLengthHints');
  931   my $showParenHints    = getOption($ans,'showParenHints');
  932   my $partialCredit     = getOption($ans,'partialCredit');
  933   my $requireParenMatch = $ans->{requireParenMatch};
  934   my $typeMatch         = $ans->{typeMatch};
  935   my $value             = $ans->{entry_type};
  936   my $ltype             = $ans->{list_type} || lc($self->type);
  937   my $stype             = $ans->{short_type} || $ltype;
  938 
  939   $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value')
  940     unless defined($value);
  941   $value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
  942   $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
  943   $ltype =~ s/^an? //; $stype =~ s/^an? //;
  944   $showHints = $showLengthHints = 0 if $ans->{isPreview};
  945 
  946   #
  947   #  Get the lists of correct and student answers
  948   #   (split formulas that return lists or unions)
  949   #
  950   my @correct = (); my ($cOpen,$cClose);
  951   if ($self->class ne 'Formula') {
  952     @correct = $self->value;
  953     $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
  954   } else {
  955     @correct = Value::List->splitFormula($self,$ans);
  956     $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
  957   }
  958   my $student = $ans->{student_value}; my @student = ($student);
  959   my ($sOpen,$sClose) = ('','');
  960   if (Value::isFormula($student) && $student->type eq $self->type) {
  961     @student = Value::List->splitFormula($student,$ans);
  962     $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
  963   } elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
  964     @student = @{$student->{data}};
  965     $sOpen = $student->{open}; $sClose = $student->{close};
  966   }
  967   return if $ans->{split_error};
  968   #
  969   #  Check for parenthesis match
  970   #
  971   if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
  972     if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
  973       my $message = "The parentheses for your $ltype ";
  974       if (($cOpen || $cClose) && ($sOpen || $sClose))
  975                                 {$message .= "are of the wrong type"}
  976       elsif ($sOpen || $sClose) {$message .= "should be removed"}
  977       else                      {$message .= "seem to be missing"}
  978       $self->cmp_Error($ans,$message) unless $ans->{isPreview};
  979     }
  980     return;
  981   }
  982 
  983   #
  984   #  Determine the maximum score
  985   #
  986   my $M = scalar(@correct);
  987   my $m = scalar(@student);
  988   my $maxscore = ($m > $M)? $m : $M;
  989 
  990   #
  991   #  Compare the two lists
  992   #  (Handle errors in user-supplied functions)
  993   #
  994   my ($score,@errors);
  995   if (ref($ans->{list_checker}) eq 'CODE') {
  996     eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)};
  997     if (!defined($score)) {
  998       die $@ if $@ ne '' && $self->{context}{error}{flag} == 0;
  999       $self->cmp_error($ans) if $self->{context}{error}{flag};
 1000     }
 1001   } else {
 1002     ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value);
 1003   }
 1004   return unless defined($score);
 1005 
 1006   #
 1007   #  Give hints about extra or missing answers
 1008   #
 1009   if ($showLengthHints) {
 1010     $value =~ s/ or /s or /; # fix "interval or union"
 1011     push(@errors,"There should be more ${value}s in your $stype")
 1012       if ($score < $maxscore && $score == $m);
 1013     push(@errors,"There should be fewer ${value}s in your $stype")
 1014       if ($score < $maxscore && $score == $M && !$showHints);
 1015   }
 1016 
 1017   #
 1018   #  Finalize the score
 1019   #
 1020   $score = 0 if ($score != $maxscore && !$partialCredit);
 1021   $ans->score($score/$maxscore);
 1022   push(@errors,"Score = $ans->{score}") if $ans->{debug};
 1023   my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g;
 1024   $ans->{error_message} = $ans->{ans_message} = $error;
 1025 }
 1026 
 1027 #
 1028 #  Compare the contents of the list to see of they are equal
 1029 #
 1030 sub cmp_list_compare {
 1031   my $self = shift;
 1032   my $correct = shift; my $student = shift; my $ans = shift; my $value = shift;
 1033   my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student);
 1034   my $ordered = $ans->{ordered};
 1035   my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview};
 1036   my $typeMatch = $ans->{typeMatch};
 1037   my $extra = $ans->{extra};
 1038   my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
 1039   my $error = $$Value::context->{error};
 1040   my $score = 0; my @errors; my $i = 0;
 1041 
 1042   #
 1043   #  Check for empty lists
 1044   #
 1045   if (scalar(@correct) == 0) {$ans->score($m == 0); return}
 1046 
 1047   #
 1048   #  Loop through student answers looking for correct ones
 1049   #
 1050   ENTRY: foreach my $entry (@student) {
 1051     $i++; $$Value::context->clearError;
 1052     $entry = Value::makeValue($entry);
 1053     $entry = Value::Formula->new($entry) if !Value::isValue($entry);
 1054     if ($ordered) {
 1055       if (scalar(@correct)) {
 1056   if (shift(@correct)->cmp_compare($entry,$ans)) {$score++; next ENTRY}
 1057       } else {
 1058   $extra->cmp_compare($entry,$ans); # do syntax check
 1059       }
 1060       if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
 1061     } else {
 1062       foreach my $k (0..$#correct) {
 1063   if ($correct[$k]->cmp_compare($entry,$ans)) {
 1064     splice(@correct,$k,1);
 1065     $score++; next ENTRY;
 1066   }
 1067   if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
 1068       }
 1069     }
 1070     #
 1071     #  Give messages about incorrect answers
 1072     #
 1073     my $nth = ''; my $answer = 'answer';
 1074     my $class = $ans->{list_type} || $self->cmp_class;
 1075     if ($m > 1) {
 1076       $nth = ' '.$self->NameForNumber($i);
 1077       $class = $ans->{cmp_class};
 1078       $answer = 'value';
 1079     }
 1080     if ($error->{flag} && $ans->{showEqualErrors}) {
 1081       my $message = $error->{message}; $message =~ s/\s+$//;
 1082       push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
 1083              '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
 1084     } elsif ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
 1085        !($ans->{ignoreStrings} && $entry->class eq 'String')) {
 1086       push(@errors,"Your$nth $answer isn't ".lc($class).
 1087      " (it looks like ".lc($entry->showClass).")");
 1088     } elsif ($showHints && $m > 1) {
 1089       push(@errors,"Your$nth $value is incorrect");
 1090     }
 1091   }
 1092 
 1093   #
 1094   #  Return the score and errors
 1095   #
 1096   return ($score,@errors);
 1097 }
 1098 
 1099 #
 1100 #  Split a formula that is a list or union into a
 1101 #    list of formulas (or Value objects).
 1102 #
 1103 sub splitFormula {
 1104   my $self = shift; my $formula = shift; my $ans = shift;
 1105   my @formula; my @entries;
 1106   if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion}
 1107     else {@entries = @{$formula->{tree}{coords}}}
 1108   foreach my $entry (@entries) {
 1109     my $v = Parser::Formula($entry);
 1110        $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
 1111     push(@formula,$v);
 1112     #
 1113     #  There shouldn't be an error evaluating the formula,
 1114     #    but you never know...
 1115     #
 1116     if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
 1117   }
 1118   return @formula;
 1119 }
 1120 
 1121 #
 1122 #  Return the value if it is defined, otherwise use a default
 1123 #
 1124 sub getOption {
 1125   my $ans = shift; my $name = shift;
 1126   my $value = $ans->{$name};
 1127   return $value if defined($value);
 1128   return $ans->{showPartialCorrectAnswers};
 1129 }
 1130 
 1131 #############################################################
 1132 
 1133 package Value::Formula;
 1134 
 1135 sub cmp_defaults {
 1136   my $self = shift;
 1137 
 1138   return (
 1139     Value::Union::cmp_defaults($self,@_),
 1140     typeMatch => Value::Formula->new("(1,2]"),
 1141     showDomainErrors => 1,
 1142   ) if $self->type eq 'Union';
 1143 
 1144   my $type = $self->type;
 1145   $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
 1146   $type = 'Value::'.$type.'::';
 1147 
 1148   return (
 1149     &{$type.'cmp_defaults'}($self,@_),
 1150     upToConstant => 0,
 1151     showDomainErrors => 1,
 1152   ) if defined(%$type) && $self->type ne 'List';
 1153 
 1154   return (
 1155     Value::List::cmp_defaults($self,@_),
 1156     removeParens => $self->{autoFormula},
 1157     typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]),
 1158     showDomainErrors => 1,
 1159   );
 1160 }
 1161 
 1162 #
 1163 #  Get the types from the values of the formulas
 1164 #     and compare those.
 1165 #
 1166 sub typeMatch {
 1167   my $self = shift; my $other = shift; my $ans = shift;
 1168   return 1 if $self->type eq $other->type;
 1169   my $typeMatch = ($self->createRandomPoints(1))[1]->[0];
 1170   $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
 1171   return 1 unless defined($other); # can't really tell, so don't report type mismatch
 1172   $typeMatch->typeMatch($other,$ans);
 1173 }
 1174 
 1175 #
 1176 #  Handle removal of outermost parens in a list.
 1177 #
 1178 sub cmp {
 1179   my $self = shift;
 1180   my $cmp = $self->SUPER::cmp(@_);
 1181   if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
 1182     $self->{tree}{open} = $self->{tree}{close} = '';
 1183     $cmp->ans_hash(correct_ans => $self->stringify)
 1184       unless defined($self->{correct_ans});
 1185   }
 1186   if ($cmp->{rh_ans}{eval} && $self->isConstant) {
 1187     $cmp->ans_hash(correct_value => $self->eval);
 1188     return $cmp;
 1189   }
 1190   if ($cmp->{rh_ans}{upToConstant}) {
 1191     my $current = Parser::Context->current();
 1192     my $context = $self->{context} = $self->{context}->copy;
 1193     Parser::Context->current(undef,$context);
 1194     $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
 1195       'C0|' . $context->{_variables}->{pattern};
 1196     $context->update; $context->variables->add('C0' => 'Parameter');
 1197     my $f = Value::Formula->new('C0')+$self;
 1198     for ('limits','test_points','test_values','num_points','granularity','resolution',
 1199    'checkUndefinedPoints','max_undefined')
 1200       {$f->{$_} = $self->{$_} if defined($self->{$_})}
 1201     $cmp->ans_hash(correct_value => $f);
 1202     Parser::Context->current(undef,$current);
 1203   }
 1204   return $cmp;
 1205 }
 1206 
 1207 sub cmp_equal {
 1208   my $self = shift; my $ans = shift;
 1209   #
 1210   #  Get the problem's seed
 1211   #
 1212   $self->{context}->flags->set(
 1213     random_seed => $self->getPG('$PG_original_problemSeed')
 1214   );
 1215 
 1216   #
 1217   #  Use the list checker if the formula is a list or union
 1218   #    Otherwise use the normal checker
 1219   #
 1220   if ($self->type =~ m/^(List|Union)$/) {
 1221     Value::List::cmp_equal($self,$ans);
 1222   } else {
 1223     $self->SUPER::cmp_equal($ans);
 1224   }
 1225 }
 1226 
 1227 sub cmp_postprocess {
 1228   my $self = shift; my $ans = shift;
 1229   return unless $ans->{score} == 0 && !$ans->{isPreview};
 1230   return if $ans->{ans_message};
 1231   if ($self->{domainMismatch} && $ans->{showDomainErrors}) {
 1232     $self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer");
 1233     return;
 1234   }
 1235   return if !$ans->{showDimensionHints};
 1236   my $other = $ans->{student_value};
 1237   return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
 1238   return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
 1239   return unless $self->type  =~ m/^(Point|Vector|Matrix)$/;
 1240   return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
 1241   $self->cmp_Error($ans,"The dimension of your result is incorrect");
 1242 }
 1243 
 1244 #
 1245 #  If an answer array was used, get the data from the
 1246 #  Matrix, Vector or Point, and format the array of
 1247 #  data using the original parameter
 1248 #
 1249 sub correct_ans {
 1250   my $self = shift;
 1251   return $self->SUPER::correct_ans unless $self->{ans_name};
 1252   my @array = ();
 1253   if ($self->{tree}->type eq 'Matrix') {
 1254     foreach my $row (@{$self->{tree}{coords}}) {
 1255       my @row = ();
 1256       foreach my $x (@{$row->coords}) {push(@row,$x->string)}
 1257       push(@array,[@row]);
 1258     }
 1259   } else {
 1260     foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
 1261     if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
 1262       else {@array = [@array]}
 1263   }
 1264   Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
 1265 }
 1266 
 1267 #
 1268 #  Get the size of the array and create the appropriate answer array
 1269 #
 1270 sub ANS_MATRIX {
 1271   my $self = shift;
 1272   my $extend = shift; my $name = shift;
 1273   my $size = shift || 5; my $type = $self->type;
 1274   my $cols = $self->length; my $rows = 1; my $sep = ',';
 1275   if ($type eq 'Matrix') {
 1276     $sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
 1277   }
 1278   if ($self->{tree}{ColumnVector}) {
 1279     $sep = ""; $type = "Matrix";
 1280     my $tmp = $rows; $rows = $cols; $cols = $tmp;
 1281     $self->{ColumnVector} = 1;
 1282   }
 1283   my $def = ($self->{context} || $$Value::context)->lists->get($type);
 1284   my $open = $self->{open} || $self->{tree}{open} || $def->{open};
 1285   my $close = $self->{close} || $self->{tree}{close} || $def->{close};
 1286   $self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
 1287 }
 1288 
 1289 sub ans_array {
 1290   my $self = shift;
 1291   return $self->SUPER::ans_array(@_) unless $self->array_OK;
 1292   $self->ANS_MATRIX(0,'',@_);
 1293 }
 1294 sub named_ans_array {
 1295   my $self = shift;
 1296   return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
 1297   $self->ANS_MATRIX(0,@_);
 1298 }
 1299 sub named_ans_array_extension {
 1300   my $self = shift;
 1301   return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
 1302   $self->ANS_MATRIX(1,@_);
 1303 }
 1304 
 1305 sub array_OK {
 1306   my $self = shift; my $tree = $self->{tree};
 1307   return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List';
 1308 }
 1309 
 1310 #
 1311 #  Get an array of values from a Matrix, Vector or Point
 1312 #
 1313 sub value {
 1314   my $self = shift;
 1315   my @array = ();
 1316   if ($self->{tree}->type eq 'Matrix') {
 1317     foreach my $row (@{$self->{tree}->coords}) {
 1318       my @row = ();
 1319       foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))}
 1320       push(@array,[@row]);
 1321     }
 1322   } else {
 1323     foreach my $x (@{$self->{tree}->coords}) {
 1324       push(@array,Value::Formula->new($x));
 1325     }
 1326   }
 1327   return @array;
 1328 }
 1329 
 1330 #############################################################
 1331 
 1332 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9