[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 5556 - (download) (as text) (annotate)
Thu Oct 4 16:40:49 2007 UTC (12 years, 4 months ago) by sh002i
File size: 17751 byte(s)
added standard copyright/license header

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK.pm,v 1.100 2007/08/13 22:59:53 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 =pod
  112 
  113  #
  114  #  Create a new MultiAnswer item from a list of items.
  115  #  The items are converted if Value items, if they aren't already.
  116  #  You can set the following fields of the resulting item:
  117  #
  118  #      checker => code            a subroutine to be called to check the
  119  #                                 student answers.  The routine is passed
  120  #                                 four parameters: a reference to the array
  121  #                                 or correct answers, a reference to the
  122  #                                 array of student answers, a reference to the
  123  #                                 MultiAnswer object itself, and a reference to
  124  #                                 the checker's answer hash.  The routine
  125  #                                 should return either a score or a reference
  126  #                                 to an array of scores (one for each answer).
  127  #
  128  #      singleResult => 0 or 1     whether to show only one entry in the
  129  #                                 results area at the top of the page,
  130  #                                 or one for each answer rule.
  131  #                                 (Default: 0)
  132  #
  133  #      namedRules => 0 or 1       whether to use named rules or default
  134  #                                 rule names.  Use named rules if you need
  135  #                                 to intersperse other rules with the
  136  #                                 ones for the MultiAnswer, in which case
  137  #                                 you must use NAMED_ANS not ANS.
  138  #                                 (Default: 0)
  139  #
  140  #      checkTypes => 0 or 1       whether the types of the student and
  141  #                                 professor's answers must match exactly
  142  #                                 or just pass the usual type-match error
  143  #                                 checking (in which case, you should check
  144  #                                 the types before you use the data).
  145  #                            (Default: 1)
  146  #
  147  #      allowBlankAnswers=>0 or 1  whether to remove the blank-check prefilter
  148  #                                 from the answer checkers for the answer
  149  #                                 checkers used for type checking the student's
  150  #                                 answers.
  151  #                                 (Default: 0)
  152  #
  153  #      separator => string        the string to use between entries in the
  154  #                                 results area when singleResult is set.
  155  #                                 (Default: semicolon)
  156  #
  157  #      tex_separator => string    same, but for the preview area.
  158  #                                 (Default: semicolon followed by thinspace)
  159  #
  160  #      format => string           an sprintf-style string used to format the
  161  #                                 students answers for the results area
  162  #                                 when singleResults is true.  If undefined,
  163  #                                 the separator parameter (above) is used to
  164  #                                 form the string.
  165  #                                 (Default: undef)
  166  #
  167  #      tex_format => string       an sprintf-style string used to format the
  168  #                                 students answer previews when singleResults
  169  #                                 mode is in effect.  If undefined, the
  170  #                                 tex_separator (above) is used to form the
  171  #                                 string.
  172  #                                 (Default: undef)
  173  #
  174 
  175 =cut
  176 
  177 my @ans_defaults = (
  178   checker => sub {0},
  179   showCoordinateHints => 0,
  180   showEndpointHints => 0,
  181   showEndTypeHints => 0,
  182 );
  183 
  184 sub new {
  185   my $self = shift; my $class = ref($self) || $self;
  186   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  187   my @data = @_; my @cmp;
  188   Value::Error("%s lists can't be empty",$class) if scalar(@data) == 0;
  189   foreach my $x (@data) {
  190     $x = Value::makeValue($x,context=>$context) unless Value::isValue($x);
  191     push(@cmp,$x->cmp(@ans_defaults));
  192   }
  193   bless {
  194     data => [@data], cmp => [@cmp], ans => [], isValue => 1,
  195     part => 0, singleResult => 0, namedRules => 0,
  196     checkTypes => 1, allowBlankAnswers => 0,
  197     tex_separator => $separator.'\,', separator => $separator.' ',
  198     tex_format => undef, format => undef,
  199     context => $context, id => $answerPrefix.($count++),
  200   }, $class;
  201 }
  202 
  203 #
  204 #  Creates an answer checker (or array of same) to be passed
  205 #  to ANS() or NAMED_ANS().  Any parameters are passed to
  206 #  the individual answer checkers.
  207 #
  208 sub cmp {
  209   my $self = shift; my %options = @_;
  210   foreach my $id ('checker','separator') {
  211     if (defined($options{$id})) {
  212       $self->{$id} = $options{$id};
  213       delete $options{$id};
  214     }
  215   }
  216   die "You must supply a checker subroutine" unless ref($self->{checker}) eq 'CODE';
  217   if ($self->{allowBlankAnswers}) {
  218     foreach my $cmp (@{$self->{cmp}}) {
  219       $cmp->install_pre_filter('erase');
  220       $cmp->install_pre_filter(sub {
  221   my $ans = shift;
  222   $ans->{student_ans} =~ s/^\s+//g;
  223   $ans->{student_ans} =~ s/\s+$//g;
  224   return $ans;
  225       });
  226     }
  227   }
  228   my @cmp = ();
  229   if ($self->{singleResult}) {
  230     push(@cmp,$self->ANS_NAME(0)) if $self->{namedRules};
  231     push(@cmp,$self->single_cmp(%options));
  232   } else {
  233     foreach my $i (0..$self->length-1) {
  234       push(@cmp,$self->ANS_NAME($i)) if $self->{namedRules};
  235       push(@cmp,$self->entry_cmp($i,%options));
  236     }
  237   }
  238   return @cmp;
  239 }
  240 
  241 ######################################################################
  242 
  243 #
  244 #  Get the answer checker used for when all the answers are treated
  245 #  as a single result.
  246 #
  247 sub single_cmp {
  248   my $self = shift; my @correct;
  249   foreach my $cmp (@{$self->{cmp}}) {push(@correct,$cmp->{rh_ans}{correct_ans})}
  250   my $ans = new AnswerEvaluator;
  251   $ans->ans_hash(
  252     correct_ans => join($self->{separator},@correct),
  253     type        => "MultiAnswer",
  254     @_,
  255   );
  256   $ans->install_evaluator(sub {my $ans = shift; (shift)->single_check($ans)},$self);
  257   $ans->install_pre_filter('erase'); # don't do blank check
  258   return $ans;
  259 }
  260 
  261 #
  262 #  Check the answers when they are treated as a single result.
  263 #
  264 #    First, call individual answer checkers to get any type-check errors
  265 #    Then perform the user's checker routine
  266 #    Finally collect the individual answers and errors and combine
  267 #      them for the single result.
  268 #
  269 sub single_check {
  270   my $self = shift; my $ans = shift; $ans->{_filter_name} = "MultiAnswer Single Check";
  271   my $inputs = $main::inputs_ref;
  272   $self->{ans}[0] = $self->{cmp}[0]->evaluate($ans->{student_ans});
  273   foreach my $i (1..$self->length-1)
  274     {$self->{ans}[$i] = $self->{cmp}[$i]->evaluate($inputs->{$self->ANS_NAME($i)})}
  275   my $score = 0; my (@errors,@student,@latex,@text);
  276   my $i = 0; my $nonblank = 0;
  277   if ($self->perform_check($ans)) {
  278     push(@errors,'<TR><TD STYLE="text-align:left" COLSPAN="2">'.$self->{ans}[0]{ans_message}.'</TD></TR>');
  279     $self->{ans}[0]{ans_message} = "";
  280   }
  281   foreach my $result (@{$self->{ans}}) {
  282     $i++; $nonblank |= ($result->{student_ans} =~ m/\S/);
  283     push(@latex,'{'.check_string($result->{preview_latex_string},'\_\_').'}');
  284     push(@text,check_string($result->{preview_text_string},'__'));
  285     push(@student,check_string($result->{student_ans},'__'));
  286     if ($result->{ans_message}) {
  287       push(@errors,'<TR VALIGN="TOP"><TD STYLE="text-align:right; border:0px" NOWRAP>' .
  288                    "<I>In answer $i</I>:&nbsp;</TD>".
  289                    '<TD STYLE="text-align:left; border:0px">'.$result->{ans_message}.'</TD></TR>');
  290     } else {$score += $result->{score}}
  291   }
  292   $ans->score($score/$self->length);
  293   $ans->{ans_message} = $ans->{error_message} = "";
  294   if (scalar(@errors)) {
  295     $ans->{ans_message} = $ans->{error_message} =
  296       '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">' .
  297        join('<TR><TD HEIGHT="4"></TD></TR>',@errors).
  298       '</TABLE>';
  299   }
  300   if ($nonblank) {
  301     $ans->{preview_latex_string} =
  302       (defined($self->{tex_format}) ? sprintf($self->{tex_format},@latex) : join($self->{tex_separator},@latex));
  303     $ans->{preview_text_string} =
  304       (defined($self->{format}) ? sprintf($self->{format},@text) : join($self->{separator},@text));
  305     $ans->{student_ans} =
  306       (defined($self->{format}) ? sprintf($self->{format},@student) : join($self->{separator},@student));
  307   }
  308   return $ans;
  309 }
  310 
  311 #
  312 #  Return a given string or a default if it is empty or not defined
  313 #
  314 sub check_string {
  315   my $s = shift;
  316   $s = shift unless defined($s) && $s =~ m/\S/;
  317   return $s;
  318 }
  319 
  320 ######################################################################
  321 
  322 #
  323 #  Answer checker to use for individual entries when singleResult
  324 #  is not in effect.
  325 #
  326 sub entry_cmp {
  327   my $self = shift; my $i = shift;
  328   my $ans = new AnswerEvaluator;
  329   $ans->ans_hash(
  330     correct_ans => $self->{cmp}[$i]{rh_ans}{correct_ans},
  331     part        => $i,
  332     type        => "MultiAnswer($i)",
  333     @_,
  334   );
  335   $ans->install_evaluator(sub {my $ans = shift; (shift)->entry_check($ans)},$self);
  336   $ans->install_pre_filter('erase'); # don't do blank check
  337   return $ans;
  338 }
  339 
  340 #
  341 #  Call the correct answser's checker to check for syntax and type errors.
  342 #  If this is the last one, perform the user's checker routine as well
  343 #  Return the individual answer (our answer hash is discarded).
  344 #
  345 sub entry_check {
  346   my $self = shift; my $ans = shift; $ans->{_filter_name} = "MultiAnswer Entry Check";
  347   my $i = $ans->{part};
  348   $self->{ans}[$i] = $self->{cmp}[$i]->evaluate($ans->{student_ans});
  349   $self->{ans}[$i]->score(0);
  350   $self->perform_check($ans) if ($i == $self->length - 1);
  351   return $self->{ans}[$i];
  352 }
  353 
  354 ######################################################################
  355 
  356 #
  357 #  Collect together the correct and student answers, and call the
  358 #  user's checker routine.
  359 #
  360 #  If any of the answers produced errors or the types don't match
  361 #    don't call the user's routine.
  362 #  Otherwise, call it, and if there was an error, report that.
  363 #  Set the individual scores based on the result from the user's routine.
  364 #
  365 sub perform_check {
  366   my $self = shift; my $rh_ans = shift;
  367   $self->context->clearError;
  368   my @correct; my @student;
  369   foreach my $ans (@{$self->{ans}}) {
  370     push(@correct,$ans->{correct_value});
  371     push(@student,$ans->{student_value});
  372     return if $ans->{ans_message} ne "" || !defined($ans->{student_value});
  373     return if $self->{checkTypes} && $ans->{student_value}->type ne $ans->{correct_value}->type &&
  374               !($self->{allowBlankAnswers} && $ans->{student_ans} !~ m/\S/) ;
  375   }
  376   my $inputs = $main::inputs_ref;
  377   $rh_ans->{isPreview} = $inputs->{previewAnswers} ||
  378                          ($inputs_{action} && $inputs->{action} =~ m/^Preview/);
  379   my @result = Value::cmp_compare([@correct],[@student],$self,$rh_ans);
  380   if (!@result && $self->context->{error}{flag}) {$self->cmp_error($self->{ans}[0]); return 1}
  381   my $result = (scalar(@result) > 1 ? [@result] : $result[0] || 0);
  382   if (ref($result) eq 'ARRAY') {
  383     die "Checker subroutine returned the wrong number of results"
  384       if (scalar(@{$result}) != $self->length);
  385     foreach my $i (0..$self->length-1) {$self->{ans}[$i]->score($result->[$i])}
  386   } elsif (Value::matchNumber($result)) {
  387     foreach my $ans (@{$self->{ans}}) {$ans->score($result)}
  388   } else {
  389     die "Checker subroutine should return a number or array of numbers ($result)";
  390   }
  391   return;
  392 }
  393 
  394 ######################################################################
  395 
  396 #
  397 #  The user's checker can call setMessage(n,message) to set the error message
  398 #  for the n-th answer blank.
  399 #
  400 sub setMessage {
  401   my $self = shift; my $i = (shift)-1; my $message = shift;
  402   $self->{ans}[$i]->{ans_message} = $self->{ans}[$i]->{error_message} = $message;
  403 }
  404 
  405 
  406 ######################################################################
  407 
  408 #
  409 #  Produce the name for a named answer blank
  410 #
  411 sub ANS_NAME {
  412   my $self = shift; my $i = shift;
  413   $self->{id}.'_'.$i;
  414 }
  415 
  416 #
  417 #  Record an answer-blank name (when using extensions)
  418 #
  419 sub NEW_NAME {
  420   my $self = shift;
  421   main::RECORD_FORM_LABEL(shift);
  422 }
  423 
  424 #
  425 #  Produce an answer rule for the next item in the list,
  426 #    taking care to use names or extensions as needed
  427 #    by the settings of the MultiAnswer.
  428 #
  429 sub ans_rule {
  430   my $self = shift; my $size = shift || 20;
  431   my $data = $self->{data}[$self->{part}];
  432   my $name = $self->ANS_NAME($self->{part}++);
  433   return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_)
  434     if ($self->{singleResult} && $self->{part} > 1);
  435   return $data->ans_rule($size,@_) unless $self->{namedRules};
  436   return $data->named_ans_rule($name,$size,@_);
  437 }
  438 
  439 #
  440 #  Do the same, but for answer arrays, which are generated by the
  441 #    Value objects automatically sized to suit their data.
  442 #    Reset the correct_ans once the array is made
  443 #
  444 sub ans_array {
  445   my $self = shift; my $size = shift || 5; my $HTML;
  446   my $data = $self->{data}[$self->{part}];
  447   my $name = $self->ANS_NAME($self->{part}++);
  448   if ($self->{singleResult} && $self->{part} > 1) {
  449     $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_);
  450   } elsif (!$self->{namedRules}) {
  451     $HTML = $data->ans_array($size,@_);
  452   } else {
  453     $HTML = $data->named_ans_array($name,$size,@_);
  454   }
  455   $self->{cmp}[$self->{part}-1] = $data->cmp(@ans_defaults);
  456   return $HTML;
  457 }
  458 
  459 ######################################################################
  460 
  461 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9