[system] / trunk / pg / lib / Value / Matrix.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3716 - (download) (as text) (annotate)
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 
  181 sub add {
  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 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9