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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9