[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 2608 Revision 2609
… …
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)};
24 24
25sub cmp { 25sub cmp {
26 my $self = shift; 26 my $self = shift;
27 $$Value::context->flags->set(StringifyAsTeX => 0); # reset this, just in case. 27 $$Value::context->flags->set(StringifyAsTeX => 0); # reset this, just in case.
28 my $ans = new AnswerEvaluator; 28 my $ans = new AnswerEvaluator;
29 my $defaults = ref($self)."::cmp_defaults";
30 $ans->ans_hash( 29 $ans->ans_hash(
31 type => "Value (".$self->class.")", 30 type => "Value (".$self->class.")",
32 correct_ans => $self->string, 31 correct_ans => $self->string,
33 correct_value => $self, 32 correct_value => $self,
34 %{$$defaults || $cmp_defaults}, 33 $self->cmp_defaults,
35 @_ 34 @_
36 ); 35 );
37 $ans->install_evaluator( 36 $ans->install_evaluator(
38 sub { 37 sub {
39 my $ans = shift; 38 my $ans = shift;
40 # can't seem to get $inputs_ref any other way 39 # can't seem to get $inputs_ref any other way
41 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}'); 40 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
42 my $self = $ans->{correct_value}; 41 my $self = $ans->{correct_value};
43 my $method = $ans->{cmp_check} || 'cmp_check'; 42 my $method = $ans->{cmp_check} || 'cmp_check';
43 $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
44 $self->$method($ans); 44 $self->$method($ans);
45 } 45 }
46 ); 46 );
47 return $ans; 47 return $ans;
48} 48}
… …
97 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} 97 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
98 my $cmp_error = $ans->{cmp_error} || 'cmp_error'; 98 my $cmp_error = $ans->{cmp_error} || 'cmp_error';
99 $self->$cmp_error($ans); 99 $self->$cmp_error($ans);
100 } else { 100 } else {
101 $ans->{ans_message} = $ans->{error_message} = 101 $ans->{ans_message} = $ans->{error_message} =
102 "Your answer isn't ".lc($ans->{correct_value}->showCmpClass). 102 "Your answer isn't ".lc($ans->{cmp_class}).
103 " (it looks like ".lc($ans->{student_value}->showClass).")" 103 " (it looks like ".lc($ans->{student_value}->showClass).")"
104 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; 104 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
105 } 105 }
106} 106}
107 107
… …
115} 115}
116 116
117# 117#
118# Class name for cmp error messages 118# Class name for cmp error messages
119# 119#
120sub showCmpClass {shift->showClass} 120sub cmp_class {
121 my $self = shift; my $ans = shift;
122 my $class = $self->showClass;
123 return "an Interval or Union" if $class =~ m/Interval/i;
124 $class =~ s/Real //;
125 return $class;
126}
121 127
122# 128#
123# Student answer evaluation failed. 129# Student answer evaluation failed.
124# Report the error, with formatting, if possible. 130# Report the error, with formatting, if possible.
125# 131#
… …
189############################################################# 195#############################################################
190############################################################# 196#############################################################
191 197
192package Value::Real; 198package Value::Real;
193 199
194our $cmp_defaults = { 200sub cmp_defaults {(
195 %{$Value::cmp_defaults}, 201 shift->SUPER::cmp_defaults,
196 ignoreStrings => 1, 202 ignoreStrings => 1,
197 ignoreInfinity => 1, 203 ignoreInfinity => 1,
198}; 204)};
199 205
200sub typeMatch { 206sub typeMatch {
201 my $self = shift; my $other = shift; my $ans = shift; 207 my $self = shift; my $other = shift; my $ans = shift;
202 return 1 unless ref($other); 208 return 1 unless ref($other);
203 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity}; 209 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
… …
210 216
211############################################################# 217#############################################################
212 218
213package Value::Infinity; 219package Value::Infinity;
214 220
215sub showCmpClass {'a Number'} 221sub cmp_class {'a Number'};
216 222
217sub typeMatch { 223sub typeMatch {
218 my $self = shift; my $other = shift; my $ans = shift; 224 my $self = shift; my $other = shift; my $ans = shift;
219 return 1 unless ref($other); 225 return 1 unless ref($other);
220 return 1 if $other->type eq 'Number'; 226 return 1 if $other->type eq 'Number';
221 $self->type eq $other->type; 227 $self->type eq $other->type;
222} 228}
223 229
224############################################################# 230#############################################################
225 231
232package Value::String;
233
234sub cmp_defaults {(
235 Value::Real->cmp_defaults,
236 typeMatch => Value::Real->new(1),
237)};
238
239sub cmp_class {
240 my $self = shift; my $ans = shift;
241 my $typeMatch = $ans->{typeMatch};
242 return 'a Word' if $typeMatch->class eq 'String';
243 return $typeMatch->cmp_class;
244};
245
246sub typeMatch {
247 my $self = shift; my $other = shift; my $ans = shift;
248 return 1 if $self->type eq $other->type || $ans->{typeMatch}->class eq 'String';
249 return $ans->{typeMatch}->typeMatch($other,$ans);
250}
251
252#############################################################
253
226package Value::Point; 254package Value::Point;
227 255
228our $cmp_defaults = { 256sub cmp_defaults {(
229 %{$Value::cmp_defaults}, 257 shift->SUPER::cmp_defaults,
230 showDimensionHints => 1, 258 showDimensionHints => 1,
231 showCoordinateHints => 1, 259 showCoordinateHints => 1,
232}; 260)};
233 261
234sub typeMatch { 262sub typeMatch {
235 my $self = shift; my $other = shift; my $ans = shift; 263 my $self = shift; my $other = shift; my $ans = shift;
236 return ref($other) && $other->type eq 'Point'; 264 return ref($other) && $other->type eq 'Point';
237} 265}
… …
258 286
259############################################################# 287#############################################################
260 288
261package Value::Vector; 289package Value::Vector;
262 290
263our $cmp_defaults = { 291sub cmp_defaults {(
264 %{$Value::cmp_defaults}, 292 shift->SUPPER::cmp_defaults,
265 showDimensionHints => 1, 293 showDimensionHints => 1,
266 showCoordinateHints => 1, 294 showCoordinateHints => 1,
267 promotePoints => 0, 295 promotePoints => 0,
268 parallel => 0, 296 parallel => 0,
269 sameDirection => 0, 297 sameDirection => 0,
270}; 298)};
271 299
272sub typeMatch { 300sub typeMatch {
273 my $self = shift; my $other = shift; my $ans = shift; 301 my $self = shift; my $other = shift; my $ans = shift;
274 return 0 unless ref($other); 302 return 0 unless ref($other);
275 $other = $ans->{student_value} = Value::Vector::promote($other) 303 $other = $ans->{student_value} = Value::Vector::promote($other)
… …
307 335
308############################################################# 336#############################################################
309 337
310package Value::Matrix; 338package Value::Matrix;
311 339
312our $cmp_defaults = { 340sub cmp_defaults {(
313 %{$Value::cmp_defaults}, 341 shiftf->SUPER::cmp_defaults,
314 showDimensionHints => 1, 342 showDimensionHints => 1,
315 showEqualErrors => 0, 343 showEqualErrors => 0,
316}; 344)};
317 345
318sub typeMatch { 346sub typeMatch {
319 my $self = shift; my $other = shift; my $ans = shift; 347 my $self = shift; my $other = shift; my $ans = shift;
320 return 0 unless ref($other); 348 return 0 unless ref($other);
321 $other = $ans->{student_value} = $self->make($other->{data}) 349 $other = $ans->{student_value} = $self->make($other->{data})
… …
343 371
344############################################################# 372#############################################################
345 373
346package Value::Interval; 374package Value::Interval;
347 375
348our $cmp_defaults = { 376sub cmp_defaults {(
349 %{$Value::cmp_defaults}, 377 shift->SUPER::cmp_defaults,
350 showEndpointHints => 1, 378 showEndpointHints => 1,
351 showEndTypeHints => 1, 379 showEndTypeHints => 1,
352}; 380)};
353
354sub showCmpClass {'an Interval or Union'}
355 381
356sub typeMatch { 382sub typeMatch {
357 my $self = shift; my $other = shift; 383 my $self = shift; my $other = shift;
358 return 0 unless ref($other); 384 return 0 unless ref($other);
359 return $other->length == 2 && 385 return $other->length == 2 &&
… …
387 413
388############################################################# 414#############################################################
389 415
390package Value::Union; 416package Value::Union;
391 417
392sub showCmpClass {'an Interval or Union'}
393
394sub typeMatch { 418sub typeMatch {
395 my $self = shift; my $other = shift; 419 my $self = shift; my $other = shift;
396 return 0 unless ref($other); 420 return 0 unless ref($other);
397 return $other->length == 2 && 421 return $other->length == 2 &&
398 ($other->{open} eq '(' || $other->{open} eq '[') && 422 ($other->{open} eq '(' || $other->{open} eq '[') &&
… …
403 427
404############################################################# 428#############################################################
405 429
406package Value::List; 430package Value::List;
407 431
408our $cmp_defaults = { 432sub cmp_defaults {(
409 %{$Value::Real::cmp_defaults}, 433 Value::Real->cmp_defaults,
410 showHints => undef, 434 showHints => undef,
411 showLengthHints => undef, 435 showLengthHints => undef,
412# partialCredit => undef, 436# partialCredit => undef,
413 partialCredit => 0, # only allow this once WW can deal with partial credit 437 partialCredit => 0, # only allow this once WW can deal with partial credit
414 ordered => 0, 438 ordered => 0,
415 entry_type => undef, 439 entry_type => undef,
416 list_type => undef, 440 list_type => undef,
417 typeMatch => undef, 441 typeMatch => undef,
418 allowParens => 0, 442 allowParens => 0,
419 showParens => 0, 443 showParens => 0,
420}; 444)};
421 445
422sub typeMatch {1} 446sub typeMatch {1}
423 447
424# 448#
425# Handle removal of outermost parens in correct answer. 449# Handle removal of outermost parens in correct answer.
… …
444 my $ordered = $ans->{ordered}; my $allowParens = $ans->{allowParens}; 468 my $ordered = $ans->{ordered}; my $allowParens = $ans->{allowParens};
445 my $typeMatch = $ans->{typeMatch} || $self->{data}[0]; 469 my $typeMatch = $ans->{typeMatch} || $self->{data}[0];
446 $typeMatch = Value::Real->make($typeMatch) 470 $typeMatch = Value::Real->make($typeMatch)
447 if !ref($typeMatch) && Value::matchNumber($typeMatch); 471 if !ref($typeMatch) && Value::matchNumber($typeMatch);
448 my $value = getOption($ans->{entry_type}, 472 my $value = getOption($ans->{entry_type},
449 Value::isValue($typeMatch)? lc($typeMatch->showCmpClass): 'value'); 473 Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value');
450 $value =~ s/^an? //; $value =~ s/(real|complex) //; 474 $value =~ s/(real|complex) //; $ans->{cmp_class} = $value; $value =~ s/^an? //;
451 my $ltype = getOption($ans->{list_type},lc($self->type)); 475 my $ltype = getOption($ans->{list_type},lc($self->type));
452 $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview}; 476 $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview};
453 477
454 my $student = $ans->{student_value}; 478 my $student = $ans->{student_value};
455 my @correct = $self->value; 479 my @correct = $self->value;
… …
478 } 502 }
479 } 503 }
480 if ($showTypeWarnings && defined($typeMatch) && 504 if ($showTypeWarnings && defined($typeMatch) &&
481 !$typeMatch->typeMatch($entry,$ans)) { 505 !$typeMatch->typeMatch($entry,$ans)) {
482 push(@errors, 506 push(@errors,
483 "Your ".$self->NameForNumber($i)." value isn't ".lc($typeMatch->showCmpClass). 507 "Your ".$self->NameForNumber($i)." value isn't ".lc($ans->{cmp_class}).
484 " (it looks like ".lc($entry->showClass).")"); 508 " (it looks like ".lc($entry->showClass).")");
485 next ENTRY; 509 next ENTRY;
486 } 510 }
487 push(@errors,"Your ".$self->NameForNumber($i)." $value is incorrect") 511 push(@errors,"Your ".$self->NameForNumber($i)." $value is incorrect")
488 if $showHints && $m > 1; 512 if $showHints && $m > 1;
Legend:
Removed from v.2608  
changed lines
  Added in v.2609
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9