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