[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 6058 - (download) (as text) (annotate)
Thu Jun 25 23:28:44 2009 UTC (10 years, 8 months ago) by gage
File size: 25430 byte(s)
syncing pg HEAD with pg2.4.7 on 6/25/2009

    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           'ans_label'            =>   undef,
  152           'type'          =>  'Undefined answer evaluator type',
  153           'preview_text_string' =>  undef,
  154           'preview_latex_string'  =>  undef,
  155           'original_student_ans'  =>  undef,
  156           'error_flag'      =>  undef,
  157           'error_message'       =>  '',
  158 
  159   };  # return a reference to a hash.
  160 
  161   bless $self, $class;
  162   $self -> setKeys(@_);
  163 
  164   return $self;
  165 }
  166 
  167 ## IN: a hash
  168 ## Checks to make sure that the keys are valid,
  169 ## then sets their value
  170 
  171 =head4  setKeys
  172 
  173       $rh_ans->setKeys(score=>1, student_answer => "yes");
  174       Sets standard elements in the AnswerHash (the ones defined
  175       above). Will give error if one attempts to set non-standard keys.
  176 
  177       To set a non-standard element in a hash use
  178 
  179       $rh_ans->{non-standard-key} = newValue;
  180 
  181       There are no safety checks when using this method.
  182 
  183 =cut
  184 
  185 
  186 sub setKeys {
  187     my $self = shift;
  188   my %inits = @_;
  189   foreach my $item (keys %inits) {
  190     if ( exists $fields{$item} ) {
  191       $self -> {$item} = $inits{$item};
  192     }
  193     else {
  194       warn "AnswerHash cannot automatically initialize an item named $item";
  195     }
  196   }
  197 }
  198 
  199 # access methods
  200 
  201 =head4 data
  202 
  203   Useage:     $rh_ans->data('foo');               set $rh_ans->{student_ans} = 'foo';
  204               $student_input = $rh_ans->data();   retrieve value of $rh_ans->{student_ans}
  205 
  206   synonym for input
  207 
  208 =head4  input
  209 
  210   Useage:     $rh_ans->input('foo')    sets $rh_ans->{student_ans} = 'foo';
  211         $student_input = $rh_ans->input();
  212 
  213   synonym for data
  214 
  215 =cut
  216 
  217 sub data {    #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo'
  218   my $self = shift;
  219   $self->input(@_);
  220 }
  221 
  222 sub input {     #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo'
  223   my $self = shift;
  224     my $input = shift;
  225     $self->{student_ans} = $input if defined($input);
  226   $self->{student_ans}
  227 }
  228 
  229 =head4  input
  230 
  231   Useage:     $rh_ans->score(1)
  232         $score = $rh_ans->score();
  233 
  234   Retrieve or set $rh_ans->{score}, the student's score on the problem.
  235 
  236 =cut
  237 
  238 sub score {
  239   my $self = shift;
  240     my $score = shift;
  241     $self->{score} = $score if defined($score);
  242   $self->{score}
  243 }
  244 
  245 # error methods
  246 
  247 =head4 throw_error
  248 
  249   Useage: $rh_ans->throw_error("FLAG", "message");
  250 
  251   FLAG is a distinctive word that describes the type of error.
  252   Examples are EVAL for an evaluation error or "SYNTAX" for a syntax error.
  253   The entry $rh_ans->{error_flag} is set to "FLAG".
  254 
  255   The catch_error and clear_error methods use
  256   this entry.
  257 
  258   message is a descriptive message for the end user, defining what error occured.
  259 
  260 =head4 catch_error
  261 
  262   Useage: $rh_ans->catch_error("FLAG2");
  263 
  264   Returns true (1) if  $rh_ans->{error_flag} equals "FLAG2", otherwise it returns
  265   false (empty string).
  266 
  267 
  268 
  269 =head4 clear_error
  270 
  271   Useage:  $rh_ans->clear_error("FLAG2");
  272 
  273   If $rh_ans->{error_flag} equals "FLAG2" then the {error_flag} entry is set to
  274   the empty string as is the entry {error_message}
  275 
  276 =head4 error_flag
  277 
  278 =head4 error_message
  279 
  280   Useage:   $flag = $rh_ans -> error_flag();
  281 
  282         $message = $rh_ans -> error_message();
  283 
  284   Retrieve or set the {error_flag} and {error_message} entries.
  285 
  286   Use catch_error and throw_error where possible.
  287 
  288 =cut
  289 
  290 
  291 
  292 sub throw_error {
  293   my $self = shift;
  294     my $flag = shift;
  295     my $message = shift;
  296     $self->{error_message} .= " $message " if defined($message);
  297     $self->{error_flag} = $flag if defined($flag);
  298   $self->{error_flag}
  299 }
  300 sub catch_error {
  301   my $self = shift;
  302     my $flag = shift;
  303     return('')  unless defined($self->{error_flag});
  304     return $self->{error_flag} unless $flag;    # empty input catches all errors.
  305     return $self->{error_flag} if $self->{error_flag} eq $flag;
  306   return '';   # nothing to catch
  307 }
  308 sub clear_error {
  309   my $self = shift;
  310   my $flag = shift;
  311   if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag})  and $flag eq $self->{error_flag}) {
  312     $self->{error_flag} = undef;
  313     $self->{error_message} = undef;
  314   }
  315   $self;
  316 }
  317 sub error_flag {
  318   my $self = shift;
  319     my $flag = shift;
  320     $self->{error_flag} = $flag if defined($flag);
  321   $self->{error_flag}
  322 }
  323 sub error_message {
  324   my $self = shift;
  325     my $message = shift;
  326     $self->{error_message} = $message if defined($message);
  327   $self->{error_message}
  328 }
  329 
  330 # error print out method
  331 
  332 =head4 pretty_print
  333 
  334 
  335   Useage:     $rh_ans -> pretty_print();
  336 
  337 
  338   Returns a string containing a representation of the AnswerHash as an HTML table.
  339 
  340 =cut
  341 
  342 
  343 sub pretty_print {
  344     my $r_input = shift;
  345     my $level = shift;
  346     $level = 4 unless defined($level);
  347     $level--;
  348     return '' unless $level > 0;  # only print three levels of hashes (safety feature)
  349     my $out = '';
  350     if ( not ref($r_input) ) {
  351       $out = $r_input;    # not a reference
  352       $out =~ s/</&lt;/g; # protect for HTML output
  353     } elsif (ref($r_input) =~/hash/i) {
  354       local($^W) = 0;
  355     $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
  356     foreach my $key (sort keys %$r_input ) {
  357       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}, $level) . "</td></tr>";
  358     }
  359     $out .="</table>";
  360   } elsif (ref($r_input) eq 'ARRAY' ) {
  361     my @array = @$r_input;
  362     $out .= "( " ;
  363     while (@array) {
  364       $out .= pretty_print(shift @array, $level) . " , ";
  365     }
  366     $out .= " )";
  367   } elsif (ref($r_input) eq 'CODE') {
  368     $out = "$r_input";
  369   } else {
  370     $out = $r_input;
  371     $out =~ s/</&lt;/g; # protect for HTML output
  372   }
  373     $out;
  374 }
  375 
  376 # action methods
  377 
  378 =head4 OR
  379 
  380   Useage:    $rh_ans->OR($rh_ans2);
  381 
  382   Returns a new AnswerHash whose score is the maximum of the scores in $rh_ans and $rh_ans2.
  383   The correct answers for the two hashes are combined with "OR".
  384   The types are concatenated with "OR" as well.
  385   Currently nothing is done with the error flags and messages.
  386 
  387 
  388 
  389 =head4 AND
  390 
  391 
  392   Useage:    $rh_ans->AND($rh_ans2);
  393 
  394   Returns a new AnswerHash whose score is the minimum of the scores in $rh_ans and $rh_ans2.
  395   The correct answers for the two hashes are combined with "AND".
  396   The types are concatenated with "AND" as well.
  397    Currently nothing is done with the error flags and messages.
  398 
  399 
  400 
  401 
  402 =cut
  403 
  404 
  405 
  406 sub OR {
  407   my $self = shift;
  408 
  409   my $rh_ans2 = shift;
  410   my %options = @_;
  411   return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash';
  412 
  413   my $out_hash = new AnswerHash;
  414   # score is the maximum of the two scores
  415   $out_hash->{score} = ( $self->{score}  <  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  416   $out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  417   $out_hash->{student_ans} = $self->{student_ans};
  418   $out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} );
  419   $out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  420   $out_hash->{original_student_ans} = $self->{original_student_ans};
  421   $out_hash;
  422 }
  423 
  424 sub AND {
  425   my $self = shift;
  426   my $rh_ans2 = shift;
  427   my %options = @_;
  428   my $out_hash = new AnswerHash;
  429   # score is the minimum of the two scores
  430   $out_hash->{score} = ( $self->{score}  >  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  431   $out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  432   $out_hash->{student_ans} = $self->{student_ans};
  433   $out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} );
  434   $out_hash->{preview_text_string} = join("  ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  435   $out_hash->{preview_latex_string} = join(" \\quad ", $self->{preview_latex_string}, $rh_ans2->{preview_latex_string} );
  436   $out_hash->{original_student_ans} = $self->{original_student_ans};
  437   $out_hash;
  438 }
  439 
  440 
  441 =head1 Description:  AnswerEvaluator
  442 
  443 
  444 
  445 
  446 =cut
  447 
  448 
  449 
  450 package AnswerEvaluator;
  451 
  452 
  453 =head3 AnswerEvaluator Methods
  454 
  455 
  456 
  457 
  458 
  459 
  460 
  461 =cut
  462 
  463 
  464 =head4 new
  465 
  466 
  467 =cut
  468 
  469 
  470 sub new {
  471   my $class = shift @_;
  472 
  473   my $self  = { pre_filters   =>  [ [\&blank_prefilter] ],
  474           evaluators    =>  [],
  475           post_filters  =>  [ [\&blank_postfilter] ],
  476           debug     =>  0,
  477           rh_ans    =>  new AnswerHash,
  478 
  479   };
  480 
  481   bless $self, $class;
  482   $self->rh_ans(@_);    #initialize answer hash
  483   return $self;
  484 }
  485 
  486 # dereference_array_ans pretty prints an answer which is stored as an anonymous array.
  487 sub dereference_array_ans {
  488   my $self = shift;
  489   my $rh_ans = shift;
  490   $rh_ans->{_filter_name} = 'dereference_array_ans';
  491   if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY'  ) {
  492     $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) ";
  493   }
  494   $rh_ans;
  495 }
  496 
  497 sub get_student_answer {
  498   my $self           = shift;
  499   my $input          = shift;
  500   my %answer_options = @_;
  501   my $display_input  = $input;
  502   $display_input =~ s/\0/\\0/g;  # make null spacings visible
  503   warn "Raw student answer is |$display_input|" if $self->{debug};
  504   $input = '' unless defined($input);
  505   if (ref($input) =~/AnswerHash/) {
  506     # in this case nothing needs to be done, since the student's answer is already in an answerhash.
  507     # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator.
  508   } elsif ($input =~ /\0/ ) {  # this case may occur with older versions of CGI??
  509       my @input = split(/\0/,$input);
  510       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  511     $input = \@input;
  512     $self-> {rh_ans} -> {student_ans} = $input;
  513   } elsif (ref($input) eq 'ARRAY' ) {  # sometimes the answer may already be decoded into an array.
  514       my @input = @$input;
  515       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  516     $input = \@input;
  517     $self-> {rh_ans} -> {student_ans} = $input;
  518   } else {
  519 
  520     $self-> {rh_ans} -> {original_student_ans} = $input;
  521     $self-> {rh_ans} -> {student_ans} = $input;
  522   }
  523   $self->{rh_ans}->{ans_label}   = $answer_options{ans_label} if defined($answer_options{ans_label});
  524   $self->{rh_ans}->{_filter_name} = 'get_student_answer';
  525   $input;
  526 }
  527 
  528 =head4  evaluate
  529 
  530   $answer_evaluator->evaluate($student_answer_string
  531 
  532 
  533 =cut
  534 our $count;   # used to keep track of where we are in queue
  535 
  536 sub evaluate {
  537   my $self    =   shift;
  538   $self->get_student_answer(@_);
  539   # dereference $self->{rh_ans};
  540   my $rh_ans      =   $self ->{rh_ans};
  541   $rh_ans->{error_flag}=undef;  #reset the error flags in case
  542   $rh_ans->{done}=undef;        #the answer evaluator is called twice
  543 
  544     warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0;
  545     $self->print_result_if_debug('pre_filter',$rh_ans);
  546 
  547   my @prefilters  = @{$self -> {pre_filters}};
  548   $count = 0;  # the get student answer filter is counted as filter -1
  549   foreach my $i (@prefilters) {
  550       last if defined( $rh_ans->{error_flag} );
  551       my @array = @$i;
  552       my $filter = shift(@array);      # the array now contains the options for the filter
  553       $rh_ans = &$filter($rh_ans,@array);
  554       $self->print_result_if_debug('pre_filter',$rh_ans,@array);
  555   }
  556   my @evaluators = @{$self -> {evaluators} };
  557   $count = 0;
  558   foreach my $i ( @evaluators )   {
  559       last if defined($rh_ans->{error_flag});
  560       my @array = @$i;
  561       my $evaluator = shift(@array);   # the array now contains the options for the filter
  562       $rh_ans = &$evaluator($rh_ans,@array);
  563       $self->print_result_if_debug('evaluator',$rh_ans,@array);
  564   }
  565   my @post_filters = @{$self -> {post_filters} };
  566   $count = 0;  # 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       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 =head4 withPreFilter
  727 
  728     $answerHash->withPreFilter(filter[,options]);
  729 
  730     Installs a prefilter (possibly with options), and returns the AnswerHash. This is so that you
  731     can add a filter to a checker without having to save the checker in a variable, e.g.,
  732 
  733         ANS(Real(10)->cmp->withPreFilter(...));
  734 
  735     or
  736 
  737         ANS(num_cmp(10)->withPreFilter(...));
  738 
  739 =cut
  740 
  741 sub withPreFilter {
  742   my $self = shift;
  743   $self->install_pre_filter(@_);
  744   return $self;
  745 }
  746 
  747 =head4 withPostFilter
  748 
  749     $answerHash->withPostFilter(filter[,options]);
  750 
  751     Installs a postfilter (possibly with options), and returns the AnswerHash. This is so that you
  752     can add a filter to a checker without having to save the checker in a variable, e.g.,
  753 
  754         ANS(Real(10)->cmp->withPostFilter(...));
  755 
  756     or
  757 
  758         ANS(num_cmp(10)->withPostFilter(...));
  759 
  760 =cut
  761 
  762 sub withPostFilter {
  763   my $self = shift;
  764   $self->install_post_filter(@_);
  765   return $self;
  766 }
  767 
  768 sub ans_hash {  #alias for rh_ans
  769   my $self = shift;
  770   $self->rh_ans(@_);
  771 }
  772 sub rh_ans {
  773   my $self = shift;
  774   my %in_hash = @_;
  775   foreach my $key (keys %in_hash) {
  776     $self->{rh_ans}->{$key} = $in_hash{$key};
  777   }
  778   $self->{rh_ans};
  779 }
  780 
  781 =head1 Description: Filters
  782 
  783 A filter is a subroutine which takes one AnswerHash as an input, followed by
  784 a hash of options.
  785 
  786     Useage:  filter($ans_hash, option1 =>value1, option2=> value2 );
  787 
  788 
  789 The filter performs some operations on the input AnswerHash and returns an
  790 AnswerHash as output.
  791 
  792 Many AnswerEvaluator objects are merely a sequence of filters placed into
  793 three queues:
  794 
  795   pre_filters:  these normalize student input, prepare text and so forth
  796   evaluators:   these decide whether or not an answer is correct
  797   post_filters: typically these clean up error messages or process errors
  798           and generate error messages.
  799 
  800 If a filter detects an error it can throw an error message using the C<$rh_ans->throw_error()>
  801 method.  This skips the AnswerHash by all remaining pre_filter C<$rh_ans->catch_error>,
  802 decides how (
  803 or whether) it is supposed to handle the error and then passes the result on
  804 to the next post_filter.
  805 
  806 Setting the flag C<$rh_ans->{done} = 1> will skip
  807 the AnswerHash past the remaining post_filters.
  808 
  809 
  810 =head3 Built in filters
  811 
  812 =head4 blank_prefilter
  813 
  814 
  815 =head4 blank_postfilter
  816 
  817 =cut
  818 
  819 ######################################################
  820 #
  821 # Built in Filters
  822 #
  823 ######################################################
  824 
  825 
  826 sub blank_prefilter  { # check for blanks
  827   my $rh_ans = shift;
  828   $rh_ans->{_filter_name} = 'blank_prefilter';
  829     # undefined answers are BLANKS
  830   ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  831                             return($rh_ans);};
  832     # answers which are arrays or hashes or some other object reference  are NOT blanks
  833     ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
  834     # if the answer is a true variable consisting only of white space it is a BLANK
  835     ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  836                             return($rh_ans);};
  837   # If we get to here, we assume that the answer is not a blank. It is defined, not a reference
  838   # and contains something other than whitespaces.
  839   $rh_ans;
  840 };
  841 
  842 sub blank_postfilter  {
  843   my $rh_ans=shift;
  844   $rh_ans->{_filter_name} = 'blank_postfilter';
  845     return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
  846     $rh_ans->{error_flag} = undef;
  847     $rh_ans->{error_message} = '';
  848     $rh_ans->{done} =1;    # no further checking is needed.
  849     $rh_ans;
  850 };
  851 
  852 1;
  853 #package AnswerEvaluatorMaker;
  854 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9