Parent Directory
| 
Revision Log
Added string comparison to all Value object classes (to compare the string value of an object to another string). Overloaded perl '.' operator to do dot product when the operands are formulas returning vectors. (Part of the auto-generation of formulas). A few improvements to real and complex class output results. Made Union class slightly more robust and removed need for makeUnion method other than in the Union itself.
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 '+' => \&add, 15 '-' => \&sub, 16 '*' => \&mult, 17 '/' => \&div, 18 '**' => \&power, 19 '.' => \&Value::_dot, 20 'x' => \&Value::cross, 21 '<=>' => \&compare, 22 'cmp' => \&Value::cmp, 23 'neg' => sub {$_[0]->neg}, 24 'abs' => sub {$_[0]->abs}, 25 'sqrt'=> sub {$_[0]->sqrt}, 26 'exp' => sub {$_[0]->exp}, 27 'log' => sub {$_[0]->log}, 28 'sin' => sub {$_[0]->sin}, 29 'cos' => sub {$_[0]->cos}, 30 'atan2' => \&atan2, 31 'nomethod' => \&Value::nomethod, 32 '""' => \&Value::stringify; 33 34 # 35 # Check that the input is a real number or a formula 36 # Make a formula if either part is a formula 37 # 38 sub new { 39 my $self = shift; my $class = ref($self) || $self; 40 my $x = shift; $x = [$x,@_] if scalar(@_) > 0; 41 $x = $x->data if ref($x) eq $pkg; 42 $x = [$x] unless ref($x) eq 'ARRAY'; 43 Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to a Real Number") 44 unless (scalar(@{$x}) == 1); 45 Value::Error("Real Number can't be ".Value::showClass($x->[0])) 46 unless (Value::isRealNumber($x->[0])); 47 return $self->formula($x->[0]) if Value::isFormula($x->[0]); 48 bless {data => $x}, $class; 49 } 50 51 # 52 # Create a new formula from the number 53 # 54 sub formula { 55 my $self = shift; my $value = shift; 56 Value::Formula->new($value); 57 } 58 59 # 60 # Return the real number type 61 # 62 sub typeRef {return $Value::Type{number}} 63 64 # 65 # return the real number 66 # 67 sub value {(shift)->{data}[0]} 68 69 ################################################## 70 71 # 72 # Return a real if it already is one, otherwise make it one 73 # 74 sub promote { 75 my $x = shift; 76 return $x if (ref($x) eq $pkg && scalar(@_) == 0); 77 return $pkg->new($x,@_); 78 } 79 # 80 # Get the data from the promoted item 81 # 82 sub promoteData {@{(promote(shift))->data}} 83 84 ################################################## 85 # 86 # Binary operations 87 # 88 89 sub add { 90 my ($l,$r,$flag) = @_; 91 if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)} 92 $r = promote($r); 93 return $pkg->make($l->{data}[0] + $r->{data}[0]); 94 } 95 96 sub sub { 97 my ($l,$r,$flag) = @_; 98 if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)} 99 $r = promote($r); 100 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} 101 return $pkg->make($l->{data}[0] - $r->{data}[0]); 102 } 103 104 sub mult { 105 my ($l,$r,$flag) = @_; 106 if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)} 107 $r = promote($r); 108 return $pkg->make($l->{data}[0]*$r->{data}[0]); 109 } 110 111 sub div { 112 my ($l,$r,$flag) = @_; 113 if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)} 114 $r = promote($r); 115 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} 116 Value::Error("Division by zero") if $r == 0; 117 return $pkg->make($l->{data}[0]/$r->{data}[0]); 118 } 119 120 sub power { 121 my ($l,$r,$flag) = @_; 122 if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)} 123 $r = promote($r); 124 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} 125 return $pkg->make($l->{data}[0]**$r->{data}[0]); 126 } 127 128 sub compare { 129 my ($l,$r,$flag) = @_; 130 if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)} 131 $r = promote($r); 132 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} 133 my ($a,$b) = ($l->{data}[0],$r->{data}[0]); 134 if ($$Value::context->{flags}{useFuzzyReals}) { 135 my $tolerance = $$Value::context->flag('tolerance'); 136 if ($$Value::context->flag('tolType') eq 'relative') { 137 my $zeroLevel = $$Value::context->flag('zeroLevel'); 138 if (abs($a) < $zeroLevel || abs($b) < $zeroLevel) { 139 $tolerance = $$Value::context->flag('zeroLevelTol'); 140 } else { 141 $tolerance = $tolerance * abs($a); 142 } 143 } 144 return 0 if abs($a-$b) < $tolerance; 145 } 146 return $a <=> $b; 147 } 148 149 ################################################## 150 # 151 # Numeric functions 152 # 153 154 sub abs {$pkg->make(CORE::abs(shift->{data}[0]))} 155 sub neg {$pkg->make(-(shift->{data}[0]))} 156 sub exp {$pkg->make(CORE::exp(shift->{data}[0]))} 157 sub log {$pkg->make(CORE::log(shift->{data}[0]))} 158 159 sub sqrt { 160 my $self = shift; 161 return $pkg->make(0) if $self == 0; 162 return $pkg->make(CORE::sqrt($self->{data}[0])); 163 } 164 165 ################################################## 166 # 167 # Trig functions 168 # 169 170 sub sin {$pkg->make(CORE::sin(shift->{data}[0]))} 171 sub cos {$pkg->make(CORE::cos(shift->{data}[0]))} 172 173 sub atan2 { 174 my ($l,$r,$flag) = @_; 175 if ($flag) {my $tmp = $l; $l = $r; $r = $l} 176 return $pkg->make(CORE::atan2($l->{data}[0],$r->{data}[0])); 177 } 178 179 ################################################## 180 181 sub string { 182 my $self = shift; my $equation = shift; my $prec = shift; 183 my $n = $self->{data}[0]; 184 my $format = ($equation->{context} || $$Value::context)->{format}{number}; 185 $n = sprintf($format,$n) if $format; # use the specified precision, if any 186 $n = uc($n); # force e notation to E 187 $n = 0 if $self == 0; # make near zero print as zero 188 $n = "(".$n.")" if ($n < 0 || $n =~ m/E/i) && defined($prec) && $prec >= 1; 189 return $n; 190 } 191 192 sub TeX { 193 my $n = (shift)->string(@_); 194 $n =~ s/E\+?(-?)0*([^)]*)/\\times 10^{$1$2}/i; # convert E notation to x10^(...) 195 return $n; 196 } 197 198 199 ########################################################################### 200 201 1; 202
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |