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