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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9