Parent Directory
| 
Revision Log
Fixed typo in name of random generator.
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 => 'a 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 => undef, 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} || lc($self->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 $ltype =~ s/^an? //; 504 $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview}; 505 506 # 507 # Get the lists of correct and student answers 508 # (split formulas that return lists or unions) 509 # 510 my @correct = (); 511 if ($self->class ne 'Formula') {@correct = $self->value} 512 else {@correct = Value::List->splitFormula($self,$ans)} 513 my $student = $ans->{student_value}; 514 my @student = ($student); 515 if ($student->class eq 'Formula' && $student->type eq $self->type) { 516 @student = Value::List->splitFormula($student,$ans); 517 } elsif ($student->class ne 'Formula' && $student->class eq $self->type && 518 ($allowParens || (!$student->{open} && !$student->{close}))) { 519 @student = @{$student->{data}}; 520 } 521 return if $ans->{split_error}; 522 if (scalar(@correct) == 0 && scalar(@student) == 0) {$ans->score(1); return} 523 524 # 525 # Initialize the score 526 # 527 my $M = scalar(@correct); 528 my $m = scalar(@student); 529 my $maxscore = ($m > $M)? $m : $M; 530 my $score = 0; my @errors; my $i = 0; 531 532 # 533 # Loop through student answers looking for correct ones 534 # 535 ENTRY: foreach my $entry (@student) { 536 $i++; 537 $entry = Value::makeValue($entry); 538 $entry = Value::Formula->new($entry) if !Value::isValue($entry); 539 if ($ordered) { 540 if (eval {shift(@correct) == $entry}) {$score++; next ENTRY} 541 } else { 542 foreach my $k (0..$#correct) { 543 if (eval {$correct[$k] == $entry}) { 544 splice(@correct,$k,1); 545 $score++; next ENTRY; 546 } 547 } 548 } 549 # 550 # Give messages about incorrect answers 551 # 552 my $nth = ''; my $answer = 'answer'; 553 my $class = $ans->{list_type} || $self->cmp_class; 554 if (scalar(@student) > 1) { 555 $nth = ' '.$self->NameForNumber($i); 556 $class = $ans->{cmp_class}; 557 $answer = 'value'; 558 } 559 if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) && 560 !($ans->{ignoreStrings} && $entry->class eq 'String')) { 561 push(@errors,"Your$nth $answer isn't ".lc($class). 562 " (it looks like ".lc($entry->showClass).")"); 563 } elsif ($showHints && $m > 1) { 564 push(@errors,"Your$nth $value is incorrect"); 565 } 566 } 567 568 # 569 # Give hints about extra or missing answsers 570 # 571 if ($showLengthHints) { 572 $value =~ s/ or /s or /; # fix "interval or union" 573 push(@errors,"There should be more ${value}s in your $ltype") 574 if ($score == $m && scalar(@correct) > 0); 575 push(@errors,"There should be fewer ${value}s in your $ltype") 576 if ($score < $maxscore && $score == $M); 577 } 578 579 # 580 # Finalize the score 581 # 582 $score = 0 if ($score != $maxscore && !$partialCredit); 583 $ans->score($score/$maxscore); 584 push(@errors,"Score = $ans->{score}") if $ans->{debug}; 585 $ans->{error_message} = $ans->{ans_message} = join("\n",@errors); 586 } 587 588 # 589 # Split a formula that is a list or union into a 590 # list of formulas (or Value objects). 591 # 592 sub splitFormula { 593 my $self = shift; my $formula = shift; my $ans = shift; 594 my @formula; my @entries; 595 if ($formula->type eq 'List') {@entries = @{$formula->{tree}{coords}}} 596 else {@entries = $formula->{tree}->makeUnion} 597 foreach my $entry (@entries) { 598 my $v = Parser::Formula($entry); 599 $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant); 600 push(@formula,$v); 601 # 602 # There shouldn't be an error evaluating the formula, 603 # but you never know... 604 # 605 if (!defined($v)) { 606 $ans->{split_error} = 1; 607 my $cmp_error = $ans->{cmp_error} || 'cmp_error'; 608 $self->$cmp_error; return; 609 } 610 } 611 return @formula; 612 } 613 614 # 615 # Return the value if it is defined, otherwise use a default 616 # 617 sub getOption { 618 my $ans = shift; my $name = shift; 619 my $value = $ans->{$name}; 620 return $value if defined($value); 621 return $ans->{showPartialCorrectAnswers}; 622 } 623 624 ############################################################# 625 626 package Value::Formula; 627 628 sub cmp_defaults { 629 my $self = shift; 630 631 return ( 632 Value::Union::cmp_defaults($self,@_), 633 typeMatch => Value::Formula->new("(1,2]"), 634 ) if $self->type eq 'Union'; 635 636 return Value::Real::cmp_defaults($self,@_) unless $self->type eq 'List'; 637 638 return ( 639 Value::List::cmp_defaults($self,@_), 640 typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]), 641 ); 642 } 643 644 # 645 # Get the types from the values of the formulas 646 # and compare those. 647 # 648 sub typeMatch { 649 my $self = shift; my $other = shift; my $ans = shift; 650 return 1 if $self->type eq $other->type; 651 my $typeMatch = ($self->createRandomPoints(1))[1]->[0]; 652 $other = eval {($other->createRandomPoints(1))[1]->[0]} if ($other->class eq 'Formula'); 653 return 1 unless defined($other); # can't really tell, so don't report type mismatch 654 $typeMatch->typeMatch($other,$ans); 655 } 656 657 # 658 # Handle removal of outermost parens in a list. 659 # 660 sub cmp { 661 my $self = shift; 662 my $cmp = $self->SUPER::cmp(@_); 663 if (!$cmp->{rh_ans}{showParens} && $self->type eq 'List') { 664 $self->{tree}{open} = $self->{tree}{close} = ''; 665 $cmp->ans_hash(correct_ans => $self->stringify); 666 } 667 return $cmp; 668 } 669 670 sub cmp_equal { 671 my $self = shift; my $ans = shift; 672 # 673 # Get the problem's seed 674 # 675 $self->{context}->flags->set( 676 random_seed => $self->getPG('$PG_original_problemSeed') 677 ); 678 679 # 680 # Use the list checker if the formula is a list or union 681 # Otherwise use the normal checker 682 # 683 if ($self->type =~ m/^(List|Union)$/) { 684 Value::List::cmp_equal($self,$ans); 685 } else { 686 $self->SUPER::cmp_equal($ans); 687 } 688 } 689 690 # 691 # Replace the ones in Value::Formula 692 # 693 sub PGseedRandom { 694 my $self = shift; 695 return if $self->{PGrandom}; 696 $self->{PGrandom} = new PGrandom($self->{context}->flag('random_seed')); 697 } 698 sub PGgetRandom {shift->{PGrandom}->random(@_)} 699 700 ############################################################# 701 702 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |