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