[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 3652 - (download) (as text) (annotate)
Sat Sep 24 00:47:30 2005 UTC (14 years, 5 months ago) by dpvc
File size: 47220 byte(s)
Added ability to have answers that are empty strings.  String("") now
will produce a valid string object regardless of the Context's defined
string values.  (You can prevent this using

       Context()->flags->set(allowEmptyStrings=>0);

if you wish).  String("")->cmp will produce an answer checker for an
empty string (it removes the blank checker that WW installs).

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9