[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 2617 - (download) (as text) (annotate)
Sun Aug 15 00:13:38 2004 UTC (15 years, 4 months ago) by dpvc
File size: 16068 byte(s)
The Union answer checker now uses the generic List checker, so that it
will be able to produce partial credit and hints about which Intervals
are correct.

    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 )};
   24 
   25 sub cmp {
   26   my $self = shift;
   27   $$Value::context->flags->set(StringifyAsTeX => 0);  # reset this, just in case.
   28   my $ans = new AnswerEvaluator;
   29   $ans->ans_hash(
   30     type => "Value (".$self->class.")",
   31     correct_ans => $self->string,
   32     correct_value => $self,
   33     $self->cmp_defaults,
   34     @_
   35   );
   36   $ans->install_evaluator(
   37     sub {
   38       my $ans = shift;
   39       #  can't seem to get $inputs_ref any other way
   40       $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
   41       my $self = $ans->{correct_value};
   42       my $method = $ans->{cmp_check} || 'cmp_check';
   43       $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
   44       $self->$method($ans);
   45     }
   46   );
   47   return $ans;
   48 }
   49 
   50 #
   51 #  Parse the student answer and compute its value,
   52 #    produce the preview strings, and then compare the
   53 #    student and professor's answers for equality.
   54 #
   55 sub cmp_check {
   56   my $self = shift; my $ans = shift;
   57   #
   58   #  Methods to call
   59   #
   60   my $cmp_equal = $ans->{cmp_equal} || 'cmp_equal';
   61   my $cmp_error = $ans->{cmp_error} || 'cmp_error';
   62   my $cmp_postprocess = $ans->{cmp_postprocess} || 'cmp_postprocess';
   63   #
   64   #  Parse and evaluate the student answer
   65   #
   66   $ans->score(0);  # assume failure
   67   my $vars = $$Value::context->{variables};
   68   $$Value::context->{variables} = {}; #  pretend there are no variables
   69   $ans->{student_formula} = Parser::Formula($ans->{student_ans});
   70   $ans->{student_value}   = Parser::Evaluate($ans->{student_formula});
   71   $$Value::context->{variables} = $vars;
   72   #
   73   #  If it parsed OK, save the output forms and check if it is correct
   74   #   otherwise report an error
   75   #
   76   if (defined $ans->{student_value}) {
   77     $ans->{student_value} = Value::Formula->new($ans->{student_value})
   78        unless Value::isValue($ans->{student_value});
   79     $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
   80     $ans->{preview_text_string}  = $ans->{student_formula}->string;
   81     $ans->{student_ans}          = $ans->{student_value}->stringify;
   82     $self->$cmp_equal($ans);
   83     $self->$cmp_postprocess($ans) if !$ans->{error_message};
   84   } else {
   85     $self->$cmp_error($ans);
   86   }
   87   return $ans;
   88 }
   89 
   90 #
   91 #  Check if the parsed student answer equals the professor's answer
   92 #
   93 sub cmp_equal {
   94   my $self = shift; my $ans = shift;
   95   if ($ans->{correct_value}->typeMatch($ans->{student_value},$ans)) {
   96     my $equal = eval {$ans->{correct_value} == $ans->{student_value}};
   97     if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
   98     my $cmp_error = $ans->{cmp_error} || 'cmp_error';
   99     $self->$cmp_error($ans);
  100   } else {
  101     $ans->{ans_message} = $ans->{error_message} =
  102       "Your answer isn't ".lc($ans->{cmp_class}).
  103         " (it looks like ".lc($ans->{student_value}->showClass).")"
  104      if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
  105   }
  106 }
  107 
  108 #
  109 #  Check if types are compatible for equality check
  110 #
  111 sub typeMatch {
  112   my $self = shift;  my $other = shift;
  113   return 1 unless ref($other);
  114   $self->type eq $other->type;
  115 }
  116 
  117 #
  118 #  Class name for cmp error messages
  119 #
  120 sub cmp_class {
  121   my $self = shift; my $ans = shift;
  122   my $class = $self->showClass;
  123   return "an Interval or Union" if $class =~ m/Interval/i;
  124   $class =~ s/Real //;
  125   return $class;
  126 }
  127 
  128 #
  129 #  Student answer evaluation failed.
  130 #  Report the error, with formatting, if possible.
  131 #
  132 sub cmp_error {
  133   my $self = shift; my $ans = shift;
  134   my $context = $$Value::context;
  135   my $message = $context->{error}{message};
  136   if ($context->{error}{pos}) {
  137     my $string = $context->{error}{string};
  138     my ($s,$e) = @{$context->{error}{pos}};
  139     $message =~ s/; see.*//;  # remove the position from the message
  140     $ans->{student_ans} =
  141        protectHTML(substr($string,0,$s)) .
  142        '<SPAN CLASS="parsehilight">' .
  143          protectHTML(substr($string,$s,$e-$s)) .
  144        '</SPAN>' .
  145        protectHTML(substr($string,$e));
  146   }
  147   $self->cmp_Error($ans,$message);
  148 }
  149 
  150 #
  151 #  Set the error message
  152 #
  153 sub cmp_Error {
  154   my $self = shift; my $ans = shift;
  155   return unless scalar(@_) > 0;
  156   $ans->score(0);
  157   $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
  158 }
  159 
  160 #
  161 #  filled in by sub-classes
  162 #
  163 sub cmp_postprocess {}
  164 
  165 #
  166 #  Quote HTML characters
  167 #
  168 sub protectHTML {
  169     my $string = shift;
  170     $string =~ s/&/\&amp;/g;
  171     $string =~ s/</\&lt;/g;
  172     $string =~ s/>/\&gt;/g;
  173     $string;
  174 }
  175 
  176 #
  177 #  names for numbers
  178 #
  179 sub NameForNumber {
  180   my $self = shift; my $n = shift;
  181   my $name =  ('zeroth','first','second','third','fourth','fifth',
  182                'sixth','seventh','eighth','ninth','tenth')[$n];
  183   $name = "$n-th" if ($n > 10);
  184   return $name;
  185 }
  186 
  187 #
  188 #  Get a value from the safe compartment
  189 #
  190 sub getPG {
  191   my $self = shift;
  192   (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
  193 }
  194 
  195 #############################################################
  196 #############################################################
  197 
  198 package Value::Real;
  199 
  200 sub cmp_defaults {(
  201   shift->SUPER::cmp_defaults,
  202   ignoreStrings => 1,
  203   ignoreInfinity => 1,
  204 )};
  205 
  206 sub typeMatch {
  207   my $self = shift; my $other = shift; my $ans = shift;
  208   return 1 unless ref($other);
  209   return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
  210   if ($other->type eq 'String' && $ans->{ignoreStrings}) {
  211     $ans->{showEqualErrors} = 0;
  212     return 1;
  213   }
  214   $self->type eq $other->type;
  215 }
  216 
  217 #############################################################
  218 
  219 package Value::Infinity;
  220 
  221 sub cmp_class {'a Number'};
  222 
  223 sub typeMatch {
  224   my $self = shift; my $other = shift; my $ans = shift;
  225   return 1 unless ref($other);
  226   return 1 if $other->type eq 'Number';
  227   $self->type eq $other->type;
  228 }
  229 
  230 #############################################################
  231 
  232 package Value::String;
  233 
  234 sub cmp_defaults {(
  235   Value::Real->cmp_defaults,
  236   typeMatch => undef,
  237 )};
  238 
  239 sub cmp_class {
  240   my $self = shift; my $ans = shift;
  241   my $typeMatch = $ans->{typeMatch};
  242   my $typeMatch = $ans->{typeMatch} = Value::Real->new(1) unless defined($typeMatch);
  243   return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
  244   return $typeMatch->cmp_class;
  245 };
  246 
  247 sub typeMatch {
  248   my $self = shift; my $other = shift; my $ans = shift;
  249   my $typeMatch = $ans->{typeMatch};
  250   my $typeMatch = $ans->{typeMatch} = Value::Real->new(1) unless defined($typeMatch);
  251   return 1 if $self->type eq $other->type || !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
  252   return $typeMatch->typeMatch($other,$ans);
  253 }
  254 
  255 #############################################################
  256 
  257 package Value::Point;
  258 
  259 sub cmp_defaults {(
  260   shift->SUPER::cmp_defaults,
  261   showDimensionHints => 1,
  262   showCoordinateHints => 1,
  263 )};
  264 
  265 sub typeMatch {
  266   my $self = shift; my $other = shift; my $ans = shift;
  267   return ref($other) && $other->type eq 'Point';
  268 }
  269 
  270 #
  271 #  Check for dimension mismatch and incorrect coordinates
  272 #
  273 sub cmp_postprocess {
  274   my $self = shift; my $ans = shift;
  275   return unless $ans->{score} == 0 && !$ans->{isPreview};
  276   if ($ans->{showDimensionHints} &&
  277       $self->length != $ans->{student_value}->length) {
  278     $self->cmp_Error($ans,"The dimension is incorrect"); return;
  279   }
  280   if ($ans->{showCoordinateHints}) {
  281     my @errors;
  282     foreach my $i (1..$self->length) {
  283       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  284   if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
  285     }
  286     $self->cmp_Error($ans,@errors); return;
  287   }
  288 }
  289 
  290 #############################################################
  291 
  292 package Value::Vector;
  293 
  294 sub cmp_defaults {(
  295   shift->SUPER::cmp_defaults,
  296   showDimensionHints => 1,
  297   showCoordinateHints => 1,
  298   promotePoints => 0,
  299   parallel => 0,
  300   sameDirection => 0,
  301 )};
  302 
  303 sub typeMatch {
  304   my $self = shift; my $other = shift; my $ans = shift;
  305   return 0 unless ref($other);
  306   $other = $ans->{student_value} = Value::Vector::promote($other)
  307     if $ans->{promotePoints} && $other->type eq 'Point';
  308   return $other->type eq 'Vector';
  309 }
  310 
  311 #
  312 #  check for dimension mismatch
  313 #        for parallel vectors, and
  314 #        for incorrect coordinates
  315 #
  316 sub cmp_postprocess {
  317   my $self = shift; my $ans = shift;
  318   return unless $ans->{score} == 0;
  319   if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
  320       $self->length != $ans->{student_value}->length) {
  321     $self->cmp_Error($ans,"The dimension is incorrect"); return;
  322   }
  323  if ($ans->{parallel} &&
  324      $self->isParallel($ans->{student_value},$ans->{sameDirection})) {
  325    $ans->score(1); return;
  326  }
  327   if (!$ans->{isPreview} && $ans->{showCoordinateHints}) {
  328     my @errors;
  329     foreach my $i (1..$self->length) {
  330       push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
  331   if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
  332     }
  333     $self->cmp_Error($ans,@errors); return;
  334   }
  335 }
  336 
  337 
  338 
  339 #############################################################
  340 
  341 package Value::Matrix;
  342 
  343 sub cmp_defaults {(
  344   shiftf->SUPER::cmp_defaults,
  345   showDimensionHints => 1,
  346   showEqualErrors => 0,
  347 )};
  348 
  349 sub typeMatch {
  350   my $self = shift; my $other = shift; my $ans = shift;
  351   return 0 unless ref($other);
  352   $other = $ans->{student_value} = $self->make($other->{data})
  353     if $other->class eq 'Point';
  354   return $other->type eq 'Matrix';
  355 }
  356 
  357 sub cmp_postprocess {
  358   my $self = shift; my $ans = shift;
  359   return unless $ans->{score} == 0 &&
  360     !$ans->{isPreview} && $ans->{showDimensionHints};
  361   my @d1 = $self->dimensions; my @d2 = $ans->{student_value}->dimensions;
  362   if (scalar(@d1) != scalar(@d2)) {
  363     $self->cmp_Error($ans,"Matrix dimension is not correct");
  364     return;
  365   } else {
  366     foreach my $i (0..scalar(@d1)-1) {
  367       if ($d1[$i] != $d2[$i]) {
  368   $self->cmp_Error($ans,"Matrix dimension is not correct");
  369   return;
  370       }
  371     }
  372   }
  373 }
  374 
  375 #############################################################
  376 
  377 package Value::Interval;
  378 
  379 sub cmp_defaults {(
  380   shift->SUPER::cmp_defaults,
  381   showEndpointHints => 1,
  382   showEndTypeHints => 1,
  383 )};
  384 
  385 sub typeMatch {
  386   my $self = shift; my $other = shift;
  387   return 0 unless ref($other);
  388   return $other->length == 2 &&
  389          ($other->{open} eq '(' || $other->{open} eq '[') &&
  390          ($other->{close} eq ')' || $other->{close} eq ']')
  391      if $other->type =~ m/^(Point|List)$/;
  392   $other->type =~ m/^(Interval|Union)$/;
  393 }
  394 
  395 #
  396 #  Check for wrong enpoints and wrong type of endpoints
  397 #
  398 sub cmp_postprocess {
  399   my $self = shift; my $ans = shift;
  400   return unless $ans->{score} == 0 && !$ans->{isPreview};
  401   my $other = $ans->{student_value};
  402   return unless $other->class eq 'Interval';
  403   my @errors;
  404   if ($ans->{showEndpointHints}) {
  405     push(@errors,"Your left endpoint is incorrect")
  406       if ($self->{data}[0] != $other->{data}[0]);
  407     push(@errors,"Your right endpoint is incorrect")
  408       if ($self->{data}[1] != $other->{data}[1]);
  409   }
  410   if (scalar(@errors) == 0 && $ans->{showEndTypeHints}) {
  411     push(@errors,"The type of interval is incorrect")
  412       if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
  413   }
  414   $self->cmp_Error($ans,@errors);
  415 }
  416 
  417 #############################################################
  418 
  419 package Value::Union;
  420 
  421 sub typeMatch {
  422   my $self = shift; my $other = shift;
  423   return 0 unless ref($other);
  424   return $other->length == 2 &&
  425          ($other->{open} eq '(' || $other->{open} eq '[') &&
  426          ($other->{close} eq ')' || $other->{close} eq ']')
  427      if $other->type =~ m/^(Point|List)$/;
  428   $other->type =~ m/^(Interval|Union)/;
  429 }
  430 
  431 #
  432 #  Use the List checker for unions, in order to get
  433 #  partial credit.  Set the various types for error
  434 #  messages.
  435 #
  436 sub cmp_defaults {(
  437   Value::List->cmp_defaults,
  438   typeMatch => Value::Interval->new("(1,2]"),
  439   list_type => 'union',
  440   entry_type => 'an interval',
  441 )}
  442 
  443 sub cmp_equal {Value::List::cmp_equal(@_)}
  444 
  445 #############################################################
  446 
  447 package Value::List;
  448 
  449 sub cmp_defaults {(
  450   Value::Real->cmp_defaults,
  451   showHints => undef,
  452   showLengthHints => undef,
  453 #  partialCredit => undef,
  454   partialCredit => 0,  #  only allow this once WW can deal with partial credit
  455   ordered => 0,
  456   entry_type => undef,
  457   list_type => undef,
  458   typeMatch => undef,
  459   allowParens => 0,
  460   showParens => 0,
  461 )};
  462 
  463 sub typeMatch {1}
  464 
  465 #
  466 #  Handle removal of outermost parens in correct answer.
  467 #
  468 sub cmp {
  469   my $self = shift;
  470   my $cmp = $self->SUPER::cmp(@_);
  471   if (!$cmp->{rh_ans}{showParens}) {
  472     $self->{open} = $self->{close} = '';
  473     $cmp->ans_hash(correct_ans => $self->stringify);
  474   }
  475   return $cmp;
  476 }
  477 
  478 sub cmp_equal {
  479   my $self = shift; my $ans = shift;
  480   my $showPartialCorrectAnswers = $self->getPG('$showPartialCorrectAnswers');
  481   my $showTypeWarnings = $ans->{showTypeWarnings};
  482   my $showHints = getOption($ans->{showHints},$showPartialCorrectAnswers);
  483   my $showLengthHints = getOption($ans->{showLengthHints},$showPartialCorrectAnswers);
  484   my $partialCredit = getOption($ans->{partialCredit},$showPartialCorrectAnswers);
  485   my $ordered = $ans->{ordered}; my $allowParens = $ans->{allowParens};
  486   my $typeMatch = $ans->{typeMatch} || $self->{data}[0];
  487   $typeMatch = Value::Real->make($typeMatch)
  488     if !ref($typeMatch) && Value::matchNumber($typeMatch);
  489   my $value = getOption($ans->{entry_type},
  490       Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value');
  491   $value =~ s/(real|complex) //; $ans->{cmp_class} = $value; $value =~ s/^an? //;
  492   my $ltype = getOption($ans->{list_type},lc($self->type));
  493   $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview};
  494 
  495   my $student = $ans->{student_value};
  496   my @correct = $self->value;
  497   my @student =
  498     $student->class =~ m/^(List|Union)$/ &&
  499       ($allowParens || (!$student->{open} && !$student->{close})) ?
  500     @{$student->{data}} : ($student);
  501 
  502   my $maxscore = scalar(@correct);
  503   my $m = scalar(@student);
  504   $maxscore = $m if ($m > $maxscore);
  505   my $score = 0; my @errors; my $i = 0;
  506 
  507   ENTRY: foreach my $entry (@student) {
  508     $i++;
  509     $entry = Value::makeValue($entry);
  510     $entry = Value::Formula->new($entry) if !Value::isValue($entry);
  511     if ($ordered) {
  512       if (eval {shift(@correct) == $entry}) {$score++; next ENTRY}
  513     } else {
  514       foreach my $k (0..$#correct) {
  515   if (eval {$correct[$k] == $entry}) {
  516     splice(@correct,$k,1);
  517     $score++; next ENTRY;
  518   }
  519       }
  520     }
  521     if ($showTypeWarnings && defined($typeMatch) &&
  522         !$typeMatch->typeMatch($entry,$ans)) {
  523       push(@errors,
  524         "Your ".$self->NameForNumber($i)." value isn't ".lc($ans->{cmp_class}).
  525      " (it looks like ".lc($entry->showClass).")");
  526       next ENTRY;
  527     }
  528     push(@errors,"Your ".$self->NameForNumber($i)." $value is incorrect")
  529       if $showHints && $m > 1;
  530   }
  531 
  532   if ($showLengthHints) {
  533     $value =~ s/ or /s or /; # fix "interval or union"
  534     push(@errors,"There should be more ${value}s in your $ltype")
  535       if ($score == $m && scalar(@correct) > 0);
  536     push(@errors,"There should be fewer ${value}s in your $ltype")
  537       if ($score < $maxscore && $score == scalar($self->value));
  538   }
  539 
  540   $score = 0 if ($score != $maxscore && !$partialCredit);
  541   $ans->score($score/$maxscore);
  542   push(@errors,"Score = $ans->{score}") if $ans->{debug};
  543   $ans->{error_message} = $ans->{ans_message} = join("\n",@errors);
  544 }
  545 
  546 #
  547 #  Return the value if it is defined, otherwise a default
  548 #
  549 sub getOption {
  550   my $value = shift; my $default = shift;
  551   return $value if defined($value);
  552   return $default;
  553 }
  554 
  555 #############################################################
  556 
  557 package Value::Formula;
  558 
  559 #
  560 #  No cmp function (for now)
  561 #
  562 sub cmp {
  563   die "Answer checker for formulas is not yet defined";
  564 }
  565 
  566 #############################################################
  567 
  568 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9