[system] / trunk / pg / lib / AnswerHash.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/AnswerHash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4969 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9