[system] / trunk / pg / lib / AnswerHash.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/AnswerHash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1117 - (download) (as text) (annotate)
Wed Jun 11 04:00:37 2003 UTC (16 years, 8 months ago) by gage
File size: 24109 byte(s)
Added a feature to correspond to a change made in process_answers in Translator.pm.

 Each answer
evaluator is given the
answer AND the answer label (e.g. AnSWer1) of the answer.  The label
is placed in the answer hash at $hash{ans_label} for use by filters
that need to know the label of the answer they are evaluating.

--Mike

    1 ##########################################################################
    2 ## AnswerHash Package
    3 ##
    4 ## Provides a data structure for answer hashes. Currently just a wrapper
    5 ## for the hash, but that might change
    6 ####################################################################
    7 # Copyright @ 1995-2002 WeBWorK Team
    8 # All Rights Reserved
    9 ####################################################################
   10 #$Id$
   11 
   12 =head1 NAME
   13 
   14   AnswerHash.pm -- located in the courseScripts directory
   15 
   16   This file contains the packages/classes:
   17   AnswerHash   and AnswerEvaluator
   18 
   19 =head1 SYNPOSIS
   20 
   21   AnswerHash  -- this class stores information related to the student's
   22            answer.  It is little more than a standard perl hash with
   23            a special name, butit does have some access and
   24            manipulation methods.  More of these may be added as it
   25            becomes necessary.
   26 
   27   Useage:    $rh_ans = new AnswerHash;
   28 
   29   AnswerEvaluator -- this class organizes the construction of
   30          answer evaluator subroutines which check the
   31          student's answer.  By plugging filters into the
   32          answer evaluator class you can customize the way the
   33          student's answer is normalized and checked.  Our hope
   34          is that with properly designed filters, it will be
   35          possible to reuse the filters in different
   36          combinations to obtain different answer evaluators,
   37          thus greatly reducing the programming and maintenance
   38          required for constructing answer evaluators.
   39 
   40   Useage:   $ans_eval  = new AnswerEvaluator;
   41 
   42 =cut
   43 
   44 =head1 DESCRIPTION : AnswerHash
   45 
   46 The answer hash class is guaranteed to contain the following instance variables:
   47 
   48   score     =>  $correctQ,
   49   correct_ans   =>  $originalCorrEqn,
   50   student_ans   =>  $modified_student_ans
   51   original_student_ans  =>  $original_student_answer,
   52   ans_message   =>  $PGanswerMessage,
   53   type      =>  'typeString',
   54   preview_text_string =>  $preview_text_string,
   55   preview_latex_string  =>  $preview_latex_string
   56 
   57 
   58   $ans_hash->{score}    --  a number between 0 and 1 indicating
   59             whether the answer is correct. Fractions
   60             allow the implementation of partial
   61             credit for incorrect answers.
   62 
   63   $ans_hash->{correct_ans}    --  The correct answer, as supplied by the
   64             instructor and then formatted. This can
   65             be viewed by the student after the answer date.
   66 
   67   $ans_hash->{student_ans}    --  This is the student answer, after reformatting;
   68             for example the answer might be forced
   69             to capital letters for comparison with
   70             the instructors answer. For a numerical
   71             answer, it gives the evaluated answer.
   72             This is displayed in the section reporting
   73             the results of checking the student answers.
   74 
   75   $ans_hash->{original_student_ans} --  This is the original student answer.
   76              This is displayed on the preview page and may be used for
   77              sticky answers.
   78 
   79   $ans_hash->{ans_message}    --  Any error message, or hint provided by
   80             the answer evaluator.
   81             This is also displayed in the section reporting
   82             the results of checking the student answers.
   83 
   84   $ans_hash->{type}     --  A string indicating the type of answer evaluator.
   85             This helps in preprocessing the student answer for errors.
   86             Some examples:
   87               'number_with_units'
   88               'function'
   89               'frac_number'
   90               'arith_number'
   91 
   92 
   93   $ans_hash->{preview_text_string}  --
   94             This typically shows how the student answer was parsed. It is
   95             displayed on the preview page. For a student answer of 2sin(3x)
   96             this would be 2*sin(3*x). For string answers it is typically the
   97             same as $ans_hash{student_ans}.
   98 
   99 
  100   $ans_hash->{preview_latex_string} --
  101             THIS IS OPTIONAL. This is latex version of the student answer
  102             which is used to show a typeset view on the answer on the preview
  103             page. For a student answer of 2/3, this would be \frac{2}{3}.
  104 
  105             'ans_message'     =>  '', # null string
  106 
  107             'preview_text_string' =>  undef,
  108             'preview_latex_string'  =>  undef,
  109             'error_flag'      =>  undef,
  110             'error_message'       =>  '',
  111 
  112 
  113 =head3 AnswerHash Methods:
  114 
  115 =cut
  116 
  117 BEGIN {
  118   be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
  119 
  120 }
  121 
  122 package AnswerHash;
  123 # initialization fields
  124 my %fields = (    'score'         =>  undef,
  125           'correct_ans'     =>  undef,
  126           'student_ans'     =>  undef,
  127           'ans_message'     =>  undef,
  128           'type'          =>  undef,
  129           'preview_text_string' =>  undef,
  130           'preview_latex_string'  =>  undef,
  131           'original_student_ans'  =>  undef
  132       );
  133 
  134 ## Initializing constructor
  135 =head4 new
  136 
  137   Useage    $rh_anshash = new AnswerHash;
  138 
  139   returns an object of type AnswerHash.
  140 
  141 =cut
  142 
  143 sub new {
  144   my $class = shift @_;
  145 
  146   my $self  = { 'score'         =>  0,
  147           'correct_ans'     =>  'No correct answer specified',
  148           'student_ans'     =>  undef,
  149           'ans_message'     =>  '',
  150           'type'          =>  'Undefined answer evaluator type',
  151           'preview_text_string' =>  undef,
  152           'preview_latex_string'  =>  undef,
  153           'original_student_ans'  =>  undef,
  154           'error_flag'      =>  undef,
  155           'error_message'       =>  '',
  156 
  157   };  # return a reference to a hash.
  158 
  159   bless $self, $class;
  160   $self -> setKeys(@_);
  161 
  162   return $self;
  163 }
  164 
  165 ## IN: a hash
  166 ## Checks to make sure that the keys are valid,
  167 ## then sets their value
  168 
  169 =head4  setKeys
  170 
  171       $rh_ans->setKeys(score=>1, student_answer => "yes");
  172       Sets standard elements in the AnswerHash (the ones defined
  173       above). Will give error if one attempts to set non-standard keys.
  174 
  175       To set a non-standard element in a hash use
  176 
  177       $rh_ans->{non-standard-key} = newValue;
  178 
  179       There are no safety checks when using this method.
  180 
  181 =cut
  182 
  183 
  184 sub setKeys {
  185     my $self = shift;
  186   my %inits = @_;
  187   foreach my $item (keys %inits) {
  188     if ( exists $fields{$item} ) {
  189       $self -> {$item} = $inits{$item};
  190     }
  191     else {
  192       warn "AnswerHash cannot automatically initialize an item named $item";
  193     }
  194   }
  195 }
  196 
  197 # access methods
  198 
  199 =head4 data
  200 
  201   Useage:     $rh_ans->data('foo');               set $rh_ans->{student_ans} = 'foo';
  202               $student_input = $rh_ans->data();   retrieve value of $rh_ans->{student_ans}
  203 
  204   synonym for input
  205 
  206 =head4  input
  207 
  208   Useage:     $rh_ans->input('foo')    sets $rh_ans->{student_ans} = 'foo';
  209         $student_input = $rh_ans->input();
  210 
  211   synonym for data
  212 
  213 =cut
  214 
  215 sub data {    #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo'
  216   my $self = shift;
  217   $self->input(@_);
  218 }
  219 
  220 sub input {     #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo'
  221   my $self = shift;
  222     my $input = shift;
  223     $self->{student_ans} = $input if defined($input);
  224   $self->{student_ans}
  225 }
  226 
  227 =head4  input
  228 
  229   Useage:     $rh_ans->score(1)
  230         $score = $rh_ans->score();
  231 
  232   Retrieve or set $rh_ans->{score}, the student's score on the problem.
  233 
  234 =cut
  235 
  236 sub score {
  237   my $self = shift;
  238     my $score = shift;
  239     $self->{score} = $score if defined($score);
  240   $self->{score}
  241 }
  242 
  243 # error methods
  244 
  245 =head4 throw_error
  246 
  247   Useage: $rh_ans->throw_error("FLAG", "message");
  248 
  249   FLAG is a distinctive word that describes the type of error.
  250   Examples are EVAL for an evaluation error or "SYNTAX" for a syntax error.
  251   The entry $rh_ans->{error_flag} is set to "FLAG".
  252 
  253   The catch_error and clear_error methods use
  254   this entry.
  255 
  256   message is a descriptive message for the end user, defining what error occured.
  257 
  258 =head4 catch_error
  259 
  260   Useage: $rh_ans->catch_error("FLAG2");
  261 
  262   Returns true (1) if  $rh_ans->{error_flag} equals "FLAG2", otherwise it returns
  263   false (empty string).
  264 
  265 
  266 
  267 =head4 clear_error
  268 
  269   Useage:  $rh_ans->clear_error("FLAG2");
  270 
  271   If $rh_ans->{error_flag} equals "FLAG2" then the {error_flag} entry is set to
  272   the empty string as is the entry {error_message}
  273 
  274 =head4 error_flag
  275 
  276 =head4 error_message
  277 
  278   Useage:   $flag = $rh_ans -> error_flag();
  279 
  280         $message = $rh_ans -> error_message();
  281 
  282   Retrieve or set the {error_flag} and {error_message} entries.
  283 
  284   Use catch_error and throw_error where possible.
  285 
  286 =cut
  287 
  288 
  289 
  290 sub throw_error {
  291   my $self = shift;
  292     my $flag = shift;
  293     my $message = shift;
  294     $self->{error_message} .= " $message " if defined($message);
  295     $self->{error_flag} = $flag if defined($flag);
  296   $self->{error_flag}
  297 }
  298 sub catch_error {
  299   my $self = shift;
  300     my $flag = shift;
  301     return('')  unless defined($self->{error_flag});
  302     return $self->{error_flag} unless $flag;    # empty input catches all errors.
  303     return $self->{error_flag} if $self->{error_flag} eq $flag;
  304   return '';   # nothing to catch
  305 }
  306 sub clear_error {
  307   my $self = shift;
  308   my $flag = shift;
  309   if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag})  and $flag eq $self->{error_flag}) {
  310     $self->{error_flag} = undef;
  311     $self->{error_message} = undef;
  312   }
  313   $self;
  314 }
  315 sub error_flag {
  316   my $self = shift;
  317     my $flag = shift;
  318     $self->{error_flag} = $flag if defined($flag);
  319   $self->{error_flag}
  320 }
  321 sub error_message {
  322   my $self = shift;
  323     my $message = shift;
  324     $self->{error_message} = $message if defined($message);
  325   $self->{error_message}
  326 }
  327 
  328 # error print out method
  329 
  330 =head4 pretty_print
  331 
  332 
  333   Useage:     $rh_ans -> pretty_print();
  334 
  335 
  336   Returns a string containing a representation of the AnswerHash as an HTML table.
  337 
  338 =cut
  339 
  340 
  341 sub pretty_print {
  342     my $r_input = shift;
  343     my $out = '';
  344     if ( not ref($r_input) ) {
  345       $out = $r_input;    # not a reference
  346     } elsif (ref($r_input) =~/hash/i) {
  347       local($^W) = 0;
  348     $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
  349     foreach my $key (sort keys %$r_input ) {
  350       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>";
  351     }
  352     $out .="</table>";
  353   } elsif (ref($r_input) eq 'ARRAY' ) {
  354     my @array = @$r_input;
  355     $out .= "( " ;
  356     while (@array) {
  357       $out .= pretty_print(shift @array) . " , ";
  358     }
  359     $out .= " )";
  360   } elsif (ref($r_input) eq 'CODE') {
  361     $out = "$r_input";
  362   } else {
  363     $out = $r_input;
  364   }
  365     $out;
  366 }
  367 
  368 # action methods
  369 
  370 =head4 OR
  371 
  372   Useage:    $rh_ans->OR($rh_ans2);
  373 
  374   Returns a new AnswerHash whose score is the maximum of the scores in $rh_ans and $rh_ans2.
  375   The correct answers for the two hashes are combined with "OR".
  376   The types are concatenated with "OR" as well.
  377   Currently nothing is done with the error flags and messages.
  378 
  379 
  380 
  381 =head4 AND
  382 
  383 
  384   Useage:    $rh_ans->AND($rh_ans2);
  385 
  386   Returns a new AnswerHash whose score is the minimum of the scores in $rh_ans and $rh_ans2.
  387   The correct answers for the two hashes are combined with "AND".
  388   The types are concatenated with "AND" as well.
  389    Currently nothing is done with the error flags and messages.
  390 
  391 
  392 
  393 
  394 =cut
  395 
  396 
  397 
  398 sub OR {
  399   my $self = shift;
  400 
  401   my $rh_ans2 = shift;
  402   my %options = @_;
  403   return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash';
  404 
  405   my $out_hash = new AnswerHash;
  406   # score is the maximum of the two scores
  407   $out_hash->{score} = ( $self->{score}  <  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  408   $out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  409   $out_hash->{student_ans} = $self->{student_ans};
  410   $out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} );
  411   $out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  412   $out_hash->{original_student_ans} = $self->{original_student_ans};
  413   $out_hash;
  414 }
  415 
  416 sub AND {
  417   my $self = shift;
  418   my $rh_ans2 = shift;
  419   my %options = @_;
  420   my $out_hash = new AnswerHash;
  421   # score is the minimum of the two scores
  422   $out_hash->{score} = ( $self->{score}  >  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  423   $out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  424   $out_hash->{student_ans} = $self->{student_ans};
  425   $out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} );
  426   $out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  427   $out_hash->{original_student_ans} = $self->{original_student_ans};
  428   $out_hash;
  429 }
  430 
  431 
  432 =head1 Description:  AnswerEvaluator
  433 
  434 
  435 
  436 
  437 =cut
  438 
  439 
  440 
  441 package AnswerEvaluator;
  442 
  443 
  444 =head3 AnswerEvaluator Methods
  445 
  446 
  447 
  448 
  449 
  450 
  451 
  452 =cut
  453 
  454 
  455 =head4 new
  456 
  457 
  458 =cut
  459 
  460 
  461 sub new {
  462   my $class = shift @_;
  463 
  464   my $self  = { pre_filters   =>  [ [\&blank_prefilter] ],
  465           evaluators    =>  [],
  466           post_filters  =>  [ [\&blank_postfilter] ],
  467           debug     =>  0,
  468           rh_ans    =>  new AnswerHash,
  469 
  470   };
  471 
  472   bless $self, $class;
  473   $self->rh_ans(@_);    #initialize answer hash
  474   return $self;
  475 }
  476 
  477 # dereference_array_ans pretty prints an answer which is stored as an anonymous array.
  478 sub dereference_array_ans {
  479   my $self = shift;
  480   my $rh_ans = shift;
  481   if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY'  ) {
  482     $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) ";
  483   }
  484   $rh_ans;
  485 }
  486 
  487 sub get_student_answer {
  488   my $self    = shift;
  489   my $input   = shift;
  490   my %answer_options             = @_;
  491   $input = '' unless defined($input);
  492   if (ref($input) =~/AnswerHash/) {
  493     # in this case nothing needs to be done, since the student's answer is already in an answerhash.
  494     # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator.
  495   } elsif ($input =~ /\0/ ) {  # this case may occur with older versions of CGI??
  496       my @input = split(/\0/,$input);
  497       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  498     $input = \@input;
  499     $self-> {rh_ans} -> {student_ans} = $input;
  500   } elsif (ref($input) eq 'ARRAY' ) {  # sometimes the answer may already be decoded into an array.
  501       my @input = @$input;
  502       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  503     $input = \@input;
  504     $self-> {rh_ans} -> {student_ans} = $input;
  505   } else {
  506 
  507     $self-> {rh_ans} -> {original_student_ans} = $input;
  508     $self-> {rh_ans} -> {student_ans} = $input;
  509   }
  510   $self->{rh_ans}->{ans_label}   = $answer_options{ans_label} if defined($answer_options{ans_label});
  511 
  512   $input;
  513 }
  514 
  515 =head4  evaluate
  516 
  517 
  518 
  519 
  520 =cut
  521 
  522 sub evaluate {
  523   my $self    =   shift;
  524   $self->get_student_answer(@_);
  525   $self->{rh_ans}->{error_flag}=undef;  #reset the error flags in case
  526   $self->{rh_ans}->{done}=undef;        #the answer evaluator is called twice
  527   my $rh_ans    =   $self ->{rh_ans};
  528     warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0;
  529   my @prefilters  = @{$self -> {pre_filters}};
  530   my $count = -1;  # the blank filter is counted as filter 0
  531   foreach my $i (@prefilters) {
  532       last if defined( $self->{rh_ans}->{error_flag} );
  533       my @array = @$i;
  534       my $filter = shift(@array);      # the array now contains the options for the filter
  535       my %options = @array;
  536       if (defined($self->{debug}) and $self->{debug}>0) {
  537 
  538         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  539         warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print();
  540       }
  541       $rh_ans   = &$filter($rh_ans,@array);
  542       warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n"
  543         if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  544       $rh_ans->{_filter_name} = undef;
  545   }
  546   my @evaluators = @{$self -> {evaluators} };
  547   $count = 0;
  548   foreach my $i ( @evaluators )   {
  549       last if defined($self->{rh_ans}->{error_flag});
  550     my @array = @$i;
  551       my $evaluator = shift(@array);   # the array now contains the options for the filter
  552       my %options = @array;
  553       if (defined($self->{debug}) and $self->{debug}>0) {
  554         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  555         warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print();
  556       }
  557     $rh_ans   = &$evaluator($rh_ans,@array);
  558     warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  559     $rh_ans->{_filter_name} = undef;
  560   }
  561   my @post_filters = @{$self -> {post_filters} };
  562   $count = -1;  # blank filter catcher is filter 0
  563   foreach my $i ( @post_filters ) {
  564       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  565     my @array = @$i;
  566 
  567       my $filter = shift(@array);      # the array now contains the options for the filter
  568       my %options = @array;
  569       if (defined($self->{debug}) and $self->{debug}>0) {
  570         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  571         warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n";
  572       }
  573 
  574     $rh_ans   = &$filter($rh_ans,@array);
  575     warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  576     $rh_ans->{_filter_name} = undef;
  577   }
  578   $rh_ans = $self->dereference_array_ans($rh_ans);
  579   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  580   warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  581   $self ->{rh_ans} = $rh_ans;
  582   $rh_ans;
  583 }
  584 # This next subroutine is for checking the instructor's answer and is not yet in use.
  585 sub correct_answer_evaluate {
  586   my $self    =   shift;
  587   $self-> {rh_ans} -> {correct_ans} = shift @_;
  588   my $rh_ans    =   $self ->{rh_ans};
  589   my @prefilters  = @{$self -> {correct_answer_pre_filters}};
  590   my $count = -1;  # the blank filter is counted as filter 0
  591   foreach my $i (@prefilters) {
  592       last if defined( $self->{rh_ans}->{error_flag} );
  593       my @array = @$i;
  594       my $filter = shift(@array);      # the array now contains the options for the filter
  595       warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  596     $rh_ans   = &$filter($rh_ans,@array);
  597     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  598   }
  599   my @evaluators = @{$self -> {correct_answer_evaluators} };
  600   $count = 0;
  601   foreach my $i ( @evaluators )   {
  602       last if defined($self->{rh_ans}->{error_flag});
  603     my @array = @$i;
  604       my $evaluator = shift(@array);   # the array now contains the options for the filter
  605       warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  606     $rh_ans   = &$evaluator($rh_ans,@array);
  607   }
  608   my @post_filters = @{$self -> {correct_answer_post_filters} };
  609   $count = -1;  # blank filter catcher is filter 0
  610   foreach my $i ( @post_filters ) {
  611       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  612     my @array = @$i;
  613       my $filter = shift(@array);      # the array now contains the options for the filter
  614       warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  615     $rh_ans   = &$filter($rh_ans,@array);
  616     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  617   }
  618   $rh_ans = $self->dereference_array_ans($rh_ans);
  619   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  620   warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  621   $self ->{rh_ans} = $rh_ans;
  622   $rh_ans;
  623 }
  624 
  625 
  626 =head4 install_pre_filter
  627 
  628 =head4 install_evaluator
  629 
  630 
  631 =head4 install_post_filter
  632 
  633 
  634 =head4
  635 
  636 
  637 
  638 =cut
  639 
  640 
  641 sub install_pre_filter {
  642   my $self =  shift;
  643   if (@_ == 0) {
  644     # do nothing if input is empty
  645   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  646     $self->{pre_filters} = [];
  647   } else {
  648     push(@{$self->{pre_filters}},[ @_ ]) if @_;  #install pre_filter and it's options
  649   }
  650   @{$self->{pre_filters}};  # return array of all pre_filters
  651 }
  652 
  653 
  654 
  655 
  656 
  657 sub install_evaluator {
  658   my $self =  shift;
  659   if (@_ == 0) {
  660     # do nothing if input is empty
  661   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  662     $self->{evaluators} = [];
  663   } else {
  664     push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  665   }
  666   @{$self->{'evaluators'}};  # return array of all evaluators
  667 }
  668 
  669 
  670 sub install_post_filter {
  671   my $self =  shift;
  672   if (@_ == 0) {
  673     # do nothing if input is empty
  674   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  675     $self->{post_filters} = [];
  676   } else {
  677     push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  678   }
  679   @{$self->{post_filters}};  # return array of all post_filters
  680 }
  681 
  682 ## filters for checking the correctAnswer
  683 sub install_correct_answer_pre_filter {
  684   my $self =  shift;
  685   if (@_ == 0) {
  686     # do nothing if input is empty
  687   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  688     $self->{correct_answer_pre_filters} = [];
  689   } else {
  690     push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_;  #install correct_answer_pre_filter and it's options
  691   }
  692   @{$self->{correct_answer_pre_filters}};  # return array of all correct_answer_pre_filters
  693 }
  694 
  695 sub install_correct_answer_evaluator {
  696   my $self =  shift;
  697   if (@_ == 0) {
  698     # do nothing if input is empty
  699   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  700     $self->{correct_answer_evaluators} = [];
  701   } else {
  702     push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  703   }
  704   @{$self->{correct_answer_evaluators}};  # return array of all evaluators
  705 }
  706 
  707 sub install_correct_answer_post_filter {
  708   my $self =  shift;
  709   if (@_ == 0) {
  710     # do nothing if input is empty
  711   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  712     $self->{correct_answer_post_filters} = [];
  713   } else {
  714     push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  715   }
  716   @{$self->{correct_answer_post_filters}};  # return array of all post_filters
  717 }
  718 
  719 sub ans_hash {  #alias for rh_ans
  720   my $self = shift;
  721   $self->rh_ans(@_);
  722 }
  723 sub rh_ans {
  724   my $self = shift;
  725   my %in_hash = @_;
  726   foreach my $key (keys %in_hash) {
  727     $self->{rh_ans}->{$key} = $in_hash{$key};
  728   }
  729   $self->{rh_ans};
  730 }
  731 
  732 =head1 Description: Filters
  733 
  734 A filter is a subroutine which takes one AnswerHash as an input, followed by
  735 a hash of options.
  736 
  737     Useage:  filter($ans_hash, option1 =>value1, option2=> value2 );
  738 
  739 
  740 The filter performs some operations on the input AnswerHash and returns an
  741 AnswerHash as output.
  742 
  743 Many AnswerEvaluator objects are merely a sequence of filters placed into
  744 three queues:
  745 
  746   pre_filters:  these normalize student input, prepare text and so forth
  747   evaluators:   these decide whether or not an answer is correct
  748   post_filters: typically these clean up error messages or process errors
  749           and generate error messages.
  750 
  751 If a filter detects an error it can throw an error message using the C<$rh_ans->throw_error()>
  752 method.  This skips the AnswerHash by all remaining pre_filter C<$rh_ans->catch_error>,
  753 decides how (
  754 or whether) it is supposed to handle the error and then passes the result on
  755 to the next post_filter.
  756 
  757 Setting the flag C<$rh_ans->{done} = 1> will skip
  758 the AnswerHash past the remaining post_filters.
  759 
  760 
  761 =head3 Built in filters
  762 
  763 =head4 blank_prefilter
  764 
  765 
  766 =head4 blank_postfilter
  767 
  768 =cut
  769 
  770 ######################################################
  771 #
  772 # Built in Filters
  773 #
  774 ######################################################
  775 
  776 
  777 sub blank_prefilter  { # check for blanks
  778   my $rh_ans = shift;
  779     # undefined answers are BLANKS
  780   ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  781                             return($rh_ans);};
  782     # answers which are arrays or hashes or some other object reference  are NOT blanks
  783     ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
  784     # if the answer is a true variable consisting only of white space it is a BLANK
  785     ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  786                             return($rh_ans);};
  787   # If we get to here, we assume that the answer is not a blank. It is defined, not a reference
  788   # and contains something other than whitespaces.
  789   $rh_ans;
  790 };
  791 
  792 sub blank_postfilter  {
  793   my $rh_ans=shift;
  794     return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
  795     $rh_ans->{error_flag} = undef;
  796     $rh_ans->{error_message} = '';
  797     $rh_ans->{done} =1;    # no further checking is needed.
  798     $rh_ans;
  799 };
  800 
  801 1;
  802 #package AnswerEvaluatorMaker;
  803 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9