[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 5373 - (download) (as text) (annotate)
Sun Aug 19 02:01:57 2007 UTC (12 years, 3 months ago) by dpvc
File size: 17259 byte(s)
Normalized comments and headers to that they will format their POD
documentation properly.  (I know that the POD processing was supposed
to strip off the initial #, but that doesn't seem to happen, so I've
added a space throughout.)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9