View of /trunk/pg/macros/answerHints.pl

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 AnswerHints()
   18 
   19 This is an answer-checker post-filter that allows you to produce
   20 additional error messages for incorrect answers.  You can trigger
   21 a message for a single answer, a collection of answers, or via a
   22 subroutine that determines the condition for the message.
   23 
   24 Note that this filter only works for MathObjects answer checkers.
   25 
   26 The answer hints are given as a pair using => with the right-hand
   27 side being the answer message and the left-hand side being one of
   28 three possibilities:  1) the value that triggers the message,
   29 2) a reference to an array of values that trigger the message, or
   30 3) a code reference to a subtroutine that accepts tthe correct
   31 answer, the student's answer, and the answer hash, and returns
   32 1 or 0 depending on whether the message should or should not be
   33 displayed.  (See the examples below.)
   34 
   35 The right-hand side can be either the message string itself, or
   36 a referrence to an array where the first element is the message
   37 string, and the remaining elements are name-value pairs that
   38 set options for the message.  These can include:
   39 
   40 =over
   41 
   42 =item C<S<< checkCorrect => 0 or 1 >>>
   43 
   44 1 means check for messages even
   45 if the answer is correct.
   46 Default: 0
   47 
   48 =item C<S<< replaceMessage => 0 or 1 >>>
   49 
   50 1 means it's OK to repalce any
   51 message that is already in place
   52 in the answer hash.
   53 Default: 0
   54 
   55 =item C<S<< checkTypes => 0 or 1 >>>
   56 
   57 1 means only perform the test
   58 if the student answer is the
   59 same type as the correct one.
   60 Default: 1
   61 
   62 =item C<S<< score => number >>>
   63 
   64 Specifies the score to use if
   65 the message is triggered (so that
   66 partial credit can be given).
   67 Default: keep original score
   68 
   69 =item C<S<< cmp_options => [...] >>>
   70 
   71 provides options for the cmp routine
   72 used to check if the student answer
   73 matches these answers.
   74 Default: []
   75 
   76 =back
   77 
   78 If more than one message matches the student's answer, the first
   79 one in the list is used.
   80 
   81 Example:
   82 
   83   ANS(Vector(1,2,3)->cmp(showCoordinateHints=>0)->withPostFilter(AnswerHints(
   84     Vector(0,0,0) => "The zero vector is not a valid solution",
   85     "-<1,2,3>" => "Try the opposite direction",
   86     "<1,2,3>" => "Well done!",
   87     ["<1,1,1>","<2,2,2>","<3,3,3>"] => "Don't just guess!",
   88     sub {
   89       my ($correct,$student,$ans) = @_;
   90       return $correct . $student == 0;
   91     } => "Your answer is perpendicular to the correct one",
   92     Vector(1,2,3) => [
   93       "You have the right direction, but not length",
   94       cmp_options => [parallel=>1],
   95     ],
   96     0 => ["Careful, your answer should be a vector!", checkTypes => 0, replaceMessage => 1],
   97     sub {
   98       my ($correct,$student,$ans) = @_;
   99       return norm($correct-$student) < .1;
  100     } => ["Close!  Keep trying.", score => .25],
  101   )));
  102 
  103 =cut
  104 
  105 sub _answerHints_init {}
  106 
  107 sub AnswerHints {
  108   return (sub {
  109     my $ans = shift; $ans->{_filter_name} = "Answer Hints Post Filter";
  110     my $correct = $ans->{correct_value};
  111     my $student = $ans->{student_value};
  112     Value::Error("AnswerHints can only be used with MathObjects answer checkers") unless ref($correct);
  113     return $ans unless ref($student);
  114 
  115     while (@_) {
  116       my $wrongList = shift; my $message = shift; my @options;
  117       ($message,@options) = @{$message} if ref($message) eq 'ARRAY';
  118       my %options = (
  119         checkCorrect => 0,
  120         replaceMessage => 0,
  121   checkTypes => 1,
  122         score => undef,
  123         cmp_options => [],
  124         @options,
  125       );
  126       next if $options{checkType} && $correct->type ne $student->type;
  127       $wrongList = [$wrongList] unless ref($wrongList) eq 'ARRAY';
  128       foreach my $wrong (@{$wrongList}) {
  129   if (ref($wrong) eq 'CODE') {
  130     if (($ans->{score} < 1 || $options{checkCorrect}) &&
  131         ($ans->{ans_message} eq "" || $options{replaceMessage}) &&
  132         &$wrong($correct,$student,$ans)) {
  133       $ans->{ans_message} = $ans->{error_message} = $message;
  134       $ans->{score} = $options{score} if defined $options{score};
  135       last;
  136     }
  137   } else {
  138     $wrong = Value::makeValue($wrong);
  139     if (($ans->{score} < 1 || $options{checkCorrect} || AnswerHints::Compare($correct,$wrong,$ans)) &&
  140         ($ans->{ans_message} eq "" || $options{replaceMessage}) &&
  141         AnswerHints::Compare($wrong,$student,$ans,@{$options{cmp_options}})) {
  142       $ans->{ans_message} = $ans->{error_message} = $message;
  143       $ans->{score} = $options{score} if defined $options{score};
  144       last;
  145     }
  146   }
  147       }
  148     }
  149     return $ans;
  150   },@_);
  151 }
  152 
  153 package AnswerHints;
  154 
  155 #
  156 #  Calls the answer checker on two values with a copy of the answer hash
  157 #  and returns true if the two values match and false otherwise.
  158 #
  159 sub Compare {
  160   my $self = shift; my $other = shift; my $ans = shift;
  161   $ans = bless {%{$ans},@_}, ref($ans);  # make a copy
  162   $ans->{typeError} = 0; $ans->{ans_message} = $ans->{error_message} = ""; $ans->{score} = 0;
  163   if (sprintf("%p",$self) ne sprintf("%p",$ans->{correct_value})) {
  164     $ans->{correct_ans} = $self->string;
  165     $ans->{correct_value} = $self;
  166     $ans->{correct_formula} = Value->Package("Formula")->new($self);
  167   }
  168   if (sprintf("%p",$other) ne sprintf("%p",$ans->{student_value})) {
  169     $ans->{student_ans} = $other->string;
  170     $ans->{student_value} = $other;
  171     $ans->{student_formula} = Value->Package("Formula")->new($other);
  172   }
  173   $self->cmp_preprocess($ans);
  174   $self->cmp_equal($ans);
  175   $self->cmp_postprocess($ans) if !$ans->{error_message} && !$ans->{typeError};
  176   return $ans->{score} >= 1;
  177 }
  178 
  179 1;