Parent Directory
| 
Revision Log
Better error messages for unreduced unions.
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 # Context can add default values to the answer checkers by class; 18 # 19 $Value::defaultContext->{cmpDefaults} = {}; 20 21 22 # 23 # Default flags for the answer checkers 24 # 25 sub cmp_defaults {( 26 showTypeWarnings => 1, 27 showEqualErrors => 1, 28 ignoreStrings => 1, 29 studentsMustReduceUnions => 1, 30 showUnionReduceWarnings => 1, 31 )} 32 33 # 34 # Create an answer checker for the given type of object 35 # 36 sub cmp { 37 my $self = shift; 38 my $ans = new AnswerEvaluator; 39 my $correct = protectHTML($self->{correct_ans}); 40 $correct = $self->correct_ans unless defined($correct); 41 $self->{context} = $$Value::context unless defined($self->{context}); 42 $ans->ans_hash( 43 type => "Value (".$self->class.")", 44 correct_ans => $correct, 45 correct_value => $self, 46 $self->cmp_defaults(@_), 47 %{$self->{context}{cmpDefaults}{$self->class} || {}}, # context-specified defaults 48 @_ 49 ); 50 $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)}); 51 $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array 52 return $ans; 53 } 54 55 sub correct_ans {protectHTML(shift->string)} 56 57 # 58 # Parse the student answer and compute its value, 59 # produce the preview strings, and then compare the 60 # student and professor's answers for equality. 61 # 62 sub cmp_parse { 63 my $self = shift; my $ans = shift; 64 # 65 # Do some setup 66 # 67 my $current = $$Value::context; # save it for later 68 my $context = $ans->{correct_value}{context} || $current; 69 Parser::Context->current(undef,$context); # change to correct answser's context 70 my $flags = contextSet($context, # save old context flags for the below 71 StringifyAsTeX => 0, # reset this, just in case. 72 no_parameters => 1, # don't let students enter parameters 73 showExtraParens => 1, # make student answer painfully unambiguous 74 reduceConstants => 0, # don't combine student constants 75 reduceConstantFunctions => 0, # don't reduce constant functions 76 ($ans->{studentsMustReduceUnions} ? 77 (reduceUnions => 0, reduceSets => 0, 78 reduceUnionsForComparison => $ans->{showUnionReduceWarnings}, 79 reduceSetsForComparison => $ans->{showUnionReduceWarnings}) : 80 (reduceUnions => 1, reduceSets => 1, 81 reduceUnionsForComparison => 1, reduceSetsForComparison => 1)), 82 ($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals 83 $self->cmp_contextFlags($ans), # any additional ones from the object itself 84 ); 85 my $inputs = $self->getPG('$inputs_ref',{action=>""}); 86 $ans->{isPreview} = $inputs->{previewAnswers} || ($inputs->{action} =~ m/^Preview/); 87 $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class}; 88 $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages 89 $ans->{preview_latex_string} = $ans->{preview_text_string} = ''; 90 91 # 92 # Parse and evaluate the student answer 93 # 94 $ans->score(0); # assume failure 95 $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans}); 96 $ans->{student_value} = Parser::Evaluate($ans->{student_formula}) 97 if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant; 98 99 # 100 # If it parsed OK, save the output forms and check if it is correct 101 # otherwise report an error 102 # 103 if (defined $ans->{student_value}) { 104 $ans->{student_value} = Value::Formula->new($ans->{student_value}) 105 unless Value::isValue($ans->{student_value}); 106 $ans->{preview_latex_string} = $ans->{student_formula}->TeX; 107 $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string); 108 $ans->{student_ans} = $ans->{preview_text_string}; 109 if ($self->cmp_collect($ans)) { 110 $self->cmp_equal($ans); 111 $self->cmp_postprocess($ans) if !$ans->{error_message}; 112 } 113 } else { 114 $self->cmp_collect($ans); 115 $self->cmp_error($ans); 116 } 117 contextSet($context,%{$flags}); # restore context values 118 Parser::Context->current(undef,$current); # put back the old context 119 return $ans; 120 } 121 122 # 123 # Check if the object has an answer array and collect the results 124 # Build the combined student answer and set the preview values 125 # 126 sub cmp_collect { 127 my $self = shift; my $ans = shift; 128 return 1 unless $self->{ans_name}; 129 $ans->{preview_latex_string} = $ans->{preview_text_string} = ""; 130 my $OK = $self->ans_collect($ans); 131 $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1); 132 return 0 unless $OK; 133 my $array = $ans->{student_formula}; 134 if ($self->{ColumnVector}) { 135 my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])} 136 $array = [@V]; 137 } elsif (scalar(@{$array}) == 1) {$array = $array->[0]} 138 my $type = $self; 139 $type = "Value::".$self->{tree}->type if $self->class eq 'Formula'; 140 $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})}; 141 if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag}) 142 {Parser::reportEvalError($@); $self->cmp_error($ans); return 0} 143 $ans->{student_value} = $ans->{student_formula}; 144 $ans->{preview_text_string} = $ans->{student_ans}; 145 $ans->{preview_latex_string} = $ans->{student_formula}->TeX; 146 if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) { 147 $ans->{student_value} = Parser::Evaluate($ans->{student_formula}); 148 return 0 unless $ans->{student_value}; 149 } 150 return 1; 151 } 152 153 # 154 # Check if the parsed student answer equals the professor's answer 155 # 156 sub cmp_equal { 157 my $self = shift; my $ans = shift; 158 my $correct = $ans->{correct_value}; 159 my $student = $ans->{student_value}; 160 if ($correct->typeMatch($student,$ans)) { 161 my $equal = $correct->cmp_compare($student,$ans); 162 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} 163 $self->cmp_error($ans); 164 } else { 165 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 166 $ans->{ans_message} = $ans->{error_message} = 167 "Your answer isn't ".lc($ans->{cmp_class})."\n". 168 "(it looks like ".lc($student->showClass).")" 169 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; 170 } 171 } 172 173 # 174 # Perform the comparison, either using the checker supplied 175 # by the answer evaluator, or the overloaded == operator. 176 # 177 178 our $CMP_ERROR = 2; # a fatal error was detected 179 our $CMP_WARNING = 3; # a warning was produced 180 181 sub cmp_compare { 182 my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || ''; 183 return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE'; 184 my $equal = eval {&{$ans->{checker}}($self,$other,$ans,$nth,@_)}; 185 if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) { 186 $$Value::context->setError(["<I>An error occurred while checking your$nth answer:</I>\n". 187 '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'',undef,undef,$CMP_ERROR); 188 warn "Please inform your instructor that an error occurred while checking your answer"; 189 } 190 return $equal; 191 } 192 193 sub cmp_list_compare {Value::List::cmp_list_compare(@_)} 194 195 # 196 # Check if types are compatible for equality check 197 # 198 sub typeMatch { 199 my $self = shift; my $other = shift; 200 return 1 unless ref($other); 201 $self->type eq $other->type && $other->class ne 'Formula'; 202 } 203 204 # 205 # Class name for cmp error messages 206 # 207 sub cmp_class { 208 my $self = shift; my $ans = shift; 209 my $class = $self->showClass; $class =~ s/Real //; 210 return $class if $class =~ m/Formula/; 211 return "an Interval, Set or Union" if $self->isSetOfReals; 212 return $class; 213 } 214 215 # 216 # Student answer evaluation failed. 217 # Report the error, with formatting, if possible. 218 # 219 sub cmp_error { 220 my $self = shift; my $ans = shift; 221 my $error = $$Value::context->{error}; 222 my $message = $error->{message}; 223 if ($error->{pos}) { 224 my $string = $error->{string}; 225 my ($s,$e) = @{$error->{pos}}; 226 $message =~ s/; see.*//; # remove the position from the message 227 $ans->{student_ans} = 228 protectHTML(substr($string,0,$s)) . 229 '<SPAN CLASS="parsehilight">' . 230 protectHTML(substr($string,$s,$e-$s)) . 231 '</SPAN>' . 232 protectHTML(substr($string,$e)); 233 } 234 $self->cmp_Error($ans,$message); 235 } 236 237 # 238 # Set the error message 239 # 240 sub cmp_Error { 241 my $self = shift; my $ans = shift; 242 return unless scalar(@_) > 0; 243 $ans->score(0); 244 $ans->{ans_message} = $ans->{error_message} = join("\n",@_); 245 } 246 247 # 248 # filled in by sub-classes 249 # 250 sub cmp_postprocess {} 251 sub cmp_contextFlags {return ()} 252 253 # 254 # Check for unreduced reduced Unions and Sets 255 # 256 sub cmp_checkUnionReduce { 257 my $self = shift; my $student = shift; my $ans = shift; my $nth = shift || ''; 258 return unless $ans->{studentsMustReduceUnions} && 259 $ans->{showUnionReduceWarnings} && 260 !$ans->{isPreview} && !Value::isFormula($student); 261 if ($student->type eq 'Union' && $student->length >= 2) { 262 my $reduced = $student->reduce; 263 return "Your$nth union can be written without overlaps" 264 unless $reduced->type eq 'Union' && $reduced->length == $student->length; 265 my @R = $reduced->sort->value; 266 my @S = $student->sort->value; 267 foreach my $i (0..$#R) { 268 return "Your$nth union can be written without overlaps" 269 unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length; 270 } 271 } elsif ($student->type eq 'Set' && $student->length >= 2) { 272 return "Your$nth set should have no repeated elements" 273 unless $student->reduce->length == $student->length; 274 } 275 return; 276 } 277 278 # 279 # create answer rules of various types 280 # 281 sub ans_rule {shift; pgCall('ans_rule',@_)} 282 sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)} 283 sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)} 284 sub ans_array {shift->ans_rule(@_)}; 285 sub named_ans_array {shift->named_ans_rule(@_)}; 286 sub named_ans_array_extension {shift->named_ans_rule_extension(@_)}; 287 288 sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)} 289 sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)} 290 291 our $answerPrefix = "MaTrIx"; 292 293 # 294 # Lay out a matrix of answer rules 295 # 296 sub ans_matrix { 297 my $self = shift; 298 my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_; 299 my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION'); 300 my $new_name = pgRef('RECORD_FORM_LABEL'); 301 my $HTML = ""; my $ename = $name; 302 if ($name eq '') { 303 my $n = pgCall('inc_ans_rule_count'); 304 $name = pgCall('NEW_ANS_NAME',$n); 305 $ename = $answerPrefix.$n; 306 } 307 $self->{ans_name} = $ename; 308 $self->{ans_rows} = $rows; 309 $self->{ans_cols} = $cols; 310 my @array = (); 311 foreach my $i (0..$rows-1) { 312 my @row = (); 313 foreach my $j (0..$cols-1) { 314 if ($i == 0 && $j == 0) { 315 if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))} 316 else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))} 317 } else { 318 push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size)); 319 } 320 } 321 push(@array,[@row]); 322 } 323 $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep); 324 } 325 326 sub ANS_NAME { 327 my ($name,$i,$j) = @_; 328 $name.'_'.$i.'_'.$j; 329 } 330 331 332 # 333 # Lay out an arbitrary matrix 334 # 335 sub format_matrix { 336 my $self = shift; 337 my $displayMode = $self->getPG('$displayMode'); 338 return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX'); 339 return $self->format_matrix_HTML(@_); 340 } 341 342 sub format_matrix_tex { 343 my $self = shift; my $array = shift; 344 my %options = (open=>'.',close=>'.',sep=>'',@_); 345 $self->{format_options} = [%options] unless $self->{format_options}; 346 my ($open,$close,$sep) = ($options{open},$options{close},$options{sep}); 347 my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]})); 348 my $tex = ""; 349 $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/; 350 $tex .= '\(\left'.$open; 351 $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep; 352 $tex .= '\begin{array}{'.('c'x$cols).'}'; 353 foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"} 354 $tex .= '\end{array}\right'.$close.'\)'; 355 return $tex; 356 } 357 358 sub format_matrix_HTML { 359 my $self = shift; my $array = shift; 360 my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_); 361 $self->{format_options} = [%options] unless $self->{format_options}; 362 my ($open,$close,$sep) = ($options{open},$options{close},$options{sep}); 363 my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]})); 364 my $HTML = ""; 365 if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'} 366 else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'} 367 foreach my $i (0..$rows-1) { 368 $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i; 369 $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,@{$array->[$i]}).'</TD></TR>'."\n"; 370 } 371 $open = $self->format_delimiter($open,$rows,$options{tth_delims}); 372 $close = $self->format_delimiter($close,$rows,$options{tth_delims}); 373 if ($open ne '' || $close ne '') { 374 $HTML = '<TR ALIGN="MIDDLE">' 375 . '<TD>'.$open.'</TD>' 376 . '<TD WIDTH="2"></TD>' 377 . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">' 378 . $HTML 379 . '</TABLE></TD>' 380 . '<TD WIDTH="4"></TD>' 381 . '<TD>'.$close.'</TD>' 382 . '</TR>'."\n"; 383 } 384 return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"' 385 . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">' 386 . $HTML 387 . '</TABLE>'; 388 } 389 390 sub VERBATIM { 391 my $string = shift; 392 my $displayMode = Value->getPG('$displayMode'); 393 $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX'; 394 return $string; 395 } 396 397 # 398 # Create a tall delimiter to match the line height 399 # 400 sub format_delimiter { 401 my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift; 402 return '' if $delim eq '' || $delim eq '.'; 403 my $displayMode = $self->getPG('$displayMode'); 404 return $self->format_delimiter_tth($delim,$rows,$tth) 405 if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/; 406 my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt'; 407 $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath'; 408 $delim = '\\'.$delim if $delim eq '{' || $delim eq '}'; 409 return '\(\left'.$delim.$rule.'\right.\)'; 410 } 411 412 # 413 # Data for tth delimiters [top,mid,bot,rep] 414 # 415 my %tth_delim = ( 416 '[' => ['','','',''], 417 ']' => ['','','',''], 418 '(' => ['','','',''], 419 ')' => ['','','',''], 420 '{' => ['','','',''], 421 '}' => ['','','',''], 422 '|' => ['|','','|','|'], 423 '<' => ['<'], 424 '>' => ['>'], 425 '\lgroup' => ['','','',''], 426 '\rgroup' => ['','','',''], 427 ); 428 429 # 430 # Make delimiters as stacks of characters 431 # 432 sub format_delimiter_tth { 433 my $self = shift; 434 my $delim = shift; my $rows = shift; my $tth = shift; 435 return '' if $delim eq '' || !defined($tth_delim{$delim}); 436 my $c = $delim; $delim = $tth_delim{$delim}; 437 $c = $delim->[0] if scalar(@{$delim}) == 1; 438 my $size = ($tth? "": "font-size:175%; "); 439 return '<SPAN STYLE="'.$size.'margin:0px 2px">'.$c.'</SPAN>' 440 if $rows == 1 || scalar(@{$delim}) == 1; 441 my $HTML = ""; 442 if ($delim->[1] eq '') { 443 $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]); 444 } else { 445 $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1), 446 $delim->[1],($delim->[3])x($rows-1), 447 $delim->[2]); 448 } 449 return '<DIV STYLE="line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>'; 450 } 451 452 453 # 454 # Look up the values of the answer array entries, and check them 455 # for syntax and other errors. Build the student answer 456 # based on these, and keep track of error messages. 457 # 458 459 my @ans_cmp_defaults = (showCoodinateHints => 0, checker => sub {0}); 460 461 sub ans_collect { 462 my $self = shift; my $ans = shift; 463 my $inputs = $self->getPG('$inputs_ref'); 464 my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__'; 465 my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols}); 466 my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1; 467 if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}} 468 $data = [$data] unless ref($data->[0]) eq 'ARRAY'; 469 foreach my $i (0..$rows-1) { 470 my @row = (); my $entry; 471 foreach my $j (0..$cols-1) { 472 if ($i || $j) { 473 $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)}; 474 } else { 475 $entry = $ans->{original_student_ans}; 476 $ans->{student_formula} = $ans->{student_value} = undef unless $entry =~ m/\S/; 477 } 478 my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry); 479 $OK &= entryCheck($result,$blank); 480 push(@row,$result->{student_formula}); 481 entryMessage($result->{ans_message},$errors,$i,$j,$rows,$cols); 482 } 483 push(@array,[@row]); 484 } 485 $ans->{student_formula} = [@array]; 486 $ans->{ans_message} = $ans->{error_message} = ""; 487 if (scalar(@{$errors})) { 488 $ans->{ans_message} = $ans->{error_message} = 489 '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'. 490 join('<TR><TD HEIGHT="4"></TD></TR>',@{$errors}). 491 '</TABLE>'; 492 $OK = 0; 493 } 494 return $OK; 495 } 496 497 sub entryMessage { 498 my $message = shift; return unless $message; 499 my ($errors,$i,$j,$rows,$cols) = @_; $i++; $j++; 500 my $title; 501 if ($rows == 1) {$title = "In entry $j"} 502 elsif ($cols == 1) {$title = "In entry $i"} 503 else {$title = "In entry ($i,$j)"} 504 push(@{$errors},"<TR VALIGN=\"TOP\"><TD STYLE=\"text-align:right; border:0px\"><I>$title</I>: </TD>". 505 "<TD STYLE=\"text-align:left; border:0px\">$message</TD></TR>"); 506 } 507 508 sub entryCheck { 509 my $ans = shift; my $blank = shift; 510 return 1 if defined($ans->{student_value}); 511 if (!defined($ans->{student_formula})) { 512 $ans->{student_formula} = $ans->{student_ans}; 513 $ans->{student_formula} = $blank unless $ans->{student_formula}; 514 } 515 return 0 516 } 517 518 519 # 520 # Get and Set values in context 521 # 522 sub contextSet { 523 my $context = shift; my %set = (@_); 524 my $flags = $context->{flags}; my $get = {}; 525 foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}} 526 return $get; 527 } 528 529 # 530 # Quote HTML characters 531 # 532 sub protectHTML { 533 my $string = shift; 534 return unless defined($string); 535 return $string if eval ('$main::displayMode') eq 'TeX'; 536 $string =~ s/&/\&/g; 537 $string =~ s/</\</g; 538 $string =~ s/>/\>/g; 539 $string; 540 } 541 542 # 543 # names for numbers 544 # 545 sub NameForNumber { 546 my $self = shift; my $n = shift; 547 my $name = ('zeroth','first','second','third','fourth','fifth', 548 'sixth','seventh','eighth','ninth','tenth')[$n]; 549 $name = "$n-th" if ($n > 10); 550 return $name; 551 } 552 553 # 554 # Get a value from the safe compartment 555 # 556 sub getPG { 557 my $self = shift; 558 # (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0]; 559 eval ('package main; '.shift); # faster 560 } 561 562 ############################################################# 563 ############################################################# 564 565 package Value::Real; 566 567 sub cmp_defaults {( 568 shift->SUPER::cmp_defaults(@_), 569 ignoreInfinity => 1, 570 )} 571 572 sub typeMatch { 573 my $self = shift; my $other = shift; my $ans = shift; 574 return 1 unless ref($other); 575 return 0 if Value::isFormula($other); 576 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity}; 577 $self->type eq $other->type; 578 } 579 580 ############################################################# 581 582 package Value::Infinity; 583 584 sub cmp_class {'a Number'}; 585 586 sub typeMatch { 587 my $self = shift; my $other = shift; my $ans = shift; 588 return 1 unless ref($other); 589 return 0 if Value::isFormula($other); 590 return 1 if $other->type eq 'Number'; 591 $self->type eq $other->type; 592 } 593 594 ############################################################# 595 596 package Value::String; 597 598 sub cmp_defaults {( 599 Value::Real->cmp_defaults(@_), 600 typeMatch => 'Value::Real', 601 )} 602 603 sub cmp_class { 604 my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch}; 605 return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String'; 606 return $typeMatch->cmp_class; 607 }; 608 609 sub typeMatch { 610 my $self = shift; my $other = shift; my $ans = shift; 611 return 0 if ref($other) && Value::isFormula($other); 612 my $typeMatch = $ans->{typeMatch}; 613 return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' || 614 $self->type eq $other->type; 615 return $typeMatch->typeMatch($other,$ans); 616 } 617 618 ############################################################# 619 620 package Value::Point; 621 622 sub cmp_defaults {( 623 shift->SUPER::cmp_defaults(@_), 624 showDimensionHints => 1, 625 showCoordinateHints => 1, 626 )} 627 628 sub typeMatch { 629 my $self = shift; my $other = shift; my $ans = shift; 630 return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula'; 631 } 632 633 # 634 # Check for dimension mismatch and incorrect coordinates 635 # 636 sub cmp_postprocess { 637 my $self = shift; my $ans = shift; 638 return unless $ans->{score} == 0 && !$ans->{isPreview}; 639 my $student = $ans->{student_value}; 640 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 641 if ($ans->{showDimensionHints} && $self->length != $student->length) { 642 $self->cmp_Error($ans,"The number of coordinates is incorrect"); return; 643 } 644 if ($ans->{showCoordinateHints}) { 645 my @errors; 646 foreach my $i (1..$self->length) { 647 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect") 648 if ($self->{data}[$i-1] != $student->{data}[$i-1]); 649 } 650 $self->cmp_Error($ans,@errors); return; 651 } 652 } 653 654 sub correct_ans { 655 my $self = shift; 656 return $self->SUPER::correct_ans unless $self->{ans_name}; 657 Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1)); 658 } 659 660 sub ANS_MATRIX { 661 my $self = shift; 662 my $extend = shift; my $name = shift; 663 my $size = shift || 5; 664 my $def = ($self->{context} || $$Value::context)->lists->get('Point'); 665 my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close}; 666 $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,','); 667 } 668 669 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)} 670 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)} 671 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)} 672 673 ############################################################# 674 675 package Value::Vector; 676 677 sub cmp_defaults {( 678 shift->SUPER::cmp_defaults(@_), 679 showDimensionHints => 1, 680 showCoordinateHints => 1, 681 promotePoints => 0, 682 parallel => 0, 683 sameDirection => 0, 684 )} 685 686 sub typeMatch { 687 my $self = shift; my $other = shift; my $ans = shift; 688 return 0 unless ref($other) && $other->class ne 'Formula'; 689 return $other->type eq 'Vector' || 690 ($ans->{promotePoints} && $other->type eq 'Point'); 691 } 692 693 # 694 # check for dimension mismatch 695 # for parallel vectors, and 696 # for incorrect coordinates 697 # 698 sub cmp_postprocess { 699 my $self = shift; my $ans = shift; 700 return unless $ans->{score} == 0; 701 my $student = $ans->{student_value}; 702 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 703 if (!$ans->{isPreview} && $ans->{showDimensionHints} && 704 $self->length != $student->length) { 705 $self->cmp_Error($ans,"The number of coordinates is incorrect"); return; 706 } 707 if ($ans->{parallel} && 708 $self->isParallel($student,$ans->{sameDirection})) { 709 $ans->score(1); return; 710 } 711 if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) { 712 my @errors; 713 foreach my $i (1..$self->length) { 714 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect") 715 if ($self->{data}[$i-1] != $student->{data}[$i-1]); 716 } 717 $self->cmp_Error($ans,@errors); return; 718 } 719 } 720 721 sub correct_ans { 722 my $self = shift; 723 return $self->SUPER::correct_ans unless $self->{ans_name}; 724 return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1)) 725 unless $self->{ColumnVector}; 726 my @array = (); foreach my $x ($self->value) {push(@array,[$x])} 727 return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1)); 728 } 729 730 sub ANS_MATRIX { 731 my $self = shift; 732 my $extend = shift; my $name = shift; 733 my $size = shift || 5; my ($def,$open,$close); 734 $def = ($self->{context} || $$Value::context)->lists->get('Matrix'); 735 $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close}; 736 return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close) 737 if ($self->{ColumnVector}); 738 $def = ($self->{context} || $$Value::context)->lists->get('Vector'); 739 $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close}; 740 $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,','); 741 } 742 743 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)} 744 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)} 745 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)} 746 747 748 ############################################################# 749 750 package Value::Matrix; 751 752 sub cmp_defaults {( 753 shift->SUPER::cmp_defaults(@_), 754 showDimensionHints => 1, 755 showEqualErrors => 0, 756 )} 757 758 sub typeMatch { 759 my $self = shift; my $other = shift; my $ans = shift; 760 return 0 unless ref($other) && $other->class ne 'Formula'; 761 return $other->type eq 'Matrix' || 762 ($other->type =~ m/^(Point|list)$/ && 763 $other->{open}.$other->{close} eq $self->{open}.$self->{close}); 764 } 765 766 sub cmp_postprocess { 767 my $self = shift; my $ans = shift; 768 return unless $ans->{score} == 0 && 769 !$ans->{isPreview} && $ans->{showDimensionHints}; 770 my $student = $ans->{student_value}; 771 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); 772 my @d1 = $self->dimensions; my @d2 = $student->dimensions; 773 if (scalar(@d1) != scalar(@d2)) { 774 $self->cmp_Error($ans,"Matrix dimension is not correct"); 775 return; 776 } else { 777 foreach my $i (0..scalar(@d1)-1) { 778 if ($d1[$i] != $d2[$i]) { 779 $self->cmp_Error($ans,"Matrix dimension is not correct"); 780 return; 781 } 782 } 783 } 784 } 785 786 sub correct_ans { 787 my $self = shift; 788 return $self->SUPER::correct_ans unless $self->{ans_name}; 789 my @array = $self->value; @array = ([@array]) if $self->isRow; 790 Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1)); 791 } 792 793 sub ANS_MATRIX { 794 my $self = shift; 795 my $extend = shift; my $name = shift; 796 my $size = shift || 5; 797 my $def = ($self->{context} || $$Value::context)->lists->get('Matrix'); 798 my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close}; 799 my @d = $self->dimensions; 800 Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d)) 801 if (scalar(@d) > 2); 802 @d = (1,@d) if (scalar(@d) == 1); 803 $self->ans_matrix($extend,$name,@d,$size,$open,$close,''); 804 } 805 806 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)} 807 sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)} 808 sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)} 809 810 ############################################################# 811 812 package Value::Interval; 813 814 sub cmp_defaults {( 815 shift->SUPER::cmp_defaults(@_), 816 showEndpointHints => 1, 817 showEndTypeHints => 1, 818 requireParenMatch => 1, 819 )} 820 821 sub typeMatch { 822 my $self = shift; my $other = shift; 823 return 0 if !Value::isValue($other) || $other->isFormula; 824 return $other->canBeInUnion; 825 } 826 827 # 828 # Check for unreduced sets and unions 829 # 830 sub cmp_compare { 831 my $self = shift; my $student = shift; my $ans = shift; 832 my $error = $self->cmp_checkUnionReduce($student,$ans,@_); 833 if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return} 834 $self->SUPER::cmp_compare($student,$ans,@_); 835 } 836 837 # 838 # Check for wrong enpoints and wrong type of endpoints 839 # 840 sub cmp_postprocess { 841 my $self = shift; my $ans = shift; 842 return unless $ans->{score} == 0 && !$ans->{isPreview}; 843 my $other = $ans->{student_value}; 844 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String'); 845 return unless $other->class eq 'Interval'; 846 my @errors; 847 if ($ans->{showEndpointHints}) { 848 push(@errors,"Your left endpoint is incorrect") 849 if ($self->{data}[0] != $other->{data}[0]); 850 push(@errors,"Your right endpoint is incorrect") 851 if ($self->{data}[1] != $other->{data}[1]); 852 } 853 if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) { 854 push(@errors,"The type of interval is incorrect") 855 if ($self->{open}.$self->{close} ne $other->{open}.$other->{close}); 856 } 857 $self->cmp_Error($ans,@errors); 858 } 859 860 ############################################################# 861 862 package Value::Set; 863 864 sub typeMatch { 865 my $self = shift; my $other = shift; 866 return 0 if !Value::isValue($other) || $other->isFormula; 867 return $other->canBeInUnion; 868 } 869 870 # 871 # Use the List checker for sets, in order to get 872 # partial credit. Set the various types for error 873 # messages. 874 # 875 sub cmp_defaults {( 876 Value::List::cmp_defaults(@_), 877 typeMatch => 'Value::Real', 878 list_type => 'a set', 879 entry_type => 'a number', 880 removeParens => 0, 881 showParenHints => 1, 882 )} 883 884 # 885 # Use the list checker if the student answer is a set 886 # otherwise use the standard compare (to get better 887 # error messages). 888 # 889 sub cmp_equal { 890 my ($self,$ans) = @_; 891 return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set'; 892 $self->SUPER::cmp_equal($ans); 893 } 894 895 # 896 # Check for unreduced sets and unions 897 # 898 sub cmp_compare { 899 my $self = shift; my $student = shift; my $ans = shift; 900 my $error = $self->cmp_checkUnionReduce($student,$ans,@_); 901 if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return} 902 $self->SUPER::cmp_compare($student,$ans,@_); 903 } 904 905 ############################################################# 906 907 package Value::Union; 908 909 sub typeMatch { 910 my $self = shift; my $other = shift; 911 return 0 unless ref($other) && $other->class ne 'Formula'; 912 return $other->length == 2 && 913 ($other->{open} eq '(' || $other->{open} eq '[') && 914 ($other->{close} eq ')' || $other->{close} eq ']') 915 if $other->type =~ m/^(Point|List)$/; 916 $other->isSetOfReals; 917 } 918 919 # 920 # Use the List checker for unions, in order to get 921 # partial credit. Set the various types for error 922 # messages. 923 # 924 sub cmp_defaults {( 925 Value::List::cmp_defaults(@_), 926 typeMatch => 'Value::Interval', 927 list_type => 'an interval, set or union', 928 short_type => 'a union', 929 entry_type => 'an interval or set', 930 )} 931 932 sub cmp_equal { 933 my $self = shift; my $ans = shift; 934 my $error = $self->cmp_checkUnionReduce($ans->{student_value},$ans); 935 if ($error) {$self->cmp_Error($ans,$error); return} 936 Value::List::cmp_equal($self,$ans); 937 } 938 939 # 940 # Check for unreduced sets and unions 941 # 942 sub cmp_compare { 943 my $self = shift; my $student = shift; my $ans = shift; 944 my $error = $self->cmp_checkUnionReduce($student,$ans,@_); 945 if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return} 946 $self->SUPER::cmp_compare($student,$ans,@_); 947 } 948 949 ############################################################# 950 951 package Value::List; 952 953 sub cmp_defaults { 954 my $self = shift; 955 my %options = (@_); 956 my $element = Value::makeValue($self->{data}[0]); 957 $element = Value::Formula->new($element) unless Value::isValue($element); 958 return ( 959 Value::Real->cmp_defaults(@_), 960 showHints => undef, 961 showLengthHints => undef, 962 showParenHints => undef, 963 partialCredit => undef, 964 ordered => 0, 965 entry_type => undef, 966 list_type => undef, 967 typeMatch => $element, 968 extra => $element, 969 requireParenMatch => 1, 970 removeParens => 1, 971 ); 972 } 973 974 # 975 # Match anything but formulas 976 # 977 sub typeMatch {return !ref($other) || $other->class ne 'Formula'} 978 979 # 980 # Handle removal of outermost parens in correct answer. 981 # 982 sub cmp { 983 my $self = shift; 984 my $cmp = $self->SUPER::cmp(@_); 985 if ($cmp->{rh_ans}{removeParens}) { 986 $self->{open} = $self->{close} = ''; 987 $cmp->ans_hash(correct_ans => $self->stringify) 988 unless defined($self->{correct_ans}); 989 } 990 return $cmp; 991 } 992 993 sub cmp_equal { 994 my $self = shift; my $ans = shift; 995 $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers'); 996 997 # 998 # get the paramaters 999 # 1000 my $showHints = getOption($ans,'showHints'); 1001 my $showLengthHints = getOption($ans,'showLengthHints'); 1002 my $showParenHints = getOption($ans,'showParenHints'); 1003 my $partialCredit = getOption($ans,'partialCredit'); 1004 my $requireParenMatch = $ans->{requireParenMatch}; 1005 my $typeMatch = $ans->{typeMatch}; 1006 my $value = $ans->{entry_type}; 1007 my $ltype = $ans->{list_type} || lc($self->type); 1008 my $stype = $ans->{short_type} || $ltype; 1009 1010 $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value') 1011 unless defined($value); 1012 $value =~ s/(real|complex) //; $ans->{cmp_class} = $value; 1013 $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/; 1014 $ltype =~ s/^an? //; $stype =~ s/^an? //; 1015 $showHints = $showLengthHints = 0 if $ans->{isPreview}; 1016 1017 # 1018 # Get the lists of correct and student answers 1019 # (split formulas that return lists or unions) 1020 # 1021 my @correct = (); my ($cOpen,$cClose); 1022 if ($self->class ne 'Formula') { 1023 @correct = $self->value; 1024 $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close}; 1025 } else { 1026 @correct = Value::List->splitFormula($self,$ans); 1027 $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close}; 1028 } 1029 my $student = $ans->{student_value}; my @student = ($student); 1030 my ($sOpen,$sClose) = ('',''); 1031 if (Value::isFormula($student) && $student->type eq $self->type) { 1032 @student = Value::List->splitFormula($student,$ans); 1033 $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close}; 1034 } elsif ($student->class ne 'Formula' && $student->class eq $self->type) { 1035 @student = @{$student->{data}}; 1036 $sOpen = $student->{open}; $sClose = $student->{close}; 1037 } 1038 return if $ans->{split_error}; 1039 # 1040 # Check for parenthesis match 1041 # 1042 if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) { 1043 if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) { 1044 my $message = "The parentheses for your $ltype "; 1045 if (($cOpen || $cClose) && ($sOpen || $sClose)) 1046 {$message .= "are of the wrong type"} 1047 elsif ($sOpen || $sClose) {$message .= "should be removed"} 1048 else {$message .= "seem to be missing"} 1049 $self->cmp_Error($ans,$message) unless $ans->{isPreview}; 1050 } 1051 return; 1052 } 1053 1054 # 1055 # Determine the maximum score 1056 # 1057 my $M = scalar(@correct); 1058 my $m = scalar(@student); 1059 my $maxscore = ($m > $M)? $m : $M; 1060 1061 # 1062 # Compare the two lists 1063 # (Handle errors in user-supplied functions) 1064 # 1065 my ($score,@errors); 1066 if (ref($ans->{list_checker}) eq 'CODE') { 1067 eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)}; 1068 if (!defined($score)) { 1069 die $@ if $@ ne '' && $self->{context}{error}{flag} == 0; 1070 $self->cmp_error($ans) if $self->{context}{error}{flag}; 1071 } 1072 } else { 1073 ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value); 1074 } 1075 return unless defined($score); 1076 1077 # 1078 # Give hints about extra or missing answers 1079 # 1080 if ($showLengthHints) { 1081 $value =~ s/( or|,) /s$1 /g; # fix "interval or union" 1082 push(@errors,"There should be more ${value}s in your $stype") 1083 if ($score < $maxscore && $score == $m); 1084 push(@errors,"There should be fewer ${value}s in your $stype") 1085 if ($score < $maxscore && $score == $M && !$showHints); 1086 } 1087 1088 # 1089 # If all the entries are in error, don't give individual messages 1090 # 1091 if ($score == 0) { 1092 my $i = 0; 1093 while ($i <= $#errors) { 1094 if ($errors[$i++] =~ m/^Your .* is incorrect$/) 1095 {splice(@errors,--$i,1)} 1096 } 1097 } 1098 1099 # 1100 # Finalize the score 1101 # 1102 $score = 0 if ($score != $maxscore && !$partialCredit); 1103 $ans->score($score/$maxscore); 1104 push(@errors,"Score = $ans->{score}") if $ans->{debug}; 1105 my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g; 1106 $ans->{error_message} = $ans->{ans_message} = $error; 1107 } 1108 1109 # 1110 # Compare the contents of the list to see of they are equal 1111 # 1112 sub cmp_list_compare { 1113 my $self = shift; 1114 my $correct = shift; my $student = shift; my $ans = shift; my $value = shift; 1115 my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student); 1116 my $ordered = $ans->{ordered}; 1117 my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview}; 1118 my $typeMatch = $ans->{typeMatch}; 1119 my $extra = $ans->{extra}; 1120 my $showHints = getOption($ans,'showHints') && !$ans->{isPreview}; 1121 my $error = $$Value::context->{error}; 1122 my $score = 0; my @errors; my $i = 0; 1123 1124 # 1125 # Check for empty lists 1126 # 1127 if (scalar(@correct) == 0) {$ans->score($m == 0); return} 1128 1129 # 1130 # Loop through student answers looking for correct ones 1131 # 1132 ENTRY: foreach my $entry (@student) { 1133 $i++; $$Value::context->clearError; 1134 $entry = Value::makeValue($entry); 1135 $entry = Value::Formula->new($entry) if !Value::isValue($entry); 1136 1137 # 1138 # Some words differ if ther eis only one entry in the student's list 1139 # 1140 my $nth = ''; my $answer = 'answer'; 1141 my $class = $ans->{list_type} || $self->cmp_class; 1142 if ($m > 1) { 1143 $nth = ' '.$self->NameForNumber($i); 1144 $class = $ans->{cmp_class}; 1145 $answer = 'value'; 1146 } 1147 1148 # 1149 # See if the entry matches the correct answer 1150 # and perform syntax checking if not 1151 # 1152 if ($ordered) { 1153 if (scalar(@correct)) { 1154 if (shift(@correct)->cmp_compare($entry,$ans,$nth,$value)) {$score++; next ENTRY} 1155 } else { 1156 $extra->cmp_compare($entry,$ans,$nth,$value); # do syntax check 1157 } 1158 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return} 1159 } else { 1160 foreach my $k (0..$#correct) { 1161 if ($correct[$k]->cmp_compare($entry,$ans,$nth,$value)) { 1162 splice(@correct,$k,1); 1163 $score++; next ENTRY; 1164 } 1165 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return} 1166 } 1167 $$Value::context->clearError; 1168 $extra->cmp_compare($entry,$ans,$nth,$value); # do syntax check 1169 } 1170 # 1171 # Give messages about incorrect answers 1172 # 1173 if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) && 1174 !($ans->{ignoreStrings} && $entry->class eq 'String')) { 1175 push(@errors,"Your$nth $answer isn't ".lc($class). 1176 " (it looks like ".lc($entry->showClass).")"); 1177 } elsif ($error->{flag} && $ans->{showEqualErrors}) { 1178 my $message = $error->{message}; $message =~ s/\s+$//; 1179 if ($m > 1 && $error->{flag} != $CMP_WARNING) { 1180 push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>", 1181 '<DIV STYLE="margin-left:1em">'.$message.'</DIV>'); 1182 } else {push(@errors,$message)} 1183 } elsif ($showHints && $m > 1) { 1184 push(@errors,"Your$nth $value is incorrect"); 1185 } 1186 } 1187 1188 # 1189 # Return the score and errors 1190 # 1191 return ($score,@errors); 1192 } 1193 1194 # 1195 # Split a formula that is a list or union into a 1196 # list of formulas (or Value objects). 1197 # 1198 sub splitFormula { 1199 my $self = shift; my $formula = shift; my $ans = shift; 1200 my @formula; my @entries; 1201 if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion} 1202 else {@entries = @{$formula->{tree}{coords}}} 1203 foreach my $entry (@entries) { 1204 my $v = Parser::Formula($entry); 1205 $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant); 1206 push(@formula,$v); 1207 # 1208 # There shouldn't be an error evaluating the formula, 1209 # but you never know... 1210 # 1211 if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return} 1212 } 1213 return @formula; 1214 } 1215 1216 # 1217 # Return the value if it is defined, otherwise use a default 1218 # 1219 sub getOption { 1220 my $ans = shift; my $name = shift; 1221 my $value = $ans->{$name}; 1222 return $value if defined($value); 1223 return $ans->{showPartialCorrectAnswers}; 1224 } 1225 1226 ############################################################# 1227 1228 package Value::Formula; 1229 1230 sub cmp_defaults { 1231 my $self = shift; 1232 1233 return ( 1234 Value::Union::cmp_defaults($self,@_), 1235 typeMatch => Value::Formula->new("(1,2]"), 1236 showDomainErrors => 1, 1237 ) if $self->type eq 'Union'; 1238 1239 my $type = $self->type; 1240 $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number'; 1241 $type = 'Value::'.$type.'::'; 1242 1243 return ( 1244 &{$type.'cmp_defaults'}($self,@_), 1245 upToConstant => 0, 1246 showDomainErrors => 1, 1247 ) if defined(%$type) && $self->type ne 'List'; 1248 1249 return ( 1250 Value::List::cmp_defaults($self,@_), 1251 removeParens => $self->{autoFormula}, 1252 typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]), 1253 showDomainErrors => 1, 1254 ); 1255 } 1256 1257 # 1258 # Get the types from the values of the formulas 1259 # and compare those. 1260 # 1261 sub typeMatch { 1262 my $self = shift; my $other = shift; my $ans = shift; 1263 return 1 if $self->type eq $other->type; 1264 my $typeMatch = ($self->createRandomPoints(1))[1]->[0]; 1265 $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other); 1266 return 1 unless defined($other); # can't really tell, so don't report type mismatch 1267 $typeMatch->typeMatch($other,$ans); 1268 } 1269 1270 # 1271 # Handle removal of outermost parens in a list. 1272 # 1273 sub cmp { 1274 my $self = shift; 1275 my $cmp = $self->SUPER::cmp(@_); 1276 if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') { 1277 $self->{tree}{open} = $self->{tree}{close} = ''; 1278 $cmp->ans_hash(correct_ans => $self->stringify) 1279 unless defined($self->{correct_ans}); 1280 } 1281 if ($cmp->{rh_ans}{eval} && $self->isConstant) { 1282 $cmp->ans_hash(correct_value => $self->eval); 1283 return $cmp; 1284 } 1285 if ($cmp->{rh_ans}{upToConstant}) { 1286 my $current = Parser::Context->current(); 1287 my $context = $self->{context} = $self->{context}->copy; 1288 Parser::Context->current(undef,$context); 1289 $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} = 1290 'C0|' . $context->{_variables}->{pattern}; 1291 $context->update; $context->variables->add('C0' => 'Parameter'); 1292 my $f = Value::Formula->new('C0')+$self; 1293 for ('limits','test_points','test_values','num_points','granularity','resolution', 1294 'checkUndefinedPoints','max_undefined') 1295 {$f->{$_} = $self->{$_} if defined($self->{$_})} 1296 $cmp->ans_hash(correct_value => $f); 1297 Parser::Context->current(undef,$current); 1298 } 1299 return $cmp; 1300 } 1301 1302 sub cmp_equal { 1303 my $self = shift; my $ans = shift; 1304 # 1305 # Get the problem's seed 1306 # 1307 $self->{context}->flags->set( 1308 random_seed => $self->getPG('$PG_original_problemSeed') 1309 ); 1310 1311 # 1312 # Use the list checker if the formula is a list or union 1313 # Otherwise use the normal checker 1314 # 1315 if ($self->type =~ m/^(List|Union|Set)$/) { 1316 Value::List::cmp_equal($self,$ans); 1317 } else { 1318 $self->SUPER::cmp_equal($ans); 1319 } 1320 } 1321 1322 sub cmp_postprocess { 1323 my $self = shift; my $ans = shift; 1324 return unless $ans->{score} == 0 && !$ans->{isPreview}; 1325 return if $ans->{ans_message}; 1326 if ($self->{domainMismatch} && $ans->{showDomainErrors}) { 1327 $self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer"); 1328 return; 1329 } 1330 return if !$ans->{showDimensionHints}; 1331 my $other = $ans->{student_value}; 1332 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String'); 1333 return unless $other->type =~ m/^(Point|Vector|Matrix)$/; 1334 return unless $self->type =~ m/^(Point|Vector|Matrix)$/; 1335 return if Parser::Item::typeMatch($self->typeRef,$other->typeRef); 1336 $self->cmp_Error($ans,"The dimension of your result is incorrect"); 1337 } 1338 1339 # 1340 # If an answer array was used, get the data from the 1341 # Matrix, Vector or Point, and format the array of 1342 # data using the original parameter 1343 # 1344 sub correct_ans { 1345 my $self = shift; 1346 return $self->SUPER::correct_ans unless $self->{ans_name}; 1347 my @array = (); 1348 if ($self->{tree}->type eq 'Matrix') { 1349 foreach my $row (@{$self->{tree}{coords}}) { 1350 my @row = (); 1351 foreach my $x (@{$row->coords}) {push(@row,$x->string)} 1352 push(@array,[@row]); 1353 } 1354 } else { 1355 foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)} 1356 if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}} 1357 else {@array = [@array]} 1358 } 1359 Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1)); 1360 } 1361 1362 # 1363 # Get the size of the array and create the appropriate answer array 1364 # 1365 sub ANS_MATRIX { 1366 my $self = shift; 1367 my $extend = shift; my $name = shift; 1368 my $size = shift || 5; my $type = $self->type; 1369 my $cols = $self->length; my $rows = 1; my $sep = ','; 1370 if ($type eq 'Matrix') { 1371 $sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length}; 1372 } 1373 if ($self->{tree}{ColumnVector}) { 1374 $sep = ""; $type = "Matrix"; 1375 my $tmp = $rows; $rows = $cols; $cols = $tmp; 1376 $self->{ColumnVector} = 1; 1377 } 1378 my $def = ($self->{context} || $$Value::context)->lists->get($type); 1379 my $open = $self->{open} || $self->{tree}{open} || $def->{open}; 1380 my $close = $self->{close} || $self->{tree}{close} || $def->{close}; 1381 $self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep); 1382 } 1383 1384 sub ans_array { 1385 my $self = shift; 1386 return $self->SUPER::ans_array(@_) unless $self->array_OK; 1387 $self->ANS_MATRIX(0,'',@_); 1388 } 1389 sub named_ans_array { 1390 my $self = shift; 1391 return $self->SUPER::named_ans_array(@_) unless $self->array_OK; 1392 $self->ANS_MATRIX(0,@_); 1393 } 1394 sub named_ans_array_extension { 1395 my $self = shift; 1396 return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK; 1397 $self->ANS_MATRIX(1,@_); 1398 } 1399 1400 sub array_OK { 1401 my $self = shift; my $tree = $self->{tree}; 1402 return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List'; 1403 } 1404 1405 # 1406 # Get an array of values from a Matrix, Vector or Point 1407 # 1408 sub value { 1409 my $self = shift; 1410 my @array = (); 1411 if ($self->{tree}->type eq 'Matrix') { 1412 foreach my $row (@{$self->{tree}->coords}) { 1413 my @row = (); 1414 foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))} 1415 push(@array,[@row]); 1416 } 1417 } else { 1418 foreach my $x (@{$self->{tree}->coords}) { 1419 push(@array,Value::Formula->new($x)); 1420 } 1421 } 1422 return @array; 1423 } 1424 1425 ############################################################# 1426 1427 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |