[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 5074 - (download) (as text) (annotate)
Thu Jun 28 23:44:45 2007 UTC (12 years, 5 months ago) by dpvc
File size: 15322 byte(s)
Updated to use new context methods.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9