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

Diff of /trunk/pg/lib/Value/AnswerChecker.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2600 Revision 2772
… …
15 15
16# 16#
17# Create an answer checker for the given type of object 17# Create an answer checker for the given type of object
18# 18#
19 19
20our $cmp_defaults = { 20sub cmp_defaults {(
21 showTypeWarnings => 1, 21 showTypeWarnings => 1,
22 showEqualErrors => 1, 22 showEqualErrors => 1,
23}; 23 ignoreStrings => 1,
24)}
24 25
25sub cmp { 26sub cmp {
26 my $self = shift; 27 my $self = shift;
27 my $ans = new AnswerEvaluator; 28 my $ans = new AnswerEvaluator;
28 my $defaults = ref($self)."::cmp_defaults";
29 $ans->ans_hash( 29 $ans->ans_hash(
30 type => "Value (".$self->class.")", 30 type => "Value (".$self->class.")",
31 correct_ans => $self->string, 31 correct_ans => protectHTML($self->string),
32 correct_value => $self, 32 correct_value => $self,
33 %{$$defaults || $cmp_defaults}, 33 $self->cmp_defaults,
34 @_ 34 @_
35 ); 35 );
36 $ans->install_evaluator( 36 $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
37 sub { 37 $self->{context} = $$Value::context unless defined($self->{context});
38 my $ans = shift;
39 # can't seem to get $inputs_ref any other way
40 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
41 my $self = $ans->{correct_value};
42 my $method = $ans->{cmp_check} || 'cmp_check';
43 $self->$method($ans);
44 }
45 );
46 return $ans; 38 return $ans;
47} 39}
48 40
49# 41#
50# Parse the student answer and compute its value, 42# Parse the student answer and compute its value,
51# produce the preview strings, and then compare the 43# produce the preview strings, and then compare the
52# student and professor's answers for equality. 44# student and professor's answers for equality.
53# 45#
54sub cmp_check { 46sub cmp_parse {
55 my $self = shift; my $ans = shift; 47 my $self = shift; my $ans = shift;
56 # 48 #
57 # Methods to call 49 # Do some setup
58 # 50 #
59 my $cmp_equal = $ans->{cmp_equal} || 'cmp_equal'; 51 my $current = $$Value::context; # save it for later
60 my $cmp_error = $ans->{cmp_error} || 'cmp_error'; 52 my $context = $ans->{correct_value}{context} || $current;
61 my $cmp_postprocess = $ans->{cmp_postprocess}; 53 Parser::Context->current(undef,$context); # change to correct answser's context
54 $context->flags->set(StringifyAsTeX => 0); # reset this, just in case.
55 $context->flags->set(no_parameters => 1); # don't let students enter parameters
56 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
57 $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
58
62 # 59 #
63 # Parse and evaluate the student answer 60 # Parse and evaluate the student answer
64 # 61 #
65 $ans->score(0); # assume failure 62 $ans->score(0); # assume failure
66 my $vars = $$Value::context->{variables};
67 $$Value::context->{variables} = {}; # pretend there are no variables
68 $ans->{student_formula} = Parser::Formula($ans->{student_ans}); 63 $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
69 $ans->{student_value} = Parser::Evaluate($ans->{student_formula}); 64 $ans->{student_value} = Parser::Evaluate($ans->{student_formula})
70 $$Value::context->{variables} = $vars; 65 if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
66
71 # 67 #
72 # If it parsed OK, save the output forms and check if it is correct 68 # If it parsed OK, save the output forms and check if it is correct
73 # otherwise report an error 69 # otherwise report an error
74 # 70 #
75 if (defined $ans->{student_value}) { 71 if (defined $ans->{student_value}) {
76 $ans->{student_value} = Value::Formula->new($ans->{student_value}) 72 $ans->{student_value} = Value::Formula->new($ans->{student_value})
77 unless Value::isValue($ans->{student_value}); 73 unless Value::isValue($ans->{student_value});
78 $ans->{preview_latex_string} = $ans->{student_formula}->TeX; 74 $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
79 $ans->{preview_text_string} = $ans->{student_formula}->string; 75 $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
80 $ans->{student_ans} = $ans->{student_value}->stringify; 76 $ans->{student_ans} = $ans->{preview_text_string};
81 $self->$cmp_equal($ans); 77 $self->cmp_equal($ans);
82 $self->$cmp_postprocess($ans) if $cmp_postprocess && !$ans->{error_message}; 78 $self->cmp_postprocess($ans) if !$ans->{error_message};
83 } else { 79 } else {
84 $self->$cmp_error($ans); 80 $self->cmp_error($ans);
85 } 81 }
82 $context->flags->set(no_parameters => 0); # let professors enter parameters
83 Parser::Context->current(undef,$current); # put back the old context
86 return $ans; 84 return $ans;
87} 85}
88 86
89# 87#
90# Check if the parsed student answer equals the professor's answer 88# Check if the parsed student answer equals the professor's answer
91# 89#
92sub cmp_equal { 90sub cmp_equal {
93 my $self = shift; my $ans = shift; 91 my $self = shift; my $ans = shift;
92 my $correct = $ans->{correct_value};
93 my $student = $ans->{student_value};
94 if ($ans->{correct_value}->typeMatch($ans->{student_value},$ans)) { 94 if ($correct->typeMatch($student,$ans)) {
95 my $equal = eval {$ans->{correct_value} == $ans->{student_value}}; 95 my $equal = eval {$correct == $student};
96 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} 96 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
97 my $cmp_error = $ans->{cmp_error} || 'cmp_error';
98 $self->$cmp_error($ans); 97 $self->cmp_error($ans);
99 } else { 98 } else {
99 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
100 $ans->{ans_message} = $ans->{error_message} = 100 $ans->{ans_message} = $ans->{error_message} =
101 "Your answer isn't ".lc($ans->{correct_value}->showClass). 101 "Your answer isn't ".lc($ans->{cmp_class}).
102 " (it looks like ".lc($ans->{student_value}->showClass).")" 102 " (it looks like ".lc($student->showClass).")"
103 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; 103 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
104 } 104 }
105} 105}
106 106
107# 107#
108# Check if types are compatible for equality check 108# Check if types are compatible for equality check
109# 109#
110sub typeMatch { 110sub typeMatch {
111 my $self = shift; my $other = shift; 111 my $self = shift; my $other = shift;
112 return 1 unless ref($other); 112 return 1 unless ref($other);
113 $self->type eq $other->type; 113 $self->type eq $other->type && $other->class ne 'Formula';
114}
115
116#
117# Class name for cmp error messages
118#
119sub cmp_class {
120 my $self = shift; my $ans = shift;
121 my $class = $self->showClass; $class =~ s/Real //;
122 return $class if $class =~ m/Formula/;
123 return "an Interval or Union" if $class =~ m/Interval/i;
124 return $class;
114} 125}
115 126
116# 127#
117# Student answer evaluation failed. 128# Student answer evaluation failed.
118# Report the error, with formatting, if possible. 129# Report the error, with formatting, if possible.
… …
130 '<SPAN CLASS="parsehilight">' . 141 '<SPAN CLASS="parsehilight">' .
131 protectHTML(substr($string,$s,$e-$s)) . 142 protectHTML(substr($string,$s,$e-$s)) .
132 '</SPAN>' . 143 '</SPAN>' .
133 protectHTML(substr($string,$e)); 144 protectHTML(substr($string,$e));
134 } 145 }
146 $self->cmp_Error($ans,$message);
147}
148
149#
150# Set the error message
151#
152sub cmp_Error {
153 my $self = shift; my $ans = shift;
154 return unless scalar(@_) > 0;
135 $ans->score(0); 155 $ans->score(0);
136 $ans->{ans_message} = $ans->{error_message} = $message; 156 $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
137} 157}
158
159#
160# filled in by sub-classes
161#
162sub cmp_postprocess {}
138 163
139# 164#
140# Quote HTML characters 165# Quote HTML characters
141# 166#
142sub protectHTML { 167sub protectHTML {
143 my $string = shift; 168 my $string = shift;
169 return $string if eval ('$main::displayMode') eq 'TeX';
144 $string =~ s/&/\&amp;/g; 170 $string =~ s/&/\&amp;/g;
145 $string =~ s/</\&lt;/g; 171 $string =~ s/</\&lt;/g;
146 $string =~ s/>/\&gt;/g; 172 $string =~ s/>/\&gt;/g;
147 $string; 173 $string;
148} 174}
149 175
150# 176#
177# names for numbers
178#
179sub NameForNumber {
180 my $self = shift; my $n = shift;
181 my $name = ('zeroth','first','second','third','fourth','fifth',
182 'sixth','seventh','eighth','ninth','tenth')[$n];
183 $name = "$n-th" if ($n > 10);
184 return $name;
185}
186
187#
151# Get a value from the safe compartment 188# Get a value from the safe compartment
152# 189#
153sub getPG { 190sub getPG {
154 my $self = shift; 191 my $self = shift;
155 (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0]; 192# (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
193 eval ('package main; '.shift); # faster
156} 194}
157 195
158############################################################# 196#############################################################
159############################################################# 197#############################################################
160 198
161package Value::Real; 199package Value::Real;
162 200
163our $cmp_defaults = { 201sub cmp_defaults {(
164 %{$Value::cmp_defaults}, 202 shift->SUPER::cmp_defaults,
165 ignoreStrings => 1, 203 ignoreInfinity => 1,
166}; 204)}
167 205
168sub typeMatch { 206sub typeMatch {
169 my $self = shift; my $other = shift; my $ans = shift; 207 my $self = shift; my $other = shift; my $ans = shift;
170 return 1 unless ref($other); 208 return 1 unless ref($other);
171 if ($other->type eq 'String' && $ans->{ignoreStrings}) { 209 return 0 if Value::isFormula($other);
172 $ans->{showEqualErrors} = 0; 210 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
173 return 1;
174 }
175 $self->type eq $other->type; 211 $self->type eq $other->type;
176} 212}
177 213
178############################################################# 214#############################################################
179 215
216package Value::Infinity;
217
218sub cmp_class {'a Number'};
219
220sub typeMatch {
221 my $self = shift; my $other = shift; my $ans = shift;
222 return 1 unless ref($other);
223 return 0 if Value::isFormula($other);
224 return 1 if $other->type eq 'Number';
225 $self->type eq $other->type;
226}
227
228#############################################################
229
230package Value::String;
231
232sub cmp_defaults {(
233 Value::Real->cmp_defaults,
234 typeMatch => 'Value::Real',
235)}
236
237sub cmp_class {
238 my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
239 return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
240 return $typeMatch->cmp_class;
241};
242
243sub typeMatch {
244 my $self = shift; my $other = shift; my $ans = shift;
245 return 0 if ref($other) && Value::isFormula($other);
246 my $typeMatch = $ans->{typeMatch};
247 return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' ||
248 $self->type eq $other->type;
249 return $typeMatch->typeMatch($other,$ans);
250}
251
252#############################################################
253
180package Value::Point; 254package Value::Point;
181 255
182our $cmp_defaults = { 256sub cmp_defaults {(
183 %{$Value::cmp_defaults}, 257 shift->SUPER::cmp_defaults,
184 showDimensionWarnings => 1, 258 showDimensionHints => 1,
185}; 259 showCoordinateHints => 1,
260)}
186 261
187sub typeMatch { 262sub typeMatch {
188 my $self = shift; my $other = shift; my $ans = shift; 263 my $self = shift; my $other = shift; my $ans = shift;
189 return 0 unless ref($other); 264 return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
190 return 0 unless $other->type eq 'Point'; 265}
191 if (!$ans->{isPreview} && $ans->{showDimensionWarnings} && 266
267#
268# Check for dimension mismatch and incorrect coordinates
269#
270sub cmp_postprocess {
271 my $self = shift; my $ans = shift;
272 return unless $ans->{score} == 0 && !$ans->{isPreview};
273 if ($ans->{showDimensionHints} &&
192 $self->length != $other->length) { 274 $self->length != $ans->{student_value}->length) {
193 $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect"; 275 $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
194 return 0; 276 }
277 if ($ans->{showCoordinateHints}) {
278 my @errors;
279 foreach my $i (1..$self->length) {
280 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
281 if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
195 } 282 }
196 return 1; 283 $self->cmp_Error($ans,@errors); return;
284 }
197} 285}
198 286
199############################################################# 287#############################################################
200 288
201package Value::Vector; 289package Value::Vector;
202 290
203our $cmp_defaults = { 291sub cmp_defaults {(
204 %{$Value::cmp_defaults}, 292 shift->SUPER::cmp_defaults,
205 showDimensionWarnings => 1, 293 showDimensionHints => 1,
294 showCoordinateHints => 1,
206 promotePoints => 0, 295 promotePoints => 0,
207 parallel => 0, 296 parallel => 0,
208 sameDirection => 0, 297 sameDirection => 0,
209 cmp_postprocess => 'cmp_postprocess', 298)}
210};
211 299
212sub typeMatch { 300sub typeMatch {
213 my $self = shift; my $other = shift; my $ans = shift; 301 my $self = shift; my $other = shift; my $ans = shift;
214 return 0 unless ref($other); 302 return 0 unless ref($other) && $other->class ne 'Formula';
215 return 0 unless $other->type eq 'Vector' || 303 return $other->type eq 'Vector' ||
216 ($ans->{promotePoints} && $other->type eq 'Point'); 304 ($ans->{promotePoints} && $other->type eq 'Point');
217 if (!$ans->{isPreview} && $ans->{showDimensionWarnings} &&
218 $self->length != $other->length) {
219 $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect";
220 return 0;
221 }
222 return 1;
223} 305}
224 306
225# 307#
226# Handle check for parallel vectors 308# check for dimension mismatch
309# for parallel vectors, and
310# for incorrect coordinates
227# 311#
228sub cmp_postprocess { 312sub cmp_postprocess {
229 my $self = shift; my $ans = shift; 313 my $self = shift; my $ans = shift;
230 return unless $ans->{parallel} && $ans->{score} == 0; 314 return unless $ans->{score} == 0;
315 if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
316 $self->length != $ans->{student_value}->length) {
317 $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
318 }
319 if ($ans->{parallel} &&
231 $ans->score(1) if $self->isParallel($ans->{student_value},$ans->{sameDirection}); 320 $self->isParallel($ans->{student_value},$ans->{sameDirection})) {
321 $ans->score(1); return;
322 }
323 if (!$ans->{isPreview} && $ans->{showCoordinateHints}) {
324 my @errors;
325 foreach my $i (1..$self->length) {
326 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
327 if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
328 }
329 $self->cmp_Error($ans,@errors); return;
330 }
232} 331}
233 332
234 333
235 334
236############################################################# 335#############################################################
237 336
238package Value::Matrix; 337package Value::Matrix;
239 338
240our $cmp_defaults = { 339sub cmp_defaults {(
241 %{$Value::cmp_defaults}, 340 shiftf->SUPER::cmp_defaults,
242 showDimensionWarnings => 1, 341 showDimensionHints => 1,
243}; 342 showEqualErrors => 0,
343)}
244 344
245sub typeMatch { 345sub typeMatch {
246 my $self = shift; my $other = shift; my $ans = shift; 346 my $self = shift; my $other = shift; my $ans = shift;
247 return 0 unless ref($other); 347 return 0 unless ref($other) && $other->class ne 'Formula';
248 $other = $self->make($other->{data}) if $other->class eq 'Point';
249 return 0 unless $other->type eq 'Matrix'; 348 return $other->type eq 'Matrix' ||
250 return 1 unless $ans->{showDimensionWarnings}; 349 ($other->type =~ m/^(Point|list)$/ &&
350 $other->{open}.$other->{close} eq $self->{open}.$self->{close});
351}
352
353sub cmp_postprocess {
354 my $self = shift; my $ans = shift;
355 return unless $ans->{score} == 0 &&
356 !$ans->{isPreview} && $ans->{showDimensionHints};
251 my @d1 = $self->dimensions; my @d2 = $other->dimensions; 357 my @d1 = $self->dimensions; my @d2 = $ans->{student_value}->dimensions;
252 if (scalar(@d1) != scalar(@d2)) { 358 if (scalar(@d1) != scalar(@d2)) {
253 $ans->{ans_message} = $ans->{error_message} =
254 "Matrix dimension is not correct"; 359 $self->cmp_Error($ans,"Matrix dimension is not correct");
255 return 0; 360 return;
256 } else { 361 } else {
257 foreach my $i (0..scalar(@d1)-1) { 362 foreach my $i (0..scalar(@d1)-1) {
258 if ($d1[$i] != $d2[$i]) { 363 if ($d1[$i] != $d2[$i]) {
259 $ans->{ans_message} = $ans->{error_message} = 364 $self->cmp_Error($ans,"Matrix dimension is not correct");
260 "Matrix dimension is not correct";
261 return 0; 365 return;
262 } 366 }
263 } 367 }
264 } 368 }
265 return 1;
266} 369}
267 370
268############################################################# 371#############################################################
269 372
270package Value::Interval; 373package Value::Interval;
271 374
272## @@@ report interval-type mismatch? @@@ 375sub cmp_defaults {(
376 shift->SUPER::cmp_defaults,
377 showEndpointHints => 1,
378 showEndTypeHints => 1,
379)}
273 380
274sub typeMatch { 381sub typeMatch {
275 my $self = shift; my $other = shift; 382 my $self = shift; my $other = shift;
276 return 0 unless ref($other); 383 return 0 unless ref($other) && $other->class ne 'Formula';
277 return $other->length == 2 && 384 return $other->length == 2 &&
278 ($other->{open} eq '(' || $other->{open} eq '[') && 385 ($other->{open} eq '(' || $other->{open} eq '[') &&
279 ($other->{close} eq ')' || $other->{close} eq ']') 386 ($other->{close} eq ')' || $other->{close} eq ']')
280 if $other->type =~ m/^(Point|List)$/; 387 if $other->type =~ m/^(Point|List)$/;
281 $other->type =~ m/^(Interval|Union)$/; 388 $other->type =~ m/^(Interval|Union)$/;
282} 389}
283 390
391#
392# Check for wrong enpoints and wrong type of endpoints
393#
394sub cmp_postprocess {
395 my $self = shift; my $ans = shift;
396 return unless $ans->{score} == 0 && !$ans->{isPreview};
397 my $other = $ans->{student_value};
398 return unless $other->class eq 'Interval';
399 my @errors;
400 if ($ans->{showEndpointHints}) {
401 push(@errors,"Your left endpoint is incorrect")
402 if ($self->{data}[0] != $other->{data}[0]);
403 push(@errors,"Your right endpoint is incorrect")
404 if ($self->{data}[1] != $other->{data}[1]);
405 }
406 if (scalar(@errors) == 0 && $ans->{showEndTypeHints}) {
407 push(@errors,"The type of interval is incorrect")
408 if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
409 }
410 $self->cmp_Error($ans,@errors);
411}
412
284############################################################# 413#############################################################
285 414
286package Value::Union; 415package Value::Union;
287 416
288sub typeMatch { 417sub typeMatch {
289 my $self = shift; my $other = shift; 418 my $self = shift; my $other = shift;
290 return 0 unless ref($other); 419 return 0 unless ref($other) && $other->class ne 'Formula';
291 return $other->length == 2 && 420 return $other->length == 2 &&
292 ($other->{open} eq '(' || $other->{open} eq '[') && 421 ($other->{open} eq '(' || $other->{open} eq '[') &&
293 ($other->{close} eq ')' || $other->{close} eq ']') 422 ($other->{close} eq ')' || $other->{close} eq ']')
294 if $other->type =~ m/^(Point|List)$/; 423 if $other->type =~ m/^(Point|List)$/;
295 $other->type =~ m/^(Interval|Union)/; 424 $other->type =~ m/^(Interval|Union)/;
296} 425}
297 426
427#
428# Use the List checker for unions, in order to get
429# partial credit. Set the various types for error
430# messages.
431#
432sub cmp_defaults {(
433 Value::List::cmp_defaults(@_),
434 typeMatch => 'Value::Interval',
435 list_type => 'an interval or union',
436 entry_type => 'an interval',
437)}
438
439sub cmp_equal {Value::List::cmp_equal(@_)}
440
298############################################################# 441#############################################################
299 442
300package Value::List; 443package Value::List;
301 444
302our $cmp_defaults = { 445sub cmp_defaults {
446 my $self = shift;
447 return (
303 %{$Value::cmp_defaults}, 448 Value::Real->cmp_defaults,
304 showHints => undef, 449 showHints => undef,
305 showLengthHints => undef, 450 showLengthHints => undef,
451 showParenHints => undef,
306# partialCredit => undef, 452 partialCredit => undef,
307 partialCredit => 0, # only allow this once WW can deal with partial credit
308 ordered => 0, 453 ordered => 0,
309 entry_type => undef, 454 entry_type => undef,
310 list_type => undef, 455 list_type => undef,
311 typeMatch => undef, 456 typeMatch => Value::makeValue($self->{data}[0]),
312 allowParens => 0, 457 requireParenMatch => 1,
313}; 458 removeParens => 1,
459 );
460}
314 461
315sub typeMatch {1} 462#
463# Match anything but formulas
464#
465sub typeMatch {return !ref($other) || $other->class ne 'Formula'}
466
467#
468# Handle removal of outermost parens in correct answer.
469#
470sub cmp {
471 my $self = shift;
472 my $cmp = $self->SUPER::cmp(@_);
473 if ($cmp->{rh_ans}{removeParens}) {
474 $self->{open} = $self->{close} = '';
475 $cmp->ans_hash(correct_ans => $self->stringify);
476 }
477 return $cmp;
478}
316 479
317sub cmp_equal { 480sub cmp_equal {
318 my $self = shift; my $ans = shift; 481 my $self = shift; my $ans = shift;
319 my $showPartialCorrectAnswers = $self->getPG('$showPartialCorrectAnswers'); 482 $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
483
484 #
485 # get the paramaters
486 #
320 my $showTypeWarnings = $ans->{showTypeWarnings}; 487 my $showTypeWarnings = $ans->{showTypeWarnings};
321 my $showHints = getOption($ans->{showHints},$showPartialCorrectAnswers); 488 my $showHints = getOption($ans,'showHints');
322 my $showLengthHints = getOption($ans->{showLengthHints},$showPartialCorrectAnswers); 489 my $showLengthHints = getOption($ans,'showLengthHints');
323 my $partialCredit = getOption($ans->{partialCredit},$showPartialCorrectAnswers); 490 my $showParenHints = getOption($ans,'showLengthHints');
324 my $ordered = $ans->{ordered}; my $allowParens = $ans->{allowParens}; 491 my $partialCredit = getOption($ans,'partialCredit');
492 my $ordered = $ans->{ordered};
493 my $requireParenMatch = $ans->{requireParenMatch};
325 my $typeMatch = $ans->{typeMatch} || $self->{data}[0]; 494 my $typeMatch = $ans->{typeMatch};
326 $typeMatch = Value::Real->make($typeMatch)
327 if !ref($typeMatch) && Value::matchNumber($typeMatch);
328 my $value = getOption($ans->{entry_type}, 495 my $value = $ans->{entry_type};
496 my $ltype = $ans->{list_type} || lc($self->type);
497
329 Value::isValue($typeMatch)? lc($typeMatch->showClass): 'value'); 498 $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value')
330 $value =~ s/^an? //; $value =~ s/(real|complex) //; 499 unless defined($value);
331 my $ltype = getOption($ans->{list_type},lc($self->type)); 500 $value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
501 $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
502 $ltype =~ s/^an? //;
332 $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview}; 503 $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview};
333 504
334 my $student = $ans->{student_value}; 505 #
506 # Get the lists of correct and student answers
507 # (split formulas that return lists or unions)
508 #
509 my @correct = (); my ($cOpen,$cClose);
510 if ($self->class ne 'Formula') {
335 my @correct = $self->value; 511 @correct = $self->value;
336 my @student = 512 $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
337 $student->class eq 'List' && 513 } else {
338 ($allowParens || (!$student->{open} && !$student->{close})) ? 514 @correct = Value::List->splitFormula($self,$ans);
339 @{$student->{data}} : ($student); 515 $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
516 }
517 my $student = $ans->{student_value}; my @student = ($student);
518 my ($sOpen,$sClose) = ('','');
519 if (Value::isFormula($student) && $student->type eq $self->type) {
520 @student = Value::List->splitFormula($student,$ans);
521 $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
522 } elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
523 @student = @{$student->{data}};
524 $sOpen = $student->{open}; $sClose = $student->{close};
525 }
526 return if $ans->{split_error};
527 #
528 # Check for parenthesis match
529 #
530 if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
531 if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
532 my $message = "The parentheses for your $ltype ";
533 if (($cOpen || $cClose) && ($sOpen || $sClose))
534 {$message .= "are of the wrong type"}
535 elsif ($sOpen || $sClose) {$message .= "should be removed"}
536 else {$message .= "are missing"}
537 $self->cmp_Error($ans,$message) unless $ans->{isPreview};
538 }
539 return;
540 }
541 #
542 # Check for empty lists
543 #
544 if (scalar(@correct) == 0 && scalar(@student) == 0) {$ans->score(1); return}
340 545
546 #
547 # Initialize the score
548 #
341 my $maxscore = scalar(@correct); 549 my $M = scalar(@correct);
342 my $m = scalar(@student); 550 my $m = scalar(@student);
343 $maxscore = $m if ($m > $maxscore); 551 my $maxscore = ($m > $M)? $m : $M;
344 my $score = 0; my @errors; my $i = 0; 552 my $score = 0; my @errors; my $i = 0;
345 553
554 #
555 # Loop through student answers looking for correct ones
556 #
346 ENTRY: foreach my $entry (@student) { 557 ENTRY: foreach my $entry (@student) {
347 $i++; 558 $i++;
348 $entry = Value::Real->make($entry) if !ref($entry) && Value::matchNumber($entry); 559 $entry = Value::makeValue($entry);
349 $entry = Value::Formula->new($entry) if !Value::isValue($entry); 560 $entry = Value::Formula->new($entry) if !Value::isValue($entry);
350 if ($ordered) { 561 if ($ordered) {
351 if (eval {shift(@correct) == $entry}) {$score++; next ENTRY} 562 if (eval {shift(@correct) == $entry}) {$score++; next ENTRY}
352 } else { 563 } else {
353 foreach my $k (0..$#correct) { 564 foreach my $k (0..$#correct) {
… …
355 splice(@correct,$k,1); 566 splice(@correct,$k,1);
356 $score++; next ENTRY; 567 $score++; next ENTRY;
357 } 568 }
358 } 569 }
359 } 570 }
360 if ($showTypeWarnings && defined($typeMatch) && 571 #
361 !$typeMatch->typeMatch($entry,$ans)) { 572 # Give messages about incorrect answers
362 push(@errors, 573 #
363 "Your ".NameForNumber($i)." value isn't ".lc($typeMatch->showClass). 574 my $nth = ''; my $answer = 'answer';
575 my $class = $ans->{list_type} || $self->cmp_class;
576 if (scalar(@student) > 1) {
577 $nth = ' '.$self->NameForNumber($i);
578 $class = $ans->{cmp_class};
579 $answer = 'value';
580 }
581 if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
582 !($ans->{ignoreStrings} && $entry->class eq 'String')) {
583 push(@errors,"Your$nth $answer isn't ".lc($class).
364 " (it looks like ".lc($entry->showClass).")"); 584 " (it looks like ".lc($entry->showClass).")");
365 next ENTRY; 585 } elsif ($showHints && $m > 1) {
586 push(@errors,"Your$nth $value is incorrect");
366 } 587 }
367 push(@errors,"Your ".NameForNumber($i)." $value is incorrect")
368 if $showHints && $m > 1;
369 } 588 }
370 589
590 #
591 # Give hints about extra or missing answsers
592 #
371 if ($showLengthHints) { 593 if ($showLengthHints) {
372 $value =~ s/ or /s or /; # fix "interval or union" 594 $value =~ s/ or /s or /; # fix "interval or union"
373 push(@errors,"There should be more ${value}s in your $ltype") 595 push(@errors,"There should be more ${value}s in your $ltype")
374 if ($score == $m && scalar(@correct) > 0); 596 if ($score == $m && scalar(@correct) > 0);
375 push(@errors,"There should be fewer ${value}s in your $ltype") 597 push(@errors,"There should be fewer ${value}s in your $ltype")
376 if ($score < $maxscore && $score == scalar($self->value)); 598 if ($score < $maxscore && $score == $M && !$showHints);
377 } 599 }
378 600
601 #
602 # Finalize the score
603 #
379 $score = 0 if ($score != $maxscore && !$partialCredit); 604 $score = 0 if ($score != $maxscore && !$partialCredit);
380 $ans->score($score/$maxscore); 605 $ans->score($score/$maxscore);
381 push(@errors,"Score = $ans->{score}") if $ans->{debug}; 606 push(@errors,"Score = $ans->{score}") if $ans->{debug};
382 $ans->{error_message} = $ans->{ans_message} = join("\n",@errors); 607 $ans->{error_message} = $ans->{ans_message} = join("\n",@errors);
383} 608}
384 609
385# 610#
611# Split a formula that is a list or union into a
612# list of formulas (or Value objects).
613#
614sub splitFormula {
615 my $self = shift; my $formula = shift; my $ans = shift;
616 my @formula; my @entries;
617 if ($formula->type eq 'List') {@entries = @{$formula->{tree}{coords}}}
618 else {@entries = $formula->{tree}->makeUnion}
619 foreach my $entry (@entries) {
620 my $v = Parser::Formula($entry);
621 $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
622 push(@formula,$v);
623 #
624 # There shouldn't be an error evaluating the formula,
625 # but you never know...
626 #
627 if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
628 }
629 return @formula;
630}
631
632#
386# Return the value if it is defined, otherwise a default 633# Return the value if it is defined, otherwise use a default
387# 634#
388sub getOption { 635sub getOption {
389 my $value = shift; my $default = shift; 636 my $ans = shift; my $name = shift;
637 my $value = $ans->{$name};
390 return $value if defined($value); 638 return $value if defined($value);
391 return $default; 639 return $ans->{showPartialCorrectAnswers};
392}
393
394#
395# names for numbers
396#
397sub NameForNumber {
398 my $n = shift;
399 my $name = ('zeroth','first','second','third','fourth','fifth',
400 'sixth','seventh','eighth','ninth','tenth')[$n];
401 $name = "$n-th" if ($n > 10);
402 return $name;
403} 640}
404 641
405############################################################# 642#############################################################
406 643
407package Value::Formula; 644package Value::Formula;
408 645
646sub cmp_defaults {
647 my $self = shift;
648
649 return (
650 Value::Union::cmp_defaults($self,@_),
651 typeMatch => Value::Formula->new("(1,2]"),
652 ) if $self->type eq 'Union';
653
654 my $type = $self->type;
655 $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
656 $type = 'Value::'.$type.'::';
657
658 return (&{$type.'cmp_defaults'}($self,@_), upToConstant => 0)
659 if defined(%$type) && $self->type ne 'List';
660
661 return (
662 Value::List::cmp_defaults($self,@_),
663 removeParens => $self->{autoFormula},
664 typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]),
665 );
666}
667
409# 668#
410# No cmp function (for now) 669# Get the types from the values of the formulas
670# and compare those.
671#
672sub typeMatch {
673 my $self = shift; my $other = shift; my $ans = shift;
674 return 1 if $self->type eq $other->type;
675 my $typeMatch = ($self->createRandomPoints(1))[1]->[0];
676 $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
677 return 1 unless defined($other); # can't really tell, so don't report type mismatch
678 $typeMatch->typeMatch($other,$ans);
679}
680
681#
682# Handle removal of outermost parens in a list.
411# 683#
412sub cmp { 684sub cmp {
413 die "Answer checker for formulas is not yet defined"; 685 my $self = shift;
686 my $cmp = $self->SUPER::cmp(@_);
687 if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
688 $self->{tree}{open} = $self->{tree}{close} = '';
689 $cmp->ans_hash(correct_ans => $self->stringify);
690 }
691 if ($cmp->{rh_ans}{upToConstant}) {
692 my $current = Parser::Context->current();
693 my $context = $self->{context} = $self->{context}->copy;
694 Parser::Context->current(undef,$context);
695 $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
696 'C0|' . $context->{_variables}->{pattern};
697 $context->update; $context->variables->add('C0' => 'Parameter');
698 $cmp->ans_hash(correct_value => Value::Formula->new('C0')+$self);
699 Parser::Context->current(undef,$current);
700 }
701 return $cmp;
702}
703
704sub cmp_equal {
705 my $self = shift; my $ans = shift;
706 #
707 # Get the problem's seed
708 #
709 $self->{context}->flags->set(
710 random_seed => $self->getPG('$PG_original_problemSeed')
711 );
712
713 #
714 # Use the list checker if the formula is a list or union
715 # Otherwise use the normal checker
716 #
717 if ($self->type =~ m/^(List|Union)$/) {
718 Value::List::cmp_equal($self,$ans);
719 } else {
720 $self->SUPER::cmp_equal($ans);
721 }
722}
723
724sub cmp_postprocess {
725 my $self = shift; my $ans = shift;
726 return unless $ans->{score} == 0 && !$ans->{isPreview};
727 return if $ans->{ans_message} || !$ans->{showDimensionHints};
728 my $other = $ans->{student_value};
729 return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
730 return unless $self->type =~ m/^(Point|Vector|Matrix)$/;
731 return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
732 $self->cmp_Error($ans,"The dimension of your result is incorrect");
414} 733}
415 734
416############################################################# 735#############################################################
417 736
4181; 7371;
Legend:
Removed from v.2600  
changed lines
  Added in v.2772
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9