[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 4969 - (download) (as text) (annotate)
Thu May 24 17:55:37 2007 UTC (12 years, 8 months ago) by gage
File size: 24495 byte(s)
Pod documentation upgrades

    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 
  136 =head4 new
  137 
  138   Useage    $rh_anshash = new AnswerHash;
  139 
  140   returns an object of type AnswerHash.
  141 
  142 =cut
  143 
  144 sub new {
  145   my $class = shift @_;
  146 
  147   my $self  = { 'score'         =>  0,
  148           'correct_ans'     =>  'No correct answer specified',
  149           'student_ans'     =>  undef,
  150           'ans_message'     =>  '',
  151           'type'          =>  'Undefined answer evaluator type',
  152           'preview_text_string' =>  undef,
  153           'preview_latex_string'  =>  undef,
  154           'original_student_ans'  =>  undef,
  155           'error_flag'      =>  undef,
  156           'error_message'       =>  '',
  157 
  158   };  # return a reference to a hash.
  159 
  160   bless $self, $class;
  161   $self -> setKeys(@_);
  162 
  163   return $self;
  164 }
  165 
  166 ## IN: a hash
  167 ## Checks to make sure that the keys are valid,
  168 ## then sets their value
  169 
  170 =head4  setKeys
  171 
  172       $rh_ans->setKeys(score=>1, student_answer => "yes");
  173       Sets standard elements in the AnswerHash (the ones defined
  174       above). Will give error if one attempts to set non-standard keys.
  175 
  176       To set a non-standard element in a hash use
  177 
  178       $rh_ans->{non-standard-key} = newValue;
  179 
  180       There are no safety checks when using this method.
  181 
  182 =cut
  183 
  184 
  185 sub setKeys {
  186     my $self = shift;
  187   my %inits = @_;
  188   foreach my $item (keys %inits) {
  189     if ( exists $fields{$item} ) {
  190       $self -> {$item} = $inits{$item};
  191     }
  192     else {
  193       warn "AnswerHash cannot automatically initialize an item named $item";
  194     }
  195   }
  196 }
  197 
  198 # access methods
  199 
  200 =head4 data
  201 
  202   Useage:     $rh_ans->data('foo');               set $rh_ans->{student_ans} = 'foo';
  203               $student_input = $rh_ans->data();   retrieve value of $rh_ans->{student_ans}
  204 
  205   synonym for input
  206 
  207 =head4  input
  208 
  209   Useage:     $rh_ans->input('foo')    sets $rh_ans->{student_ans} = 'foo';
  210         $student_input = $rh_ans->input();
  211 
  212   synonym for data
  213 
  214 =cut
  215 
  216 sub data {    #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo'
  217   my $self = shift;
  218   $self->input(@_);
  219 }
  220 
  221 sub input {     #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo'
  222   my $self = shift;
  223     my $input = shift;
  224     $self->{student_ans} = $input if defined($input);
  225   $self->{student_ans}
  226 }
  227 
  228 =head4  input
  229 
  230   Useage:     $rh_ans->score(1)
  231         $score = $rh_ans->score();
  232 
  233   Retrieve or set $rh_ans->{score}, the student's score on the problem.
  234 
  235 =cut
  236 
  237 sub score {
  238   my $self = shift;
  239     my $score = shift;
  240     $self->{score} = $score if defined($score);
  241   $self->{score}
  242 }
  243 
  244 # error methods
  245 
  246 =head4 throw_error
  247 
  248   Useage: $rh_ans->throw_error("FLAG", "message");
  249 
  250   FLAG is a distinctive word that describes the type of error.
  251   Examples are EVAL for an evaluation error or "SYNTAX" for a syntax error.
  252   The entry $rh_ans->{error_flag} is set to "FLAG".
  253 
  254   The catch_error and clear_error methods use
  255   this entry.
  256 
  257   message is a descriptive message for the end user, defining what error occured.
  258 
  259 =head4 catch_error
  260 
  261   Useage: $rh_ans->catch_error("FLAG2");
  262 
  263   Returns true (1) if  $rh_ans->{error_flag} equals "FLAG2", otherwise it returns
  264   false (empty string).
  265 
  266 
  267 
  268 =head4 clear_error
  269 
  270   Useage:  $rh_ans->clear_error("FLAG2");
  271 
  272   If $rh_ans->{error_flag} equals "FLAG2" then the {error_flag} entry is set to
  273   the empty string as is the entry {error_message}
  274 
  275 =head4 error_flag
  276 
  277 =head4 error_message
  278 
  279   Useage:   $flag = $rh_ans -> error_flag();
  280 
  281         $message = $rh_ans -> error_message();
  282 
  283   Retrieve or set the {error_flag} and {error_message} entries.
  284 
  285   Use catch_error and throw_error where possible.
  286 
  287 =cut
  288 
  289 
  290 
  291 sub throw_error {
  292   my $self = shift;
  293     my $flag = shift;
  294     my $message = shift;
  295     $self->{error_message} .= " $message " if defined($message);
  296     $self->{error_flag} = $flag if defined($flag);
  297   $self->{error_flag}
  298 }
  299 sub catch_error {
  300   my $self = shift;
  301     my $flag = shift;
  302     return('')  unless defined($self->{error_flag});
  303     return $self->{error_flag} unless $flag;    # empty input catches all errors.
  304     return $self->{error_flag} if $self->{error_flag} eq $flag;
  305   return '';   # nothing to catch
  306 }
  307 sub clear_error {
  308   my $self = shift;
  309   my $flag = shift;
  310   if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag})  and $flag eq $self->{error_flag}) {
  311     $self->{error_flag} = undef;
  312     $self->{error_message} = undef;
  313   }
  314   $self;
  315 }
  316 sub error_flag {
  317   my $self = shift;
  318     my $flag = shift;
  319     $self->{error_flag} = $flag if defined($flag);
  320   $self->{error_flag}
  321 }
  322 sub error_message {
  323   my $self = shift;
  324     my $message = shift;
  325     $self->{error_message} = $message if defined($message);
  326   $self->{error_message}
  327 }
  328 
  329 # error print out method
  330 
  331 =head4 pretty_print
  332 
  333 
  334   Useage:     $rh_ans -> pretty_print();
  335 
  336 
  337   Returns a string containing a representation of the AnswerHash as an HTML table.
  338 
  339 =cut
  340 
  341 
  342 sub pretty_print {
  343     my $r_input = shift;
  344     my $level = shift;
  345     $level = 4 unless defined($level);
  346     $level--;
  347     return '' unless $level > 0;  # only print three levels of hashes (safety feature)
  348     my $out = '';
  349     if ( not ref($r_input) ) {
  350       $out = $r_input;    # not a reference
  351       $out =~ s/</&lt;/g; # protect for HTML output
  352     } elsif (ref($r_input) =~/hash/i) {
  353       local($^W) = 0;
  354     $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
  355     foreach my $key (sort keys %$r_input ) {
  356       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}, $level) . "</td></tr>";
  357     }
  358     $out .="</table>";
  359   } elsif (ref($r_input) eq 'ARRAY' ) {
  360     my @array = @$r_input;
  361     $out .= "( " ;
  362     while (@array) {
  363       $out .= pretty_print(shift @array, $level) . " , ";
  364     }
  365     $out .= " )";
  366   } elsif (ref($r_input) eq 'CODE') {
  367     $out = "$r_input";
  368   } else {
  369     $out = $r_input;
  370     $out =~ s/</&lt;/g; # protect for HTML output
  371   }
  372     $out;
  373 }
  374 
  375 # action methods
  376 
  377 =head4 OR
  378 
  379   Useage:    $rh_ans->OR($rh_ans2);
  380 
  381   Returns a new AnswerHash whose score is the maximum of the scores in $rh_ans and $rh_ans2.
  382   The correct answers for the two hashes are combined with "OR".
  383   The types are concatenated with "OR" as well.
  384   Currently nothing is done with the error flags and messages.
  385 
  386 
  387 
  388 =head4 AND
  389 
  390 
  391   Useage:    $rh_ans->AND($rh_ans2);
  392 
  393   Returns a new AnswerHash whose score is the minimum of the scores in $rh_ans and $rh_ans2.
  394   The correct answers for the two hashes are combined with "AND".
  395   The types are concatenated with "AND" as well.
  396    Currently nothing is done with the error flags and messages.
  397 
  398 
  399 
  400 
  401 =cut
  402 
  403 
  404 
  405 sub OR {
  406   my $self = shift;
  407 
  408   my $rh_ans2 = shift;
  409   my %options = @_;
  410   return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash';
  411 
  412   my $out_hash = new AnswerHash;
  413   # score is the maximum of the two scores
  414   $out_hash->{score} = ( $self->{score}  <  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  415   $out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  416   $out_hash->{student_ans} = $self->{student_ans};
  417   $out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} );
  418   $out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  419   $out_hash->{original_student_ans} = $self->{original_student_ans};
  420   $out_hash;
  421 }
  422 
  423 sub AND {
  424   my $self = shift;
  425   my $rh_ans2 = shift;
  426   my %options = @_;
  427   my $out_hash = new AnswerHash;
  428   # score is the minimum of the two scores
  429   $out_hash->{score} = ( $self->{score}  >  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  430   $out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  431   $out_hash->{student_ans} = $self->{student_ans};
  432   $out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} );
  433   $out_hash->{preview_text_string} = join("  ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  434   $out_hash->{preview_latex_string} = join(" \\quad ", $self->{preview_latex_string}, $rh_ans2->{preview_latex_string} );
  435   $out_hash->{original_student_ans} = $self->{original_student_ans};
  436   $out_hash;
  437 }
  438 
  439 
  440 =head1 Description:  AnswerEvaluator
  441 
  442 
  443 
  444 
  445 =cut
  446 
  447 
  448 
  449 package AnswerEvaluator;
  450 
  451 
  452 =head3 AnswerEvaluator Methods
  453 
  454 
  455 
  456 
  457 
  458 
  459 
  460 =cut
  461 
  462 
  463 =head4 new
  464 
  465 
  466 =cut
  467 
  468 
  469 sub new {
  470   my $class = shift @_;
  471 
  472   my $self  = { pre_filters   =>  [ [\&blank_prefilter] ],
  473           evaluators    =>  [],
  474           post_filters  =>  [ [\&blank_postfilter] ],
  475           debug     =>  0,
  476           rh_ans    =>  new AnswerHash,
  477 
  478   };
  479 
  480   bless $self, $class;
  481   $self->rh_ans(@_);    #initialize answer hash
  482   return $self;
  483 }
  484 
  485 # dereference_array_ans pretty prints an answer which is stored as an anonymous array.
  486 sub dereference_array_ans {
  487   my $self = shift;
  488   my $rh_ans = shift;
  489   $rh_ans->{_filter_name} = 'dereference_array_ans';
  490   if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY'  ) {
  491     $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) ";
  492   }
  493   $rh_ans;
  494 }
  495 
  496 sub get_student_answer {
  497   my $self           = shift;
  498   my $input          = shift;
  499   my %answer_options = @_;
  500   my $display_input  = $input;
  501   $display_input =~ s/\0/\\0/g;  # make null spacings visible
  502   warn "Raw student answer is |$display_input|" if $self->{debug};
  503   $input = '' unless defined($input);
  504   if (ref($input) =~/AnswerHash/) {
  505     # in this case nothing needs to be done, since the student's answer is already in an answerhash.
  506     # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator.
  507   } elsif ($input =~ /\0/ ) {  # this case may occur with older versions of CGI??
  508       my @input = split(/\0/,$input);
  509       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  510     $input = \@input;
  511     $self-> {rh_ans} -> {student_ans} = $input;
  512   } elsif (ref($input) eq 'ARRAY' ) {  # sometimes the answer may already be decoded into an array.
  513       my @input = @$input;
  514       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  515     $input = \@input;
  516     $self-> {rh_ans} -> {student_ans} = $input;
  517   } else {
  518 
  519     $self-> {rh_ans} -> {original_student_ans} = $input;
  520     $self-> {rh_ans} -> {student_ans} = $input;
  521   }
  522   $self->{rh_ans}->{ans_label}   = $answer_options{ans_label} if defined($answer_options{ans_label});
  523   $self->{rh_ans}->{_filter_name} = 'get_student_answer';
  524   $input;
  525 }
  526 
  527 =head4  evaluate
  528 
  529   $answer_evaluator->evaluate($student_answer_string
  530 
  531 
  532 =cut
  533 our $count;   # used to keep track of where we are in queue
  534 
  535 sub evaluate {
  536   my $self    =   shift;
  537   $self->get_student_answer(@_);
  538   # dereference $self->{rh_ans};
  539   my $rh_ans      =   $self ->{rh_ans};
  540   $rh_ans->{error_flag}=undef;  #reset the error flags in case
  541   $rh_ans->{done}=undef;        #the answer evaluator is called twice
  542 
  543     warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0;
  544     $self->print_result_if_debug('pre_filter',$rh_ans);
  545 
  546   my @prefilters  = @{$self -> {pre_filters}};
  547   $count = 0;  # the get student answer filter is counted as filter -1
  548   foreach my $i (@prefilters) {
  549       last if defined( $rh_ans->{error_flag} );
  550       my @array = @$i;
  551       my $filter = shift(@array);      # the array now contains the options for the filter
  552       $rh_ans               = &$filter($rh_ans,@array);
  553       $self->print_result_if_debug('pre_filter',$rh_ans,@array);
  554   }
  555   my @evaluators = @{$self -> {evaluators} };
  556   $count = 0;
  557   foreach my $i ( @evaluators )   {
  558       last if defined($rh_ans->{error_flag});
  559     my @array = @$i;
  560       my $evaluator = shift(@array);   # the array now contains the options for the filter
  561       $rh_ans               = &$evaluator($rh_ans,@array);
  562       $self->print_result_if_debug('evaluator',$rh_ans,@array);
  563   }
  564   my @post_filters = @{$self -> {post_filters} };
  565   $count = 0;  # 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       $rh_ans               = &$filter($rh_ans,@array);
  572       $self->print_result_if_debug('post_filter',$rh_ans,@array);
  573   }
  574   $rh_ans = $self->dereference_array_ans($rh_ans);
  575   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  576   warn "<h4>final result: </h4>", $rh_ans->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  577   # re-refrence $rh_ans;
  578   $self ->{rh_ans} = $rh_ans;
  579   $rh_ans;
  580 }
  581 sub print_result_if_debug {
  582   my $self = shift;
  583   my $queue = shift;    # the name of the queue we are in
  584   my $rh_ans= shift;
  585   my %options = @_;
  586   if (defined($self->{debug}) and $self->{debug}>0) {
  587         $rh_ans->{rh_options} = \%options;  #include the options in the debug information
  588         my $name = (defined($rh_ans->{_filter_name})) ? $rh_ans->{_filter_name}: 'unnamed';
  589         warn "$count. Result from \"$name\" $queue:", $rh_ans->pretty_print();
  590         ++$count;
  591    }
  592   $rh_ans->{_filter_name} = undef;
  593 }
  594 
  595 # This next subroutine is for checking the instructor's answer and is not yet in use.
  596 # sub correct_answer_evaluate {
  597 #   my $self    =   shift;
  598 #   $self-> {rh_ans} -> {correct_ans} = shift @_;
  599 #   my $rh_ans    =   $self ->{rh_ans};
  600 #   my @prefilters  = @{$self -> {correct_answer_pre_filters}};
  601 #   my $count = -1;  # the blank filter is counted as filter 0
  602 #   foreach my $i (@prefilters) {
  603 #       last if defined( $rh_ans->{error_flag} );
  604 #       my @array = @$i;
  605 #       my $filter = shift(@array);      # the array now contains the options for the filter
  606 #       warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  607 #     $rh_ans   = &$filter($rh_ans,@array);
  608 #     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  609 #   }
  610 #   my @evaluators = @{$self -> {correct_answer_evaluators} };
  611 #   $count = 0;
  612 #   foreach my $i ( @evaluators )   {
  613 #       last if defined($self->{rh_ans}->{error_flag});
  614 #     my @array = @$i;
  615 #       my $evaluator = shift(@array);   # the array now contains the options for the filter
  616 #       warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  617 #     $rh_ans   = &$evaluator($rh_ans,@array);
  618 #   }
  619 #   my @post_filters = @{$self -> {correct_answer_post_filters} };
  620 #   $count = -1;  # blank filter catcher is filter 0
  621 #   foreach my $i ( @post_filters ) {
  622 #       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  623 #     my @array = @$i;
  624 #       my $filter = shift(@array);      # the array now contains the options for the filter
  625 #       warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  626 #     $rh_ans   = &$filter($rh_ans,@array);
  627 #     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  628 #   }
  629 #   $rh_ans = $self->dereference_array_ans($rh_ans);
  630 #   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  631 #   warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  632 #   $self ->{rh_ans} = $rh_ans;
  633 #   $rh_ans;
  634 # }
  635 
  636 
  637 =head4 install_pre_filter
  638 
  639 =head4 install_evaluator
  640 
  641 
  642 =head4 install_post_filter
  643 
  644 
  645 
  646 =cut
  647 
  648 sub install_pre_filter {
  649   my $self =  shift;
  650   if (@_ == 0) {
  651     # do nothing if input is empty
  652   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  653     $self->{pre_filters} = [];
  654   } else {
  655     push(@{$self->{pre_filters}},[ @_ ]) if @_;  #install pre_filter and it's options
  656   }
  657   @{$self->{pre_filters}};  # return array of all pre_filters
  658 }
  659 
  660 
  661 
  662 
  663 
  664 sub install_evaluator {
  665   my $self =  shift;
  666   if (@_ == 0) {
  667     # do nothing if input is empty
  668   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  669     $self->{evaluators} = [];
  670   } else {
  671     push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  672   }
  673   @{$self->{'evaluators'}};  # return array of all evaluators
  674 }
  675 
  676 
  677 sub install_post_filter {
  678   my $self =  shift;
  679   if (@_ == 0) {
  680     # do nothing if input is empty
  681   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  682     $self->{post_filters} = [];
  683   } else {
  684     push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  685   }
  686   @{$self->{post_filters}};  # return array of all post_filters
  687 }
  688 
  689 ## filters for checking the correctAnswer
  690 sub install_correct_answer_pre_filter {
  691   my $self =  shift;
  692   if (@_ == 0) {
  693     # do nothing if input is empty
  694   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  695     $self->{correct_answer_pre_filters} = [];
  696   } else {
  697     push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_;  #install correct_answer_pre_filter and it's options
  698   }
  699   @{$self->{correct_answer_pre_filters}};  # return array of all correct_answer_pre_filters
  700 }
  701 
  702 sub install_correct_answer_evaluator {
  703   my $self =  shift;
  704   if (@_ == 0) {
  705     # do nothing if input is empty
  706   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  707     $self->{correct_answer_evaluators} = [];
  708   } else {
  709     push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  710   }
  711   @{$self->{correct_answer_evaluators}};  # return array of all evaluators
  712 }
  713 
  714 sub install_correct_answer_post_filter {
  715   my $self =  shift;
  716   if (@_ == 0) {
  717     # do nothing if input is empty
  718   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  719     $self->{correct_answer_post_filters} = [];
  720   } else {
  721     push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  722   }
  723   @{$self->{correct_answer_post_filters}};  # return array of all post_filters
  724 }
  725 
  726 sub ans_hash {  #alias for rh_ans
  727   my $self = shift;
  728   $self->rh_ans(@_);
  729 }
  730 sub rh_ans {
  731   my $self = shift;
  732   my %in_hash = @_;
  733   foreach my $key (keys %in_hash) {
  734     $self->{rh_ans}->{$key} = $in_hash{$key};
  735   }
  736   $self->{rh_ans};
  737 }
  738 
  739 =head1 Description: Filters
  740 
  741 A filter is a subroutine which takes one AnswerHash as an input, followed by
  742 a hash of options.
  743 
  744     Useage:  filter($ans_hash, option1 =>value1, option2=> value2 );
  745 
  746 
  747 The filter performs some operations on the input AnswerHash and returns an
  748 AnswerHash as output.
  749 
  750 Many AnswerEvaluator objects are merely a sequence of filters placed into
  751 three queues:
  752 
  753   pre_filters:  these normalize student input, prepare text and so forth
  754   evaluators:   these decide whether or not an answer is correct
  755   post_filters: typically these clean up error messages or process errors
  756           and generate error messages.
  757 
  758 If a filter detects an error it can throw an error message using the C<$rh_ans->throw_error()>
  759 method.  This skips the AnswerHash by all remaining pre_filter C<$rh_ans->catch_error>,
  760 decides how (
  761 or whether) it is supposed to handle the error and then passes the result on
  762 to the next post_filter.
  763 
  764 Setting the flag C<$rh_ans->{done} = 1> will skip
  765 the AnswerHash past the remaining post_filters.
  766 
  767 
  768 =head3 Built in filters
  769 
  770 =head4 blank_prefilter
  771 
  772 
  773 =head4 blank_postfilter
  774 
  775 =cut
  776 
  777 ######################################################
  778 #
  779 # Built in Filters
  780 #
  781 ######################################################
  782 
  783 
  784 sub blank_prefilter  { # check for blanks
  785   my $rh_ans = shift;
  786   $rh_ans->{_filter_name} = 'blank_prefilter';
  787     # undefined answers are BLANKS
  788   ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  789                             return($rh_ans);};
  790     # answers which are arrays or hashes or some other object reference  are NOT blanks
  791     ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
  792     # if the answer is a true variable consisting only of white space it is a BLANK
  793     ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  794                             return($rh_ans);};
  795   # If we get to here, we assume that the answer is not a blank. It is defined, not a reference
  796   # and contains something other than whitespaces.
  797   $rh_ans;
  798 };
  799 
  800 sub blank_postfilter  {
  801   my $rh_ans=shift;
  802   $rh_ans->{_filter_name} = 'blank_postfilter';
  803     return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
  804     $rh_ans->{error_flag} = undef;
  805     $rh_ans->{error_message} = '';
  806     $rh_ans->{done} =1;    # no further checking is needed.
  807     $rh_ans;
  808 };
  809 
  810 1;
  811 #package AnswerEvaluatorMaker;
  812 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9