[system] / trunk / pg / macros / parserMultiPart.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/parserMultiPart.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : dpvc 3270 sub _parserMultiPart_init {}
2 :    
3 :     #
4 :     # MultiPart objects let you tie several answer blanks to a single
5 :     # answer checker, so you can have the answer in one blank influence
6 :     # the answer in another. The MultiPart can produce either a single
7 :     # result in the answer results area, or a separate result for each
8 :     # blank.
9 :     #
10 :     # To create a MultiPart pass a list of answers to MultiPart() in the
11 :     # order they will appear in the problem. For example:
12 :     #
13 :     # $mp = MultiPart("x^2",-1,1);
14 :     #
15 :     # or
16 :     #
17 :     # $mp = MultiPart(Vector(1,1,1),Vector(2,2,2))->with(singleResult=>1);
18 :     #
19 :     # Then, use $mp->ans_rule to create answer blanks for the various parts
20 :     # just as you would ans_rule. You can pass the width of the blank, which
21 :     # defaults to 20 otherwise. For example:
22 :     #
23 :     # BEGIN_TEXT
24 :     # \(f(x)\) = \{$mp->ans_rule(20)\} produces the same value
25 :     # at \(x\) = \{$mp->ans_rule(10)\} as it does at \(x\) = \{$mp->ans_rule(10)\}.
26 :     # END_TEXT
27 :     #
28 :     # Finally, call $mp->cmp to produce the answer checker(s) used in the MultiPart.
29 :     # You need to provide a checker routine that will be called to determine if the
30 :     # answers are correct or not. The checker will only be called if the student
31 :     # answers have no syntax errors and their types match the types of the professor's
32 :     # answers, so you don't ahve to worry about handling bad data from the student
33 :     # (at least as far as typechecking goes).
34 :     #
35 :     # The checker routine should accept three parameters: a reference to the array
36 :     # of correct answers, a reference to the array of student answers, and a reference
37 :     # to the MultiPart itself. It should do whatever checking it needs to do and
38 :     # then return a score for the MultiPart as a whole (every answer blank will be
39 :     # given the same score), or a reference to an array of scores, one for each
40 :     # blank. The routine can set error messages via the MultiPart's setMessage()
41 :     # method (e.g., $mp->setMessage(1,"The function can't be the identity") would
42 :     # set the message for the first answer blank of the MultiPart), or can call
43 :     # Value::Error() to generate an error and die.
44 :     #
45 :     # The checker routine can be supplied either when the MultiPart is created, or
46 :     # when the cmp() method is called. For example:
47 :     #
48 :     # $mp = MultiPart("x^2",1,-1)->with(
49 :     # singleResult => 1,
50 :     # checker => sub {
51 :     # my ($correct,$student,$self) = @_; # get the parameters
52 :     # my ($f,$x1,$x2) = @{$student}; # extract the student answers
53 :     # Value::Error("Function can't be the identity") if ($f == 'x');
54 :     # Value::Error("Function can't be constant") if ($f->isConstant);
55 :     # return $f->eval(x=>$x1) == $f->eval(x=>$x2);
56 :     # },
57 :     # );
58 :     # .
59 :     # .
60 :     # .
61 :     # ANS($mp->cmp);
62 :     #
63 :     # or
64 :     #
65 :     # $mp = MultiPart("x^2",1,-1)->with(singleResult=>1);
66 :     # sub check {
67 :     # my ($correct,$student,$self) = @_; # get the parameters
68 :     # my ($f,$x1,$x2) = @{$student}; # extract the student answers
69 :     # Value::Error("Function can't be the identity") if ($f == 'x');
70 :     # Value::Error("Function can't be constant") if ($f->isConstant);
71 :     # return $f->eval(x=>$x1) == $f->eval(x=>$x2);
72 :     # };
73 :     # .
74 :     # .
75 :     # .
76 :     # ANS($mp->cmp(checker=>~~&check));
77 :     #
78 :     ######################################################################
79 :    
80 :     package MultiPart;
81 :     our @ISA = qw(Value);
82 :    
83 :     our $count = 0; # counter for unique identifier for multi-parts
84 :     our $answerPrefix = "MuLtIpArT"; # answer rule prefix
85 :     our $separator = ';'; # separator for singleResult previews
86 :    
87 :     #
88 :     # Create a new MultiPart item from a list of items.
89 :     # The items are converted if Value items, if they aren't already.
90 :     # You can set the following fields of the resulting item:
91 :     #
92 :     # checker => code a subroutine to be called to check the
93 :     # student answers. The routine is passed
94 :     # three parameters: a reference to the array
95 :     # or correct answers, a reference to the
96 :     # array of student answers, and a reference
97 :     # to the MultiPart object itself. The routine
98 :     # should return either a score or an array of
99 :     # scores (one for each student answer).
100 :     #
101 :     # singleResult => 0 or 1 whether to show only one entry in the
102 :     # results area at the top of the page,
103 :     # or one for each answer rule.
104 :     # (Default: 0)
105 :     #
106 :     # namedRules => 0 or 1 wether to use named rules or default
107 :     # rule names. Use named rules if you need
108 :     # to intersperse other rules with the
109 :     # ones for the MultiPart, in which case
110 :     # you must use NAMED_ANS not ANS.
111 :     # (Default: 0)
112 :     #
113 :     # checkTypes => 0 or 1 whether the types of the student and
114 :     # professor's answers must match exactly
115 :     # or just pass the usual type-match error
116 :     # checking (in which case, you should check
117 :     # the types before you use the data).
118 :     # (Default: 1)
119 :     #
120 :     # separator => string the string to use between entries in the
121 :     # results area when singleResult is set.
122 :     #
123 :     # tex_separator => string same, but for the preview area.
124 :     #
125 :     my @ans_defaults = (
126 :     checker => sub {0},
127 :     showCoordinateHints => 0,
128 :     showEndpointHints => 0,
129 :     showEndTypeHints => 0,
130 :     );
131 :    
132 :     sub new {
133 :     my $self = shift; my $class = ref($self) || $self;
134 :     my @data = @_; my @cmp;
135 :     Value::Error($class." lists can't be empty") if scalar(@data) == 0;
136 :     foreach my $x (@data) {
137 :     $x = Value::makeValue($x) unless Value::isValue($x);
138 :     push(@cmp,$x->cmp(@ans_defaults));
139 :     }
140 :     bless {
141 :     data => [@data], cmp => [@cmp], ans => [],
142 :     part => 0, singleResult => 0, namedRules => 0, checkTypes => 1,
143 :     tex_separator => $separator.'\,', separator => $separator.' ',
144 :     context => $$Value::context, id => $answerPrefix.($count++),
145 :     }, $class;
146 :     }
147 :    
148 :     #
149 :     # Creates an answer checker (or array of same) to be passed
150 :     # to ANS() or NAMED_ANS(). Any parameters are passed to
151 :     # the individual answer checkers.
152 :     #
153 :     sub cmp {
154 :     my $self = shift; my %options = @_;
155 :     foreach my $id ('checker','separator') {
156 :     if (defined($options{$id})) {
157 :     $self->{$id} = $options{$id};
158 :     delete $options{$id};
159 :     }
160 :     }
161 :     die "You must supply a checker subroutine" unless ref($self->{checker}) eq 'CODE';
162 :     my @cmp = ();
163 :     if ($self->{singleResult}) {
164 :     push(@cmp,$self->ANS_NAME(0)) if $self->{namedRules};
165 :     push(@cmp,$self->single_cmp(%options));
166 :     } else {
167 :     foreach my $i (0..$self->length-1) {
168 :     push(@cmp,$self->ANS_NAME($i)) if $self->{namedRules};
169 :     push(@cmp,$self->entry_cmp($i,%options));
170 :     }
171 :     }
172 :     return @cmp;
173 :     }
174 :    
175 :     ######################################################################
176 :    
177 :     #
178 :     # Get the answer checker used for when all the answers are treated
179 :     # as a single result.
180 :     #
181 :     sub single_cmp {
182 :     my $self = shift; my @correct;
183 :     foreach my $cmp (@{$self->{cmp}}) {push(@correct,$cmp->{rh_ans}{correct_ans})}
184 :     my $ans = new AnswerEvaluator;
185 :     $ans->ans_hash(
186 :     correct_ans => join($self->{separator},@correct),
187 :     type => "MultiPart",
188 :     @_,
189 :     );
190 :     $ans->install_evaluator(sub {my $ans = shift; (shift)->single_check($ans)},$self);
191 :     $ans->install_pre_filter('erase'); # don't do blank check
192 :     return $ans;
193 :     }
194 :    
195 :     #
196 :     # Check the answers when they are treated as a single result.
197 :     #
198 :     # First, call individual answer checkers to get any type-check errors
199 :     # Then perform the user's checker routine
200 :     # Finally collect the individual answers and errors and combine
201 :     # them for the single result.
202 :     #
203 :     sub single_check {
204 :     my $self = shift; my $ans = shift;
205 :     my $inputs = $main::inputs_ref;
206 :     $self->{ans}[0] = $self->{cmp}[0]->evaluate($ans->{student_ans});
207 :     foreach my $i (1..$self->length-1)
208 :     {$self->{ans}[$i] = $self->{cmp}[$i]->evaluate($inputs->{$self->ANS_NAME($i)})}
209 :     my $score = 0; my (@errors,@student,@latex,@text);
210 :     my $i = 0; my $nonblank = 0;
211 :     if ($self->perform_check) {
212 :     push(@errors,$self->{ans}[0]{ans_message});
213 :     $self->{ans}[0]{ans_message} = "";
214 :     }
215 :     foreach my $result (@{$self->{ans}}) {
216 :     $i++; $nonblank |= ($result->{student_ans} =~ m/\S/);
217 :     push(@latex,check_string($result->{preview_latex_string},'\_\_'));
218 :     push(@text,check_string($result->{preview_text_string},'__'));
219 :     push(@student,check_string($result->{student_ans},'__'));
220 :     if ($result->{ans_message}) {
221 :     push(@errors,"Answer $i: ".$result->{ans_message});
222 :     } else {$score += $result->{score}}
223 :     }
224 :     $ans->score($score/$self->length);
225 :     $ans->{ans_message} = $ans->{error_message} = join("<BR>",@errors);
226 :     if ($nonblank) {
227 :     $ans->{preview_latex_string} = '{'.join('}'.$self->{tex_separator}.'{',@latex).'}';
228 :     $ans->{preview_text_string} = join($self->{separator},@text);
229 :     $ans->{student_ans} = join($self->{separator},@student);
230 :     }
231 :     return $ans;
232 :     }
233 :    
234 :     #
235 :     # Return a given string or a default if it is empty or not defined
236 :     #
237 :     sub check_string {
238 :     my $s = shift;
239 :     $s = shift unless defined($s) && $s =~ m/\S/;
240 :     return $s;
241 :     }
242 :    
243 :     ######################################################################
244 :    
245 :     #
246 :     # Answer checker to use for individual entries when singleResult
247 :     # is not in effect.
248 :     #
249 :     sub entry_cmp {
250 :     my $self = shift; my $i = shift;
251 :     my $ans = new AnswerEvaluator;
252 :     $ans->ans_hash(
253 :     correct_ans => $self->{cmp}[$i]{rh_ans}{correct_ans},
254 :     part => $i,
255 :     type => "MultiPart($i)",
256 :     @_,
257 :     );
258 :     $ans->install_evaluator(sub {my $ans = shift; (shift)->entry_check($ans)},$self);
259 :     $ans->install_pre_filter('erase'); # don't do blank check
260 :     return $ans;
261 :     }
262 :    
263 :     #
264 :     # Call the correct answser's checker to check for syntax and type errors.
265 :     # If this is the last one, perform the user's checker routine as well
266 :     # Return the individual answer (our answer hash is discarded).
267 :     #
268 :     sub entry_check {
269 :     my $self = shift; my $ans = shift;
270 :     my $i = $ans->{part};
271 :     $self->{ans}[$i] = $self->{cmp}[$i]->evaluate($ans->{student_ans});
272 :     $self->{ans}[$i]->score(0);
273 :     $self->perform_check if ($i == $self->length - 1);
274 :     return $self->{ans}[$i];
275 :     }
276 :    
277 :     ######################################################################
278 :    
279 :     #
280 :     # Collect together the correct and student answers, and call the
281 :     # user's checker routine.
282 :     #
283 :     # If any of the answers produced errors or the types don't match
284 :     # don't call the user's routine.
285 :     # Otherwise, call it, and if there was an error, report that.
286 :     # Set the individual scores based on the result from the user's routine.
287 :     #
288 :     sub perform_check {
289 :     my $self = shift; $self->{context}->clearError;
290 :     my @correct; my @student;
291 :     foreach my $ans (@{$self->{ans}}) {
292 :     push(@correct,$ans->{correct_value});
293 :     push(@student,$ans->{student_value});
294 :     return if $ans->{ans_message} ne "" || !defined($ans->{student_value});
295 :     return if $self->{checkTypes} && $ans->{student_value}->type ne $ans->{correct_value}->type;
296 :     }
297 :     my $result = Value::cmp_compare([@correct],[@student],$self);
298 :     if (!defined($result) && $self->{context}{error}{flag}) {$self->cmp_error($self->{ans}[0]); return 1}
299 :     $result = 0 if (!defined($result) || $result eq '');
300 :     if (ref($result) eq 'ARRAY') {
301 :     die "Checker subroutine returned the wrong number of results"
302 :     if (scalar(@{$result}) != $self->length);
303 :     foreach my $i (0..$self->length-1) {$self->{ans}[$i]->score($result->[$i])}
304 :     } elsif (Value::matchNumber($result)) {
305 :     foreach my $ans (@{$self->{ans}}) {$ans->score($result)}
306 :     } else {
307 :     die "Checker subroutine should return a number or array of numbers ($result)";
308 :     }
309 :     return;
310 :     }
311 :    
312 :     ######################################################################
313 :    
314 :     #
315 :     # The user's checker can call setMessage(n,message) to set the error message
316 :     # for the n-th answer blank.
317 :     #
318 :     sub setMessage {
319 :     my $self = shift; my $i = (shift)-1; my $message = shift;
320 :     $self->{ans}[$i]->{ans_message} = $self->{ans}[$i]->{error_message} = $message;
321 :     }
322 :    
323 :    
324 :     ######################################################################
325 :    
326 :     #
327 :     # Produce the name for a named answer blank
328 :     #
329 :     sub ANS_NAME {
330 :     my $self = shift; my $i = shift;
331 :     $self->{id}.'_'.$i;
332 :     }
333 :    
334 :     #
335 :     # Record an answer-blank name (when using extensions)
336 :     #
337 :     sub NEW_NAME {
338 :     my $self = shift;
339 :     main::RECORD_FORM_LABEL(shift);
340 :     }
341 :    
342 :     #
343 :     # Produce an answer rule for the next item in the list,
344 :     # taking care to use names or extensions as needed
345 :     # by the settings of the MultiPart.
346 :     #
347 :     sub ans_rule {
348 :     my $self = shift; my $size = shift || 20;
349 :     my $data = $self->{data}[$self->{part}];
350 :     my $name = $self->ANS_NAME($self->{part}++);
351 :     return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_)
352 :     if ($self->{singleResult} && $self->{part} > 1);
353 :     return $data->ans_rule($size,@_) unless $self->{namedRules};
354 :     return $data->named_ans_rule($name,$size,@_);
355 :     }
356 :    
357 :     #
358 :     # Do the same, but for answer arrays, which are generated by the
359 :     # Value objects automatically sized to suit their data.
360 :     # Reset the correct_ans once the array is made
361 :     #
362 :     sub ans_array {
363 :     my $self = shift; my $size = shift || 5; my $HTML;
364 :     my $data = $self->{data}[$self->{part}];
365 :     my $name = $self->ANS_NAME($self->{part}++);
366 :     if ($self->{singleResult} && $self->{part} > 1) {
367 :     $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_);
368 :     } elsif (!$self->{namedRules}) {
369 :     $HTML = $data->ans_array($size,@_);
370 :     } else {
371 :     $HTML = $data->named_ans_array($name,$size,@_);
372 :     }
373 :     $self->{cmp}[$self->{part}-1] = $data->cmp(@ans_defaults);
374 :     return $HTML;
375 :     }
376 :    
377 :     ######################################################################
378 :    
379 :     package main;
380 :    
381 :     #
382 :     # Main routine to create MultiPart items.
383 :     #
384 :     sub MultiPart {MultiPart->new(@_)};
385 :    
386 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9