[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 2060 - (download) (as text) (annotate)
Sun May 9 17:43:32 2004 UTC (15 years, 8 months ago) by gage
File size: 24270 byte(s)
Cosmetic fixes to code layout.

    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   my $display_input  = $input;
  492   $display_input =~ s/\0/\\0/g;  # make null spacings visible
  493   warn "Raw student answer is |$display_input|" if $self->{debug};
  494   $input = '' unless defined($input);
  495   if (ref($input) =~/AnswerHash/) {
  496     # in this case nothing needs to be done, since the student's answer is already in an answerhash.
  497     # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator.
  498   } elsif ($input =~ /\0/ ) {  # this case may occur with older versions of CGI??
  499       my @input = split(/\0/,$input);
  500       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  501     $input = \@input;
  502     $self-> {rh_ans} -> {student_ans} = $input;
  503   } elsif (ref($input) eq 'ARRAY' ) {  # sometimes the answer may already be decoded into an array.
  504       my @input = @$input;
  505       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  506     $input = \@input;
  507     $self-> {rh_ans} -> {student_ans} = $input;
  508   } else {
  509 
  510     $self-> {rh_ans} -> {original_student_ans} = $input;
  511     $self-> {rh_ans} -> {student_ans} = $input;
  512   }
  513   $self->{rh_ans}->{ans_label}   = $answer_options{ans_label} if defined($answer_options{ans_label});
  514 
  515   $input;
  516 }
  517 
  518 =head4  evaluate
  519 
  520 
  521 
  522 
  523 =cut
  524 
  525 sub evaluate {
  526   my $self    =   shift;
  527   $self->get_student_answer(@_);
  528   $self->{rh_ans}->{error_flag}=undef;  #reset the error flags in case
  529   $self->{rh_ans}->{done}=undef;        #the answer evaluator is called twice
  530   my $rh_ans      =   $self ->{rh_ans};
  531     warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0;
  532   my @prefilters  = @{$self -> {pre_filters}};
  533   my $count = -1;  # the blank filter is counted as filter 0
  534   foreach my $i (@prefilters) {
  535       last if defined( $self->{rh_ans}->{error_flag} );
  536       my @array = @$i;
  537       my $filter = shift(@array);      # the array now contains the options for the filter
  538       my %options = @array;
  539       if (defined($self->{debug}) and $self->{debug}>0) {
  540 
  541         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  542         warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print();
  543       }
  544       $rh_ans   = &$filter($rh_ans,@array);
  545       warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n"
  546         if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  547       $rh_ans->{_filter_name} = undef;
  548   }
  549   my @evaluators = @{$self -> {evaluators} };
  550   $count = 0;
  551   foreach my $i ( @evaluators )   {
  552       last if defined($self->{rh_ans}->{error_flag});
  553     my @array = @$i;
  554       my $evaluator = shift(@array);   # the array now contains the options for the filter
  555       my %options = @array;
  556       if (defined($self->{debug}) and $self->{debug}>0) {
  557         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  558         warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print();
  559       }
  560     $rh_ans   = &$evaluator($rh_ans,@array);
  561     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});
  562     $rh_ans->{_filter_name} = undef;
  563   }
  564   my @post_filters = @{$self -> {post_filters} };
  565   $count = -1;  # blank filter catcher is filter 0
  566   foreach my $i ( @post_filters ) {
  567       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  568     my @array = @$i;
  569 
  570       my $filter = shift(@array);      # the array now contains the options for the filter
  571       my %options = @array;
  572       if (defined($self->{debug}) and $self->{debug}>0) {
  573         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  574         warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n";
  575       }
  576 
  577     $rh_ans   = &$filter($rh_ans,@array);
  578     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});
  579     $rh_ans->{_filter_name} = undef;
  580   }
  581   $rh_ans = $self->dereference_array_ans($rh_ans);
  582   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  583   warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  584   $self ->{rh_ans} = $rh_ans;
  585   $rh_ans;
  586 }
  587 # This next subroutine is for checking the instructor's answer and is not yet in use.
  588 sub correct_answer_evaluate {
  589   my $self    =   shift;
  590   $self-> {rh_ans} -> {correct_ans} = shift @_;
  591   my $rh_ans    =   $self ->{rh_ans};
  592   my @prefilters  = @{$self -> {correct_answer_pre_filters}};
  593   my $count = -1;  # the blank filter is counted as filter 0
  594   foreach my $i (@prefilters) {
  595       last if defined( $self->{rh_ans}->{error_flag} );
  596       my @array = @$i;
  597       my $filter = shift(@array);      # the array now contains the options for the filter
  598       warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  599     $rh_ans   = &$filter($rh_ans,@array);
  600     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  601   }
  602   my @evaluators = @{$self -> {correct_answer_evaluators} };
  603   $count = 0;
  604   foreach my $i ( @evaluators )   {
  605       last if defined($self->{rh_ans}->{error_flag});
  606     my @array = @$i;
  607       my $evaluator = shift(@array);   # the array now contains the options for the filter
  608       warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  609     $rh_ans   = &$evaluator($rh_ans,@array);
  610   }
  611   my @post_filters = @{$self -> {correct_answer_post_filters} };
  612   $count = -1;  # blank filter catcher is filter 0
  613   foreach my $i ( @post_filters ) {
  614       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  615     my @array = @$i;
  616       my $filter = shift(@array);      # the array now contains the options for the filter
  617       warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  618     $rh_ans   = &$filter($rh_ans,@array);
  619     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  620   }
  621   $rh_ans = $self->dereference_array_ans($rh_ans);
  622   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  623   warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  624   $self ->{rh_ans} = $rh_ans;
  625   $rh_ans;
  626 }
  627 
  628 
  629 =head4 install_pre_filter
  630 
  631 =head4 install_evaluator
  632 
  633 
  634 =head4 install_post_filter
  635 
  636 
  637 =head4
  638 
  639 
  640 
  641 =cut
  642 
  643 
  644 sub install_pre_filter {
  645   my $self =  shift;
  646   if (@_ == 0) {
  647     # do nothing if input is empty
  648   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  649     $self->{pre_filters} = [];
  650   } else {
  651     push(@{$self->{pre_filters}},[ @_ ]) if @_;  #install pre_filter and it's options
  652   }
  653   @{$self->{pre_filters}};  # return array of all pre_filters
  654 }
  655 
  656 
  657 
  658 
  659 
  660 sub install_evaluator {
  661   my $self =  shift;
  662   if (@_ == 0) {
  663     # do nothing if input is empty
  664   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  665     $self->{evaluators} = [];
  666   } else {
  667     push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  668   }
  669   @{$self->{'evaluators'}};  # return array of all evaluators
  670 }
  671 
  672 
  673 sub install_post_filter {
  674   my $self =  shift;
  675   if (@_ == 0) {
  676     # do nothing if input is empty
  677   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  678     $self->{post_filters} = [];
  679   } else {
  680     push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  681   }
  682   @{$self->{post_filters}};  # return array of all post_filters
  683 }
  684 
  685 ## filters for checking the correctAnswer
  686 sub install_correct_answer_pre_filter {
  687   my $self =  shift;
  688   if (@_ == 0) {
  689     # do nothing if input is empty
  690   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  691     $self->{correct_answer_pre_filters} = [];
  692   } else {
  693     push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_;  #install correct_answer_pre_filter and it's options
  694   }
  695   @{$self->{correct_answer_pre_filters}};  # return array of all correct_answer_pre_filters
  696 }
  697 
  698 sub install_correct_answer_evaluator {
  699   my $self =  shift;
  700   if (@_ == 0) {
  701     # do nothing if input is empty
  702   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  703     $self->{correct_answer_evaluators} = [];
  704   } else {
  705     push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  706   }
  707   @{$self->{correct_answer_evaluators}};  # return array of all evaluators
  708 }
  709 
  710 sub install_correct_answer_post_filter {
  711   my $self =  shift;
  712   if (@_ == 0) {
  713     # do nothing if input is empty
  714   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  715     $self->{correct_answer_post_filters} = [];
  716   } else {
  717     push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  718   }
  719   @{$self->{correct_answer_post_filters}};  # return array of all post_filters
  720 }
  721 
  722 sub ans_hash {  #alias for rh_ans
  723   my $self = shift;
  724   $self->rh_ans(@_);
  725 }
  726 sub rh_ans {
  727   my $self = shift;
  728   my %in_hash = @_;
  729   foreach my $key (keys %in_hash) {
  730     $self->{rh_ans}->{$key} = $in_hash{$key};
  731   }
  732   $self->{rh_ans};
  733 }
  734 
  735 =head1 Description: Filters
  736 
  737 A filter is a subroutine which takes one AnswerHash as an input, followed by
  738 a hash of options.
  739 
  740     Useage:  filter($ans_hash, option1 =>value1, option2=> value2 );
  741 
  742 
  743 The filter performs some operations on the input AnswerHash and returns an
  744 AnswerHash as output.
  745 
  746 Many AnswerEvaluator objects are merely a sequence of filters placed into
  747 three queues:
  748 
  749   pre_filters:  these normalize student input, prepare text and so forth
  750   evaluators:   these decide whether or not an answer is correct
  751   post_filters: typically these clean up error messages or process errors
  752           and generate error messages.
  753 
  754 If a filter detects an error it can throw an error message using the C<$rh_ans->throw_error()>
  755 method.  This skips the AnswerHash by all remaining pre_filter C<$rh_ans->catch_error>,
  756 decides how (
  757 or whether) it is supposed to handle the error and then passes the result on
  758 to the next post_filter.
  759 
  760 Setting the flag C<$rh_ans->{done} = 1> will skip
  761 the AnswerHash past the remaining post_filters.
  762 
  763 
  764 =head3 Built in filters
  765 
  766 =head4 blank_prefilter
  767 
  768 
  769 =head4 blank_postfilter
  770 
  771 =cut
  772 
  773 ######################################################
  774 #
  775 # Built in Filters
  776 #
  777 ######################################################
  778 
  779 
  780 sub blank_prefilter  { # check for blanks
  781   my $rh_ans = shift;
  782     # undefined answers are BLANKS
  783   ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  784                             return($rh_ans);};
  785     # answers which are arrays or hashes or some other object reference  are NOT blanks
  786     ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
  787     # if the answer is a true variable consisting only of white space it is a BLANK
  788     ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  789                             return($rh_ans);};
  790   # If we get to here, we assume that the answer is not a blank. It is defined, not a reference
  791   # and contains something other than whitespaces.
  792   $rh_ans;
  793 };
  794 
  795 sub blank_postfilter  {
  796   my $rh_ans=shift;
  797     return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
  798     $rh_ans->{error_flag} = undef;
  799     $rh_ans->{error_message} = '';
  800     $rh_ans->{done} =1;    # no further checking is needed.
  801     $rh_ans;
  802 };
  803 
  804 1;
  805 #package AnswerEvaluatorMaker;
  806 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9