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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3654 - (download) (as text) (annotate)
Sat Sep 24 02:38:19 2005 UTC (14 years, 5 months ago) by dpvc
File size: 15141 byte(s)
Updated to be able to handle empty anwswer blanks.  There is a new
parameter for the MultiPart object (allowBlankAnswers) that controls
whether the checker routine will be called even when there are blank
entries (normally, the checker is not called unless all the entries
are non-blank).  Use

  $mp = MultiPart(1,2)->with(checkTypes=>0,allowBlankAnswers=>0);

to have the checker routine called when answers are left blank.

You can now also include blank answers in the list itself:

  $mp = MultiPart(1,2,"");

(there is no need to include allowBlankAnswers in this case, because
the blank string will take care of itself.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9