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

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

Sun Oct 16 03:37:17 2005 UTC (14 years, 1 month ago) by dpvc
File size: 11668 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 the Matrix class.
4 #
5 #    @@@ Still needs lots of work @@@
6 #
7 package Value::Matrix;
8 my $pkg = 'Value::Matrix'; 9 10 use strict; 11 use vars qw(@ISA); 12 @ISA = qw(Value); 13 14 use overload 15 '+' => sub {shift->add(@_)}, 16 '-' => sub {shift->sub(@_)}, 17 '*' => sub {shift->mult(@_)}, 18 '/' => sub {shift->div(@_)}, 19 '**' => sub {shift->power(@_)}, 20 '.' => sub {shift->_dot(@_)}, 21 'x' => sub {shift->cross(@_)}, 22 '<=>' => sub {shift->compare(@_)}, 23 'cmp' => sub {shift->compare_string(@_)}, 24 'neg' => sub {shift->neg}, 25 'nomethod' => sub {shift->nomethod(@_)}, 26 '""' => sub {shift->stringify(@_)}; 27 28 # 29 # Convert a value to a matrix. The value can be: 30 # a list of numbers or list of (nested) references to arrays of numbers 31 # a point, vector or matrix object, a matrix-valued formula, or a string 32 # that evaluates to a matrix 33 # 34 sub new { 35 my$self = shift; my $class = ref($self) || $self; 36 my$M = shift; $M = Value::makeValue($M) if !ref($M) && scalar(@_) == 0; 37 return bless {data =>$M->data}, $class 38 if (Value::class($M) =~ m/Point|Vector|Matrix/ && scalar(@_) == 0);
39   return $M if (Value::isFormula($M) && $M->type eq Value::class($self));
40   $M = [$M,@_] if (ref($M) ne 'ARRAY' || scalar(@_) > 0); 41 Value::Error("Matrices must have at least one entry") unless scalar(@{$M}) > 0;
42   return $self->matrixMatrix(@{$M}) if ref($M->[0]) =~ m/ARRAY|Matrix/; 43 return$self->numberMatrix(@{$M}); 44 } 45 46 # 47 # (Recursively) make a matrix from a list of array refs 48 # and report errors about the entry types 49 # 50 sub matrixMatrix { 51 my$self = shift; my $class = ref($self) || $self; 52 my ($x,$m); my @M = (); my$isFormula = 0;
53   foreach $x (@_) { 54 if (Value::isFormula($x)) {push(@M,$x);$isFormula = 1} else {
55       $m =$pkg->new($x); push(@M,$m);
56       $isFormula = 1 if Value::isFormula($m);
57     }
58   }
59   my ($type,$len) = ($M[0]->entryType->{name},$M[0]->length);
60   foreach $x (@M) { 61 Value::Error("Matrix rows must all be the same type") 62 unless (defined($x->entryType) && $type eq$x->entryType->{name});
63     Value::Error("Matrix rows must all be the same length") unless ($len eq$x->length);
64   }
65   return $self->formula([@M]) if$isFormula;
66   bless {data => [@M]}, $class; 67 } 68 69 # 70 # Form a 1 x n matrix from a list of numbers 71 # (could become a row of an m x n matrix) 72 # 73 sub numberMatrix { 74 my$self = shift; my $class = ref($self) || $self; 75 my @M = (); my$isFormula = 0;
76   foreach my $x (@_) { 77$x = Value::makeValue($x); 78 Value::Error("Matrix row entries must be numbers") unless Value::isNumber($x);
79     push(@M,$x);$isFormula = 1 if Value::isFormula($x); 80 } 81 return$self->formula([@M]) if $isFormula; 82 bless {data => [@M]},$class;
83 }
84
85 #
86 #  Recursively get the entries in the matrix and return
87 #  an array of (references to arrays of ... ) numbers
88 #
89 sub value {
90   my $self = shift; 91 my$M = $self->data; 92 return @{$M} if Value::class($M->[0]) ne 'Matrix'; 93 my @M = (); 94 foreach my$x (@{$M}) {push(@M,[$x->value])}
95   return @M;
96 }
97 #
98 #  Recursively get the dimensions of the matrix.
99 #  Returns (n) for a 1 x n, or (n,m) for an n x m, etc.
100 #
101 sub dimensions {
102   my $self = shift; 103 my$r = $self->length; 104 my$v = $self->data; 105 return ($r,) if (Value::class($v->[0]) ne 'Matrix'); 106 return ($r,$v->[0]->dimensions); 107 } 108 # 109 # Return the proper type for the matrix 110 # 111 sub typeRef { 112 my$self = shift;
113   return Value::Type($self->class,$self->length, $Value::Type{number}) 114 if (Value::class($self->data->[0]) ne 'Matrix');
115   return Value::Type($self->class,$self->length, $self->data->[0]->typeRef); 116 } 117 118 # 119 # True if the matrix is a square matrix 120 # 121 sub isSquare { 122 my$self = shift;
123   my @d = $self->dimensions; 124 return 0 if scalar(@d) > 2; 125 return 1 if scalar(@d) == 1 &&$d[0] == 1;
126   return $d[0] ==$d[1];
127 }
128
129 #
130 #  True if the matrix is 1-dimensional (i.e., is a matrix row)
131 #
132 sub isRow {
133   my $self = shift; 134 my @d =$self->dimensions;
135   return scalar(@d) == 1;
136 }
137
138 #
139 #  See if the matrix is an Indenity matrix
140 #
141 sub isOne {
142   my $self = shift; 143 return 0 unless$self->isSquare;
144   my $i = 0; 145 foreach my$row (@{$self->{data}}) { 146 my$j = 0;
147     foreach my $k (@{$row->{data}}) {
148       return 0 unless $k eq (($i == $j)? "1": "0"); 149$j++;
150     }
151     $i++; 152 } 153 return 1; 154 } 155 156 # 157 # See if the matrix is all zeros 158 # 159 sub isZero { 160 my$self = shift;
161   foreach my $x (@{$self->{data}}) {return 0 unless $x->isZero} 162 return 1; 163 } 164 165 # 166 # Make arbitrary data into a matrix, if possible 167 # 168 sub promote { 169 my$x = shift;
170   return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY'; 171 return$x if ref($x) eq$pkg;
172   return $pkg->make(@{$x->data}) if Value::class($x) =~ m/Point|Vector/; 173 Value::Error("Can't convert %s to a Matrix",Value::showClass($x));
174 }
175
176 ############################################
177 #
178 #  Operations on matrices
179 #
180
182   my ($l,$r,$flag) = @_; 183 if ($l->promotePrecedence($r)) {return$r->add($l,!$flag)}
184   ($l,$r) = (promote($l)->data,promote($r)->data);
185   Value::Error("Matrix addition with different dimensions")
186     unless scalar(@{$l}) == scalar(@{$r});
187   my @s = ();
188   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] + $r->[$i])}
189   return $pkg->make(@s); 190 } 191 192 sub sub { 193 my ($l,$r,$flag) = @_;
194   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)} 195 ($l,$r) = (promote($l)->data,promote($r)->data); 196 Value::Error("Matrix subtraction with different dimensions") 197 unless scalar(@{$l}) == scalar(@{$r}); 198 if ($flag) {my $tmp =$l; $l =$r; $r =$tmp};
199   my @s = ();
200   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] - $r->[$i])}
201   return $pkg->make(@s); 202 } 203 204 sub mult { 205 my ($l,$r,$flag) = @_;
206   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)} 207 # 208 # Constant multiplication 209 # 210 if (Value::matchNumber($r) || Value::isComplex($r)) { 211 my @coords = (); 212 foreach my$x (@{$l->data}) {push(@coords,$x*$r)} 213 return$pkg->make(@coords);
214   }
215   #
216   #  Make points and vectors into columns if they are on the right
217   #
218   if (!$flag && Value::class($r) =~ m/Point|Vector/)
219     {$r = (promote($r))->transpose} else {$r = promote($r)}
220   #
221   if ($flag) {my$tmp = $l;$l = $r;$r = $tmp} 222 my @dl =$l->dimensions; my @dr = $r->dimensions; 223 if (scalar(@dl) == 1) {@dl = (1,@dl);$l = $pkg->make($l)}
224   if (scalar(@dr) == 1) {@dr = (@dr,1); $r =$pkg->make($r)->transpose} 225 Value::Error("Can only multiply 2-dimensional matrices") if scalar(@dl) > 2 || scalar(@dr) > 2; 226 Value::Error("Matices of dimensions %dx%d and %dx%d can't be multiplied",@dl,@dr) 227 unless ($dl[1] == $dr[0]); 228 # 229 # Do matrix multiplication 230 # 231 my @l =$l->value; my @r = $r->value; 232 my @M = (); 233 foreach my$i (0..$dl[0]-1) { 234 my @row = (); 235 foreach my$j (0..$dr[1]-1) { 236 my$s = 0;
237       foreach my $k (0..$dl[1]-1) {$s +=$l[$i]->[$k] * $r[$k]->[$j]} 238 push(@row,$s);
239     }
240     push(@M,$pkg->make(@row)); 241 } 242 return$pkg->make(@M);
243 }
244
245 sub div {
246   my ($l,$r,$flag) = @_; 247 if ($l->promotePrecedence($r)) {return$r->div($l,!$flag)}
248   Value::Error("Can't divide by a Matrix") if $flag; 249 Value::Error("Matrices can only be divided by numbers") 250 unless (Value::matchNumber($r) || Value::isComplex($r)); 251 Value::Error("Division by zero") if$r == 0;
252   my @coords = ();
253   foreach my $x (@{$l->data}) {push(@coords,$x/$r)}
254   return $pkg->make(@coords); 255 } 256 257 sub power { 258 my ($l,$r,$flag) = @_;
259   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)} 260 Value::Error("Can't use Matrices in exponents") if$flag;
261   Value::Error("Only square matrices can be raised to a power") unless $l->isSquare; 262 return Value::Matrix::I($l->length) if $r == 0; 263 Value::Error("Matrix powers must be positive integers") unless$r =~ m/^[1-9]\d*$/; 264 my$M = $l; foreach my$i (2..$r) {$M = $M*$l}
265   return $M; 266 } 267 268 # 269 # Do lexicographic comparison 270 # 271 sub compare { 272 my ($l,$r,$flag) = @_;
273   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)} 274 ($l,$r) = (promote($l)->data,promote($r)->data); 275 Value::Error("Matrix comparison with different dimensions") 276 unless scalar(@{$l}) == scalar(@{$r}); 277 if ($flag) {my $tmp =$l; $l =$r; $r =$tmp};
278   my $cmp = 0; 279 foreach my$i (0..scalar(@{$l})-1) { 280$cmp = $l->[$i] <=> $r->[$i];
281     last if $cmp; 282 } 283 return$cmp;
284 }
285
286 sub neg {
287   my $p = promote(@_)->data; 288 my @coords = (); 289 foreach my$x (@{$p}) {push(@coords,-$x)}
290   return $pkg->make(@coords); 291 } 292 293 # 294 # Transpose an n x m matrix 295 # 296 sub transpose { 297 my$self = shift;
298   my @d = $self->dimensions; 299 if (scalar(@d) == 1) {@d = (1,@d);$self = $pkg->make($self)}
300   Value::Error("Can't transpose %d-dimensional matrices",scalar(@d)) unless scalar(@d) == 2;
301   my @M = (); my $M =$self->data;
302   foreach my $j (0..$d[1]-1) {
303     my @row = ();
304     foreach my $i (0..$d[0]-1) {push(@row,$M->[$i]->data->[$j])} 305 push(@M,$pkg->make(@row));
306   }
307   return $pkg->make(@M); 308 } 309 310 # 311 # Get an identity matrix of the requested size 312 # 313 sub I { 314 my$d = shift; $d = shift if ref($d) eq $pkg; 315 my @M = (); my @Z = split('',0 x$d);
316   foreach my $i (0..$d-1) {
317     my @row = @Z; $row[$i] = 1;
318     push(@M,$pkg->make(@row)); 319 } 320 return$pkg->make(@M);
321 }
322
323 #
324 #  Extract a given row from the matrix
325 #
326 sub row {
327   my $M = promote(shift); my$i = shift;
328   return if $i == 0;$i-- if $i > 0; 329 if ($M->isRow) {return if $i != 0; return$M}
330   return $M->data->[$i];
331 }
332
333 #
334 #  Extract a given element from the matrix
335 #
336 sub element {
337   my $M = promote(shift); 338 return$M->extract(@_);
339 }
340
341 #
342 #  Extract a given column from the matrix
343 #
344 sub column {
345   my $M = promote(shift); my$j = shift;
346   return if $j == 0;$j-- if $j > 0; 347 my @d =$M->dimensions; my @col = ();
348   return if $j+1 >$d[1];
349   return $M->data->[$j] if scalar(@d) == 1;
350   foreach my $row (@{$M->data}) {push(@col,$pkg->make($row->data->[$j]))} 351 return$pkg->make(@col);
352 }
353
354 # @@@ removeRow, removeColumn @@@
355 # @@@ Det, inverse @@@
356
357 ############################################
358 #
359 #  Generate the various output formats
360 #
361
362 sub stringify {
363   my $self = shift; 364 return$self->TeX if $$Value::context->flag('StringifyAsTeX'); 365 return self->string(undef,self->{open},self->{close}); 366 } 367 368 sub string { 369 my self = shift; my equation = shift; 370 my def = (equation->{context} ||$$Value::context)->lists->get('Matrix');
371   my $open = shift ||$def->{open}; my $close = shift ||$def->{close};
372   my @coords = ();
373   foreach my $x (@{$self->data}) {
374     if (Value::isValue($x)) {push(@coords,$x->string($equation,$open,$close))} 375 else {push(@coords,$x)}
376   }
377   return $open.join(',',@coords).$close;
378 }
379
380 #
381 #  Use array environment to lay out matrices
382 #
383 sub TeX {
384   my $self = shift; my$equation = shift;
385   my $def = ($equation->{context} || Value::context)->lists->get('Matrix');
386   my $open = shift ||$self->{open} || $def->{open}; 387 my$close = shift || $self->{close} ||$def->{close};
388   $open = '\{' if$open eq '{'; $close = '\}' if$close eq '}';
389   my $TeX = ''; my @entries = (); my$d;
390   if ($self->isRow) { 391 foreach my$x (@{$self->data}) { 392 push(@entries,(Value::isValue($x))? $x->TeX($equation): $x); 393 } 394$TeX .= join(' &',@entries) . "\n";
395     $d = scalar(@entries); 396 } else { 397 foreach my$row (@{$self->data}) { 398 foreach my$x (@{$row->data}) { 399 push(@entries,(Value::isValue($x))? $x->TeX($equation): $x); 400 } 401$TeX .= join(' &',@entries) . '\cr'."\n";
402       $d = scalar(@entries); @entries = (); 403 } 404 } 405 return '\left'.$open.'\begin{array}{'.('c'x$d).'}'."\n".$TeX.'\end{array}\right'.\$close;
406 }
407
408 ###########################################################################
409
410 1;
411