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

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

Tue Feb 15 21:53:23 2005 UTC (15 years ago) by dpvc
File size: 9098 byte(s)
Improved the Real(), Complex(), Point(), Vector(), Matrix() and
String() constructors so that they will process formulas passed to
them as strings rather than requiring perl objects for these.

For example, you can use Real("2/3") rather than Real(2/3) if you
want.  Also, Real("1+x") will return a formula returning a real
(essentially the same as Formula("1+x") in this case).


    1 ###########################################################################
2 #
3 #  Implements Vector class
4 #
5 package Value::Vector;
6 my $pkg = 'Value::Vector'; 7 8 use strict; 9 use vars qw(@ISA); 10 @ISA = qw(Value); 11 12 use overload 13 '+' => \&add, 14 '-' => \&sub, 15 '*' => \&mult, 16 '/' => \&div, 17 '**' => \&power, 18 '.' => \&Value::_dot, 19 'x' => \&cross, 20 '<=>' => \&compare, 21 'cmp' => \&Value::cmp, 22 'neg' => sub {$_[0]->neg},
23        'abs' => sub {$_[0]->abs}, 24 'nomethod' => \&Value::nomethod, 25 '""' => \&stringify; 26 27 # 28 # Convert a value to a Vector. The value can be 29 # a list of numbers, or an reference to an array of numbers 30 # a point or vector object (demote a vector) 31 # a matrix if it is n x 1 or 1 x n 32 # a string that parses to a vector 33 # 34 sub new { 35 my$self = shift; my $class = ref($self) || $self; 36 my$p = shift; $p = [$p,@_] if (scalar(@_) > 0);
37   $p = Value::makeValue($p) if (defined($p) && !ref($p));
38   return $p if (Value::isFormula($p) && $p->type eq Value::class($self));
39   my $pclass = Value::class($p); my $isFormula = 0; 40 my @d; @d =$p->dimensions if $pclass eq 'Matrix'; 41 if ($pclass =~ m/Point|Vector/) {$p =$p->data}
42   elsif ($pclass eq 'Matrix' && scalar(@d) == 1) {$p = [$p->value]} 43 elsif ($pclass eq 'Matrix' && scalar(@d) == 2 && $d[0] == 1) {$p = ($p->value)[0]} 44 elsif ($pclass eq 'Matrix' && scalar(@d) == 2 && $d[1] == 1) {$p = ($p->transpose->value)[0]} 45 else { 46$p = [$p] if (defined($p) && ref($p) ne 'ARRAY'); 47 Value::Error("Vectors must have at least one coordinate") unless defined($p) && scalar(@{$p}) > 0; 48 foreach my$x (@{$p}) { 49$x = Value::makeValue($x); 50$isFormula = 1 if Value::isFormula($x); 51 Value::Error("Coordinate of Vector can't be ".Value::showClass($x))
52         unless Value::isNumber($x); 53 } 54 } 55 return$self->formula($p) if$isFormula;
56   bless {data => $p},$class;
57 }
58
59 #
60 #  The number of coordinates
61 #
62 sub length {return scalar(@{shift->{data}})}
63
64 #
65 #  Try to promote arbitary data to a vector
66 #
67 sub promote {
68   my $x = shift; 69 return$pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
70   return $x if ref($x) eq $pkg; 71 return$pkg->make(@{$x->data}) if Value::class($x) eq 'Point';
72   Value::Error("Can't convert ".Value::showClass($x)." to a Vector"); 73 } 74 75 ############################################ 76 # 77 # Operations on vectors 78 # 79 80 sub add { 81 my ($l,$r,$flag) = @_;
82   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)} 83 ($l,$r) = (promote($l)->data,promote($r)->data); 84 Value::Error("Vector addition with different number of coordiantes") 85 unless scalar(@{$l}) == scalar(@{$r}); 86 my @s = (); 87 foreach my$i (0..scalar(@{$l})-1) {push(@s,$l->[$i] +$r->[$i])} 88 return$pkg->make(@s);
89 }
90
91 sub sub {
92   my ($l,$r,$flag) = @_; 93 if ($l->promotePrecedence($r)) {return$r->sub($l,!$flag)}
94   ($l,$r) = (promote($l)->data,promote($r)->data);
95   Value::Error("Vector subtraction with different number of coordiantes")
96     unless scalar(@{$l}) == scalar(@{$r});
97   if ($flag) {my$tmp = $l;$l = $r;$r = $tmp}; 98 my @s = (); 99 foreach my$i (0..scalar(@{$l})-1) {push(@s,$l->[$i] -$r->[$i])} 100 return$pkg->make(@s);
101 }
102
103 sub mult {
104   my ($l,$r,$flag) = @_; 105 if ($l->promotePrecedence($r)) {return$r->mult($l,!$flag)}
106   Value::Error("Vectors can only be multiplied by numbers")
107     unless (Value::matchNumber($r) || Value::isComplex($r));
108   my @coords = ();
109   foreach my $x (@{$l->data}) {push(@coords,$x*$r)}
110   return $pkg->make(@coords); 111 } 112 113 sub div { 114 my ($l,$r,$flag) = @_;
115   if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)} 116 Value::Error("Can't divide by a Vector") if$flag;
117   Value::Error("Vectors can only be divided by numbers")
118     unless (Value::matchNumber($r) || Value::isComplex($r));
119   Value::Error("Division by zero") if $r == 0; 120 my @coords = (); 121 foreach my$x (@{$l->data}) {push(@coords,$x/$r)} 122 return$pkg->make(@coords);
123 }
124
125 sub power {
126   my ($l,$r,$flag) = @_; 127 if ($l->promotePrecedence($r)) {return$r->power($l,!$flag)}
128   Value::Error("Can't raise Vectors to powers") unless $flag; 129 Value::Error("Can't use Vectors in exponents"); 130 } 131 132 sub dot { 133 my ($l,$r,$flag) = @_;
134   ($l,$r) = (promote($l)->data,promote($r)->data);
135   Value::Error("Vector dot product with different number of coordiantes")
136     unless scalar(@{$l}) == scalar(@{$r});
137   my $s = 0; 138 foreach my$i (0..scalar(@{$l})-1) {$s += $l->[$i] * $r->[$i]}
139   return $s; 140 } 141 142 sub cross { 143 my ($l,$r,$flag) = @_;
144   if ($l->promotePrecedence($r)) {return $r->dot($l,!$flag)} 145 ($l,$r) = (promote($l)->data,promote($r)->data); 146 Value::Error("Vector must be in 3-space for cross product") 147 unless scalar(@{$l}) == 3 && scalar(@{$r}) == 3; 148$pkg->make($l->[1]*$r->[2] - $l->[2]*$r->[1],
149            -($l->[0]*$r->[2] - $l->[2]*$r->[0]),
150              $l->[0]*$r->[1] - $l->[1]*$r->[0]);
151 }
152
153 #
154 #  If points are different length, shorter is smaller,
155 #  Otherwise, do lexicographic comparison.
156 #
157 sub compare {
158   my ($l,$r,$flag) = @_; 159 if ($l->promotePrecedence($r)) {return$r->compare($l,!$flag)}
160   ($l,$r) = (promote($l)->data,promote($r)->data);
161   return scalar(@{$l}) <=> scalar(@{$r}) unless scalar(@{$l}) == scalar(@{$r});
162   if ($flag) {my$tmp = $l;$l = $r;$r = $tmp}; 163 my$cmp = 0;
164   foreach my $i (0..scalar(@{$l})-1) {
165     $cmp =$l->[$i] <=>$r->[$i]; 166 last if$cmp;
167   }
168   return $cmp; 169 } 170 171 sub neg { 172 my$p = promote(@_)->data;
173   my @coords = ();
174   foreach my $x (@{$p}) {push(@coords,-$x)} 175 return$pkg->make(@coords);
176 }
177
178 sub abs {norm(@_)}
179 sub norm {
180   my $p = promote(@_)->data; 181 my$s = 0;
182   foreach my $x (@{$p}) {$s +=$x*$x} 183 return CORE::sqrt($s);
184 }
185
186 sub unit {
187   my $self = shift; 188 my$n = $self->norm; return$self if $n == 0; 189 return$self / $n; 190 } 191 192 ############################################ 193 # 194 # Check for parallel vectors 195 # 196 197 sub isParallel { 198 my$U = shift; my $V = shift; my$sameDirection = shift;
199   my @u = (promote($U))->value; 200 my @v = (promote($V))->value;
201   return 0 unless  scalar(@u) == scalar(@v);
202   my $k = ''; # will be scaling factor for u = k v 203 foreach my$i (0..$#u) { 204 # 205 # make sure we use fuzzy math 206 # 207$u[$i] = Value::Real->new($u[$i]) unless Value::isReal($u[$i]); 208$v[$i] = Value::Real->new($v[$i]) unless Value::isReal($v[$i]); 209 if ($k ne '') {
210       return 0 if ($v[$i] != $k*$u[$i]); 211 } else { 212 # 213 # if one is zero and the other isn't then not parallel 214 # otherwise use the ratio of the two as k. 215 # 216 if ($u[$i] == 0) { 217 return 0 if$v[$i] != 0; 218 } else { 219 return 0 if$v[$i] == 0; 220$k = ($v[$i]/$u[$i])->value;
221         return 0 if $k < 0 &&$sameDirection;
222       }
223     }
224   }
225   #
226   #  Note: it will return 1 if both are zero vectors.  This is a
227   #  feature, since one is provided by the problem writer, and he
228   #  should only supply the zero vector if he means it.  One could
229   #  return ($k ne '') to return 0 if both are zero. 230 # 231 return 1; 232 } 233 234 sub areParallel {shift->isParallel(@_)} 235 236 237 ############################################ 238 # 239 # Generate the various output formats 240 # 241 242 my$ijk_string = ['i','j','k','0'];
243 my $ijk_TeX = ['\boldsymbol{i}','\boldsymbol{j}','\boldsymbol{k}','\boldsymbol{0}']; 244 245 sub stringify { 246 my$self = shift;
247   return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX'); 248 return self->string(undef,self->{open},self->{close}) 249 }; 250 251 sub string { 252 my self = shift; my equation = shift; 253 return self->ijk(ijk_string) 254 if (self->{ijk} || equation->{ijk} ||$$Value::context->flag("ijk")); 255 my$def = ($equation->{context} || $$Value::context)->lists->get('Vector'); 256 my open = shift || def->{open}; my close = shift || def->{close}; 257 my @coords = (); 258 foreach my x (@{self->data}) { 259 if (Value::isValue(x)) {push(@coords,x->string(equation))} else {push(@coords,x)} 260 } 261 return open.join(',',@coords).close; 262 } 263 264 sub TeX { 265 my self = shift; my equation = shift; 266 return self->ijk if (self->{ijk} || equation->{ijk} ||$$Value::context->flag("ijk")); 267 my$def = ($equation->{context} ||$$Value::context)->lists->get('Vector'); 268 my$open = shift || $def->{open}; my$close = shift || $def->{close}; 269 my @coords = (); 270 foreach my$x (@{$self->data}) { 271 if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)} 272 } 273 return '\left'.$open.join(',',@coords).'\right'.$close; 274 } 275 276 sub ijk { 277 my$self = shift; my $ijk = shift ||$ijk_TeX;
278   my @coords = @{$self->data}; 279 Value::Error("Method 'ijk' can only be used on vectors in three-space") 280 unless (scalar(@coords) <= 3); 281 my$string = ''; my $n; my$term;
282   foreach $n (0..scalar(@coords)-1) { 283$term = $coords[$n];
284     if ($term != 0) { 285$term = '' if $term == 1;$term = '-' if $term == -1; 286$term = '('.$term.')' if$term =~ m/e/i;
287       $term = '+' .$term unless $string eq '' or$term =~ m/^-/;
288       $string .=$term . $ijk->[$n];
289     }
290   }
291   $string =$ijk->[3] if $string eq ''; 292 return$string;
293 }
294
295 ###########################################################################
296
297 1;
298