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