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