Parent Directory
| 
Revision Log
Don't convert lists to inervals unless they have the correct types of parens.
1 package Value; 2 my $pkg = 'Value'; 3 use vars qw($context $defaultContext %Type); 4 use strict; 5 6 =head1 DESCRIPTION 7 8 Value (also called MathObjects) are intelligent versions of standard mathematical 9 objects. They 'know' how to produce string or TeX or perl representations 10 of themselves. They also 'know' how to compare themselves to student responses -- 11 in other words they contain their own answer evaluators (response evaluators). 12 The standard operators like +, -, *, <, ==, >, etc, all work with them (when they 13 make sense), so that you can use these MathObjects in a natural way. The comparisons 14 like equality are "fuzzy", meaning that two items are equal when they are "close enough" 15 (by tolerances that are set in the current Context). 16 17 =cut 18 19 20 =head3 Value context 21 22 ############################################################# 23 # 24 # Initialize the context-- flags set 25 # 26 The following are list objects, meaning that they involve delimiters (parentheses) 27 of some type. 28 29 lists => { 30 'Point' => {open => '(', close => ')'}, 31 'Vector' => {open => '<', close => '>'}, 32 'Matrix' => {open => '[', close => ']'}, 33 'List' => {open => '(', close => ')'}, 34 'Set' => {open => '{', close => '}'}, 35 }, 36 37 The following context flags are set: 38 39 # For vectors: 40 # 41 ijk => 0, # print vectors as <...> 42 # 43 # For strings: 44 # 45 allowEmptyStrings => 1, 46 infiniteWord => 'infinity', 47 # 48 # For intervals and unions: 49 # 50 ignoreEndpointTypes => 0, 51 reduceSets => 1, 52 reduceSetsForComparison => 1, 53 reduceUnions => 1, 54 reduceUnionsForComparison => 1, 55 # 56 # For fuzzy reals: 57 # 58 useFuzzyReals => 1, 59 tolerance => 1E-4, 60 tolType => 'relative', 61 zeroLevel => 1E-14, 62 zeroLevelTol => 1E-12, 63 # 64 # For Formulas: 65 # 66 limits => [-2,2], 67 num_points => 5, 68 granularity => 1000, 69 resolution => undef, 70 max_adapt => 1E8, 71 checkUndefinedPoints => 0, 72 max_undefined => undef, 73 }, 74 75 76 =cut 77 78 BEGIN { 79 80 use Value::Context; 81 82 $defaultContext = Value::Context->new( 83 lists => { 84 'Point' => {open => '(', close => ')'}, 85 'Vector' => {open => '<', close => '>'}, 86 'Matrix' => {open => '[', close => ']'}, 87 'List' => {open => '(', close => ')'}, 88 'Set' => {open => '{', close => '}'}, 89 }, 90 flags => { 91 # 92 # For vectors: 93 # 94 ijk => 0, # print vectors as <...> 95 # 96 # For strings: 97 # 98 allowEmptyStrings => 1, 99 infiniteWord => 'infinity', 100 # 101 # For intervals and unions: 102 # 103 ignoreEndpointTypes => 0, 104 reduceSets => 1, 105 reduceSetsForComparison => 1, 106 reduceUnions => 1, 107 reduceUnionsForComparison => 1, 108 # 109 # For fuzzy reals: 110 # 111 useFuzzyReals => 1, 112 tolerance => 1E-4, 113 tolType => 'relative', 114 zeroLevel => 1E-14, 115 zeroLevelTol => 1E-12, 116 # 117 # For Formulas: 118 # 119 limits => [-2,2], 120 num_points => 5, 121 granularity => 1000, 122 resolution => undef, 123 max_adapt => 1E8, 124 checkUndefinedPoints => 0, 125 max_undefined => undef, 126 }, 127 ); 128 129 $context = \$defaultContext; 130 131 } 132 133 =head3 Implemented MathObject types and their precedence 134 135 # 136 # Precedence of the various types 137 # (They will be promoted upward automatically when needed) 138 # 139 140 'Number' => 0, 141 'Real' => 1, 142 'Infinity' => 2, 143 'Complex' => 3, 144 'Point' => 4, 145 'Vector' => 5, 146 'Matrix' => 6, 147 'List' => 7, 148 'Interval' => 8, 149 'Set' => 9, 150 'Union' => 10, 151 'String' => 11, 152 'Formula' => 12, 153 'special' => 20, 154 155 =cut 156 157 $$context->{precedence} = { 158 'Number' => 0, 159 'Real' => 1, 160 'Infinity' => 2, 161 'Complex' => 3, 162 'Point' => 4, 163 'Vector' => 5, 164 'Matrix' => 6, 165 'List' => 7, 166 'Interval' => 8, 167 'Set' => 9, 168 'Union' => 10, 169 'String' => 11, 170 'Formula' => 12, 171 'special' => 20, 172 }; 173 174 # 175 # Binding of perl operator to class method 176 # 177 $$context->{method} = { 178 '+' => 'add', 179 '-' => 'sub', 180 '*' => 'mult', 181 '/' => 'div', 182 '**' => 'power', 183 '.' => '_dot', # see _dot below 184 'x' => 'cross', 185 '%' => 'modulo', 186 '<=>' => 'compare', 187 'cmp' => 'compare_string', 188 }; 189 190 $$context->{pattern}{infinite} = '[-+]?inf(?:inity)?'; 191 $$context->{pattern}{infinity} = '\+?inf(?:inity)?'; 192 $$context->{pattern}{-infinity} = '-inf(?:inity)?'; 193 194 push(@{$$context->{data}{values}},'method','precedence'); 195 196 # 197 # Copy a context and its data 198 # 199 sub copy { 200 my $self = shift; 201 my $copy = {%{$self}}; $copy->{data} = [@{$self->{data}}]; 202 foreach my $x (@{$copy->{data}}) {$x = $x->copy if Value::isValue($x)} 203 return bless $copy, ref($self); 204 } 205 206 =head3 getFlag 207 208 # 209 # Get the value of a flag from the object itself, 210 # or from the context, or from the default context 211 # or from the given default, whichever is found first. 212 # 213 214 Usage: $mathObj->getFlag("showTypeWarnings"); 215 $mathObj->getFlag("showTypeWarnings",1); # default is second parameter 216 217 =cut 218 219 sub getFlag { 220 my $self = shift; my $name = shift; 221 if (ref($self) && ref($self) ne 'ARRAY') { 222 return $self->{$name} if defined($self->{$name}); 223 if (defined $self->{equation}) { 224 return $self->{equation}{$name} if defined($self->{equation}{$name}); 225 return $self->{equation}{equation}{$name} 226 if defined($self->{equation}{equation}) && defined($self->{equation}{equation}{$name}); 227 } 228 } 229 my $context = $self->context; 230 return $context->{answerHash}{$name} 231 if defined($context->{answerHash}) && defined($context->{answerHash}{$name}); # use WW answerHash flags first 232 return $context->{flags}{$name} if defined($context->{flags}{$name}); 233 return shift; 234 } 235 236 # 237 # Get or set the context of an object 238 # 239 sub context { 240 my $self = shift; my $context = shift; 241 if (ref($self) && ref($self) ne 'ARRAY') { 242 if ($context && $self->{context} != $context) { 243 $self->{context} = $context; 244 if (defined $self->{data}) { 245 foreach my $x (@{$self->{data}}) {$x->context($context) if ref($x)} 246 } 247 } 248 return $self->{context} if $self->{context}; 249 } 250 return $$Value::context; 251 } 252 253 # 254 # Set context but return object 255 # 256 sub inContext {my $self = shift; $self->context(@_); $self} 257 258 259 ############################################################# 260 261 # 262 # Check if the object class matches one of a list of classes 263 # 264 sub classMatch { 265 my $self = shift; my $class = class($self); 266 my $ref = ref($self); my $isHash = ($ref && $ref ne 'ARRAY' && $ref ne 'CODE'); 267 my $context = ($isHash ? $self->{context} || Value->context : Value->context); 268 foreach my $name (@_) { 269 return 1 if $class eq $name || $ref eq $context->Package($name,1) || 270 $ref eq "Value::$name" || ($isHash && $self->{"is".$name}); 271 } 272 return 0; 273 } 274 275 # 276 # Check if a value is a number, complex, etc. 277 # 278 sub matchNumber {my $n = shift; $n =~ m/^$$Value::context->{pattern}{signedNumber}$/i} 279 sub matchInfinite {my $n = shift; $n =~ m/^$$Value::context->{pattern}{infinite}$/i} 280 sub isReal {classMatch(shift,'Real')} 281 sub isComplex {classMatch(shift,'Complex')} 282 sub isContext {class(shift) eq 'Context'} 283 sub isFormula {classMatch(shift,'Formula')} 284 sub isValue { 285 my $v = shift; 286 return (ref($v) || $v) =~ m/^Value::/ || 287 (ref($v) && ref($v) ne 'ARRAY' && ref($v) ne 'CODE' && $v->{isValue}); 288 } 289 290 sub isNumber { 291 my $n = shift; 292 return $n->{tree}->isNumber if isFormula($n); 293 return classMatch($n,'Real','Complex') || matchNumber($n); 294 } 295 296 sub isRealNumber { 297 my $n = shift; 298 return $n->{tree}->isRealNumber if isFormula($n); 299 return isReal($n) || matchNumber($n); 300 } 301 302 sub isZero { 303 my $self = shift; 304 return 0 if scalar(@{$self->{data}}) == 0; 305 foreach my $x (@{$self->{data}}) {return 0 if $x ne "0"} 306 return 1; 307 } 308 309 sub isOne {0} 310 311 sub isSetOfReals {0} 312 sub canBeInUnion { 313 my $self = shift; 314 return $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' && 315 $self->{open} =~ m/^[\(\[]$/ && $self->{close} =~ m/^[\)\]]$/; 316 } 317 318 ###################################################################### 319 320 # 321 # Value->Package(name[,noerror]]) 322 # 323 # Returns the package name for the specificied Value object class 324 # (as specified by the context's {value} hash, or "Value::name"). 325 # 326 sub Package {(shift)->context->Package(@_)} 327 328 =head3 makeValue 329 330 Usage: Value::makeValue(45); 331 332 Will create a Real mathObject. 333 # 334 # Convert non-Value objects to Values, if possible 335 # 336 337 =cut 338 339 sub makeValue { 340 my $x = shift; return $x if Value::isValue($x); 341 my %params = (showError => 0, makeFormula => 1, context => Value->context, @_); 342 my $context = $params{context}; 343 return $context->Package("Real")->make($context,$x) if matchNumber($x); 344 if (matchInfinite($x)) { 345 my $I = $context->Package("Infinity")->new($context); 346 $I = $I->neg if $x =~ m/^$context->{pattern}{-infinity}$/; 347 return $I; 348 } 349 return $context->Package("String")->make($context,$x) 350 if !$Parser::installed || $context->{strings}{$x} || 351 ($x eq '' && $context->{flags}{allowEmptyStrings}); 352 return $x if !$params{makeFormula}; 353 Value::Error("String constant '%s' is not defined in this context",$x) 354 if $params{showError}; 355 $x = $context->Package("Formula")->new($context,$x); 356 $x = $x->eval if $x->isConstant; 357 return $x; 358 } 359 360 =head3 showClass 361 362 Usage: TEXT( $mathObj -> showClass() ); 363 364 Will print the class of the MathObject 365 366 # 367 # Get a printable version of the class of an object 368 # (used primarily in error messages) 369 # 370 371 =cut 372 373 sub showClass { 374 my $value = shift; 375 if (ref($value) || $value !~ m/::/) { 376 $value = Value::makeValue($value,makeFormula=>0); 377 return "'".$value."'" unless Value::isValue($value); 378 } 379 my $class = class($value); 380 return showType($value) if Value::classMatch($value,'List'); 381 $class .= ' Number' if Value::classMatch($value,'Real','Complex'); 382 $class .= ' of Intervals' if Value::classMatch($value,'Union'); 383 $class = 'Word' if Value::classMatch($value,'String'); 384 return 'a Formula that returns '.showType($value->{tree}) if Value::isFormula($value); 385 return 'an '.$class if $class =~ m/^[aeio]/i; 386 return 'a '.$class; 387 } 388 389 =head3 showType 390 391 Usage: TEXT( $mathObj -> showType() ); 392 393 Will print the class of the MathObject 394 395 # 396 # Get a printable version of the type of an object 397 # (the class and type are not the same. For example 398 # a Formula-class object can be of type Number) 399 # 400 401 =cut 402 403 sub showType { 404 my $value = shift; 405 my $type = $value->type; 406 if ($type eq 'List') { 407 my $ltype = $value->typeRef->{entryType}{name}; 408 if ($ltype && $ltype ne 'unknown') { 409 $ltype =~ s/y$/ie/; 410 $type .= ' of '.$ltype.'s'; 411 } 412 } 413 return 'an Infinity' if $type eq 'String' && $value->{isInfinite}; 414 return 'a Word' if $type eq 'String'; 415 return 'a Complex Number' if $value->isComplex; 416 return 'an '.$type if $type =~ m/^[aeio]/i; 417 return 'a '.$type; 418 } 419 420 # 421 # Return a string describing a value's type 422 # 423 sub getType { 424 my $equation = shift; my $value = shift; 425 my $strings = $equation->{context}{strings}; 426 if (ref($value) eq 'ARRAY') { 427 return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/); 428 my ($type,$ltype); 429 foreach my $x (@{$value}) { 430 $type = getType($equation,$x); 431 if ($type eq 'value') { 432 $type = $x->type if $x->classMatch('Formula'); 433 $type = 'Number' if $x->classMatch('Complex') || $type eq 'Complex'; 434 } 435 $ltype = $type if $ltype eq ''; 436 return 'List' if $type ne $ltype; 437 } 438 return 'Point' if $ltype eq 'Number'; 439 return 'Matrix' if $ltype =~ m/Point|Matrix/; 440 return 'List'; 441 } 442 elsif (Value::isFormula($value)) {return 'Formula'} 443 elsif (Value::classMatch($value,'Infinity')) {return 'Infinity'} 444 elsif (Value::isReal($value)) {return 'Number'} 445 elsif (Value::isValue($value)) {return 'value'} 446 elsif (ref($value)) {return 'unknown'} 447 elsif (defined($strings->{$value})) {return 'String'} 448 elsif (Value::isNumber($value)) {return 'Number'} 449 elsif ($value eq '' && $equation->{context}{flags}{allowEmptyStrings}) {return 'String'} 450 return 'unknown'; 451 } 452 453 # 454 # Get a string describing a value's type, 455 # and convert the value to a Value object (if needed) 456 # 457 sub getValueType { 458 my $equation = shift; my $value = shift; 459 my $type = Value::getType($equation,$value); 460 if ($type eq 'String') {$type = $Value::Type{string}} 461 elsif ($type eq 'Number') {$type = $Value::Type{number}} 462 elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}} 463 elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef} 464 elsif ($type eq 'unknown') { 465 $equation->Error(["Can't convert %s to a constant",Value::showClass($value)]); 466 } else { 467 $type = $equation->{context}->Package($type); 468 $value = $type->new($equation->{context},@{$value}); 469 $type = $value->typeRef; 470 } 471 return ($value,$type); 472 } 473 474 # 475 # Convert a list of values to a list of formulas (called by Parser::Value) 476 # 477 sub toFormula { 478 my $formula = shift; 479 my $processed = 0; 480 my @f = (); my $vars = {}; 481 foreach my $x (@_) { 482 if (isFormula($x)) { 483 $formula->{context} = $x->{context}, $processed = 1 unless $processed; 484 $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}}; 485 push(@f,$x->{tree}->copy($formula)); 486 } else { 487 push(@f,$formula->Item("Value")->new($formula,$x)); 488 } 489 } 490 return (@f); 491 } 492 493 # 494 # Convert a list of values (and open and close parens) 495 # to a formula whose type is the list type associated with 496 # the parens. 497 # 498 sub formula { 499 my $self = shift; my $values = shift; 500 my $context = $self->context; 501 my $list = $context->lists->get($self->class); 502 my $open = $list->{'open'}; 503 my $close = $list->{'close'}; 504 my $paren = $open; $paren = 'list' if $self->classMatch('List'); 505 my $formula = $self->Package("Formula")->blank($context); 506 my @coords = Value::toFormula($formula,@{$values}); 507 $formula->{tree} = $formula->Item("List")->new($formula,[@coords],0, 508 $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close); 509 $formula->{autoFormula} = 1; # mark that this was generated automatically 510 return $formula; 511 } 512 513 # 514 # A shortcut for new() that creates an instance of the object, 515 # but doesn't do the error checking. We assume the data are already 516 # known to be good. 517 # 518 sub make { 519 my $self = shift; my $class = ref($self) || $self; 520 my $context = (Value::isContext($_[0]) ? shift : $self->context); 521 bless {data => [@_], context => $context}, $class; 522 } 523 524 # 525 # Easy method for setting parameters of an object 526 # (returns a copy with the new values set, but the copy 527 # is not a deep copy.) 528 # 529 sub with { 530 my $self = shift; 531 bless {%{$self},@_}, ref($self); 532 } 533 534 ###################################################################### 535 536 # 537 # Return a type structure for the item 538 # (includes name, length of vectors, and so on) 539 # 540 sub Type { 541 my $name = shift; my $length = shift; my $entryType = shift; 542 $length = 1 unless defined $length; 543 return {name => $name, length => $length, entryType => $entryType, 544 list => (defined $entryType), @_}; 545 } 546 547 # 548 # Some predefined types 549 # 550 %Type = ( 551 number => Value::Type('Number',1), 552 complex => Value::Type('Number',2), 553 string => Value::Type('String',1), 554 infinity => Value::Type('Infinity',1), 555 unknown => Value::Type('unknown',0,undef,list => 1) 556 ); 557 558 # 559 # Return various information about the object 560 # 561 sub value {return @{(shift)->{data}}} # the value of the object (as an array) 562 sub data {return (shift)->{data}} # the reference to the value 563 sub length {return scalar(@{(shift)->{data}})} # the number of coordinates 564 sub type {return (shift)->typeRef->{name}} # the object type 565 sub entryType {return (shift)->typeRef->{entryType}} # the coordinate type 566 # 567 # The the full type-hash for the item 568 # 569 sub typeRef { 570 my $self = shift; 571 return Value::Type($self->class, $self->length, $Value::Type{number}); 572 } 573 # 574 # The Value.pm object class 575 # 576 sub class { 577 my $self = shift; my $class = ref($self) || $self; 578 $class =~ s/.*:://; 579 return $class; 580 } 581 582 # 583 # Get an element from a point, vector, matrix, or list 584 # 585 sub extract { 586 my $M = shift; my $i; my @indices = @_; 587 return unless Value::isValue($M); 588 @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]); 589 while (scalar(@indices) > 0) { 590 return if Value::isNumber($M); 591 $i = shift @indices; $i = $i->value if Value::isValue($i); 592 Value::Error("Can't extract element number '%s' (index must be an integer)",$i) 593 unless $i =~ m/^-?\d+$/; 594 return if $i == 0; $i-- if $i > 0; 595 $M = $M->data->[$i]; 596 } 597 return $M; 598 } 599 600 ###################################################################### 601 602 use overload 603 '+' => '_add', 604 '-' => '_sub', 605 '*' => '_mult', 606 '/' => '_div', 607 '**' => '_power', 608 '.' => '_dot', 609 'x' => '_cross', 610 '%' => '_modulo', 611 '<=>' => '_compare', 612 'cmp' => '_compare_string', 613 '~' => '_twiddle', 614 'neg' => '_neg', 615 'abs' => '_abs', 616 'sqrt'=> '_sqrt', 617 'exp' => '_exp', 618 'log' => '_log', 619 'sin' => '_sin', 620 'cos' => '_cos', 621 'atan2' => '_atan2', 622 'nomethod' => 'nomethod', 623 '""' => 'stringify'; 624 625 # 626 # Promote an operand to the same precedence as the current object 627 # 628 sub promotePrecedence { 629 my $self = shift; my $other = shift; my $context = $self->context; 630 return 0 unless Value::isValue($other); 631 my $sprec = $context->{precedence}{class($self)}; 632 my $oprec = $context->{precedence}{class($other)}; 633 return (defined($sprec) && defined($oprec) && $sprec < $oprec); 634 } 635 636 sub promote { 637 my $self = shift; my $class = ref($self) || $self; 638 my $context = (Value::isContext($_[0]) ? shift : $self->context); 639 my $x = (scalar(@_) ? shift : $self); 640 return $x->inContext($context) if ref($x) eq $class && scalar(@_) == 0; 641 return $self->new($context,$x,@_); 642 } 643 644 # 645 # Return the operators in the correct order 646 # 647 sub checkOpOrder { 648 my ($l,$r,$flag) = @_; 649 if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)} 650 } 651 652 # 653 # Return the operators in the correct order, and promote the 654 # other value, if needed. 655 # 656 sub checkOpOrderWithPromote { 657 my ($l,$r,$flag) = @_; $r = $l->promote($r); 658 if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)} 659 } 660 661 # 662 # Handle a binary operator, promoting the object types 663 # as needed, and then calling the main method 664 # 665 sub binOp { 666 my ($l,$r,$flag,$call) = @_; 667 if ($l->promotePrecedence($r)) {return $r->$call($l,!$flag)} 668 else {return $l->$call($r,$flag)} 669 } 670 671 # 672 # stubs for binary operations (with promotion) 673 # 674 sub _add {binOp(@_,'add')} 675 sub _sub {binOp(@_,'sub')} 676 sub _mult {binOp(@_,'mult')} 677 sub _div {binOp(@_,'div')} 678 sub _power {binOp(@_,'power')} 679 sub _cross {binOp(@_,'cross')} 680 sub _modulo {binOp(@_,'modulo')} 681 682 sub _compare {transferTolerances(@_); binOp(@_,'compare')} 683 sub _compare_string {binOp(@_,'compare_string')} 684 685 sub _atan2 {binOp(@_,'atan2')} 686 687 sub _twiddle {(shift)->twiddle} 688 sub _neg {(shift)->neg} 689 sub _abs {(shift)->abs} 690 sub _sqrt {(shift)->sqrt} 691 sub _exp {(shift)->exp} 692 sub _log {(shift)->log} 693 sub _sin {(shift)->sin} 694 sub _cos {(shift)->cos} 695 696 # 697 # Default stub to call when no function is defined for an operation 698 # 699 sub nomethod { 700 my ($l,$r,$flag,$op) = @_; 701 my $call = $l->context->{method}{$op}; 702 if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)} 703 my $error = "Can't use '%s' with %s-valued operands"; 704 $error .= " (use '**' for exponentiation)" if $op eq '^'; 705 Value::Error($error,$op,$l->class); 706 } 707 708 sub nodef { 709 my $self = shift; my $func = shift; 710 Value::Error("Can't use '%s' with %s-valued operands",$func,$self->class); 711 } 712 713 # 714 # Stubs for the sub-classes 715 # 716 sub add {nomethod(@_,'+')} 717 sub sub {nomethod(@_,'-')} 718 sub mult {nomethod(@_,'*')} 719 sub div {nomethod(@_,'/')} 720 sub power {nomethod(@_,'**')} 721 sub cross {nomethod(@_,'x')} 722 sub modulo {nomethod(@_,'%')} 723 724 sub twiddle {nodef(shift,"~")} 725 sub neg {nodef(shift,"-")} 726 sub abs {nodef(shift,"abs")} 727 sub sqrt {nodef(shift,"sqrt")} 728 sub exp {nodef(shift,"exp")} 729 sub log {nodef(shift,"log")} 730 sub sin {nodef(shift,"sin")} 731 sub cos {nodef(shift,"cos")} 732 733 # 734 # If the right operand is higher precedence, we switch the order. 735 # 736 # If the right operand is also a Value object, we do the object's 737 # dot method to combine the two objects of the same class. 738 # 739 # Otherwise, since . is used for string concatenation, we want to retain 740 # that. Since the resulting string is often used in Formula and will be 741 # parsed again, we put parentheses around the values to guarantee that 742 # the values will be treated as one mathematical unit. For example, if 743 # $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be 744 # (1+x)/y not 1+(x/y), as it would be without the implicit parentheses. 745 # 746 sub _dot { 747 my ($l,$r,$flag) = @_; 748 return $r->_dot($l,!$flag) if ($l->promotePrecedence($r)); 749 return $l->dot($r,$flag) if (Value::isValue($r)); 750 if (Value->context->flag('StringifyAsTeX')) {$l = $l->TeX} else {$l = $l->pdot} 751 return ($flag)? ($r.$l): ($l.$r); 752 } 753 # 754 # Some classes override this 755 # 756 sub dot { 757 my ($l,$r,$flag) = @_; 758 my $tex = Value->context->flag('StringifyAsTeX'); 759 if ($tex) {$l = $l->TeX} else {$l = $l->pdot} 760 if (ref($r)) {if ($tex) {$r = $r->TeX} else {$r = $r->pdot}} 761 return ($flag)? ($r.$l): ($l.$r); 762 } 763 764 # 765 # Some classes override this to add parens 766 # 767 sub pdot {shift->stringify} 768 769 770 # 771 # Compare the values of the objects 772 # (list classes should replace this) 773 # 774 sub compare { 775 my ($l,$r) = Value::checkOpOrder(@_); 776 return $l->value <=> $r->value; 777 } 778 779 # 780 # Compare the values as strings 781 # 782 sub compare_string { 783 my ($l,$r,$flag) = @_; 784 $l = $l->stringify; $r = $r->stringify if Value::isValue($r); 785 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} 786 return $l cmp $r; 787 } 788 789 # 790 # Copy flags from the parent object to its children (recursively). 791 # 792 sub transferFlags { 793 my $self = shift; 794 foreach my $flag (@_) { 795 next unless defined $self->{$flag}; 796 foreach my $x (@{$self->{data}}) { 797 if ($x->{$flag} ne $self->{$flag}) { 798 $x->{$flag} = $self->{$flag}; 799 $x->transferFlags($flag); 800 } 801 } 802 } 803 } 804 805 sub transferTolerances { 806 my ($self,$other) = @_; 807 $self->transferFlags("tolerance","tolType","zeroLevel","zeroLevelTol"); 808 $other->transferFlags("tolerance","tolType","zeroLevel","zeroLevelTol") if Value::isValue($other); 809 } 810 811 =head3 output methods for MathObjects 812 813 # 814 # Generate the various output formats 815 # (can be replaced by sub-classes) 816 # 817 818 =cut 819 820 =head4 stringify 821 822 Usage: TEXT($mathObj); or TEXT( $mathObj->stringify() ) ; 823 824 Produces text string or TeX output depending on context 825 Context()->texStrings; 826 Context()->normalStrings; 827 828 called automatically when object is called in a string context. 829 830 =cut 831 832 sub stringify { 833 my $self = shift; 834 return $self->TeX if Value->context->flag('StringifyAsTeX'); 835 return $self->string; 836 } 837 838 =head4 ->string 839 840 Usage: $mathObj->string() 841 842 ---produce a string representation of the object 843 (as opposed to stringify, which can produce TeX or string versions) 844 845 =cut 846 847 sub string { 848 my $self = shift; my $equation = shift; 849 my $def = ($equation->{context} || $self->context)->lists->get($self->class); 850 return $self->value unless $def; 851 my $open = shift; my $close = shift; 852 $open = $self->{open} unless defined($open); 853 $open = $def->{open} unless defined($open); 854 $close = $self->{close} unless defined($close); 855 $close = $def->{close} unless defined($close); 856 my @coords = (); 857 foreach my $x (@{$self->data}) { 858 if (Value::isValue($x)) { 859 $x->{format} = $self->{format} if defined $self->{format}; 860 push(@coords,$x->string($equation)); 861 } else { 862 push(@coords,$x); 863 } 864 } 865 return $open.join($def->{separator},@coords).$close; 866 } 867 868 =head4 ->TeX 869 870 Usage: $mathObj->TeX() 871 872 ---produce TeX prepresentation of the object 873 874 =cut 875 876 sub TeX { 877 my $self = shift; my $equation = shift; 878 my $context = $equation->{context} || $self->context; 879 my $def = $context->lists->get($self->class); 880 return $self->string(@_) unless $def; 881 my $open = shift; my $close = shift; 882 $open = $self->{open} unless defined($open); 883 $open = $def->{open} unless defined($open); 884 $close = $self->{close} unless defined($close); 885 $close = $def->{close} unless defined($close); 886 $open =~ s/([{}])/\\$1/g; $close =~ s/([{}])/\\$1/g; 887 $open = '\left'.$open if $open; $close = '\right'.$close if $close; 888 my @coords = (); my $str = $context->{strings}; 889 foreach my $x (@{$self->data}) { 890 if (Value::isValue($x)) { 891 $x->{format} = $self->{format} if defined $self->{format}; 892 push(@coords,$x->TeX($equation)); 893 } elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})} 894 else {push(@coords,$x)} 895 } 896 return $open.join(',',@coords).$close; 897 } 898 899 # 900 # For perl, call the appropriate constructor around the object's data 901 # 902 sub perl { 903 my $self = shift; my $parens = shift; my $matrix = shift; 904 my $mtype = $self->classMatch('Matrix'); $mtype = -1 if $mtype & !$matrix; 905 my $perl; my @p = (); 906 foreach my $x (@{$self->data}) { 907 if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)} 908 } 909 @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $self->classMatch('Interval'); 910 if ($matrix) { 911 $perl = join(',',@p); 912 $perl = '['.$perl.']' if $mtype > 0; 913 } else { 914 $perl = ref($self).'->new('.join(',',@p).')'; 915 $perl = "($perl)->with(open=>'$self->{open}',close=>'$self->{close}')" 916 if $self->classMatch('List') && $self->{open}.$self->{close} ne '()'; 917 $perl = '('.$perl.')' if $parens == 1; 918 } 919 return $perl; 920 } 921 922 # 923 # Stubs for when called by Parser 924 # 925 sub eval {shift} 926 sub reduce {shift} 927 928 sub ijk { 929 Value::Error("Can't use method 'ijk' with objects of type '%s'",(shift)->class); 930 } 931 932 933 =head3 Error 934 935 Usage: Value::Error("We're sorry..."); 936 937 # 938 # Report an error 939 # 940 941 =cut 942 943 sub Error { 944 my $message = shift; my $context = Value->context; 945 $message = [$message,@_] if scalar(@_) > 0; 946 $context->setError($message,''); 947 $message = $context->{error}{message}; 948 die $message . traceback() if $context->flags('showTraceback'); 949 die $message . getCaller(); 950 } 951 952 # 953 # Try to locate the line and file where the error occurred 954 # 955 sub getCaller { 956 my $frame = 2; 957 while (my ($pkg,$file,$line,$subname) = caller($frame++)) { 958 return " at line $line of $file\n" 959 unless $pkg =~ /^(Value|Parser)/ || 960 $subname =~ m/^(Value|Parser).*(new|call)$/; 961 } 962 return ""; 963 } 964 965 # 966 # For debugging 967 # 968 sub traceback { 969 my $frame = shift; $frame = 2 unless defined($frame); 970 my $trace = ''; 971 while (my ($pkg,$file,$line,$subname) = caller($frame++)) 972 {$trace .= " in $subname at line $line of $file\n"} 973 return $trace; 974 } 975 976 ########################################################################### 977 # 978 # Load the sub-classes. 979 # 980 981 END { 982 use Value::Real; 983 use Value::Complex; 984 use Value::Infinity; 985 use Value::Point; 986 use Value::Vector; 987 use Value::Matrix; 988 use Value::List; 989 use Value::Interval; 990 use Value::Set; 991 use Value::Union; 992 use Value::String; 993 use Value::Formula; 994 995 use Value::WeBWorK; # stuff specific to WeBWorK 996 } 997 998 ########################################################################### 999 1000 our $installed = 1; 1001 1002 ########################################################################### 1003 1004 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |