[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 3172 - (download) (as text) (annotate)
Tue Feb 15 21:58:54 2005 UTC (15 years ago) by dpvc
File size: 22808 byte(s)
Updated the answer checkers so that you can more easily specify how
the correct answer shoudl be displayed.  In the past, you could use
something like Real(sqrt(2))->cmp(correct_ans=>"sqrt(2)") to do this,
but that is awkward.  Now the Compute() function (which parses and
then evaluates a string) sets things up so that the original string
will be what is used as the correct answer.  That means
Compute("sqrt(2)")->cmp will have the same result as the example
above.

You can also set the {correct_ans} properly of any Parser object to
have that value used as the correct answer.  For example

     $x = Real(sqrt(2));
     $x->{correct_ans} = "sqrt(2)";
     ANS($x->cmp)

would also produce the same answer checker as the two previous
examples.  All three methods should work.  Use the one that is most
convenient for you.

    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 = $self->{correct_ans};
   30   $correct = $self->string unless defined($correct);
   31   $ans->ans_hash(
   32     type => "Value (".$self->class.")",
   33     correct_ans => protectHTML($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   $self->{context} = $$Value::context unless defined($self->{context});
   40   return $ans;
   41 }
   42 
   43 #
   44 #  Parse the student answer and compute its value,
   45 #    produce the preview strings, and then compare the
   46 #    student and professor's answers for equality.
   47 #
   48 sub cmp_parse {
   49   my $self = shift; my $ans = shift;
   50   #
   51   #  Do some setup
   52   #
   53   my $current = $$Value::context; # save it for later
   54   my $context = $ans->{correct_value}{context} || $current;
   55   Parser::Context->current(undef,$context); # change to correct answser's context
   56   my $flags = contextSet($context, # save old context flags for the below
   57     StringifyAsTeX => 0,             # reset this, just in case.
   58     no_parameters => 1,              # don't let students enter parameters
   59     showExtraParens => 1,            # make student answer painfully unambiguous
   60     reduceConstants => 0,            # don't combine student constants
   61     reduceConstantFunctions => 0,    # don't reduce constant functions
   62   );
   63   $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
   64   $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
   65   $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
   66   $ans->{preview_latex_string} = $ans->{preview_text_string} = '';
   67 
   68   #
   69   #  Parse and evaluate the student answer
   70   #
   71   $ans->score(0);  # assume failure
   72   $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
   73   $ans->{student_value} = Parser::Evaluate($ans->{student_formula})
   74     if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
   75 
   76   #
   77   #  If it parsed OK, save the output forms and check if it is correct
   78   #   otherwise report an error
   79   #
   80   if (defined $ans->{student_value}) {
   81     $ans->{student_value} = Value::Formula->new($ans->{student_value})
   82        unless Value::isValue($ans->{student_value});
   83     $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
   84     $ans->{preview_text_string}  = protectHTML($ans->{student_formula}->string);
   85     $ans->{student_ans}          = $ans->{preview_text_string};
   86     $self->cmp_equal($ans);
   87     $self->cmp_postprocess($ans) if !$ans->{error_message};
   88   } else {
   89     $self->cmp_error($ans);
   90   }
   91   contextSet($context,%{$flags});            # restore context values
   92   Parser::Context->current(undef,$current);  # put back the old context
   93   return $ans;
   94 }
   95 
   96 #
   97 #  Check if the parsed student answer equals the professor's answer
   98 #
   99 sub cmp_equal {
  100   my $self = shift; my $ans = shift;
  101   my $correct = $ans->{correct_value};
  102   my $student = $ans->{student_value};
  103   if ($correct->typeMatch($student,$ans)) {
  104     my $equal = eval {$correct == $student};
  105     if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
  106     $self->cmp_error($ans);
  107   } else {
  108     return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
  109     $ans->{ans_message} = $ans->{error_message} =
  110       "Your answer isn't ".lc($ans->{cmp_class}).
  111         " (it looks like ".lc($student->showClass).")"
  112      if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
  113   }
  114 }
  115 
  116 #
  117 #  Check if types are compatible for equality check
  118 #
  119 sub typeMatch {
  120   my $self = shift;  my $other = shift;
  121   return 1 unless ref($other);
  122   $self->type eq $other->type && $other->class ne 'Formula';
  123 }
  124 
  125 #
  126 #  Class name for cmp error messages
  127 #
  128 sub cmp_class {
  129   my $self = shift; my $ans = shift;
  130   my $class = $self->showClass; $class =~ s/Real //;
  131   return $class if $class =~ m/Formula/;
  132   return "an Interval or Union" if $class =~ m/Interval/i;
  133   return $class;
  134 }
  135 
  136 #
  137 #  Student answer evaluation failed.
  138 #  Report the error, with formatting, if possible.
  139 #
  140 sub cmp_error {
  141   my $self = shift; my $ans = shift;
  142   my $context = $$Value::context;
  143   my $message = $context->{error}{message};
  144   if ($context->{error}{pos}) {
  145     my $string = $context->{error}{string};
  146     my ($s,$e) = @{$context->{error}{pos}};
  147     $message =~ s/; see.*//;  # remove the position from the message
  148     $ans->{student_ans} =
  149        protectHTML(substr($string,0,$s)) .
  150        '<SPAN CLASS="parsehilight">' .
  151          protectHTML(substr($string,$s,$e-$s)) .
  152        '</SPAN>' .
  153        protectHTML(substr($string,$e));
  154   }
  155   $self->cmp_Error($ans,$message);
  156 }
  157 
  158 #
  159 #  Set the error message
  160 #
  161 sub cmp_Error {
  162   my $self = shift; my $ans = shift;
  163   return unless scalar(@_) > 0;
  164   $ans->score(0);
  165   $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
  166 }
  167 
  168 #
  169 #  filled in by sub-classes
  170 #
  171 sub cmp_postprocess {}
  172 
  173 #
  174 #  Get and Set values in context
  175 #
  176 sub contextSet {
  177   my $context = shift; my %set = (@_);
  178   my $flags = $context->{flags}; my $get = {};
  179   foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}}
  180   return $get;
  181 }
  182 
  183 #
  184 #  Quote HTML characters
  185 #
  186 sub protectHTML {
  187     my $string = shift;
  188     return $string if eval ('$main::displayMode') eq 'TeX';
  189     $string =~ s/&/\&amp;/g;
  190     $string =~ s/</\&lt;/g;
  191     $string =~ s/>/\&gt;/g;
  192     $string;
  193 }
  194 
  195 #
  196 #  names for numbers
  197 #
  198 sub NameForNumber {
  199   my $self = shift; my $n = shift;
  200   my $name =  ('zeroth','first','second','third','fourth','fifth',
  201                'sixth','seventh','eighth','ninth','tenth')[$n];
  202   $name = "$n-th" if ($n > 10);
  203   return $name;
  204 }
  205 
  206 #
  207 #  Get a value from the safe compartment
  208 #
  209 sub getPG {
  210   my $self = shift;
  211 #  (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
  212   eval ('package main; '.shift);  # faster
  213 }
  214 
  215 #############################################################
  216 #############################################################
  217 
  218 package Value::Real;
  219 
  220 sub cmp_defaults {(
  221   shift->SUPER::cmp_defaults,
  222   ignoreInfinity => 1,
  223 )}
  224 
  225 sub typeMatch {
  226   my $self = shift; my $other = shift; my $ans = shift;
  227   return 1 unless ref($other);
  228   return 0 if Value::isFormula($other);
  229   return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
  230   $self->type eq $other->type;
  231 }
  232 
  233 #############################################################
  234 
  235 package Value::Infinity;
  236 
  237 sub cmp_class {'a Number'};
  238 
  239 sub typeMatch {
  240   my $self = shift; my $other = shift; my $ans = shift;
  241   return 1 unless ref($other);
  242   return 0 if Value::isFormula($other);
  243   return 1 if $other->type eq 'Number';
  244   $self->type eq $other->type;
  245 }
  246 
  247 #############################################################
  248 
  249 package Value::String;
  250 
  251 sub cmp_defaults {(
  252   Value::Real->cmp_defaults,
  253   typeMatch => 'Value::Real',
  254 )}
  255 
  256 sub cmp_class {
  257   my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
  258   return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
  259   return $typeMatch->cmp_class;
  260 };
  261 
  262 sub typeMatch {
  263   my $self = shift; my $other = shift; my $ans = shift;
  264   return 0 if ref($other) && Value::isFormula($other);
  265   my $typeMatch = $ans->{typeMatch};
  266   return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' ||
  267                  $self->type eq $other->type;
  268   return $typeMatch->typeMatch($other,$ans);
  269 }
  270 
  271 #############################################################
  272 
  273 package Value::Point;
  274 
  275 sub cmp_defaults {(
  276   shift->SUPER::cmp_defaults,
  277   showDimensionHints => 1,
  278   showCoordinateHints => 1,
  279 )}
  280 
  281 sub typeMatch {
  282   my $self = shift; my $other = shift; my $ans = shift;
  283   return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
  284 }
  285 
  286 #
  287 #  Check for dimension mismatch and incorrect coordinates
  288 #
  289 sub cmp_postprocess {
  290   my $self = shift; my $ans = shift;
  291   return unless $ans->{score} == 0 && !$ans->{isPreview};
  292   if ($ans->{showDimensionHints} &&
  293       $self->length != $ans->{student_value}->length) {
  294     $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
  295   }
  296   if ($ans->{showCoordinateHints}) {
  297     my @errors;
  298     foreach my $i (1..$self->length) {
  299       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  300   if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
  301     }
  302     $self->cmp_Error($ans,@errors); return;
  303   }
  304 }
  305 
  306 #############################################################
  307 
  308 package Value::Vector;
  309 
  310 sub cmp_defaults {(
  311   shift->SUPER::cmp_defaults,
  312   showDimensionHints => 1,
  313   showCoordinateHints => 1,
  314   promotePoints => 0,
  315   parallel => 0,
  316   sameDirection => 0,
  317 )}
  318 
  319 sub typeMatch {
  320   my $self = shift; my $other = shift; my $ans = shift;
  321   return 0 unless ref($other) && $other->class ne 'Formula';
  322   return $other->type eq 'Vector' ||
  323      ($ans->{promotePoints} && $other->type eq 'Point');
  324 }
  325 
  326 #
  327 #  check for dimension mismatch
  328 #        for parallel vectors, and
  329 #        for incorrect coordinates
  330 #
  331 sub cmp_postprocess {
  332   my $self = shift; my $ans = shift;
  333   return unless $ans->{score} == 0;
  334   if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
  335       $self->length != $ans->{student_value}->length) {
  336     $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
  337   }
  338   if ($ans->{parallel} &&
  339       $self->isParallel($ans->{student_value},$ans->{sameDirection})) {
  340     $ans->score(1); return;
  341   }
  342   if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) {
  343     my @errors;
  344     foreach my $i (1..$self->length) {
  345       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  346   if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
  347     }
  348     $self->cmp_Error($ans,@errors); return;
  349   }
  350 }
  351 
  352 
  353 
  354 #############################################################
  355 
  356 package Value::Matrix;
  357 
  358 sub cmp_defaults {(
  359   shift->SUPER::cmp_defaults,
  360   showDimensionHints => 1,
  361   showEqualErrors => 0,
  362 )}
  363 
  364 sub typeMatch {
  365   my $self = shift; my $other = shift; my $ans = shift;
  366   return 0 unless ref($other) && $other->class ne 'Formula';
  367   return $other->type eq 'Matrix' ||
  368     ($other->type =~ m/^(Point|list)$/ &&
  369      $other->{open}.$other->{close} eq $self->{open}.$self->{close});
  370 }
  371 
  372 sub cmp_postprocess {
  373   my $self = shift; my $ans = shift;
  374   return unless $ans->{score} == 0 &&
  375     !$ans->{isPreview} && $ans->{showDimensionHints};
  376   my @d1 = $self->dimensions; my @d2 = $ans->{student_value}->dimensions;
  377   if (scalar(@d1) != scalar(@d2)) {
  378     $self->cmp_Error($ans,"Matrix dimension is not correct");
  379     return;
  380   } else {
  381     foreach my $i (0..scalar(@d1)-1) {
  382       if ($d1[$i] != $d2[$i]) {
  383   $self->cmp_Error($ans,"Matrix dimension is not correct");
  384   return;
  385       }
  386     }
  387   }
  388 }
  389 
  390 #############################################################
  391 
  392 package Value::Interval;
  393 
  394 sub cmp_defaults {(
  395   shift->SUPER::cmp_defaults,
  396   showEndpointHints => 1,
  397   showEndTypeHints => 1,
  398 )}
  399 
  400 sub typeMatch {
  401   my $self = shift; my $other = shift;
  402   return 0 unless ref($other) && $other->class ne 'Formula';
  403   return $other->length == 2 &&
  404          ($other->{open} eq '(' || $other->{open} eq '[') &&
  405          ($other->{close} eq ')' || $other->{close} eq ']')
  406      if $other->type =~ m/^(Point|List)$/;
  407   $other->type =~ m/^(Interval|Union)$/;
  408 }
  409 
  410 #
  411 #  Check for wrong enpoints and wrong type of endpoints
  412 #
  413 sub cmp_postprocess {
  414   my $self = shift; my $ans = shift;
  415   return unless $ans->{score} == 0 && !$ans->{isPreview};
  416   my $other = $ans->{student_value};
  417   return unless $other->class eq 'Interval';
  418   my @errors;
  419   if ($ans->{showEndpointHints}) {
  420     push(@errors,"Your left endpoint is incorrect")
  421       if ($self->{data}[0] != $other->{data}[0]);
  422     push(@errors,"Your right endpoint is incorrect")
  423       if ($self->{data}[1] != $other->{data}[1]);
  424   }
  425   if (scalar(@errors) == 0 && $ans->{showEndTypeHints}) {
  426     push(@errors,"The type of interval is incorrect")
  427       if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
  428   }
  429   $self->cmp_Error($ans,@errors);
  430 }
  431 
  432 #############################################################
  433 
  434 package Value::Union;
  435 
  436 sub typeMatch {
  437   my $self = shift; my $other = shift;
  438   return 0 unless ref($other) && $other->class ne 'Formula';
  439   return $other->length == 2 &&
  440          ($other->{open} eq '(' || $other->{open} eq '[') &&
  441          ($other->{close} eq ')' || $other->{close} eq ']')
  442      if $other->type =~ m/^(Point|List)$/;
  443   $other->type =~ m/^(Interval|Union)/;
  444 }
  445 
  446 #
  447 #  Use the List checker for unions, in order to get
  448 #  partial credit.  Set the various types for error
  449 #  messages.
  450 #
  451 sub cmp_defaults {(
  452   Value::List::cmp_defaults(@_),
  453   typeMatch => 'Value::Interval',
  454   list_type => 'an interval or union',
  455   entry_type => 'an interval',
  456 )}
  457 
  458 sub cmp_equal {Value::List::cmp_equal(@_)}
  459 
  460 #############################################################
  461 
  462 package Value::List;
  463 
  464 sub cmp_defaults {
  465   my $self = shift;
  466   return (
  467     Value::Real->cmp_defaults,
  468     showHints => undef,
  469     showLengthHints => undef,
  470     showParenHints => undef,
  471     partialCredit => undef,
  472     ordered => 0,
  473     entry_type => undef,
  474     list_type => undef,
  475     typeMatch => Value::makeValue($self->{data}[0]),
  476     requireParenMatch => 1,
  477     removeParens => 1,
  478    );
  479 }
  480 
  481 #
  482 #  Match anything but formulas
  483 #
  484 sub typeMatch {return !ref($other) || $other->class ne 'Formula'}
  485 
  486 #
  487 #  Handle removal of outermost parens in correct answer.
  488 #
  489 sub cmp {
  490   my $self = shift;
  491   my $cmp = $self->SUPER::cmp(@_);
  492   if ($cmp->{rh_ans}{removeParens}) {
  493     $self->{open} = $self->{close} = '';
  494     $cmp->ans_hash(correct_ans => $self->stringify)
  495       unless defined($self->{correct_ans});
  496   }
  497   return $cmp;
  498 }
  499 
  500 sub cmp_equal {
  501   my $self = shift; my $ans = shift;
  502   $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
  503 
  504   #
  505   #  get the paramaters
  506   #
  507   my $showTypeWarnings = $ans->{showTypeWarnings};
  508   my $showHints        = getOption($ans,'showHints');
  509   my $showLengthHints  = getOption($ans,'showLengthHints');
  510   my $showParenHints   = getOption($ans,'showLengthHints');
  511   my $partialCredit    = getOption($ans,'partialCredit');
  512   my $ordered = $ans->{ordered};
  513   my $requireParenMatch = $ans->{requireParenMatch};
  514   my $typeMatch = $ans->{typeMatch};
  515   my $value     = $ans->{entry_type};
  516   my $ltype     = $ans->{list_type} || lc($self->type);
  517 
  518   $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value')
  519     unless defined($value);
  520   $value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
  521   $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
  522   $ltype =~ s/^an? //;
  523   $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview};
  524 
  525   #
  526   #  Get the lists of correct and student answers
  527   #   (split formulas that return lists or unions)
  528   #
  529   my @correct = (); my ($cOpen,$cClose);
  530   if ($self->class ne 'Formula') {
  531     @correct = $self->value;
  532     $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
  533   } else {
  534     @correct = Value::List->splitFormula($self,$ans);
  535     $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
  536   }
  537   my $student = $ans->{student_value}; my @student = ($student);
  538   my ($sOpen,$sClose) = ('','');
  539   if (Value::isFormula($student) && $student->type eq $self->type) {
  540     @student = Value::List->splitFormula($student,$ans);
  541     $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
  542   } elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
  543     @student = @{$student->{data}};
  544     $sOpen = $student->{open}; $sClose = $student->{close};
  545   }
  546   return if $ans->{split_error};
  547   #
  548   #  Check for parenthesis match
  549   #
  550   if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
  551     if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
  552       my $message = "The parentheses for your $ltype ";
  553       if (($cOpen || $cClose) && ($sOpen || $sClose))
  554                                 {$message .= "are of the wrong type"}
  555       elsif ($sOpen || $sClose) {$message .= "should be removed"}
  556       else                      {$message .= "are missing"}
  557       $self->cmp_Error($ans,$message) unless $ans->{isPreview};
  558     }
  559     return;
  560   }
  561   #
  562   #  Check for empty lists
  563   #
  564   if (scalar(@correct) == 0 && scalar(@student) == 0) {$ans->score(1); return}
  565 
  566   #
  567   #  Initialize the score
  568   #
  569   my $M = scalar(@correct);
  570   my $m = scalar(@student);
  571   my $maxscore = ($m > $M)? $m : $M;
  572   my $score = 0; my @errors; my $i = 0;
  573 
  574   #
  575   #  Loop through student answers looking for correct ones
  576   #
  577   ENTRY: foreach my $entry (@student) {
  578     $i++;
  579     $entry = Value::makeValue($entry);
  580     $entry = Value::Formula->new($entry) if !Value::isValue($entry);
  581     if ($ordered) {
  582       if (eval {shift(@correct) == $entry}) {$score++; next ENTRY}
  583     } else {
  584       foreach my $k (0..$#correct) {
  585   if (eval {$correct[$k] == $entry}) {
  586     splice(@correct,$k,1);
  587     $score++; next ENTRY;
  588   }
  589       }
  590     }
  591     #
  592     #  Give messages about incorrect answers
  593     #
  594     my $nth = ''; my $answer = 'answer';
  595     my $class = $ans->{list_type} || $self->cmp_class;
  596     if (scalar(@student) > 1) {
  597       $nth = ' '.$self->NameForNumber($i);
  598       $class = $ans->{cmp_class};
  599       $answer = 'value';
  600     }
  601     if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
  602   !($ans->{ignoreStrings} && $entry->class eq 'String')) {
  603       push(@errors,"Your$nth $answer isn't ".lc($class).
  604      " (it looks like ".lc($entry->showClass).")");
  605     } elsif ($showHints && $m > 1) {
  606       push(@errors,"Your$nth $value is incorrect");
  607     }
  608   }
  609 
  610   #
  611   #  Give hints about extra or missing answsers
  612   #
  613   if ($showLengthHints) {
  614     $value =~ s/ or /s or /; # fix "interval or union"
  615     push(@errors,"There should be more ${value}s in your $ltype")
  616       if ($score == $m && scalar(@correct) > 0);
  617     push(@errors,"There should be fewer ${value}s in your $ltype")
  618       if ($score < $maxscore && $score == $M && !$showHints);
  619   }
  620 
  621   #
  622   #  Finalize the score
  623   #
  624   $score = 0 if ($score != $maxscore && !$partialCredit);
  625   $ans->score($score/$maxscore);
  626   push(@errors,"Score = $ans->{score}") if $ans->{debug};
  627   $ans->{error_message} = $ans->{ans_message} = join("\n",@errors);
  628 }
  629 
  630 #
  631 #  Split a formula that is a list or union into a
  632 #    list of formulas (or Value objects).
  633 #
  634 sub splitFormula {
  635   my $self = shift; my $formula = shift; my $ans = shift;
  636   my @formula; my @entries;
  637   if ($formula->type eq 'List') {@entries = @{$formula->{tree}{coords}}}
  638       else {@entries = $formula->{tree}->makeUnion}
  639   foreach my $entry (@entries) {
  640     my $v = Parser::Formula($entry);
  641        $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
  642     push(@formula,$v);
  643     #
  644     #  There shouldn't be an error evaluating the formula,
  645     #    but you never know...
  646     #
  647     if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
  648   }
  649   return @formula;
  650 }
  651 
  652 #
  653 #  Return the value if it is defined, otherwise use a default
  654 #
  655 sub getOption {
  656   my $ans = shift; my $name = shift;
  657   my $value = $ans->{$name};
  658   return $value if defined($value);
  659   return $ans->{showPartialCorrectAnswers};
  660 }
  661 
  662 #############################################################
  663 
  664 package Value::Formula;
  665 
  666 sub cmp_defaults {
  667   my $self = shift;
  668 
  669   return (
  670     Value::Union::cmp_defaults($self,@_),
  671     typeMatch => Value::Formula->new("(1,2]"),
  672   ) if $self->type eq 'Union';
  673 
  674   my $type = $self->type;
  675   $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
  676   $type = 'Value::'.$type.'::';
  677 
  678   return (&{$type.'cmp_defaults'}($self,@_), upToConstant => 0)
  679     if defined(%$type) && $self->type ne 'List';
  680 
  681   return (
  682     Value::List::cmp_defaults($self,@_),
  683     removeParens => $self->{autoFormula},
  684     typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]),
  685   );
  686 }
  687 
  688 #
  689 #  Get the types from the values of the formulas
  690 #     and compare those.
  691 #
  692 sub typeMatch {
  693   my $self = shift; my $other = shift; my $ans = shift;
  694   return 1 if $self->type eq $other->type;
  695   my $typeMatch = ($self->createRandomPoints(1))[1]->[0];
  696   $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
  697   return 1 unless defined($other); # can't really tell, so don't report type mismatch
  698   $typeMatch->typeMatch($other,$ans);
  699 }
  700 
  701 #
  702 #  Handle removal of outermost parens in a list.
  703 #
  704 sub cmp {
  705   my $self = shift;
  706   my $cmp = $self->SUPER::cmp(@_);
  707   if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
  708     $self->{tree}{open} = $self->{tree}{close} = '';
  709     $cmp->ans_hash(correct_ans => $self->stringify)
  710       unless defined($self->{correct_ans});
  711   }
  712   if ($cmp->{rh_ans}{eval} && $self->isConstant) {
  713     $cmp->ans_hash(correct_value => $self->eval);
  714     return $cmp;
  715   }
  716   if ($cmp->{rh_ans}{upToConstant}) {
  717     my $current = Parser::Context->current();
  718     my $context = $self->{context} = $self->{context}->copy;
  719     Parser::Context->current(undef,$context);
  720     $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
  721       'C0|' . $context->{_variables}->{pattern};
  722     $context->update; $context->variables->add('C0' => 'Parameter');
  723     $cmp->ans_hash(correct_value => Value::Formula->new('C0')+$self);
  724     Parser::Context->current(undef,$current);
  725   }
  726   return $cmp;
  727 }
  728 
  729 sub cmp_equal {
  730   my $self = shift; my $ans = shift;
  731   #
  732   #  Get the problem's seed
  733   #
  734   $self->{context}->flags->set(
  735     random_seed => $self->getPG('$PG_original_problemSeed')
  736   );
  737 
  738   #
  739   #  Use the list checker if the formula is a list or union
  740   #    Otherwise use the normal checker
  741   #
  742   if ($self->type =~ m/^(List|Union)$/) {
  743     Value::List::cmp_equal($self,$ans);
  744   } else {
  745     $self->SUPER::cmp_equal($ans);
  746   }
  747 }
  748 
  749 sub cmp_postprocess {
  750   my $self = shift; my $ans = shift;
  751   return unless $ans->{score} == 0 && !$ans->{isPreview};
  752   return if $ans->{ans_message} || !$ans->{showDimensionHints};
  753   my $other = $ans->{student_value};
  754   return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
  755   return unless $self->type  =~ m/^(Point|Vector|Matrix)$/;
  756   return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
  757   $self->cmp_Error($ans,"The dimension of your result is incorrect");
  758 }
  759 
  760 #############################################################
  761 
  762 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9