[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 6292 - (download) (as text) (annotate)
Tue Jun 8 18:00:53 2010 UTC (8 years, 1 month ago) by mgage
File size: 25597 byte(s)
syncing cvn with changes made to the cvs

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9