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