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