Parent Directory
| 
Revision Log
Added isSetOfReals and canBeInUnion methods to the Value objects, and replaced the ad hoc tests for these conditions to call these routines. Cleaned up the make() methods for Intervals, Sets and Unions, and improved the new() methods to handle more cases better. Fixed Value::makeValue() to handle an array reference correctly. I don't THINK any of this will break anything. :-)
1 package Value; 2 my $pkg = 'Value'; 3 use vars qw($context $defaultContext %Type); 4 use strict; 5 6 ############################################################# 7 # 8 # Initialize the context 9 # 10 11 use Value::Context; 12 13 $defaultContext = Value::Context->new( 14 lists => { 15 'Point' => {open => '(', close => ')'}, 16 'Vector' => {open => '<', close => '>'}, 17 'Matrix' => {open => '[', close => ']'}, 18 'List' => {open => '(', close => ')'}, 19 'Set' => {open => '{', close => '}'}, 20 }, 21 flags => { 22 # 23 # For vectors: 24 # 25 ijk => 0, # print vectors as <...> 26 # 27 # word to use for infinity 28 # 29 infiniteWord => 'infinity', 30 # 31 # For intervals and unions: 32 # 33 ignoreEndpointTypes => 0, 34 reduceSets => 1, 35 reduceSetsForComparison => 1, 36 reduceUnions => 1, 37 reduceUnionsForComparison => 1, 38 # 39 # For fuzzy reals: 40 # 41 useFuzzyReals => 1, 42 tolerance => 1E-4, 43 tolType => 'relative', 44 zeroLevel => 1E-14, 45 zeroLevelTol => 1E-12, 46 # 47 # For Formulas: 48 # 49 limits => [-2,2], 50 num_points => 5, 51 granularity => 1000, 52 resolution => undef, 53 max_adapt => 1E8, 54 checkUndefinedPoints => 0, 55 max_undefined => undef, 56 }, 57 ); 58 59 $context = \$defaultContext; 60 61 62 # 63 # Precedence of the various types 64 # (They will be promoted upward automatically when needed) 65 # 66 $$context->{precedence} = { 67 'Number' => 0, 68 'Real' => 1, 69 'Infinity' => 2, 70 'Complex' => 3, 71 'Point' => 4, 72 'Vector' => 5, 73 'Matrix' => 6, 74 'List' => 7, 75 'Interval' => 8, 76 'Set' => 9, 77 'Union' => 10, 78 'String' => 11, 79 'Formula' => 12, 80 'special' => 20, 81 }; 82 83 # 84 # Binding of perl operator to class method 85 # 86 $$context->{method} = { 87 '+' => 'add', 88 '-' => 'sub', 89 '*' => 'mult', 90 '/' => 'div', 91 '**' => 'power', 92 '.' => '_dot', # see _dot below 93 'x' => 'cross', 94 '<=>' => 'compare', 95 'cmp' => 'compare_string', 96 }; 97 98 $$context->{pattern}{infinite} = '[-+]?inf(?:inity)?'; 99 $$context->{pattern}{infinity} = '\+?inf(?:inity)?'; 100 $$context->{pattern}{-infinity} = '-inf(?:inity)?'; 101 102 push(@{$$context->{data}{values}},'method','precedence'); 103 104 # 105 # Get the value of a flag from the object itself, 106 # or from the context, or from the default context 107 # or from the given default, whichever is found first. 108 # 109 sub getFlag { 110 my $self = shift; my $name = shift; 111 return $self->{$name} if ref($self) && defined($self->{$name}); 112 return $self->{context}{flags}{$name} if ref($self) && defined($self->{context}{flags}{$name}); 113 return $$Value::context->{flags}{$name} if defined($$Value::context->{flags}{$name}); 114 return shift; 115 } 116 117 ############################################################# 118 119 # 120 # Check if a value is a number, complex, etc. 121 # 122 sub matchNumber {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i} 123 sub matchInfinite {my $n = shift; $n =~ m/^$$context->{pattern}{infinite}$/i} 124 sub isReal {class(shift) eq 'Real'} 125 sub isComplex {class(shift) eq 'Complex'} 126 sub isFormula { 127 my $v = shift; 128 return class($v) eq 'Formula' || 129 (ref($v) && ref($v) ne 'ARRAY' && $v->{isFormula}); 130 } 131 sub isValue { 132 my $v = shift; 133 return (ref($v) || $v) =~ m/^Value::/ || 134 (ref($v) && ref($v) ne 'ARRAY' && $v->{isValue}); 135 } 136 137 sub isNumber { 138 my $n = shift; 139 return $n->{tree}->isNumber if isFormula($n); 140 return isReal($n) || isComplex($n) || matchNumber($n); 141 } 142 143 sub isRealNumber { 144 my $n = shift; 145 return $n->{tree}->isRealNumber if isFormula($n); 146 return isReal($n) || matchNumber($n); 147 } 148 149 sub isZero { 150 my $self = shift; 151 return 0 if scalar(@{$self->{data}}) == 0; 152 foreach my $x (@{$self->{data}}) {return 0 unless $x eq "0"} 153 return 1; 154 } 155 156 sub isOne {0} 157 158 sub isSetOfReals {0} 159 sub canBeInUnion { 160 my $self = shift; 161 return $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' && 162 $self->{open} =~ m/^[\(\[]$/ && $self->{close} =~ m/^[\)\]]$/; 163 } 164 165 # 166 # Convert non-Value objects to Values, if possible 167 # 168 sub makeValue { 169 my $x = shift; my %params = (showError => 0, makeFormula => 1, @_); 170 return $x if (ref($x) && ref($x) ne 'ARRAY') || $x eq ''; 171 return Value::Real->make($x) if matchNumber($x); 172 if (matchInfinite($x)) { 173 my $I = Value::Infinity->new(); 174 $I = $I->neg if $x =~ m/^$$Value::context->{pattern}{-infinity}$/; 175 return $I; 176 } 177 return Value::String->make($x) 178 if (!$Parser::installed || $$Value::context->{strings}{$x}); 179 return $x if !$params{makeFormula}; 180 Value::Error("String constant '%s' is not defined in this context",$x) 181 if $params{showError}; 182 $x = Value::Formula->new($x); 183 $x = $x->eval if $x->isConstant; 184 return $x; 185 } 186 187 # 188 # Get a printable version of the class of an object 189 # 190 sub showClass { 191 my $value = makeValue(shift,makeFormula=>0); 192 return "'".$value."'" unless Value::isValue($value); 193 my $class = class($value); 194 return showType($value) if ($class eq 'List'); 195 $class .= ' Number' if $class =~ m/^(Real|Complex)$/; 196 $class .= ' of Intervals' if $class eq 'Union'; 197 $class = 'Word' if $class eq 'String'; 198 return 'a Formula that returns '.showType($value->{tree}) if ($class eq 'Formula'); 199 return 'an '.$class if $class =~ m/^[aeio]/i; 200 return 'a '.$class; 201 } 202 203 # 204 # Get a printable version of the type of an object 205 # 206 sub showType { 207 my $value = shift; 208 my $type = $value->type; 209 if ($type eq 'List') { 210 my $ltype = $value->typeRef->{entryType}{name}; 211 if ($ltype && $ltype ne 'unknown') { 212 $ltype =~ s/y$/ie/; 213 $type .= ' of '.$ltype.'s'; 214 } 215 } 216 return 'a Word' if $type eq 'String'; 217 return 'a Complex Number' if $value->isComplex; 218 return 'an '.$type if $type =~ m/^[aeio]/i; 219 return 'a '.$type; 220 } 221 222 # 223 # Return a string describing a value's type 224 # 225 sub getType { 226 my $equation = shift; my $value = shift; 227 my $strings = $equation->{context}{strings}; 228 if (ref($value) eq 'ARRAY') { 229 return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/); 230 my ($type,$ltype); 231 foreach my $x (@{$value}) { 232 $type = getType($equation,$x); 233 if ($type eq 'value') { 234 $type = $x->type if $x->class eq 'Formula'; 235 $type = 'Number' if $x->class eq 'Complex' || $type eq 'Complex'; 236 } 237 $ltype = $type if $ltype eq ''; 238 return 'List' if $type ne $ltype; 239 } 240 return 'Point' if $ltype eq 'Number'; 241 return 'Matrix' if $ltype =~ m/Point|Matrix/; 242 return 'List'; 243 } 244 elsif (Value::isFormula($value)) {return 'Formula'} 245 elsif (Value::class($value) eq 'Infinity') {return 'Infinity'} 246 elsif (Value::isReal($value)) {return 'Number'} 247 elsif (Value::isValue($value)) {return 'value'} 248 elsif (ref($value)) {return 'unknown'} 249 elsif (defined($strings->{$value})) {return 'String'} 250 elsif (Value::isNumber($value)) {return 'Number'} 251 return 'unknown'; 252 } 253 254 # 255 # Get a string describing a value's type, 256 # and convert the value to a Value object (if needed) 257 # 258 sub getValueType { 259 my $equation = shift; my $value = shift; 260 my $type = Value::getType($equation,$value); 261 if ($type eq 'String') {$type = $Value::Type{string}} 262 elsif ($type eq 'Number') {$type = $Value::Type{number}} 263 elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}} 264 elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef} 265 elsif ($type eq 'unknown') { 266 $equation->Error(["Can't convert %s to a constant",Value::showClass($value)]); 267 } else { 268 $type = 'Value::'.$type, $value = $type->new(@{$value}); 269 $type = $value->typeRef; 270 } 271 return ($value,$type); 272 } 273 274 # 275 # Convert a list of values to a list of formulas (called by Parser::Value) 276 # 277 sub toFormula { 278 my $formula = shift; 279 my $processed = 0; 280 my @f = (); my $vars = {}; 281 foreach my $x (@_) { 282 if (isFormula($x)) { 283 $formula->{context} = $x->{context}, $processed = 1 unless $processed; 284 $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}}; 285 push(@f,$x->{tree}->copy($formula)); 286 } else { 287 push(@f,$formula->{context}{parser}{Value}->new($formula,$x)); 288 } 289 } 290 return (@f); 291 } 292 293 # 294 # Convert a list of values (and open and close parens) 295 # to a formula whose type is the list type associated with 296 # the parens. 297 # 298 sub formula { 299 my $self = shift; my $values = shift; 300 my $class = $self->class; 301 my $list = $$context->lists->get($class); 302 my $open = $list->{'open'}; 303 my $close = $list->{'close'}; 304 my $paren = $open; $paren = 'list' if $class eq 'List'; 305 my $formula = Value::Formula->blank; 306 my @coords = Value::toFormula($formula,@{$values}); 307 $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0, 308 $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close); 309 $formula->{autoFormula} = 1; # mark that this was generated automatically 310 return $formula; 311 } 312 313 # 314 # A shortcut for new() that creates an instance of the object, 315 # but doesn't do the error checking. We assume the data are already 316 # known to be good. 317 # 318 sub make { 319 my $self = shift; my $class = ref($self) || $self; 320 bless {data => [@_]}, $class; 321 } 322 323 # 324 # Easy method for setting parameters of an object 325 # 326 sub with { 327 my $self = shift; my %hash = @_; 328 foreach my $id (keys(%hash)) {$self->{$id} = $hash{$id}} 329 return $self; 330 } 331 332 # 333 # Return a type structure for the item 334 # (includes name, length of vectors, and so on) 335 # 336 sub Type { 337 my $name = shift; my $length = shift; my $entryType = shift; 338 $length = 1 unless defined $length; 339 return {name => $name, length => $length, entryType => $entryType, 340 list => (defined $entryType), @_}; 341 } 342 343 # 344 # Some predefined types 345 # 346 %Type = ( 347 number => Value::Type('Number',1), 348 complex => Value::Type('Number',2), 349 string => Value::Type('String',1), 350 infinity => Value::Type('Infinity',1), 351 unknown => Value::Type('unknown',0,undef,list => 1) 352 ); 353 354 # 355 # Return various information about the object 356 # 357 sub value {return @{(shift)->{data}}} # the value of the object (as an array) 358 sub data {return (shift)->{data}} # the reference to the value 359 sub length {return scalar(@{(shift)->{data}})} # the number of coordinates 360 sub type {return (shift)->typeRef->{name}} # the object type 361 sub entryType {return (shift)->typeRef->{entryType}} # the coordinate type 362 # 363 # The the full type-hash for the item 364 # 365 sub typeRef { 366 my $self = shift; 367 return Value::Type($self->class, $self->length, $Value::Type{number}); 368 } 369 # 370 # The Value.pm object class 371 # 372 sub class { 373 my $self = shift; my $class = ref($self) || $self; 374 $class =~ s/.*:://; 375 return $class; 376 } 377 378 # 379 # Get an element from a point, vector, matrix, or list 380 # 381 sub extract { 382 my $M = shift; my $i; my @indices = @_; 383 return unless Value::isValue($M); 384 @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]); 385 while (scalar(@indices) > 0) { 386 $i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i); 387 Value::Error("Can't extract element number '%s' (index must be an integer)",$i) 388 unless $i =~ m/^-?\d+$/; 389 $M = $M->data->[$i]; 390 } 391 return $M; 392 } 393 394 395 # 396 # Promote an operand to the same precedence as the current object 397 # 398 sub promotePrecedence { 399 my $self = shift; my $other = shift; 400 return 0 unless Value::isValue($other); 401 my $sprec = $$context->{precedence}{class($self)}; 402 my $oprec = $$context->{precedence}{class($other)}; 403 return (defined($oprec) && $sprec < $oprec); 404 } 405 406 sub promote {shift} 407 408 # 409 # Default stub to call when no function is defined for an operation 410 # 411 sub nomethod { 412 my ($l,$r,$flag,$op) = @_; 413 my $call = $$context->{method}{$op}; 414 if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)} 415 my $error = "Can't use '%s' with %s-valued operands"; 416 $error .= " (use '**' for exponentiation)" if $op eq '^'; 417 Value::Error($error,$op,$l->class); 418 } 419 420 # 421 # Stubs for the sub-classes 422 # 423 sub add {nomethod(@_,'+')} 424 sub sub {nomethod(@_,'-')} 425 sub mult {nomethod(@_,'*')} 426 sub div {nomethod(@_,'/')} 427 sub power {nomethod(@_,'**')} 428 sub cross {nomethod(@_,'x')} 429 430 # 431 # If the right operand is higher precedence, we switch the order. 432 # 433 # If the right operand is also a Value object, we do the object's 434 # dot method to combine the two objects of the same class. 435 # 436 # Otherwise, since . is used for string concatenation, we want to retain 437 # that. Since the resulting string is often used in Formula and will be 438 # parsed again, we put parentheses around the values to guarantee that 439 # the values will be treated as one mathematical unit. For example, if 440 # $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be 441 # (1+x)/y not 1+(x/y), as it would be without the implicit parentheses. 442 # 443 sub _dot { 444 my ($l,$r,$flag) = @_; 445 return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r)); 446 return $l->dot($r,$flag) if (Value::isValue($r)); 447 $l = $l->stringify; $l = '('.$l.')' unless $$Value::context->flag('StringifyAsTeX'); 448 return ($flag)? ($r.$l): ($l.$r); 449 } 450 # 451 # Some classes override this 452 # 453 sub dot { 454 my ($l,$r,$flag) = @_; 455 my $tex = $$Value::context->flag('StringifyAsTeX'); 456 $l = $l->stringify; $l = '('.$l.')' if $tex; 457 if (ref($r)) {$r = $r->stringify; $r = '('.$l.')' if $tex} 458 return ($flag)? ($r.$l): ($l.$r); 459 } 460 461 # 462 # Compare the values of the objects 463 # (list classes should replace this) 464 # 465 sub compare { 466 my ($l,$r,$flag) = @_; 467 if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)} 468 return $l->value <=> $r->value; 469 } 470 471 # 472 # Compare the values as strings 473 # 474 sub compare_string { 475 my ($l,$r,$flag) = @_; 476 if ($l->promotePrecedence($r)) {return $r->compare_string($l,!$flag)} 477 $l = $l->stringify; $r = $r->stringify if Value::isValue($r); 478 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} 479 return $l cmp $r; 480 } 481 482 # 483 # Generate the various output formats 484 # (can be replaced by sub-classes) 485 # 486 sub stringify { 487 my $self = shift; 488 return $self->TeX() if $$Value::context->flag('StringifyAsTeX'); 489 my $def = $$Value::context->lists->get($self->class); 490 return $self->string unless $def; 491 my $open = $self->{open}; $open = $def->{open} unless defined($open); 492 my $close = $self->{close}; $close = $def->{close} unless defined($close); 493 $open.join($def->{separator},@{$self->data}).$close; 494 } 495 496 sub string { 497 my $self = shift; my $equation = shift; 498 my $def = ($equation->{context} || $$Value::context)->lists->get($self->class); 499 return $self->value unless $def; 500 my $open = shift; my $close = shift; 501 $open = $self->{open} unless defined($open); 502 $open = $def->{open} unless defined($open); 503 $close = $self->{close} unless defined($close); 504 $close = $def->{close} unless defined($close); 505 my @coords = (); 506 foreach my $x (@{$self->data}) { 507 if (Value::isValue($x)) 508 {push(@coords,$x->string($equation))} else {push(@coords,$x)} 509 } 510 return $open.join($def->{separator},@coords).$close; 511 } 512 513 sub TeX { 514 my $self = shift; my $equation = shift; 515 my $context = $equation->{context} || $$Value::context; 516 my $def = $context->lists->get($self->class); 517 return $self->string(@_) unless $def; 518 my $open = shift; my $close = shift; 519 $open = $self->{open} unless defined($open); 520 $open = $def->{open} unless defined($open); 521 $close = $self->{close} unless defined($close); 522 $close = $def->{close} unless defined($close); 523 $open =~ s/([{}])/\\$1/g; $close =~ s/([{}])/\\$1/g; 524 $open = '\left'.$open if $open; $close = '\right'.$close if $close; 525 my @coords = (); my $str = $context->{strings}; 526 foreach my $x (@{$self->data}) { 527 if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} 528 elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})} 529 else {push(@coords,$x)} 530 } 531 return $open.join(',',@coords).$close; 532 } 533 534 # 535 # For perl, call the appropriate constructor around the object's data 536 # 537 sub perl { 538 my $self = shift; my $parens = shift; my $matrix = shift; 539 my $class = $self->class; 540 my $mtype = $class eq 'Matrix'; $mtype = -1 if $mtype & !$matrix; 541 my $perl; my @p = (); 542 foreach my $x (@{$self->data}) { 543 if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)} 544 } 545 @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval'; 546 if ($matrix) { 547 $perl = join(',',@p); 548 $perl = '['.$perl.']' if $mtype > 0; 549 } else { 550 $perl = 'new '.ref($self).'('.join(',',@p).')'; 551 $perl = '('.$perl.')' if $parens == 1; 552 } 553 return $perl; 554 } 555 556 # 557 # Stubs for when called by Parser 558 # 559 sub eval {shift} 560 sub reduce {shift} 561 562 sub ijk { 563 Value::Error("Can't use method 'ijk' with objects of type '%s'",(shift)->class); 564 } 565 566 # 567 # Report an error 568 # 569 sub Error { 570 my $message = shift; 571 $message = [$message,@_] if scalar(@_) > 0; 572 $$context->setError($message,''); 573 $message = $$context->{error}{message}; 574 die $message . traceback() if $$context->{debug}; 575 die $message . getCaller(); 576 } 577 578 # 579 # Try to locate the line and file where the error occurred 580 # 581 sub getCaller { 582 my $frame = 2; 583 while (my ($pkg,$file,$line,$subname) = caller($frame++)) { 584 return " at line $line of $file\n" 585 unless $pkg =~ /^(Value|Parser)/ || 586 $subname =~ m/^(Value|Parser).*(new|call)$/; 587 } 588 return ""; 589 } 590 591 # 592 # For debugging 593 # 594 sub traceback { 595 my $frame = shift; $frame = 2 unless defined($frame); 596 my $trace = ''; 597 while (my ($pkg,$file,$line,$subname) = caller($frame++)) 598 {$trace .= " in $subname at line $line of $file\n"} 599 return $trace; 600 } 601 602 ########################################################################### 603 # 604 # Load the sub-classes. 605 # 606 607 use Value::Real; 608 use Value::Complex; 609 use Value::Infinity; 610 use Value::Point; 611 use Value::Vector; 612 use Value::Matrix; 613 use Value::List; 614 use Value::Interval; 615 use Value::Set; 616 use Value::Union; 617 use Value::String; 618 use Value::Formula; 619 620 use Value::WeBWorK; # stuff specific to WeBWorK 621 622 ########################################################################### 623 624 use vars qw($installed); 625 $Value::installed = 1; 626 627 ########################################################################### 628 ########################################################################### 629 # 630 # To Do: 631 # 632 # Make Complex class include more of Complex1.pm 633 # Make better interval comparison 634 # Include context in objects within new() calls. 635 # 636 ########################################################################### 637 638 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |