[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 3328 - (download) (as text) (annotate)
Fri Jul 1 15:52:36 2005 UTC (14 years, 7 months ago) by gage
File size: 24408 byte(s)
Added commment

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9