[system] / trunk / pg / lib / Value / Real.pm Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# View of /trunk/pg/lib/Value/Real.pm

Sun Oct 16 03:37:17 2005 UTC (14 years, 1 month ago) by dpvc
File size: 6111 byte(s)
In the past, when Value objects were inserted into strings, they would
automatically include parentheses so that if you had $f equal to 1+x and$g equal to 1-x, then Formula("$f/$g") would mean (1+x)/(1-x)
rather than 1+(x/1)-x, which is what would happen as a straing string
substitution.

The problem is that this would also happen for real numbers, vectors,
and everything else, even when it wasn't necessary.  So if $x=Real(3), then "Let x =$x" would be "Let x = (3)".

I have changed the behavior of the string concatenation for Value
objects so that parentheses are only added in a few cases: for
Formulas, Complex numbers, and Unions.  This makes the other Value
objects work more like regular variables in strings, but might cause
some problems with strings that are used as formulas.  For example, if
$a = Real(-3), then "x + 2$a" will become "x + 2 -3", or "x-1" rather
than the expected "x - 6".  (The old approach would have made it "x +
2 (-3)" which would have worked properly).  For the most part, it is
easier to use something like "x + 2*$a" or even "x" + 2*$a in this
case, so the extra trouble of having to avoid parentheses when you
really meant to substitute the value into a string didn't seem worth
it.


    1 ##########################################################################
2 #
3 #  Implements "fuzzy" real numbers (two are equal when they are "close enough")
4 #
5
6 package Value::Real;
7 my $pkg = 'Value::Real'; 8 9 use strict; 10 use vars qw(@ISA); 11 @ISA = qw(Value); 12 13 use overload 14 '+' => sub {shift->add(@_)}, 15 '-' => sub {shift->sub(@_)}, 16 '*' => sub {shift->mult(@_)}, 17 '/' => sub {shift->div(@_)}, 18 '**' => sub {shift->power(@_)}, 19 '.' => sub {shift->_dot(@_)}, 20 'x' => sub {shift->cross(@_)}, 21 '<=>' => sub {shift->compare(@_)}, 22 'cmp' => sub {shift->compare_string(@_)}, 23 'neg' => sub {shift->neg}, 24 'abs' => sub {shift->abs}, 25 'sqrt'=> sub {shift->sqrt}, 26 'exp' => sub {shift->exp}, 27 'log' => sub {shift->log}, 28 'sin' => sub {shift->sin}, 29 'cos' => sub {shift->cos}, 30 'atan2' => sub {shift->atan2(@_)}, 31 'nomethod' => sub {shift->nomethod(@_)}, 32 '""' => sub {shift->stringify(@_)}; 33 34 # 35 # Check that the input is a real number or a formula 36 # or a string that evaluates to a number 37 # 38 sub new { 39 my$self = shift; my $class = ref($self) || $self; 40 my$x = shift; $x = [$x,@_] if scalar(@_) > 0;
41   return $x if ref($x) eq $pkg; 42$x = [$x] unless ref($x) eq 'ARRAY';
43   Value::Error("Can't convert ARRAY of length %d to %s",scalar(@{$x}),Value::showClass($class))
44     unless (scalar(@{$x}) == 1); 45 if (Value::isRealNumber($x->[0])) {
46     return $self->formula($x->[0]) if Value::isFormula($x->[0]); 47 return (bless {data =>$x}, $class); 48 } 49$x = Value::makeValue($x->[0]); 50 return$x if Value::isRealNumber($x); 51 Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($class)); 52 } 53 54 # 55 # Check that result is a number 56 # 57 sub make { 58 my$self = shift;
59   return $self->SUPER::make(@_) unless$_[0] eq "nan";
60   Value::Error("Result is not a real number");
61 }
62
63 #
64 #  Create a new formula from the number
65 #
66 sub formula {
67   my $self = shift; my$value = shift;
68   Value::Formula->new($value); 69 } 70 71 # 72 # Return the real number type 73 # 74 sub typeRef {return$Value::Type{number}}
75 sub length {1}
76
77 #
78 #  return the real number
79 #
80 sub value {(shift)->{data}[0]}
81
82 sub isZero {shift eq "0"}
83 sub isOne {shift eq "1"}
84
85
86 ##################################################
87
88 #
89 #  Return a real if it already is one, otherwise make it one
90 #
91 sub promote {
92   my $x = shift; 93 return$x if (ref($x) eq$pkg && scalar(@_) == 0);
94   return $pkg->new($x,@_);
95 }
96 #
97 #  Get the data from the promoted item
98 #
99 sub promoteData {@{(promote(shift))->data}}
100
101 ##################################################
102 #
103 #  Binary operations
104 #
105
107   my ($l,$r,$flag) = @_; 108 if ($l->promotePrecedence($r)) {return$r->add($l,!$flag)}
109   $r = promote($r);
110   return $pkg->make($l->{data}[0] + $r->{data}[0]); 111 } 112 113 sub sub { 114 my ($l,$r,$flag) = @_;
115   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)} 116$r = promote($r); 117 if ($flag) {my $tmp =$l; $l =$r; $r =$tmp}
118   return $pkg->make($l->{data}[0] - $r->{data}[0]); 119 } 120 121 sub mult { 122 my ($l,$r,$flag) = @_;
123   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)} 124$r = promote($r); 125 return$pkg->make($l->{data}[0]*$r->{data}[0]);
126 }
127
128 sub div {
129   my ($l,$r,$flag) = @_; 130 if ($l->promotePrecedence($r)) {return$r->div($l,!$flag)}
131   $r = promote($r);
132   if ($flag) {my$tmp = $l;$l = $r;$r = $tmp} 133 Value::Error("Division by zero") if$r == 0;
134   return $pkg->make($l->{data}[0]/$r->{data}[0]); 135 } 136 137 sub power { 138 my ($l,$r,$flag) = @_;
139   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)} 140$r = promote($r); 141 if ($flag) {my $tmp =$l; $l =$r; $r =$tmp}
142   my $x =$l->{data}[0]**$r->{data}[0]; 143 return$pkg->make($x) unless$x eq 'nan';
144   Value::Error("Can't raise a negative number to a power") if ($l->{data}[0] < 0); 145 Value::Error("result of exponention is not a number"); 146 } 147 148 sub compare { 149 my ($l,$r,$flag) = @_;
150   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)} 151$r = promote($r); 152 if ($flag) {my $tmp =$l; $l =$r; $r =$tmp}
153   my ($a,$b) = ($l->{data}[0],$r->{data}[0]);
154   if ($$Value::context->{flags}{useFuzzyReals}) { 155 my tolerance =$$Value::context->flag('tolerance');
156     if ($$Value::context->flag('tolType') eq 'relative') { 157 my zeroLevel =$$Value::context->flag('zeroLevel');
158       if (abs($a) <$zeroLevel || abs($b) <$zeroLevel) {
159   $tolerance = $$Value::context->flag('zeroLevelTol'); 160 } else { 161 tolerance = tolerance * abs(a); 162 } 163 } 164 return 0 if abs(a-b) < tolerance; 165 } 166 return a <=> b; 167 } 168 169 ################################################## 170 # 171 # Numeric functions 172 # 173 174 sub abs {pkg->make(CORE::abs(shift->{data}[0]))} 175 sub neg {pkg->make(-(shift->{data}[0]))} 176 sub exp {pkg->make(CORE::exp(shift->{data}[0]))} 177 sub log {pkg->make(CORE::log(shift->{data}[0]))} 178 179 sub sqrt { 180 my self = shift; 181 return pkg->make(0) if self == 0; 182 return pkg->make(CORE::sqrt(self->{data}[0])); 183 } 184 185 ################################################## 186 # 187 # Trig functions 188 # 189 190 sub sin {pkg->make(CORE::sin(shift->{data}[0]))} 191 sub cos {pkg->make(CORE::cos(shift->{data}[0]))} 192 193 sub atan2 { 194 my (l,r,flag) = @_; 195 if (l->promotePrecedence(r)) {return r->atan2(l,!flag)} 196 r = promote(r); 197 if (flag) {my tmp = l; l = r; r = l} 198 return pkg->make(CORE::atan2(l->{data}[0],r->{data}[0])); 199 } 200 201 ################################################## 202 203 sub string { 204 my self = shift; my equation = shift; my prec = shift; 205 my n = self->{data}[0]; 206 my format = (equation->{context} ||$$Value::context)->{format}{number}; 207 if ($format) {
208     $n = sprintf($format,$n); 209 if ($format =~ m/#\s*$/) {$n =~ s/(\.\d*?)0*#$/$1/; $n =~ s/\.$//}
210   }
211   $n = uc($n); # force e notation to E
212   $n = 0 if abs($n) < Value::context->flag('zeroLevelTol');
213   $n = "(".$n.")" if ($n < 0 ||$n =~ m/E/i) && defined($prec) &&$prec >= 1;
214   return $n; 215 } 216 217 sub TeX { 218 my$n = (shift)->string(@_);
219   $n =~ s/E\+?(-?)0*([^)]*)/\\times 10^{$1$2}/i; # convert E notation to x10^(...) 220 return$n;
221 }
222
223
224 ###########################################################################
225
226 1;