[system] / trunk / webwork / system / courseScripts / AnswerHash.pm Repository:
ViewVC logotype

View of /trunk/webwork/system/courseScripts/AnswerHash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 188 - (download) (as text) (annotate)
Tue Sep 4 16:40:58 2001 UTC (18 years, 3 months ago) by gage
File size: 17102 byte(s)
Modifications in these two files make questions whose answer blanks hve
the same names behave properly.

The new versions of CGI seem to return such answers as a reference to an array.
Earlier versions returned the answrs as a string with \0 separators.

With the new changes the AnswerEvaluator get_student_answer subroutine and
the NAMED_ANS_RULE in PGbasicmacros.pl will handle either a null separated
string or an answer array when dealing with vector answers.

This should correct some difficulties experienced in the linear algebra
questions.  More testing needs to be done.

    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 =pod
    8 
    9 For the most part AnswerHash is an object which contains data.  It has only a few methods.
   10 The data which is automatically initiallized by the constructor new is given here:
   11 
   12     $new_answer_hash       =        {   'score'         =>  0,
   13                       'correct_ans'     =>  "No correct answer specified",
   14                       'student_ans'     =>  undef,
   15                       'original_student_ans', =>  undef,
   16                       'type'          =>  'Undefined answer evaluator type',
   17                       'ans_message'     =>  '',
   18 
   19                       'preview_text_string' =>  undef,
   20                       'preview_latex_string'  =>  undef,
   21                       'error_flag'      =>  undef,
   22                       'error_message'       =>  '',
   23 
   24                     };
   25 
   26 
   27 
   28 Methods:
   29         new
   30 
   31         setKeys       $rh_ans->setKeys{score=>1};  Sets elements in the AnswerHash.
   32                                                            There is a check to make sure that the
   33                                                            key is one of the values listed above.
   34 
   35                             $rh_ans->{non_standard_value} = 'oops';
   36                                             Add an element to the AnswerHash.
   37                                             No checks are made. Can be used (cautiously)
   38                                             to customize and extend the AnswerHash type.
   39 
   40         OR
   41 
   42         AND
   43 
   44 =cut
   45 
   46 BEGIN {
   47   be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
   48 
   49 }
   50 
   51 package AnswerHash;
   52 # initialization fields
   53 my %fields = (    'score'         =>  undef,
   54           'correct_ans'     =>  undef,
   55           'student_ans'     =>  undef,
   56           'ans_message'     =>  undef,
   57           'type'          =>  undef,
   58           'preview_text_string' =>  undef,
   59           'preview_latex_string'  =>  undef,
   60           'original_student_ans'  =>  undef
   61       );
   62 
   63 ## Initializing constructor
   64 sub new {
   65   my $class = shift @_;
   66 
   67   my $self  = { 'score'         =>  0,
   68           'correct_ans'     =>  'No correct answer specified',
   69           'student_ans'     =>  undef,
   70           'ans_message'     =>  '',
   71           'type'          =>  'Undefined answer evaluator type',
   72           'preview_text_string' =>  undef,
   73           'preview_latex_string'  =>  undef,
   74           'original_student_ans'  =>  undef,
   75           'error_flag'      =>  undef,
   76           'error_message'       =>  '',
   77 
   78   };  # return a reference to a hash.
   79 
   80   bless $self, $class;
   81   $self -> setKeys(@_);
   82 
   83   return $self;
   84 }
   85 
   86 ## IN: a hash
   87 ## Checks to make sure that the keys are valid,
   88 ## then sets their value
   89 sub setKeys {
   90     my $self = shift;
   91   my %inits = @_;
   92   foreach my $item (keys %inits) {
   93     if ( exists $fields{$item} ) {
   94       $self -> {$item} = $inits{$item};
   95     }
   96     else {
   97       warn "AnswerHash cannot automatically initialize an item named $item";
   98     }
   99   }
  100 }
  101 
  102 # access methods
  103 sub data {    #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo'
  104   my $self = shift;
  105   $self->input(@_);
  106 }
  107 
  108 sub input {     #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo'
  109   my $self = shift;
  110     my $input = shift;
  111     $self->{student_ans} = $input if defined($input);
  112   $self->{student_ans}
  113 }
  114 sub score {
  115   my $self = shift;
  116     my $score = shift;
  117     $self->{score} = $score if defined($score);
  118   $self->{score}
  119 }
  120 
  121 # error methods
  122 sub throw_error {
  123   my $self = shift;
  124     my $flag = shift;
  125     my $message = shift;
  126     $self->{error_message} .= " $message " if defined($message);
  127     $self->{error_flag} = $flag if defined($flag);
  128   $self->{error_flag}
  129 }
  130 sub catch_error {
  131   my $self = shift;
  132     my $flag = shift;
  133     return('')  unless defined($self->{error_flag});
  134     return $self->{error_flag} unless $flag;    # empty input catches all errors.
  135     return $self->{error_flag} if $self->{error_flag} eq $flag;
  136   return '';   # nothing to catch
  137 }
  138 sub clear_error {
  139   my $self = shift;
  140   my $flag = shift;
  141   if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag})  and $flag eq $self->{error_flag}) {
  142     $self->{error_flag} = undef;
  143     $self->{error_message} = undef;
  144   }
  145   $self;
  146 }
  147 sub error_flag {
  148   my $self = shift;
  149     my $flag = shift;
  150     $self->{error_flag} = $flag if defined($flag);
  151   $self->{error_flag}
  152 }
  153 sub error_message {
  154   my $self = shift;
  155     my $message = shift;
  156     $self->{error_message} = $message if defined($message);
  157   $self->{error_message}
  158 }
  159 
  160 # error print out method
  161 
  162 sub pretty_print {
  163     my $r_input = shift;
  164     my $out = '';
  165     if ( not ref($r_input) ) {
  166       $out = $r_input;    # not a reference
  167     } elsif (ref($r_input) =~/hash/i) {
  168       local($^W) = 0;
  169     $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
  170     foreach my $key (sort keys %$r_input ) {
  171       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>";
  172     }
  173     $out .="</table>";
  174   } elsif (ref($r_input) eq 'ARRAY' ) {
  175     my @array = @$r_input;
  176     $out .= "( " ;
  177     while (@array) {
  178       $out .= pretty_print(shift @array) . " , ";
  179     }
  180     $out .= " )";
  181   } elsif (ref($r_input) eq 'CODE') {
  182     $out = "$r_input";
  183   } else {
  184     $out = $r_input;
  185   }
  186     $out;
  187 }
  188 
  189 # action methods
  190 sub OR {
  191   my $self = shift;
  192 
  193   my $rh_ans2 = shift;
  194   my %options = @_;
  195   return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash';
  196 
  197   my $out_hash = new AnswerHash;
  198   # score is the maximum of the two scores
  199   $out_hash->{score} = ( $self->{score}  <  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  200   $out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  201   $out_hash->{student_ans} = $self->{student_ans};
  202   $out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} );
  203   $out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  204   $out_hash->{original_student_ans} = $self->{original_student_ans};
  205   $out_hash;
  206 }
  207 
  208 sub AND {
  209   my $self = shift;
  210   my $rh_ans2 = shift;
  211   my %options = @_;
  212   my $out_hash = new AnswerHash;
  213   # score is the minimum of the two scores
  214   $out_hash->{score} = ( $self->{score}  >  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
  215   $out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
  216   $out_hash->{student_ans} = $self->{student_ans};
  217   $out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} );
  218   $out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
  219   $out_hash->{original_student_ans} = $self->{original_student_ans};
  220   $out_hash;
  221 }
  222 
  223 package AnswerEvaluator;
  224 
  225 
  226 
  227 
  228 sub new {
  229   my $class = shift @_;
  230 
  231   my $self  = { pre_filters   =>  [ [\&blank_prefilter] ],
  232           evaluators    =>  [],
  233           post_filters  =>  [ [\&blank_postfilter] ],
  234           debug     =>  0,
  235           rh_ans    =>  new AnswerHash,
  236 
  237   };
  238 
  239   bless $self, $class;
  240   $self->rh_ans(@_);    #initialize answer hash
  241   return $self;
  242 }
  243 
  244 # dereference_array_ans pretty prints an answer which is stored as an anonymous array.
  245 sub dereference_array_ans {
  246   my $self = shift;
  247   my $rh_ans = shift;
  248   if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY'  ) {
  249     $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) ";
  250   }
  251   $rh_ans;
  252 }
  253 
  254 sub get_student_answer {
  255   my $self  = shift;
  256   my $input   = shift;
  257   $input = '' unless defined($input);
  258   if (ref($input) =~/AnswerHash/) {
  259     # in this case nothing needs to be done, since the student's answer is already in an answerhash.
  260     # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator.
  261   } elsif ($input =~ /\0/ ) {  # this case may occur with older versions of CGI??
  262       my @input = split(/\0/,$input);
  263       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  264     $input = \@input;
  265     $self-> {rh_ans} -> {student_ans} = $input;
  266   } elsif (ref($input) eq 'ARRAY' ) {  # sometimes the answer may already be decoded into an array.
  267       my @input = @$input;
  268       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  269     $input = \@input;
  270     $self-> {rh_ans} -> {student_ans} = $input;
  271   } else {
  272 
  273     $self-> {rh_ans} -> {original_student_ans} = $input;
  274     $self-> {rh_ans} -> {student_ans} = $input;
  275   }
  276 
  277 
  278   $input;
  279 }
  280 
  281 sub evaluate {
  282   my $self    =   shift;
  283   $self->get_student_answer(shift @_);
  284   my $rh_ans    =   $self ->{rh_ans};
  285     warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0;
  286   my @prefilters  = @{$self -> {pre_filters}};
  287   my $count = -1;  # the blank filter is counted as filter 0
  288   foreach my $i (@prefilters) {
  289       last if defined( $self->{rh_ans}->{error_flag} );
  290       my @array = @$i;
  291       my $filter = shift(@array);      # the array now contains the options for the filter
  292       my %options = @array;
  293       if (defined($self->{debug}) and $self->{debug}>0) {
  294 
  295         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  296         warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print();
  297       }
  298       $rh_ans   = &$filter($rh_ans,@array);
  299       warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n"
  300         if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  301       $rh_ans->{_filter_name} = undef;
  302   }
  303   my @evaluators = @{$self -> {evaluators} };
  304   $count = 0;
  305   foreach my $i ( @evaluators )   {
  306       last if defined($self->{rh_ans}->{error_flag});
  307     my @array = @$i;
  308       my $evaluator = shift(@array);   # the array now contains the options for the filter
  309       my %options = @array;
  310       if (defined($self->{debug}) and $self->{debug}>0) {
  311         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  312         warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print();
  313       }
  314     $rh_ans   = &$evaluator($rh_ans,@array);
  315     warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  316     $rh_ans->{_filter_name} = undef;
  317   }
  318   my @post_filters = @{$self -> {post_filters} };
  319   $count = -1;  # blank filter catcher is filter 0
  320   foreach my $i ( @post_filters ) {
  321       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  322     my @array = @$i;
  323 
  324       my $filter = shift(@array);      # the array now contains the options for the filter
  325       my %options = @array;
  326       if (defined($self->{debug}) and $self->{debug}>0) {
  327         $self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
  328         warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n";
  329       }
  330 
  331     $rh_ans   = &$filter($rh_ans,@array);
  332     warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name});
  333     $rh_ans->{_filter_name} = undef;
  334   }
  335   $rh_ans = $self->dereference_array_ans($rh_ans);
  336   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  337   warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  338   $self ->{rh_ans} = $rh_ans;
  339   $rh_ans;
  340 }
  341 # This next subroutine is for checking the instructor's answer and is not yet in use.
  342 sub correct_answer_evaluate {
  343   my $self    =   shift;
  344   $self-> {rh_ans} -> {correct_ans} = shift @_;
  345   my $rh_ans    =   $self ->{rh_ans};
  346   my @prefilters  = @{$self -> {correct_answer_pre_filters}};
  347   my $count = -1;  # the blank filter is counted as filter 0
  348   foreach my $i (@prefilters) {
  349       last if defined( $self->{rh_ans}->{error_flag} );
  350       my @array = @$i;
  351       my $filter = shift(@array);      # the array now contains the options for the filter
  352       warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  353     $rh_ans   = &$filter($rh_ans,@array);
  354     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  355   }
  356   my @evaluators = @{$self -> {correct_answer_evaluators} };
  357   $count = 0;
  358   foreach my $i ( @evaluators )   {
  359       last if defined($self->{rh_ans}->{error_flag});
  360     my @array = @$i;
  361       my $evaluator = shift(@array);   # the array now contains the options for the filter
  362       warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  363     $rh_ans   = &$evaluator($rh_ans,@array);
  364   }
  365   my @post_filters = @{$self -> {correct_answer_post_filters} };
  366   $count = -1;  # blank filter catcher is filter 0
  367   foreach my $i ( @post_filters ) {
  368       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  369     my @array = @$i;
  370       my $filter = shift(@array);      # the array now contains the options for the filter
  371       warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  372     $rh_ans   = &$filter($rh_ans,@array);
  373     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  374   }
  375   $rh_ans = $self->dereference_array_ans($rh_ans);
  376   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  377   warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  378   $self ->{rh_ans} = $rh_ans;
  379   $rh_ans;
  380 }
  381 
  382 sub install_pre_filter {
  383   my $self =  shift;
  384   if (@_ == 0) {
  385     # do nothing if input is empty
  386   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  387     $self->{pre_filters} = [];
  388   } else {
  389     push(@{$self->{pre_filters}},[ @_ ]) if @_;  #install pre_filter and it's options
  390   }
  391   @{$self->{pre_filters}};  # return array of all pre_filters
  392 }
  393 
  394 sub install_evaluator {
  395   my $self =  shift;
  396   if (@_ == 0) {
  397     # do nothing if input is empty
  398   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  399     $self->{evaluators} = [];
  400   } else {
  401     push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  402   }
  403   @{$self->{'evaluators'}};  # return array of all evaluators
  404 }
  405 
  406 sub install_post_filter {
  407   my $self =  shift;
  408   if (@_ == 0) {
  409     # do nothing if input is empty
  410   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  411     $self->{post_filters} = [];
  412   } else {
  413     push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  414   }
  415   @{$self->{post_filters}};  # return array of all post_filters
  416 }
  417 
  418 ## filters for checking the correctAnswer
  419 sub install_correct_answer_pre_filter {
  420   my $self =  shift;
  421   if (@_ == 0) {
  422     # do nothing if input is empty
  423   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  424     $self->{correct_answer_pre_filters} = [];
  425   } else {
  426     push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_;  #install correct_answer_pre_filter and it's options
  427   }
  428   @{$self->{correct_answer_pre_filters}};  # return array of all correct_answer_pre_filters
  429 }
  430 
  431 sub install_correct_answer_evaluator {
  432   my $self =  shift;
  433   if (@_ == 0) {
  434     # do nothing if input is empty
  435   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  436     $self->{correct_answer_evaluators} = [];
  437   } else {
  438     push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options
  439   }
  440   @{$self->{correct_answer_evaluators}};  # return array of all evaluators
  441 }
  442 
  443 sub install_correct_answer_post_filter {
  444   my $self =  shift;
  445   if (@_ == 0) {
  446     # do nothing if input is empty
  447   } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
  448     $self->{correct_answer_post_filters} = [];
  449   } else {
  450     push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
  451   }
  452   @{$self->{correct_answer_post_filters}};  # return array of all post_filters
  453 }
  454 
  455 sub ans_hash {  #alias for rh_ans
  456   my $self = shift;
  457   $self->rh_ans(@_);
  458 }
  459 sub rh_ans {
  460   my $self = shift;
  461   my %in_hash = @_;
  462   foreach my $key (keys %in_hash) {
  463     $self->{rh_ans}->{$key} = $in_hash{$key};
  464   }
  465   $self->{rh_ans};
  466 }
  467 ######################################################
  468 #
  469 # Built in Filters
  470 #
  471 ######################################################
  472 
  473 
  474 sub blank_prefilter  { # check for blanks
  475   my $rh_ans = shift;
  476     # undefined answers are BLANKS
  477   ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  478                             return($rh_ans);};
  479     # answers which are arrays or hashes or some other object reference  are NOT blanks
  480     ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
  481     # if the answer is a true variable consisting only of white space it is a BLANK
  482     ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  483                             return($rh_ans);};
  484   # If we get to here, we assume that the answer is not a blank. It is defined, not a reference
  485   # and contains something other than whitespaces.
  486   $rh_ans;
  487 };
  488 
  489 sub blank_postfilter  {
  490   my $rh_ans=shift;
  491     return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
  492     $rh_ans->{error_flag} = undef;
  493     $rh_ans->{error_message} = '';
  494     $rh_ans->{done} =1;    # no further checking is needed.
  495     $rh_ans;
  496 };
  497 
  498 1;
  499 #package AnswerEvaluatorMaker;
  500 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9