[system] / trunk / pg / macros / parserMultiAnswer.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5633 - (download) (as text) (annotate)
Mon Apr 14 23:29:53 2008 UTC (11 years, 10 months ago) by sh002i
File size: 17642 byte(s)
documentation improvements

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/macros/parserMultiAnswer.pl,v 1.9 2007/10/04 16:40:48 sh002i Exp $
    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 NAME
   18 
   19 parserMultiAnswer.pl - Tie several blanks to a single answer checker.
   20 
   21 =head1 DESCRIPTION
   22 
   23 MultiAnswer objects let you tie several answer blanks to a single
   24 answer checker, so you can have the answer in one blank influence
   25 the answer in another.  The MultiAnswer can produce either a single
   26 result in the answer results area, or a separate result for each
   27 blank.
   28 
   29 To create a MultiAnswer pass a list of answers to MultiAnswer() in the
   30 order they will appear in the problem.  For example:
   31 
   32   $mp = MultiAnswer("x^2",-1,1);
   33 
   34 or
   35 
   36   $mp = MultiAnswer(Vector(1,1,1),Vector(2,2,2))->with(singleResult=>1);
   37 
   38 Then, use $mp->ans_rule to create answer blanks for the various parts
   39 just as you would ans_rule.  You can pass the width of the blank, which
   40 defaults to 20 otherwise.  For example:
   41 
   42   BEGIN_TEXT
   43   \(f(x)\) = \{$mp->ans_rule(20)\} produces the same value
   44   at \(x\) = \{$mp->ans_rule(10)\} as it does at \(x\) = \{$mp->ans_rule(10)\}.
   45   END_TEXT
   46 
   47 Finally, call $mp->cmp to produce the answer checker(s) used in the MultiAnswer.
   48 You need to provide a checker routine that will be called to determine if the
   49 answers are correct or not.  The checker will only be called if the student
   50 answers have no syntax errors and their types match the types of the professor's
   51 answers, so you don't have to worry about handling bad data from the student
   52 (at least as far as typechecking goes).
   53 
   54 The checker routine should accept four parameters:  a reference to the array
   55 of correct answers, a reference to the array of student answers, a reference
   56 to the MultiAnswer itself, and a reference to the answer hash.  It should do
   57 whatever checking it needs to do and then return a score for the MultiAnswer
   58 as a whole (every answer blank will be given the same score), or a reference
   59 to an array of scores, one for each blank.  The routine can set error messages
   60 via the MultiAnswer's setMessage() method (e.g.,
   61 
   62   $mp->setMessage(1,"The function can't be the identity");
   63 
   64 would set the message for the first answer blank of the MultiAnswer), or can
   65 call Value::Error() to generate an error and die.
   66 
   67 The checker routine can be supplied either when the MultiAnswer is created, or
   68 when the cmp() method is called.  For example:
   69 
   70   $mp = MultiAnswer("x^2",1,-1)->with(
   71     singleResult => 1,
   72     checker => sub {
   73       my ($correct,$student,$self) = @_;  # get the parameters
   74       my ($f,$x1,$x2) = @{$student};      # extract the student answers
   75       Value::Error("Function can't be the identity") if ($f == 'x');
   76       Value::Error("Function can't be constant") if ($f->isConstant);
   77       return $f->eval(x=>$x1) == $f->eval(x=>$x2);
   78     },
   79   );
   80   ANS($mp->cmp);
   81 
   82 or
   83 
   84   $mp = MultiAnswer("x^2",1,-1)->with(singleResult=>1);
   85   sub check {
   86     my ($correct,$student,$self) = @_;  # get the parameters
   87     my ($f,$x1,$x2) = @{$student};      # extract the student answers
   88     Value::Error("Function can't be the identity") if ($f == 'x');
   89     Value::Error("Function can't be constant") if ($f->isConstant);
   90     return $f->eval(x=>$x1) == $f->eval(x=>$x2);
   91   };
   92   ANS($mp->cmp(checker=>~~&check));
   93 
   94 =cut
   95 
   96 loadMacros("MathObjects.pl");
   97 
   98 sub _parserMultiAnswer_init {
   99   main::PG_restricted_eval('sub MultiAnswer {MultiAnswer->new(@_)}');
  100 }
  101 
  102 ##################################################
  103 
  104 package MultiAnswer;
  105 our @ISA = qw(Value);
  106 
  107 our $count = 0;                      # counter for unique identifier for multi-parts
  108 our $answerPrefix = "MuLtIaNsWeR";   # answer rule prefix
  109 our $separator = ';';                # separator for singleResult previews
  110 
  111 =head1 CONSTRUCTOR
  112 
  113   MultiAnswer($answer1, $answer2, ...);
  114   MultiAnswer($answer1, $answer2, ...)->with(...);
  115 
  116 Create a new MultiAnswer item from a list of items. The items are converted if
  117 Value items, if they aren't already. You can set the following fields of the
  118 resulting item:
  119 
  120     checker => code            a subroutine to be called to check the
  121                                student answers.  The routine is passed
  122                                four parameters: a reference to the array
  123                                or correct answers, a reference to the
  124                                array of student answers, a reference to the
  125                                MultiAnswer object itself, and a reference to
  126                                the checker's answer hash.  The routine
  127                                should return either a score or a reference
  128                                to an array of scores (one for each answer).
  129 
  130     singleResult => 0 or 1     whether to show only one entry in the
  131                                results area at the top of the page,
  132                                or one for each answer rule.
  133                                (Default: 0)
  134 
  135     namedRules => 0 or 1       whether to use named rules or default
  136                                rule names.  Use named rules if you need
  137                                to intersperse other rules with the
  138                                ones for the MultiAnswer, in which case
  139                                you must use NAMED_ANS not ANS.
  140                                (Default: 0)
  141 
  142     checkTypes => 0 or 1       whether the types of the student and
  143                                professor's answers must match exactly
  144                                or just pass the usual type-match error
  145                                checking (in which case, you should check
  146                                the types before you use the data).
  147                                (Default: 1)
  148 
  149     allowBlankAnswers=>0 or 1  whether to remove the blank-check prefilter
  150                                from the answer checkers for the answer
  151                                checkers used for type checking the student's
  152                                answers.
  153                                (Default: 0)
  154 
  155     separator => string        the string to use between entries in the
  156                                results area when singleResult is set.
  157                                (Default: semicolon)
  158 
  159     tex_separator => string    same, but for the preview area.
  160                                (Default: semicolon followed by thinspace)
  161 
  162     format => string           an sprintf-style string used to format the
  163                                students answers for the results area
  164                                when singleResults is true.  If undefined,
  165                                the separator parameter (above) is used to
  166                                form the string.
  167                                (Default: undef)
  168 
  169     tex_format => string       an sprintf-style string used to format the
  170                                students answer previews when singleResults
  171                                mode is in effect.  If undefined, the
  172                                tex_separator (above) is used to form the
  173                                string.
  174                                (Default: undef)
  175 
  176 =cut
  177 
  178 my @ans_defaults = (
  179   checker => sub {0},
  180   showCoordinateHints => 0,
  181   showEndpointHints => 0,
  182   showEndTypeHints => 0,
  183 );
  184 
  185 sub new {
  186   my $self = shift; my $class = ref($self) || $self;
  187   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  188   my @data = @_; my @cmp;
  189   Value::Error("%s lists can't be empty",$class) if scalar(@data) == 0;
  190   foreach my $x (@data) {
  191     $x = Value::makeValue($x,context=>$context) unless Value::isValue($x);
  192     push(@cmp,$x->cmp(@ans_defaults));
  193   }
  194   bless {
  195     data => [@data], cmp => [@cmp], ans => [], isValue => 1,
  196     part => 0, singleResult => 0, namedRules => 0,
  197     checkTypes => 1, allowBlankAnswers => 0,
  198     tex_separator => $separator.'\,', separator => $separator.' ',
  199     tex_format => undef, format => undef,
  200     context => $context, id => $answerPrefix.($count++),
  201   }, $class;
  202 }
  203 
  204 #
  205 #  Creates an answer checker (or array of same) to be passed
  206 #  to ANS() or NAMED_ANS().  Any parameters are passed to
  207 #  the individual answer checkers.
  208 #
  209 sub cmp {
  210   my $self = shift; my %options = @_;
  211   foreach my $id ('checker','separator') {
  212     if (defined($options{$id})) {
  213       $self->{$id} = $options{$id};
  214       delete $options{$id};
  215     }
  216   }
  217   die "You must supply a checker subroutine" unless ref($self->{checker}) eq 'CODE';
  218   if ($self->{allowBlankAnswers}) {
  219     foreach my $cmp (@{$self->{cmp}}) {
  220       $cmp->install_pre_filter('erase');
  221       $cmp->install_pre_filter(sub {
  222   my $ans = shift;
  223   $ans->{student_ans} =~ s/^\s+//g;
  224   $ans->{student_ans} =~ s/\s+$//g;
  225   return $ans;
  226       });
  227     }
  228   }
  229   my @cmp = ();
  230   if ($self->{singleResult}) {
  231     push(@cmp,$self->ANS_NAME(0)) if $self->{namedRules};
  232     push(@cmp,$self->single_cmp(%options));
  233   } else {
  234     foreach my $i (0..$self->length-1) {
  235       push(@cmp,$self->ANS_NAME($i)) if $self->{namedRules};
  236       push(@cmp,$self->entry_cmp($i,%options));
  237     }
  238   }
  239   return @cmp;
  240 }
  241 
  242 ######################################################################
  243 
  244 #
  245 #  Get the answer checker used for when all the answers are treated
  246 #  as a single result.
  247 #
  248 sub single_cmp {
  249   my $self = shift; my @correct;
  250   foreach my $cmp (@{$self->{cmp}}) {push(@correct,$cmp->{rh_ans}{correct_ans})}
  251   my $ans = new AnswerEvaluator;
  252   $ans->ans_hash(
  253     correct_ans => join($self->{separator},@correct),
  254     type        => "MultiAnswer",
  255     @_,
  256   );
  257   $ans->install_evaluator(sub {my $ans = shift; (shift)->single_check($ans)},$self);
  258   $ans->install_pre_filter('erase'); # don't do blank check
  259   return $ans;
  260 }
  261 
  262 #
  263 #  Check the answers when they are treated as a single result.
  264 #
  265 #    First, call individual answer checkers to get any type-check errors
  266 #    Then perform the user's checker routine
  267 #    Finally collect the individual answers and errors and combine
  268 #      them for the single result.
  269 #
  270 sub single_check {
  271   my $self = shift; my $ans = shift; $ans->{_filter_name} = "MultiAnswer Single Check";
  272   my $inputs = $main::inputs_ref;
  273   $self->{ans}[0] = $self->{cmp}[0]->evaluate($ans->{student_ans});
  274   foreach my $i (1..$self->length-1)
  275     {$self->{ans}[$i] = $self->{cmp}[$i]->evaluate($inputs->{$self->ANS_NAME($i)})}
  276   my $score = 0; my (@errors,@student,@latex,@text);
  277   my $i = 0; my $nonblank = 0;
  278   if ($self->perform_check($ans)) {
  279     push(@errors,'<TR><TD STYLE="text-align:left" COLSPAN="2">'.$self->{ans}[0]{ans_message}.'</TD></TR>');
  280     $self->{ans}[0]{ans_message} = "";
  281   }
  282   foreach my $result (@{$self->{ans}}) {
  283     $i++; $nonblank |= ($result->{student_ans} =~ m/\S/);
  284     push(@latex,'{'.check_string($result->{preview_latex_string},'\_\_').'}');
  285     push(@text,check_string($result->{preview_text_string},'__'));
  286     push(@student,check_string($result->{student_ans},'__'));
  287     if ($result->{ans_message}) {
  288       push(@errors,'<TR VALIGN="TOP"><TD STYLE="text-align:right; border:0px" NOWRAP>' .
  289                    "<I>In answer $i</I>:&nbsp;</TD>".
  290                    '<TD STYLE="text-align:left; border:0px">'.$result->{ans_message}.'</TD></TR>');
  291     } else {$score += $result->{score}}
  292   }
  293   $ans->score($score/$self->length);
  294   $ans->{ans_message} = $ans->{error_message} = "";
  295   if (scalar(@errors)) {
  296     $ans->{ans_message} = $ans->{error_message} =
  297       '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">' .
  298        join('<TR><TD HEIGHT="4"></TD></TR>',@errors).
  299       '</TABLE>';
  300   }
  301   if ($nonblank) {
  302     $ans->{preview_latex_string} =
  303       (defined($self->{tex_format}) ? sprintf($self->{tex_format},@latex) : join($self->{tex_separator},@latex));
  304     $ans->{preview_text_string} =
  305       (defined($self->{format}) ? sprintf($self->{format},@text) : join($self->{separator},@text));
  306     $ans->{student_ans} =
  307       (defined($self->{format}) ? sprintf($self->{format},@student) : join($self->{separator},@student));
  308   }
  309   return $ans;
  310 }
  311 
  312 #
  313 #  Return a given string or a default if it is empty or not defined
  314 #
  315 sub check_string {
  316   my $s = shift;
  317   $s = shift unless defined($s) && $s =~ m/\S/;
  318   return $s;
  319 }
  320 
  321 ######################################################################
  322 
  323 #
  324 #  Answer checker to use for individual entries when singleResult
  325 #  is not in effect.
  326 #
  327 sub entry_cmp {
  328   my $self = shift; my $i = shift;
  329   my $ans = new AnswerEvaluator;
  330   $ans->ans_hash(
  331     correct_ans => $self->{cmp}[$i]{rh_ans}{correct_ans},
  332     part        => $i,
  333     type        => "MultiAnswer($i)",
  334     @_,
  335   );
  336   $ans->install_evaluator(sub {my $ans = shift; (shift)->entry_check($ans)},$self);
  337   $ans->install_pre_filter('erase'); # don't do blank check
  338   return $ans;
  339 }
  340 
  341 #
  342 #  Call the correct answser's checker to check for syntax and type errors.
  343 #  If this is the last one, perform the user's checker routine as well
  344 #  Return the individual answer (our answer hash is discarded).
  345 #
  346 sub entry_check {
  347   my $self = shift; my $ans = shift; $ans->{_filter_name} = "MultiAnswer Entry Check";
  348   my $i = $ans->{part};
  349   $self->{ans}[$i] = $self->{cmp}[$i]->evaluate($ans->{student_ans});
  350   $self->{ans}[$i]->score(0);
  351   $self->perform_check($ans) if ($i == $self->length - 1);
  352   return $self->{ans}[$i];
  353 }
  354 
  355 ######################################################################
  356 
  357 #
  358 #  Collect together the correct and student answers, and call the
  359 #  user's checker routine.
  360 #
  361 #  If any of the answers produced errors or the types don't match
  362 #    don't call the user's routine.
  363 #  Otherwise, call it, and if there was an error, report that.
  364 #  Set the individual scores based on the result from the user's routine.
  365 #
  366 sub perform_check {
  367   my $self = shift; my $rh_ans = shift;
  368   $self->context->clearError;
  369   my @correct; my @student;
  370   foreach my $ans (@{$self->{ans}}) {
  371     push(@correct,$ans->{correct_value});
  372     push(@student,$ans->{student_value});
  373     return if $ans->{ans_message} ne "" || !defined($ans->{student_value});
  374     return if $self->{checkTypes} && $ans->{student_value}->type ne $ans->{correct_value}->type &&
  375               !($self->{allowBlankAnswers} && $ans->{student_ans} !~ m/\S/) ;
  376   }
  377   my $inputs = $main::inputs_ref;
  378   $rh_ans->{isPreview} = $inputs->{previewAnswers} ||
  379                          ($inputs_{action} && $inputs->{action} =~ m/^Preview/);
  380   my @result = Value::cmp_compare([@correct],[@student],$self,$rh_ans);
  381   if (!@result && $self->context->{error}{flag}) {$self->cmp_error($self->{ans}[0]); return 1}
  382   my $result = (scalar(@result) > 1 ? [@result] : $result[0] || 0);
  383   if (ref($result) eq 'ARRAY') {
  384     die "Checker subroutine returned the wrong number of results"
  385       if (scalar(@{$result}) != $self->length);
  386     foreach my $i (0..$self->length-1) {$self->{ans}[$i]->score($result->[$i])}
  387   } elsif (Value::matchNumber($result)) {
  388     foreach my $ans (@{$self->{ans}}) {$ans->score($result)}
  389   } else {
  390     die "Checker subroutine should return a number or array of numbers ($result)";
  391   }
  392   return;
  393 }
  394 
  395 ######################################################################
  396 
  397 #
  398 #  The user's checker can call setMessage(n,message) to set the error message
  399 #  for the n-th answer blank.
  400 #
  401 sub setMessage {
  402   my $self = shift; my $i = (shift)-1; my $message = shift;
  403   $self->{ans}[$i]->{ans_message} = $self->{ans}[$i]->{error_message} = $message;
  404 }
  405 
  406 
  407 ######################################################################
  408 
  409 #
  410 #  Produce the name for a named answer blank
  411 #
  412 sub ANS_NAME {
  413   my $self = shift; my $i = shift;
  414   $self->{id}.'_'.$i;
  415 }
  416 
  417 #
  418 #  Record an answer-blank name (when using extensions)
  419 #
  420 sub NEW_NAME {
  421   my $self = shift;
  422   main::RECORD_FORM_LABEL(shift);
  423 }
  424 
  425 #
  426 #  Produce an answer rule for the next item in the list,
  427 #    taking care to use names or extensions as needed
  428 #    by the settings of the MultiAnswer.
  429 #
  430 sub ans_rule {
  431   my $self = shift; my $size = shift || 20;
  432   my $data = $self->{data}[$self->{part}];
  433   my $name = $self->ANS_NAME($self->{part}++);
  434   return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_)
  435     if ($self->{singleResult} && $self->{part} > 1);
  436   return $data->ans_rule($size,@_) unless $self->{namedRules};
  437   return $data->named_ans_rule($name,$size,@_);
  438 }
  439 
  440 #
  441 #  Do the same, but for answer arrays, which are generated by the
  442 #    Value objects automatically sized to suit their data.
  443 #    Reset the correct_ans once the array is made
  444 #
  445 sub ans_array {
  446   my $self = shift; my $size = shift || 5; my $HTML;
  447   my $data = $self->{data}[$self->{part}];
  448   my $name = $self->ANS_NAME($self->{part}++);
  449   if ($self->{singleResult} && $self->{part} > 1) {
  450     $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_);
  451   } elsif (!$self->{namedRules}) {
  452     $HTML = $data->ans_array($size,@_);
  453   } else {
  454     $HTML = $data->named_ans_array($name,$size,@_);
  455   }
  456   $self->{cmp}[$self->{part}-1] = $data->cmp(@ans_defaults);
  457   return $HTML;
  458 }
  459 
  460 ######################################################################
  461 
  462 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9