Parent Directory
| 
Revision Log
Compartmentalize the equality check one step further. The cmp_equal
method now calls a new cmp_compare method to perform the actual
comparison (rather than use == directly). The cmp_compare method
either calls a user-supplied checker routine, or defaults to using the
== operator. The list checker also uses cmp_compare to check the
individual items in the list. The list checker also calls a new
cmp_list_checker method to perform the list check. This can be
overridden by a user-supplied list-checking routine.
To supply an alternate checking routine, use the "checker" option to
the cmp() method of the correct answer object. For example:
sub check {
my ($correct,$student,$ans) = @_;
return 0 unless $correct->length == $student->length;
my ($x,$y) = $student->value; # break up a point;
return $x**2 - $y**2 = 1; # check if it is on a hyperbola
}
Point(1,0)->cmp(checker=>~~&check);
This will check if the student's point lies on the given hyperbola. All
the usual error messages will be issued if the student's answer is not
a point, or is of the wrong dimension, etc.
You can use
sub list_check {
my ($correct,$student,$ans) = @_;
my @correct = @{$correct}; my @student = @{$student};
...
return ($score,@errors);
}
List(...)->cmp(list_checker=>~~&list_check);
to replace the list-checking routine with your own custom one. The
$correct and $student values are array references to the elements in
the lists provided by the professor and student. (Note that you do
NOT get a List() object; this allows you to handle lists of formulas,
since a List of formulas becomes a formula returning a list). The
checker routine should return the number of correct elements in the
student's list ($score), and a list of error messages produced while
checking the two lists (@errors). (This is a list of messages, since
you might want to include an error for each entry in the list, for
example).
If your checker or list_checker routine wants to die with an error
message, use Value::Error(message). This will put the message in the
WeBWorK display area at the top of the page. If you use die(message),
or if the code fails due to a runtime error, then "pink screen of
death" will be produced indicating the error and asking the student to
report the error to the professor.
1 ############################################################# 2 # 3 # Implements the ->cmp method for Value objects. This produces 4 # an answer checker appropriate for the type of object. 5 # Additional options can be passed to the checker to 6 # modify its action. 7 # 8 # The individual Value packages are modified below to add the 9 # needed methods. 10 # 11 12 ############################################################# 13 14 package Value; 15 16 # 17 # Create an answer checker for the given type of object 18 # 19 20 sub cmp_defaults {( 21 showTypeWarnings => 1, 22 showEqualErrors => 1, 23 ignoreStrings => 1, 24 )} 25 26 sub cmp { 27 my $self = shift; 28 my $ans = new AnswerEvaluator; 29 my $correct = $self->{correct_ans}; 30 $correct = $self->string unless defined($correct); 31 $ans->ans_hash( 32 type => "Value (".$self->class.")", 33 correct_ans => protectHTML($correct), 34 correct_value => $self, 35 $self->cmp_defaults(@_), 36 @_ 37 ); 38 $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)}); 39 $self->{context} = $$Value::context unless defined($self->{context}); 40 return $ans; 41 } 42 43 # 44 # Parse the student answer and compute its value, 45 # produce the preview strings, and then compare the 46 # student and professor's answers for equality. 47 # 48 sub cmp_parse { 49 my $self = shift; my $ans = shift; 50 # 51 # Do some setup 52 # 53 my $current = $$Value::context; # save it for later 54 my $context = $ans->{correct_value}{context} || $current; 55 Parser::Context->current(undef,$context); # change to correct answser's context 56 my $flags = contextSet($context, # save old context flags for the below 57 StringifyAsTeX => 0, # reset this, just in case. 58 no_parameters => 1, # don't let students enter parameters 59 showExtraParens => 1, # make student answer painfully unambiguous 60 reduceConstants => 0, # don't combine student constants 61 reduceConstantFunctions => 0, # don't reduce constant functions 62 ); 63 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}'); 64 $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class}; 65 $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages 66 $ans->{preview_latex_string} = $ans->{preview_text_string} = ''; 67 68 # 69 # Parse and evaluate the student answer 70 # 71 $ans->score(0); # assume failure 72 $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans}); 73 $ans->{student_value} = Parser::Evaluate($ans->{student_formula}) 74 if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant; 75 76 # 77 # If it parsed OK, save the output forms and check if it is correct 78 # otherwise report an error 79 # 80 if (defined $ans->{student_value}) { 81 $ans->{student_value} = Value::Formula->new($ans->{student_value}) 82 unless Value::isValue($ans->{student_value}); 83 $ans->{preview_latex_string} = $ans->{student_formula}->TeX; 84 $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string); 85 $ans->{student_ans} = $ans->{preview_text_string}; 86 $self->cmp_equal($ans); 87 $self->cmp_postprocess($ans) if !$ans->{error_message}; 88 } else { 89 $self->cmp_error($ans); 90 } 91 contextSet($context,%{$flags}); # restore context values 92 Parser::Context->current(undef,$current); # put back the old context 93 return $ans; 94 } 95 96 # 97 # Check if the parsed student answer equals the professor's answer 98 # 99 sub cmp_equal { 100 my $self = shift; my $ans = shift; 101 my $correct = $ans->{correct_value}; 102 my $student = $ans->{student_value}; 103 if ($correct->typeMatch($student,$ans)) { 104 my $equal = $correct->cmp_compare($student,$ans); 105 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} 106 $self->cmp_error($ans); 107 } else { 108 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 109 $ans->{ans_message} = $ans->{error_message} = 110 "Your answer isn't ".lc($ans->{cmp_class}). 111 " (it looks like ".lc($student->showClass).")" 112 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; 113 } 114 } 115 116 # 117 # Perform the comparison, either using the checker supplied 118 # by the answer evaluator, or the overloaded == operator. 119 # 120 121 our $CMP_ERROR = 2; # a fatal error was detected 122 123 sub cmp_compare { 124 my $self = shift; my $other = shift; my $ans = shift; 125 return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE'; 126 my $equal = eval {&{$ans->{checker}}($self,$other,$ans)}; 127 if (!defined($equal) && $@ ne '' && !$$Value::context->{error}{flag}) { 128 $$Value::context->setError("<I>An error occurred while checking your answer:</I>\n". 129 '<DIV STYLE="margin-left:1em">'.$@.'</DIV>',''); 130 $$Value::context->{error}{flag} = $CMP_ERROR; 131 warn "Please inform your instructor that an error occurred while checking your answer"; 132 } 133 return $equal; 134 } 135 136 sub cmp_list_compare {Value::List::cmp_list_compare(@_)} 137 138 # 139 # Check if types are compatible for equality check 140 # 141 sub typeMatch { 142 my $self = shift; my $other = shift; 143 return 1 unless ref($other); 144 $self->type eq $other->type && $other->class ne 'Formula'; 145 } 146 147 # 148 # Class name for cmp error messages 149 # 150 sub cmp_class { 151 my $self = shift; my $ans = shift; 152 my $class = $self->showClass; $class =~ s/Real //; 153 return $class if $class =~ m/Formula/; 154 return "an Interval or Union" if $class =~ m/Interval/i; 155 return $class; 156 } 157 158 # 159 # Student answer evaluation failed. 160 # Report the error, with formatting, if possible. 161 # 162 sub cmp_error { 163 my $self = shift; my $ans = shift; 164 my $error = $$Value::context->{error}; 165 my $message = $error->{message}; 166 if ($error->{pos}) { 167 my $string = $error->{string}; 168 my ($s,$e) = @{$error->{pos}}; 169 $message =~ s/; see.*//; # remove the position from the message 170 $ans->{student_ans} = 171 protectHTML(substr($string,0,$s)) . 172 '<SPAN CLASS="parsehilight">' . 173 protectHTML(substr($string,$s,$e-$s)) . 174 '</SPAN>' . 175 protectHTML(substr($string,$e)); 176 } 177 $self->cmp_Error($ans,$message); 178 } 179 180 # 181 # Set the error message 182 # 183 sub cmp_Error { 184 my $self = shift; my $ans = shift; 185 return unless scalar(@_) > 0; 186 $ans->score(0); 187 $ans->{ans_message} = $ans->{error_message} = join("\n",@_); 188 } 189 190 # 191 # filled in by sub-classes 192 # 193 sub cmp_postprocess {} 194 195 # 196 # Get and Set values in context 197 # 198 sub contextSet { 199 my $context = shift; my %set = (@_); 200 my $flags = $context->{flags}; my $get = {}; 201 foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}} 202 return $get; 203 } 204 205 # 206 # Quote HTML characters 207 # 208 sub protectHTML { 209 my $string = shift; 210 return $string if eval ('$main::displayMode') eq 'TeX'; 211 $string =~ s/&/\&/g; 212 $string =~ s/</\</g; 213 $string =~ s/>/\>/g; 214 $string; 215 } 216 217 # 218 # names for numbers 219 # 220 sub NameForNumber { 221 my $self = shift; my $n = shift; 222 my $name = ('zeroth','first','second','third','fourth','fifth', 223 'sixth','seventh','eighth','ninth','tenth')[$n]; 224 $name = "$n-th" if ($n > 10); 225 return $name; 226 } 227 228 # 229 # Get a value from the safe compartment 230 # 231 sub getPG { 232 my $self = shift; 233 # (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0]; 234 eval ('package main; '.shift); # faster 235 } 236 237 ############################################################# 238 ############################################################# 239 240 package Value::Real; 241 242 sub cmp_defaults {( 243 shift->SUPER::cmp_defaults(@_), 244 ignoreInfinity => 1, 245 )} 246 247 sub typeMatch { 248 my $self = shift; my $other = shift; my $ans = shift; 249 return 1 unless ref($other); 250 return 0 if Value::isFormula($other); 251 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity}; 252 $self->type eq $other->type; 253 } 254 255 ############################################################# 256 257 package Value::Infinity; 258 259 sub cmp_class {'a Number'}; 260 261 sub typeMatch { 262 my $self = shift; my $other = shift; my $ans = shift; 263 return 1 unless ref($other); 264 return 0 if Value::isFormula($other); 265 return 1 if $other->type eq 'Number'; 266 $self->type eq $other->type; 267 } 268 269 ############################################################# 270 271 package Value::String; 272 273 sub cmp_defaults {( 274 Value::Real->cmp_defaults(@_), 275 typeMatch => 'Value::Real', 276 )} 277 278 sub cmp_class { 279 my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch}; 280 return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String'; 281 return $typeMatch->cmp_class; 282 }; 283 284 sub typeMatch { 285 my $self = shift; my $other = shift; my $ans = shift; 286 return 0 if ref($other) && Value::isFormula($other); 287 my $typeMatch = $ans->{typeMatch}; 288 return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' || 289 $self->type eq $other->type; 290 return $typeMatch->typeMatch($other,$ans); 291 } 292 293 ############################################################# 294 295 package Value::Point; 296 297 sub cmp_defaults {( 298 shift->SUPER::cmp_defaults(@_), 299 showDimensionHints => 1, 300 showCoordinateHints => 1, 301 )} 302 303 sub typeMatch { 304 my $self = shift; my $other = shift; my $ans = shift; 305 return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula'; 306 } 307 308 # 309 # Check for dimension mismatch and incorrect coordinates 310 # 311 sub cmp_postprocess { 312 my $self = shift; my $ans = shift; 313 return unless $ans->{score} == 0 && !$ans->{isPreview}; 314 my $student = $ans->{student_value}; 315 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 316 if ($ans->{showDimensionHints} && $self->length != $student->length) { 317 $self->cmp_Error($ans,"The dimension of your result is incorrect"); return; 318 } 319 if ($ans->{showCoordinateHints}) { 320 my @errors; 321 foreach my $i (1..$self->length) { 322 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect") 323 if ($self->{data}[$i-1] != $student->{data}[$i-1]); 324 } 325 $self->cmp_Error($ans,@errors); return; 326 } 327 } 328 329 ############################################################# 330 331 package Value::Vector; 332 333 sub cmp_defaults {( 334 shift->SUPER::cmp_defaults(@_), 335 showDimensionHints => 1, 336 showCoordinateHints => 1, 337 promotePoints => 0, 338 parallel => 0, 339 sameDirection => 0, 340 )} 341 342 sub typeMatch { 343 my $self = shift; my $other = shift; my $ans = shift; 344 return 0 unless ref($other) && $other->class ne 'Formula'; 345 return $other->type eq 'Vector' || 346 ($ans->{promotePoints} && $other->type eq 'Point'); 347 } 348 349 # 350 # check for dimension mismatch 351 # for parallel vectors, and 352 # for incorrect coordinates 353 # 354 sub cmp_postprocess { 355 my $self = shift; my $ans = shift; 356 return unless $ans->{score} == 0; 357 my $student = $ans->{student_value}; 358 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 359 if (!$ans->{isPreview} && $ans->{showDimensionHints} && 360 $self->length != $student->length) { 361 $self->cmp_Error($ans,"The dimension of your result is incorrect"); return; 362 } 363 if ($ans->{parallel} && 364 $self->isParallel($student,$ans->{sameDirection})) { 365 $ans->score(1); return; 366 } 367 if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) { 368 my @errors; 369 foreach my $i (1..$self->length) { 370 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect") 371 if ($self->{data}[$i-1] != $student->{data}[$i-1]); 372 } 373 $self->cmp_Error($ans,@errors); return; 374 } 375 } 376 377 378 379 ############################################################# 380 381 package Value::Matrix; 382 383 sub cmp_defaults {( 384 shift->SUPER::cmp_defaults(@_), 385 showDimensionHints => 1, 386 showEqualErrors => 0, 387 )} 388 389 sub typeMatch { 390 my $self = shift; my $other = shift; my $ans = shift; 391 return 0 unless ref($other) && $other->class ne 'Formula'; 392 return $other->type eq 'Matrix' || 393 ($other->type =~ m/^(Point|list)$/ && 394 $other->{open}.$other->{close} eq $self->{open}.$self->{close}); 395 } 396 397 sub cmp_postprocess { 398 my $self = shift; my $ans = shift; 399 return unless $ans->{score} == 0 && 400 !$ans->{isPreview} && $ans->{showDimensionHints}; 401 my $student = $ans->{student_value}; 402 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 403 my @d1 = $self->dimensions; my @d2 = $student->dimensions; 404 if (scalar(@d1) != scalar(@d2)) { 405 $self->cmp_Error($ans,"Matrix dimension is not correct"); 406 return; 407 } else { 408 foreach my $i (0..scalar(@d1)-1) { 409 if ($d1[$i] != $d2[$i]) { 410 $self->cmp_Error($ans,"Matrix dimension is not correct"); 411 return; 412 } 413 } 414 } 415 } 416 417 ############################################################# 418 419 package Value::Interval; 420 421 sub cmp_defaults {( 422 shift->SUPER::cmp_defaults(@_), 423 showEndpointHints => 1, 424 showEndTypeHints => 1, 425 )} 426 427 sub typeMatch { 428 my $self = shift; my $other = shift; 429 return 0 unless ref($other) && $other->class ne 'Formula'; 430 return $other->length == 2 && 431 ($other->{open} eq '(' || $other->{open} eq '[') && 432 ($other->{close} eq ')' || $other->{close} eq ']') 433 if $other->type =~ m/^(Point|List)$/; 434 $other->type =~ m/^(Interval|Union)$/; 435 } 436 437 # 438 # Check for wrong enpoints and wrong type of endpoints 439 # 440 sub cmp_postprocess { 441 my $self = shift; my $ans = shift; 442 return unless $ans->{score} == 0 && !$ans->{isPreview}; 443 my $other = $ans->{student_value}; 444 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String'); 445 return unless $other->class eq 'Interval'; 446 my @errors; 447 if ($ans->{showEndpointHints}) { 448 push(@errors,"Your left endpoint is incorrect") 449 if ($self->{data}[0] != $other->{data}[0]); 450 push(@errors,"Your right endpoint is incorrect") 451 if ($self->{data}[1] != $other->{data}[1]); 452 } 453 if (scalar(@errors) == 0 && $ans->{showEndTypeHints}) { 454 push(@errors,"The type of interval is incorrect") 455 if ($self->{open}.$self->{close} ne $other->{open}.$other->{close}); 456 } 457 $self->cmp_Error($ans,@errors); 458 } 459 460 ############################################################# 461 462 package Value::Union; 463 464 sub typeMatch { 465 my $self = shift; my $other = shift; 466 return 0 unless ref($other) && $other->class ne 'Formula'; 467 return $other->length == 2 && 468 ($other->{open} eq '(' || $other->{open} eq '[') && 469 ($other->{close} eq ')' || $other->{close} eq ']') 470 if $other->type =~ m/^(Point|List)$/; 471 $other->type =~ m/^(Interval|Union)/; 472 } 473 474 # 475 # Use the List checker for unions, in order to get 476 # partial credit. Set the various types for error 477 # messages. 478 # 479 sub cmp_defaults {( 480 Value::List::cmp_defaults(@_), 481 typeMatch => 'Value::Interval', 482 list_type => 'an interval or union', 483 entry_type => 'an interval', 484 )} 485 486 sub cmp_equal {Value::List::cmp_equal(@_)} 487 488 ############################################################# 489 490 package Value::List; 491 492 sub cmp_defaults { 493 my $self = shift; 494 my %options = (@_); 495 return ( 496 Value::Real->cmp_defaults(@_), 497 showHints => undef, 498 showLengthHints => undef, 499 showParenHints => undef, 500 partialCredit => undef, 501 ordered => 0, 502 showEqualErrors => $options{ordered}, 503 entry_type => undef, 504 list_type => undef, 505 typeMatch => Value::makeValue($self->{data}[0]), 506 requireParenMatch => 1, 507 removeParens => 1, 508 ); 509 } 510 511 # 512 # Match anything but formulas 513 # 514 sub typeMatch {return !ref($other) || $other->class ne 'Formula'} 515 516 # 517 # Handle removal of outermost parens in correct answer. 518 # 519 sub cmp { 520 my $self = shift; 521 my $cmp = $self->SUPER::cmp(@_); 522 if ($cmp->{rh_ans}{removeParens}) { 523 $self->{open} = $self->{close} = ''; 524 $cmp->ans_hash(correct_ans => $self->stringify) 525 unless defined($self->{correct_ans}); 526 } 527 return $cmp; 528 } 529 530 sub cmp_equal { 531 my $self = shift; my $ans = shift; 532 $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers'); 533 534 # 535 # get the paramaters 536 # 537 my $showHints = getOption($ans,'showHints'); 538 my $showLengthHints = getOption($ans,'showLengthHints'); 539 my $showParenHints = getOption($ans,'showLengthHints'); 540 my $partialCredit = getOption($ans,'partialCredit'); 541 my $requireParenMatch = $ans->{requireParenMatch}; 542 my $typeMatch = $ans->{typeMatch}; 543 my $value = $ans->{entry_type}; 544 my $ltype = $ans->{list_type} || lc($self->type); 545 546 $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value') 547 unless defined($value); 548 $value =~ s/(real|complex) //; $ans->{cmp_class} = $value; 549 $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/; 550 $ltype =~ s/^an? //; 551 $showHints = $showLengthHints = 0 if $ans->{isPreview}; 552 553 # 554 # Get the lists of correct and student answers 555 # (split formulas that return lists or unions) 556 # 557 my @correct = (); my ($cOpen,$cClose); 558 if ($self->class ne 'Formula') { 559 @correct = $self->value; 560 $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close}; 561 } else { 562 @correct = Value::List->splitFormula($self,$ans); 563 $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close}; 564 } 565 my $student = $ans->{student_value}; my @student = ($student); 566 my ($sOpen,$sClose) = ('',''); 567 if (Value::isFormula($student) && $student->type eq $self->type) { 568 @student = Value::List->splitFormula($student,$ans); 569 $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close}; 570 } elsif ($student->class ne 'Formula' && $student->class eq $self->type) { 571 @student = @{$student->{data}}; 572 $sOpen = $student->{open}; $sClose = $student->{close}; 573 } 574 return if $ans->{split_error}; 575 # 576 # Check for parenthesis match 577 # 578 if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) { 579 if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) { 580 my $message = "The parentheses for your $ltype "; 581 if (($cOpen || $cClose) && ($sOpen || $sClose)) 582 {$message .= "are of the wrong type"} 583 elsif ($sOpen || $sClose) {$message .= "should be removed"} 584 else {$message .= "are missing"} 585 $self->cmp_Error($ans,$message) unless $ans->{isPreview}; 586 } 587 return; 588 } 589 590 # 591 # Determine the maximum score 592 # 593 my $M = scalar(@correct); 594 my $m = scalar(@student); 595 my $maxscore = ($m > $M)? $m : $M; 596 597 # 598 # Compare the two lists 599 # (Handle errors in user-supplied functions) 600 # 601 my ($score,@errors); 602 if (ref($ans->{list_checker}) eq 'CODE') { 603 eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)}; 604 if (!defined($score)) { 605 die $@ if $@ ne '' && $self->{context}{error}{flag} == 0; 606 $self->cmp_error($ans) if $self->{context}{error}{flag}; 607 } 608 } else { 609 ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value); 610 } 611 return unless defined($score); 612 613 # 614 # Give hints about extra or missing answers 615 # 616 if ($showLengthHints) { 617 $value =~ s/ or /s or /; # fix "interval or union" 618 push(@errors,"There should be more ${value}s in your $ltype") 619 if ($score < $maxscore && $score == $m); 620 push(@errors,"There should be fewer ${value}s in your $ltype") 621 if ($score < $maxscore && $score == $M && !$showHints); 622 } 623 624 # 625 # Finalize the score 626 # 627 $score = 0 if ($score != $maxscore && !$partialCredit); 628 $ans->score($score/$maxscore); 629 push(@errors,"Score = $ans->{score}") if $ans->{debug}; 630 $ans->{error_message} = $ans->{ans_message} = join("\n",@errors); 631 } 632 633 # 634 # Compare the contents of the list to see of they are equal 635 # 636 sub cmp_list_compare { 637 my $self = shift; 638 my $correct = shift; my $student = shift; my $ans = shift; my $value = shift; 639 my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student); 640 my $ordered = $ans->{ordered}; 641 my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview}; 642 my $typeMatch = $ans->{typeMatch}; 643 my $showHints = getOption($ans,'showHints') && !$ans->{isPreview}; 644 my $error = $$Value::context->{error}; 645 my $score = 0; my @errors; my $i = 0; 646 647 # 648 # Check for empty lists 649 # 650 if (scalar(@correct) == 0) {$ans->score($m == 0); return} 651 652 # 653 # Loop through student answers looking for correct ones 654 # 655 ENTRY: foreach my $entry (@student) { 656 $i++; $$Value::context->clearError; 657 $entry = Value::makeValue($entry); 658 $entry = Value::Formula->new($entry) if !Value::isValue($entry); 659 if ($ordered) { 660 if (shift(@correct)->cmp_compare($entry,$ans)) {$score++; next ENTRY} 661 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return} 662 } else { 663 foreach my $k (0..$#correct) { 664 if ($correct[$k]->cmp_compare($entry,$ans)) { 665 splice(@correct,$k,1); 666 $score++; next ENTRY; 667 } 668 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return} 669 } 670 } 671 # 672 # Give messages about incorrect answers 673 # 674 my $nth = ''; my $answer = 'answer'; 675 my $class = $ans->{list_type} || $self->cmp_class; 676 if ($m > 1) { 677 $nth = ' '.$self->NameForNumber($i); 678 $class = $ans->{cmp_class}; 679 $answer = 'value'; 680 } 681 if ($error->{flag} && $ans->{showEqualErrors}) { 682 push(@errors,"<I>An error occured while processing your$nth $answer:</I>", 683 '<DIV STYLE="margin-left:1em">'.$error->{message}.'</DIV>'); 684 } elsif ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) && 685 !($ans->{ignoreStrings} && $entry->class eq 'String')) { 686 push(@errors,"Your$nth $answer isn't ".lc($class). 687 " (it looks like ".lc($entry->showClass).")"); 688 } elsif ($showHints && $m > 1) { 689 push(@errors,"Your$nth $value is incorrect"); 690 } 691 } 692 693 # 694 # Return the score and errors 695 # 696 return ($score,@errors); 697 } 698 699 # 700 # Split a formula that is a list or union into a 701 # list of formulas (or Value objects). 702 # 703 sub splitFormula { 704 my $self = shift; my $formula = shift; my $ans = shift; 705 my @formula; my @entries; 706 if ($formula->type eq 'List') {@entries = @{$formula->{tree}{coords}}} 707 else {@entries = $formula->{tree}->makeUnion} 708 foreach my $entry (@entries) { 709 my $v = Parser::Formula($entry); 710 $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant); 711 push(@formula,$v); 712 # 713 # There shouldn't be an error evaluating the formula, 714 # but you never know... 715 # 716 if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return} 717 } 718 return @formula; 719 } 720 721 # 722 # Return the value if it is defined, otherwise use a default 723 # 724 sub getOption { 725 my $ans = shift; my $name = shift; 726 my $value = $ans->{$name}; 727 return $value if defined($value); 728 return $ans->{showPartialCorrectAnswers}; 729 } 730 731 ############################################################# 732 733 package Value::Formula; 734 735 sub cmp_defaults { 736 my $self = shift; 737 738 return ( 739 Value::Union::cmp_defaults($self,@_), 740 typeMatch => Value::Formula->new("(1,2]"), 741 ) if $self->type eq 'Union'; 742 743 my $type = $self->type; 744 $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number'; 745 $type = 'Value::'.$type.'::'; 746 747 return (&{$type.'cmp_defaults'}($self,@_), upToConstant => 0) 748 if defined(%$type) && $self->type ne 'List'; 749 750 return ( 751 Value::List::cmp_defaults($self,@_), 752 removeParens => $self->{autoFormula}, 753 typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]), 754 ); 755 } 756 757 # 758 # Get the types from the values of the formulas 759 # and compare those. 760 # 761 sub typeMatch { 762 my $self = shift; my $other = shift; my $ans = shift; 763 return 1 if $self->type eq $other->type; 764 my $typeMatch = ($self->createRandomPoints(1))[1]->[0]; 765 $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other); 766 return 1 unless defined($other); # can't really tell, so don't report type mismatch 767 $typeMatch->typeMatch($other,$ans); 768 } 769 770 # 771 # Handle removal of outermost parens in a list. 772 # 773 sub cmp { 774 my $self = shift; 775 my $cmp = $self->SUPER::cmp(@_); 776 if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') { 777 $self->{tree}{open} = $self->{tree}{close} = ''; 778 $cmp->ans_hash(correct_ans => $self->stringify) 779 unless defined($self->{correct_ans}); 780 } 781 if ($cmp->{rh_ans}{eval} && $self->isConstant) { 782 $cmp->ans_hash(correct_value => $self->eval); 783 return $cmp; 784 } 785 if ($cmp->{rh_ans}{upToConstant}) { 786 my $current = Parser::Context->current(); 787 my $context = $self->{context} = $self->{context}->copy; 788 Parser::Context->current(undef,$context); 789 $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} = 790 'C0|' . $context->{_variables}->{pattern}; 791 $context->update; $context->variables->add('C0' => 'Parameter'); 792 $cmp->ans_hash(correct_value => Value::Formula->new('C0')+$self); 793 Parser::Context->current(undef,$current); 794 } 795 return $cmp; 796 } 797 798 sub cmp_equal { 799 my $self = shift; my $ans = shift; 800 # 801 # Get the problem's seed 802 # 803 $self->{context}->flags->set( 804 random_seed => $self->getPG('$PG_original_problemSeed') 805 ); 806 807 # 808 # Use the list checker if the formula is a list or union 809 # Otherwise use the normal checker 810 # 811 if ($self->type =~ m/^(List|Union)$/) { 812 Value::List::cmp_equal($self,$ans); 813 } else { 814 $self->SUPER::cmp_equal($ans); 815 } 816 } 817 818 sub cmp_postprocess { 819 my $self = shift; my $ans = shift; 820 return unless $ans->{score} == 0 && !$ans->{isPreview}; 821 return if $ans->{ans_message} || !$ans->{showDimensionHints}; 822 my $other = $ans->{student_value}; 823 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String'); 824 return unless $other->type =~ m/^(Point|Vector|Matrix)$/; 825 return unless $self->type =~ m/^(Point|Vector|Matrix)$/; 826 return if Parser::Item::typeMatch($self->typeRef,$other->typeRef); 827 $self->cmp_Error($ans,"The dimension of your result is incorrect"); 828 } 829 830 ############################################################# 831 832 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |