Parent Directory
| 
Revision Log
AnswerEvaluators can now handle ans_hash as an input (this allows the answerevaluator to be used as a filter in another answer evaluator Cosmetic changes made to the error reporting when the debug flag is set.
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>=></td><td> ".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 if (ref($input) =~/AnswerHash/) { 258 # in this case nothing needs to be done, since the student's answer is already in an answerhash. 259 # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator. 260 } elsif ($input =~ /\0/ ) { 261 my @input = split(/\0/,$input); 262 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 263 $input = \@input; 264 $self-> {rh_ans} -> {student_ans} = $input; 265 } else { 266 $input = '' unless defined($input); 267 $self-> {rh_ans} -> {original_student_ans} = $input; 268 $self-> {rh_ans} -> {student_ans} = $input; 269 } 270 271 272 $input; 273 } 274 275 sub evaluate { 276 my $self = shift; 277 $self->get_student_answer(shift @_); 278 my $rh_ans = $self ->{rh_ans}; 279 warn "<H3> Answer evaluator information: </H3>\n" if $self->{debug}>0; 280 my @prefilters = @{$self -> {pre_filters}}; 281 my $count = -1; # the blank filter is counted as filter 0 282 foreach my $i (@prefilters) { 283 last if defined( $self->{rh_ans}->{error_flag} ); 284 my @array = @$i; 285 my $filter = shift(@array); # the array now contains the options for the filter 286 my %options = @array; 287 if (defined($self->{debug}) and $self->{debug}>0) { 288 289 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 290 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print(); 291 } 292 $rh_ans = &$filter($rh_ans,@array); 293 warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}); 294 $rh_ans->{_filter_name} = undef; 295 } 296 my @evaluators = @{$self -> {evaluators} }; 297 $count = 0; 298 foreach my $i ( @evaluators ) { 299 last if defined($self->{rh_ans}->{error_flag}); 300 my @array = @$i; 301 my $evaluator = shift(@array); # the array now contains the options for the filter 302 my %options = @array; 303 if (defined($self->{debug}) and $self->{debug}>0) { 304 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 305 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print(); 306 } 307 $rh_ans = &$evaluator($rh_ans,@array); 308 warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}); 309 $rh_ans->{_filter_name} = undef; 310 } 311 my @post_filters = @{$self -> {post_filters} }; 312 $count = -1; # blank filter catcher is filter 0 313 foreach my $i ( @post_filters ) { 314 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 315 my @array = @$i; 316 317 my $filter = shift(@array); # the array now contains the options for the filter 318 my %options = @array; 319 if (defined($self->{debug}) and $self->{debug}>0) { 320 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 321 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n"; 322 } 323 324 $rh_ans = &$filter($rh_ans,@array); 325 warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}); 326 $rh_ans->{_filter_name} = undef; 327 } 328 $rh_ans = $self->dereference_array_ans($rh_ans); 329 # make sure that the student answer is not an array so that it is reported correctly in answer section. 330 warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 331 $self ->{rh_ans} = $rh_ans; 332 $rh_ans; 333 } 334 # This next subroutine is for checking the instructor's answer and is not yet in use. 335 sub correct_answer_evaluate { 336 my $self = shift; 337 $self-> {rh_ans} -> {correct_ans} = shift @_; 338 my $rh_ans = $self ->{rh_ans}; 339 my @prefilters = @{$self -> {correct_answer_pre_filters}}; 340 my $count = -1; # the blank filter is counted as filter 0 341 foreach my $i (@prefilters) { 342 last if defined( $self->{rh_ans}->{error_flag} ); 343 my @array = @$i; 344 my $filter = shift(@array); # the array now contains the options for the filter 345 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 346 $rh_ans = &$filter($rh_ans,@array); 347 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 348 } 349 my @evaluators = @{$self -> {correct_answer_evaluators} }; 350 $count = 0; 351 foreach my $i ( @evaluators ) { 352 last if defined($self->{rh_ans}->{error_flag}); 353 my @array = @$i; 354 my $evaluator = shift(@array); # the array now contains the options for the filter 355 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 356 $rh_ans = &$evaluator($rh_ans,@array); 357 } 358 my @post_filters = @{$self -> {correct_answer_post_filters} }; 359 $count = -1; # blank filter catcher is filter 0 360 foreach my $i ( @post_filters ) { 361 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 362 my @array = @$i; 363 my $filter = shift(@array); # the array now contains the options for the filter 364 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 365 $rh_ans = &$filter($rh_ans,@array); 366 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 367 } 368 $rh_ans = $self->dereference_array_ans($rh_ans); 369 # make sure that the student answer is not an array so that it is reported correctly in answer section. 370 warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 371 $self ->{rh_ans} = $rh_ans; 372 $rh_ans; 373 } 374 375 sub install_pre_filter { 376 my $self = shift; 377 if (@_ == 0) { 378 # do nothing if input is empty 379 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 380 $self->{pre_filters} = []; 381 } else { 382 push(@{$self->{pre_filters}},[ @_ ]) if @_; #install pre_filter and it's options 383 } 384 @{$self->{pre_filters}}; # return array of all pre_filters 385 } 386 387 sub install_evaluator { 388 my $self = shift; 389 if (@_ == 0) { 390 # do nothing if input is empty 391 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 392 $self->{evaluators} = []; 393 } else { 394 push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options 395 } 396 @{$self->{'evaluators'}}; # return array of all evaluators 397 } 398 399 sub install_post_filter { 400 my $self = shift; 401 if (@_ == 0) { 402 # do nothing if input is empty 403 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 404 $self->{post_filters} = []; 405 } else { 406 push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 407 } 408 @{$self->{post_filters}}; # return array of all post_filters 409 } 410 411 ## filters for checking the correctAnswer 412 sub install_correct_answer_pre_filter { 413 my $self = shift; 414 if (@_ == 0) { 415 # do nothing if input is empty 416 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 417 $self->{correct_answer_pre_filters} = []; 418 } else { 419 push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_; #install correct_answer_pre_filter and it's options 420 } 421 @{$self->{correct_answer_pre_filters}}; # return array of all correct_answer_pre_filters 422 } 423 424 sub install_correct_answer_evaluator { 425 my $self = shift; 426 if (@_ == 0) { 427 # do nothing if input is empty 428 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 429 $self->{correct_answer_evaluators} = []; 430 } else { 431 push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options 432 } 433 @{$self->{correct_answer_evaluators}}; # return array of all evaluators 434 } 435 436 sub install_correct_answer_post_filter { 437 my $self = shift; 438 if (@_ == 0) { 439 # do nothing if input is empty 440 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 441 $self->{correct_answer_post_filters} = []; 442 } else { 443 push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 444 } 445 @{$self->{correct_answer_post_filters}}; # return array of all post_filters 446 } 447 448 sub ans_hash { #alias for rh_ans 449 my $self = shift; 450 $self->rh_ans(@_); 451 } 452 sub rh_ans { 453 my $self = shift; 454 my %in_hash = @_; 455 foreach my $key (keys %in_hash) { 456 $self->{rh_ans}->{$key} = $in_hash{$key}; 457 } 458 $self->{rh_ans}; 459 } 460 ###################################################### 461 # 462 # Built in Filters 463 # 464 ###################################################### 465 466 467 sub blank_prefilter { # check for blanks 468 my $rh_ans = shift; 469 # undefined answers are BLANKS 470 ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 471 return($rh_ans);}; 472 # answers which are arrays or hashes or some other object reference are NOT blanks 473 ( ref($rh_ans->{student_ans} ) ) && do { return( $rh_ans ) }; 474 # if the answer is a true variable consisting only of white space it is a BLANK 475 ( ($rh_ans->{student_ans}) !~ /\S/ ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 476 return($rh_ans);}; 477 # If we get to here, we assume that the answer is not a blank. It is defined, not a reference 478 # and contains something other than whitespaces. 479 $rh_ans; 480 }; 481 482 sub blank_postfilter { 483 my $rh_ans=shift; 484 return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK'; 485 $rh_ans->{error_flag} = undef; 486 $rh_ans->{error_message} = ''; 487 $rh_ans->{done} =1; # no further checking is needed. 488 $rh_ans; 489 }; 490 491 1; 492 #package AnswerEvaluatorMaker; 493
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |