Parent Directory
| 
Revision Log
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 106 sub add { 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;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |