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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2601 Revision 2603
43# 43#
44# Precedence of the various types 44# Precedence of the various types
45# (They will be promoted upward automatically when needed) 45# (They will be promoted upward automatically when needed)
46# 46#
47$$context->{precedence} = { 47$$context->{precedence} = {
48 'Number' => 0, 48 'Number' => 0,
49 'Real' => 1, 49 'Real' => 1,
50 'Infinity' => 2,
50 'Complex' => 2, 51 'Complex' => 3,
51 'Point' => 3, 52 'Point' => 4,
52 'Vector' => 4, 53 'Vector' => 5,
53 'Matrix' => 5, 54 'Matrix' => 6,
54 'List' => 6, 55 'List' => 7,
55 'Interval' => 7, 56 'Interval' => 8,
56 'Union' => 8, 57 'Union' => 9,
57 'Formula' => 9, 58 'Formula' => 10,
58}; 59};
59 60
60# 61#
61# Binding of perl operator to class method 62# Binding of perl operator to class method
62# 63#
80############################################################# 81#############################################################
81 82
82# 83#
83# Check if a value is a number, complex, etc. 84# Check if a value is a number, complex, etc.
84# 85#
85sub matchNumber {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i} 86sub matchNumber {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i}
87sub matchInfinite {my $n = shift; $n =~ m/^$$context->{pattern}{infinite}$/i}
86sub isReal {class(shift) eq 'Real'} 88sub isReal {class(shift) eq 'Real'}
87sub isComplex {class(shift) eq 'Complex'} 89sub isComplex {class(shift) eq 'Complex'}
88sub isFormula {class(shift) eq 'Formula'} 90sub isFormula {class(shift) eq 'Formula'}
89sub isValue {ref(shift) =~ m/^Value::/} 91sub isValue {ref(shift) =~ m/^Value::/}
90 92
99 return $n->{tree}->isRealNumber if isFormula($n); 101 return $n->{tree}->isRealNumber if isFormula($n);
100 return isReal($n) || matchNumber($n); 102 return isReal($n) || matchNumber($n);
101} 103}
102 104
103# 105#
106# Convert non-Value objects to Values, if possible
107#
108sub makeValue {
109 my $x = shift;
110 return $x if ref($x);
111 return Value::Real->make($x) if matchNumber($x);
112 return $x unless matchInfinite($x);
113 my $I = Value::Infinity->new();
114 $I = $I->neg if $x =~ m/^$$Value::context->{pattern}{-infinity}$/;
115 return $I;
116}
117
118#
104# Get a printable version of the class of an object 119# Get a printable version of the class of an object
105# 120#
106sub showClass { 121sub showClass {
107 my $value = shift; 122 my $value = makeValue(shift);
108 return "'".$value."'" unless ref($value); 123 return "'".$value."'" unless ref($value);
109 my $class = class($value); 124 my $class = class($value);
110 $class = 'Infinity' if $class eq 'String' && $value->{isInfinite}; 125 $class = 'Infinity' if $class eq 'String' && $value->{isInfinite};
111 $class .= ' Number' if $class =~ m/^(Real|Complex)$/; 126 $class .= ' Number' if $class =~ m/^(Real|Complex)$/;
112 $class .= ' of Intervals' if $class eq 'Union'; 127 $class .= ' of Intervals' if $class eq 'Union';
113 return showType($value->{tree}) if $class eq 'Formula'; 128 return showType($value->{tree}) if $class eq 'Formula';
114 return 'an '.$class if substr($class,0,1) =~ m/[aeio]/i; 129 return 'an '.$class if $class =~ m/^[aeio]/i;
115 return 'a '.$class; 130 return 'a '.$class;
116} 131}
117 132
118# 133#
119# Get a printable version of the type of an object 134# Get a printable version of the type of an object
120# 135#
121sub showType { 136sub showType {
122 my $value = shift; 137 my $value = shift;
123 my $type = $value->type; 138 my $type = $value->type;
124 return 'a Complex Number' if $value->isComplex; 139 return 'a Complex Number' if $value->isComplex;
125 return 'an Infinity' if $value->{isInfinite};
126 return 'an '.$type if substr($type,0,1) =~ m/[aeio]/i; 140 return 'an '.$type if $type =~ m/^[aeio]/i;
127 return 'a '.$type; 141 return 'a '.$type;
128} 142}
129 143
130# 144#
131# return a string describing a value's type 145# Return a string describing a value's type
132# 146#
133sub getType { 147sub getType {
134 my $equation = shift; my $value = shift; 148 my $equation = shift; my $value = shift;
135 my $strings = $equation->{context}{strings}; 149 my $strings = $equation->{context}{strings};
136 if (ref($value) eq 'ARRAY') { 150 if (ref($value) eq 'ARRAY') {
334# 348#
335sub _dot { 349sub _dot {
336 my ($l,$r,$flag) = @_; 350 my ($l,$r,$flag) = @_;
337 return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r)); 351 return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r));
338 return $l->dot($r,$flag) if (Value::isValue($r)); 352 return $l->dot($r,$flag) if (Value::isValue($r));
339 $l = '(' . $l->string . ')'; 353 $l = '(' . $l->stringify . ')';
340 return ($flag)? ($r.$l): ($l.$r); 354 return ($flag)? ($r.$l): ($l.$r);
341} 355}
342# 356#
343# Some classes override this 357# Some classes override this
344# 358#
345sub dot { 359sub dot {
346 my ($l,$r,$flag) = @_; 360 my ($l,$r,$flag) = @_;
347 $l = '(' . $l->stringify . ')'; $r = '(' . $r->stringify . ')' if ref($r); 361 $l = '(' . $l->stringify . ')'; $r = '(' . $r->stringify . ')' if ref($r);
348 return ($flag)? ($r.$l): ($l.$r); 362 return ($flag)? ($r.$l): ($l.$r);
349} 363}
350 364
433# Load the sub-classes. 447# Load the sub-classes.
434# 448#
435 449
436use Value::Real; 450use Value::Real;
437use Value::Complex; 451use Value::Complex;
452use Value::Infinity;
438use Value::Point; 453use Value::Point;
439use Value::Vector; 454use Value::Vector;
440use Value::Matrix; 455use Value::Matrix;
441use Value::List; 456use Value::List;
442use Value::Interval; 457use Value::Interval;

Legend:
Removed from v.2601  
changed lines
  Added in v.2603

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9