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