[system] / trunk / pg / lib / Value.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/Value.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3192 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9