diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 1499656c68..5ba0738654 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -6,128 +6,137 @@ =head1 Value::Matrix class - References: -MathObject Matrix methods: L -MathObject Contexts: L -CPAN RealMatrix docs: L +=over -Allowing Matrices in Fractions: -L +=item MathObject Matrix methods: L - Context()->parens->set("[" => {formMatrix => 1}); +=item MathObject Contexts: L -Files interacting with Matrices: +=item CPAN RealMatrix docs: L -L +=back -L +For allowing Matrices in Fractions, see L -L + Context()->parens->set("[" => {formMatrix => 1}); -L -- checking whether vectors form a basis +=head2 Files interacting with Matrices: -L -- tools for row reduction via elementary matrices +=over -L -- Generates unimodular matrices with real entries +=item L -L +=item L -L +=item L -L +=item L -- checking whether vectors form a basis -L +=item L -- tools for row reduction via elementary matrices -quickMatrixEntry.pl +=item L -- Generates unimodular matrices with real entries -L +=item L -Contexts +=item L - Matrix -- allows students to enter [[3,4],[3,6]] - -- formMatrix =>1 also allows this? - Complex-Matrix -- allows complex entries +=item L -Creation methods +=item L - $M1 = Matrix([1,2],[3,4]); - $M2 = Matrix([5,6],[7,8]); - $v = Vector(9,10); - $w = ColumnVector(9,10); # differs in how it is printed +=item quickMatrixEntry.pl -Commands added in Value::matrix +=item L + +=back + +=head2 Contexts - Conversion - $matrix->values produces [[3,4,5],[1,3,4]] recursive array references of numbers (not MathObjects) - $matrix->wwMatrix produces CPAN MatrixReal1 matrix, used for computation subroutines +=over +=item C -- allows students to enter [[3,4],[3,6]] + -- formMatrix =>1 also allows this? +=item C -- allows complex entries - Information - $matrix->dimension: ARRAY +=back - Access values +=head2 Creation of Matrices - row : MathObjectMatrix - column : MathObjectMatrix - element : Real or Complex value +Using the C, C or C methods + +Examples: + + $M1 = Matrix([1,2],[3,4]); + $M2 = Matrix([5,6],[7,8]); + $v = Vector(9,10); + $w = ColumnVector(9,10); # differs in how it is printed + +Commands added in Value::matrix - Assign values +Conversion: + $matrix->value produces [[3,4,5],[1,3,4]] recursive array references of numbers (not MathObjects) + $matrix->wwMatrix produces CPAN MatrixReal1 matrix, used for computation subroutines - these need to be added: +Information + $matrix->dimension: ARRAY -see C in MatrixReduce and L +Access values - Advanced - $matrix->data: ARRAY reference (internal data) of MathObjects (Real,Complex, Fractions) - stored at each location. + row : MathObjectMatrix + column : MathObjectMatrix + element : Real or Complex value +Update values + setElement. + +See C in MatrixReduce and L Passthrough methods covering subroutines in Matrix.pm which overrides or augment CPAN's MatrixReal1.pm. Matrix is a specialized subclass of MatrixReal1.pm The actual calculations for these methods are done in C - trace - proj - proj_coeff - L - R - PL - PR - -Passthrough methods covering subroutines in C -(this has been modified to handle complex numbers) -The actual calculations are done in C subroutines -The commands below are Value::Matrix B unless otherwise noted. + trace + proj + proj_coeff + L + R + PL + PR +Passthrough methods covering subroutines in C (this has been modified to handle complex numbers) +The actual calculations are done in C subroutines. +The commands below are Value::Matrix B unless otherwise noted. - condition - det - inverse - is_symmetric - decompose_LR - dim - norm_one - norm_max - kleene - normalize - solve_LR($v) - LR decomposition - solve($M,$v) - function version of solve_LR - order_LR - order of LR decomposition matrix (number of non-zero equations)(also order() ) - order($M) - function version of order_LR - solve_GSM - solve_SSM - solve_RM + condition + det + inverse + is_symmetric + decompose_LR + dim + norm_one + norm_max + kleene + normalize + solve_LR($v) - LR decomposition + solve($M,$v) - function version of solve_LR + order_LR - order of LR decomposition matrix (number of non-zero equations)(also order() ) + order($M) - function version of order_LR + solve_GSM + solve_SSM + solve_RM + +=head2 methods =cut -# package Value::Matrix; my $pkg = 'Value::Matrix'; use strict; +use warnings; no strict "refs"; use Matrix; use Complex1; @@ -171,7 +180,7 @@ sub matrixMatrix { #internal my ($x, $m); my @M = (); my $isFormula = 0; - foreach $x (@_) { + for $x (@_) { if (Value::isFormula($x)) { push(@M, $x); $isFormula = 1 } else { $m = $self->new($context, $x); @@ -180,7 +189,7 @@ sub matrixMatrix { #internal } } my ($type, $len) = ($M[0]->entryType->{name}, $M[0]->length); - foreach $x (@M) { + for $x (@M) { Value::Error("Matrix rows must all be the same type") unless (defined($x->entryType) && $type eq $x->entryType->{name}); Value::Error("Matrix rows must all be the same length") unless ($len eq $x->length); @@ -199,7 +208,7 @@ sub numberMatrix { #internal my $context = shift; my @M = (); my $isFormula = 0; - foreach my $x (@_) { + for my $x (@_) { $x = Value::makeValue($x, context => $context); Value::Error("Matrix row entries must be numbers: $x ") unless _isNumber($x); push(@M, $x); @@ -209,19 +218,44 @@ sub numberMatrix { #internal bless { data => [@M], context => $context }, $class; } -# -# Recursively get the entries in the matrix and return -# an array of (references to arrays of ... ) numbers -# +=head3 value + +Returns the array of arrayrefs of the matrix. + +Usage: + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A->value; + + # returns ([1,2,3,4],[5,6,7,8],[9,10,11,12]) + +=cut + sub value { my $self = shift; my $M = $self->data; return @{$M} unless Value::classMatch($M->[0], 'Matrix'); - my @M = (); - foreach my $x (@{$M}) { push(@M, [ $x->value ]) } - return @M; + return map { [ $_->value ] } @$M; } +=head3 dimensions + +Returns the dimensions of the matrix as an array + +Usage: + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A->dimensions; + +returns the array C<(3,4)> + + my $B = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + $B->dimensions; + +returns C<(2,2,2)> + +=cut + # # Recursively get the dimensions of the matrix. # Returns (n) for a 1 x n, or (n,m) for an n x m, etc. @@ -244,36 +278,68 @@ sub typeRef { return Value::Type($self->class, $self->length, $self->data->[0]->typeRef); } -# -# True if the matrix is a square matrix -# +=head3 isSquare + +Return true is the matrix is square, false otherwise + +Usage: + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]); + + $A->isSquare; # is '' (false) + $B->isSquare; # is 1 (true); + +=cut + sub isSquare { my $self = shift; my @d = $self->dimensions; - return 0 if scalar(@d) > 2; + return 1 if scalar(@d) == 1 && $d[0] == 1; + return 0 if scalar(@d) != 2; return $d[0] == $d[1]; } -# -# True if the matrix is 1-dimensional (i.e., is a matrix row) -# +=head3 isRow + +Return true if the matix is 1-dimensional (i.e., is a matrix row) + +Usage: + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $row_vect = Matrix([ 1, 2, 3, 4 ]); + + $A->isRow; # is '' (false) + $row_vect->isRow; # is 1 (true) + +=cut + sub isRow { my $self = shift; my @d = $self->dimensions; return scalar(@d) == 1; } -# -# See if the matrix is an Identity matrix -# +=head3 C, check for identity matrix. + +Usage: + + $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16] ]); + $A->isOne; # is false + + $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]); + $B->isOne; # is true; + +=cut + sub isOne { my $self = shift; return 0 unless $self->isSquare; my $i = 0; - foreach my $row (@{ $self->{data} }) { + for my $row (@{ $self->{data} }) { my $j = 0; - foreach my $k (@{ $row->{data} }) { + for my $k (@{ $row->{data} }) { return 0 unless $k eq (($i == $j) ? "1" : "0"); $j++; } @@ -282,12 +348,21 @@ sub isOne { return 1; } -# -# See if the matrix is all zeros -# +=head3 C, check for zero matrix. + +Usage: + + $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16] ]); + $A->isZero; # is false + + $B = Matrix([ [ 0, 0, 0 ], [ 0, 0, 0 ], [ 0, 0, 0 ] ]); + $B->isZero; # is true; + +=cut + sub isZero { my $self = shift; - foreach my $x (@{ $self->{data} }) { return 0 unless $x->isZero } + for my $x (@{ $self->{data} }) { return 0 unless $x->isZero } return 1; } @@ -444,7 +519,7 @@ sub add { Value::Error("Can't add Matrices with different dimensions") unless scalar(@l) == scalar(@r); my @s = (); - foreach my $i (0 .. scalar(@l) - 1) { push(@s, $l[$i] + $r[$i]) } + for my $i (0 .. scalar(@l) - 1) { push(@s, $l[$i] + $r[$i]) } return $self->inherit($other)->make(@s); } @@ -455,7 +530,7 @@ sub sub { Value::Error("Can't subtract Matrices with different dimensions") unless scalar(@l) == scalar(@r); my @s = (); - foreach my $i (0 .. scalar(@l) - 1) { push(@s, $l[$i] - $r[$i]) } + for my $i (0 .. scalar(@l) - 1) { push(@s, $l[$i] - $r[$i]) } return $self->inherit($other)->make(@s); } @@ -463,20 +538,20 @@ sub mult { my ($l, $r, $flag) = @_; my $self = $l; my $other = $r; - # - # Constant multiplication - # + + # Perform constant multiplication. + if (_isNumber($r)) { my @coords = (); - foreach my $x (@{ $l->data }) { push(@coords, $x * $r) } + for my $x (@{ $l->data }) { push(@coords, $x * $r) } return $self->make(@coords); } - # - # Make points and vectors into columns if they are on the right - # + + # Make points and vectors into columns if they are on the right. + if (!$flag && Value::classMatch($r, 'Point', 'Vector')) { $r = ($self->promote($r))->transpose } else { $r = $self->promote($r) } - # + if ($flag) { my $tmp = $l; $l = $r; $r = $tmp } my @dl = $l->dimensions; my @dr = $r->dimensions; @@ -485,17 +560,17 @@ sub mult { Value::Error("Can only multiply 2-dimensional matrices") if scalar(@dl) > 2 || scalar(@dr) > 2; Value::Error("Matrices of dimensions %dx%d and %dx%d can't be multiplied", @dl, @dr) unless ($dl[1] == $dr[0]); - # - # Do matrix multiplication - # + + # Perform atrix multiplication. + my @l = $l->value; my @r = $r->value; my @M = (); - foreach my $i (0 .. $dl[0] - 1) { + for my $i (0 .. $dl[0] - 1) { my @row = (); - foreach my $j (0 .. $dr[1] - 1) { + for my $j (0 .. $dr[1] - 1) { my $s = 0; - foreach my $k (0 .. $dl[1] - 1) { $s += $l[$i]->[$k] * $r[$k]->[$j] } + for my $k (0 .. $dl[1] - 1) { $s += $l[$i]->[$k] * $r[$k]->[$j] } push(@row, $s); } push(@M, $self->make(@row)); @@ -511,7 +586,7 @@ sub div { Value::Error("Matrices can only be divided by Numbers") unless _isNumber($r); Value::Error("Division by zero") if $r == 0; my @coords = (); - foreach my $x (@{ $l->data }) { push(@coords, $x / $r) } + for my $x (@{ $l->data }) { push(@coords, $x / $r) } return $self->make(@coords); } @@ -530,20 +605,18 @@ sub power { Value::Error("Matrix powers must be non-negative integers") unless _isNumber($r) && $r =~ m/^\d+$/; return $context->Package("Matrix")->I($l->length, $context) if $r == 0; my $M = $l; - foreach my $i (2 .. $r) { $M = $M * $l } + for my $i (2 .. $r) { $M = $M * $l } return $M; } -# # Do lexicographic comparison (row by row) -# sub compare { my ($self, $l, $r) = Value::checkOpOrderWithPromote(@_); Value::Error("Can't compare Matrices with different dimensions") unless join(',', $l->dimensions) eq join(',', $r->dimensions); my @l = @{ $l->data }; my @r = @{ $r->data }; - foreach my $i (0 .. scalar(@l) - 1) { + for my $i (0 .. scalar(@l) - 1) { my $cmp = $l[$i] <=> $r[$i]; return $cmp if $cmp; } @@ -566,9 +639,17 @@ sub twiddle { return $self->make(@coords); } -# -# Transpose an n x m matrix -# +=head3 C + +Take the transpose of a matrix. + +Usage: + + $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A->transpose; + +=cut + sub transpose { my $self = promote(@_); my @d = $self->dimensions; @@ -576,19 +657,27 @@ sub transpose { Value::Error("Can't transpose %d-dimensional matrices", scalar(@d)) unless scalar(@d) == 2; my @M = (); my $M = $self->data; - foreach my $j (0 .. $d[1] - 1) { + for my $j (0 .. $d[1] - 1) { my @row = (); - foreach my $i (0 .. $d[0] - 1) { push(@row, $M->[$i]->data->[$j]) } + for my $i (0 .. $d[0] - 1) { push(@row, $M->[$i]->data->[$j]) } push(@M, $self->make(@row)); } return $self->make(@M); } -# -# Get an identity matrix of the requested size -# Value::Matrix->I(n) -# $A->I # n is the number of rows of $A -# +=head3 C, identity matrix + +Get an identity matrix of the requested size + + Value::Matrix->I(n) + +Usage: + + Value::Matrix->I(3); # returns a 3 by 3 identity matrix. + $A->I; # return an n by n identity matrix, where n is the number of rows of A + +=cut + sub I { my $self = shift; my $d = shift; @@ -605,15 +694,78 @@ sub I { return $self->make($context, @M); } -# -# Get an elementary matrix of the requested size and type -# Value::Matrix->E(n,[i,j]) nxn, swap rows i and j -# Value::Matrix->E(n,[i,j],k) nxn, replace row i with row i added to k times row j -# Value::Matrix->E(n,[i],k) nxn, scale row i by k -# $A->E([i,j]) # n is the number of rows of $A -# $A->E([i,j],k) # n is the number of rows of $A -# $A->E([i],k) # n is the number of rows of $A -# +=head3 C, elementary matrix contruction + +Get an elementary matrix of the requested size and type. These include matrix that upon left multiply will +perform row operations. + +=over + +=item * Row Swap + +To perform a row swap between rows C and C, then C. + +Usage: + + my $E1 = Value::Matrix->E(3, [ 1, 3 ]); + +returns the matrix + [[0, 0, 1], + [0, 1, 0], + [1, 0, 0]] + +or if the matrix C<$A> exists then + + $A->E([1, 3]); + +where the size of the resulting matrix is the number of rows of C<$A>. + +=item * Multiply a row by a constant + +To create the matrix that will multiply a row C, by constant C, then C + +Usage: + + my $E2 = Value::Matrix->E(4, [2], 3); + +generates the matrix + + [ [ 1, 0, 0, 0 ], + [ 0, 4, 0, 0 ], + [ 0, 0, 1, 0 ], + [ 0, 0, 0, 1 ] ] + +or if the matrix C<$A> exists then + + $A->E([4], 3); + +will generate the elementary matrix of size number of rows of C<$A>, which multiplies row 4 by 3. + +=item * Multiply a row by a constant and add to another row. + +To create the matrix that will multiply a row C, by constant C and add to row C then C + +Usage: + + Value::Matrix->E(4, [ 3, 2 ], -3); + +generates the matrix: + + [ [ 1, 0, 0, 0 ], + [ 0, 1, 0, 0 ], + [ 0, -3, 1, 0 ], + [ 0, 0, 0, 1 ] ] + +or if the matrix C<$A> exists then + + $A->E([3, 4], -5); + +will generate the elementary matrix of size number of rows of C<$A>, which multiplies row 3 by -5 and adds to row 4. + +=back + +=cut + sub E { my ($self, $d, $rows, $k, $context) = @_; if (ref $d eq 'ARRAY') { @@ -652,13 +804,39 @@ sub E { return $self->make($context, @M); } -# -# Get a permutation matrix of the requested size -# E.g. P(3,[1,2,3]) corresponds to cycle (123) applied to rows of I_3i, -# and P(6,[1,4],[2,4,6]) corresponds to cycle product (14)(246) applied to rows of I_6 -# Value::Matrix->P(n,(cycles)) -# $A->P((cycles)) # n is the number of rows of $A -# +=head3 C

, create a permutation matrix + +Creates a permutation matrix of the requested size. + +C<< Value::Matrix->P(n,(cycles)) >> in general where C is a sequence of array references +of the cycles. + +If one has an existing matrix C<$A>, then C<< $A->P(cycles) >> generals a permutation matrix of the +same size as C<$A>. + +Usage: + + Value::Matrix->P(3,[1, 2, 3]); # corresponds to cycle (123) applied to rows of I_3. + +returns the matrix [[0,1,0],[0,0,1],[1,0,0]] + + Value::Matrix->P(6,[1,3],[2,4,6]); # permutation matrix on cycle product (13)(246) + +returns the matrix + [[0,0,1,0,0,0], + [0,0,0,0,0,1], + [1,0,0,0,0,0], + [0,1,0,0,0,0], + [0,0,0,0,1,0], + [0,0,0,1,0,0]] + + $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16] ]); + $P3 = $A->P([1,4]); + +returns the matrix [[0,0,0,1],[0,1,0,0],[0,0,1,0],[1,0,0,0]] + +=cut + sub P { my ($self, $d, @cycles) = @_; if (ref $d eq 'ARRAY') { @@ -697,12 +875,20 @@ sub P { return $self->make($context, @M); } -# -# Get an all zero matrix of the requested size -# Value::Matrix->Zero(m,n) -# Value::Matrix->Zero(n) -# $A->Zero # n is the number of rows of $A -# +=head3 C + +Create a zero matrix of requested size. If called on existing matrix, creates a matrix as +the same size as given matrix. + +Usage: + Value::Matrix->Zero(m,n); # creates a m by n zero matrix. + Value::Matrix->Zero(n); # creates an n ny n zero matrix. + + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A1->Zero; # generates a zero matrix as same size as $A1. + +=cut + sub Zero { my ($self, $m, $n, $context) = @_; $context = $self->context unless $context; @@ -720,26 +906,43 @@ sub Zero { return $self->make($context, @M); } -# -# Extract a given row from the matrix -# +=head3 C + +Extract a given row from the matrix. + +Usage: + + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A1->row(2); # returns the row Matrix [5,6,7,8] + +=cut + sub row { my $self = (ref($_[0]) ? $_[0] : shift); my $M = $self->promote(shift); my $i = shift; - return if $i == 0; - $i-- if $i > 0; + Value::Error("Row must be a positive integer") unless $i =~ m/^[1-9]\d*$/; + $i-- if $i > 0; if ($M->isRow) { return if $i != 0 && $i != -1; return $M } return $M->data->[$i]; } -# -# Extract a given column from the matrix -# +=head3 C + +Extract a given column from the matrix. + +Usage: + + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A1->column(2); # returns the column Matrix [[2],[6],[10]] + +=cut + sub column { my $self = (ref($_[0]) ? $_[0] : shift); my $M = $self->promote(shift); my $j = shift; + Value::Error("Column must be a positive integer") unless $j =~ m/^[1-9]\d*$/; return if $j == 0; $j-- if $j > 0; my @d = $M->dimensions; @@ -749,27 +952,171 @@ sub column { } return if $j + 1 > $d[1] || $j < -$d[1]; my @col = (); - foreach my $row (@{ $M->data }) { push(@col, $self->make($row->data->[$j])) } + for my $row (@{ $M->data }) { push(@col, $self->make($row->data->[$j])) } return $self->make(@col); } -# -# Extract a given element from the matrix -# +=head3 C + +Extract an element from the given row/col. + +Usage: + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A->element(2,3); # returns 7 + + my $B = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + $B->element(1,2,1); # returns 3; + + my $row = Matrix([4,3,2,1]); + $row->element(2); # returns 3; +=cut + sub element { my $self = (ref($_[0]) ? $_[0] : shift); my $M = $self->promote(shift); return $M->extract(@_); } -# @@@ assign @@@ +=head3 C + +Assign an element in the matrix to a value. + +Inputs: indices as an arrayref and the value in a form that can be parsed. + +Note: this mutates the matrix itself. + +Usage: + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + $A->setElement([2,3],-5); + + +=cut + +sub setElement { + my ($self, $ind, $value) = @_; + + # Drill down into the matrix + my $el = $self->{data}[ $ind->[0] - 1 ]; + for my $i (1 .. scalar(@$ind) - 1) { $el = $el->{data}[ $ind->[$i] - 1 ]; } + + # update the value of $el + $el = Value::makeValue($value); +} + +=head3 C + + +Return a submatrix of the matrix. If the rows and columns are array refs, the given rows and +columns of the matrix are returns as a Matrix object. + +If the input are integers, then the submatrix with that row and column removed. + +Usage: + + $A = Matrix([[1,2,3,4],[5,6,7,8],[9,10,11,12]]); + + $A->subMatrix([2..3],[2..4]); # returns a Matrix([[6,7,8],[10,11,12]]) + + $A->subMatrix(2,3); # returns Matrix([ [ 1, 2, 4 ], [ 9, 10, 12 ] ]); + + $A->subMatrix([3,1,2],[1,4,2]); # returns Matrix([9,12,10],[1,4,2],[5,8,6]); +=cut + +sub subMatrix { + my ($self, $r, $c) = @_; + my $context = $self->context; + my ($rows, $cols); + my ($nrow, $ncol) = $self->dimensions; + + # check if the inputs are integers. + if (ref $r eq '' && ref $c eq '') { + Value::Error("The input $r is not a valid row.") unless $r >= 1 && $r <= $nrow && int($r) == $r; + Value::Error("The input $c is not a valid column.") unless $c >= 1 && $c <= $ncol && int($c) == $c; + $rows = [ grep { $_ != $r } (1 .. $nrow) ]; + $cols = [ grep { $_ != $c } (1 .. $ncol) ]; + } elsif (ref $r eq 'ARRAY' && ref $c eq 'ARRAY') { + $rows = $r; + $cols = $c; + for my $i (@$rows) { + Value::Error("The input $i is not a valid row.") unless int($i) == $i && $i >= 1 && $i <= $nrow; + } + for my $i (@$cols) { + Value::Error("The input $i is not a valid column.") unless int($i) == $i && $i >= 1 && $i <= $ncol; + } + } else { + Value::Error('The inputs must both be integers or array refs.'); + } + my @M = (); + for my $r (@$rows) { + push(@M, $self->make($context, map { $self->element($r, $_) } @$cols)); + } + return $self->make($context, @M); +} + +=head3 C + +Remove a row from a matrix. + +Usage: + + $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16] ]); + $A->removeRow(3); + +results in C<[[1,2,3,4],[5,6,7,8],[13,14,15,16]]>. + +=cut + +sub removeRow { + my ($self, $row) = @_; + my $context = $self->context; + my @d = $self->dimensions; + Value::Error("The method removeRow is only valid for 2D matrices.") unless scalar(@d) eq 2; + my ($nrow, $ncol) = @d; + Value::Error("The input $row is not a valid row.") + unless ref($row) eq '' && $row >= 1 && $row <= $nrow && int($row) == $row; + + my @M = (); + for my $r (1 .. $nrow) { push(@M, $self->make($context, $r)) unless $r eq $row; } + return $self->make($context, @M); +} + +=head3 + +Remove a column from a matrix. + +Usage: + + $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16] ]); + $A->removeColumn(2); + +results in C<[[1,3,4],[5,7,8],[9,11,12],[13,15,16]]>. + +=cut + +sub removeColumn { + my ($self, $col) = @_; + my $context = $self->context; + my @d = $self->dimensions; + Value::Error("The method removeColumn is only valid for 2D matrices.") unless scalar(@d) eq 2; + my ($nrow, $ncol) = @d; + Value::Error("The input $col is not a valid column.") + unless ref($col) eq '' && $col >= 1 && $col <= $ncol && int($col) == $col; + + my @M = (); + for my $r (1 .. $nrow) { + my @row = (); + for my $c (1 .. $ncol) { push(@row, $self->element($r, $c)) unless $c eq $col; } + push(@M, $self->make($context, @row)); + } + return $self->make($context, @M); +} + # @@@ removeRow, removeColumn @@@ # @@@ Minor @@@ -################################################## -# # Convert MathObject Matrix to old-style Matrix -# sub wwMatrix { my $self = (ref($_[0]) ? $_[0] : shift); my $M = $self->promote(shift); @@ -780,14 +1127,14 @@ sub wwMatrix { Value->Error("Matrix must be two-dimensional to convert to MatrixReal1") if scalar(@d) > 2; if (scalar(@d) == 1) { $wwM = new Matrix(1, $d[0]); - foreach my $j (0 .. $d[0] - 1) { + for my $j (0 .. $d[0] - 1) { $wwM->[0][0][$j] = $self->wwMatrixEntry($M->data->[$j]); } } else { $wwM = new Matrix(@d); - foreach my $i (0 .. $d[0] - 1) { + for my $i (0 .. $d[0] - 1) { my $row = $M->data->[$i]; - foreach my $j (0 .. $d[1] - 1) { + for my $j (0 .. $d[1] - 1) { $wwM->[0][$i][$j] = $self->wwMatrixEntry($row->data->[$j]); } } @@ -996,7 +1343,7 @@ sub TeX { my $d; if ($self->isRow) { - foreach my $x (@{ $self->data }) { + for my $x (@{ $self->data }) { if (Value::isValue($x)) { $x->{format} = $self->{format} if defined $self->{format}; push(@entries, $x->TeX($equation)); @@ -1007,8 +1354,8 @@ sub TeX { $TeX .= join(' &', @entries) . "\n"; $d = scalar(@entries); } else { - foreach my $row (@{ $self->data }) { - foreach my $x (@{ $row->data }) { + for my $row (@{ $self->data }) { + for my $x (@{ $row->data }) { if (Value::isValue($x)) { $x->{format} = $self->{format} if defined $self->{format}; push(@entries, $x->TeX($equation)); @@ -1025,7 +1372,5 @@ sub TeX { return '\left' . $open . '\begin{array}{' . ('c' x $d) . '}' . "\n" . $TeX . '\end{array}\right' . $close; } -########################################################################### - 1; diff --git a/t/math_objects/matrix.t b/t/math_objects/matrix.t new file mode 100644 index 0000000000..02055cf1b2 --- /dev/null +++ b/t/math_objects/matrix.t @@ -0,0 +1,259 @@ +#!/usr/bin/env perl + +=head1 MathObjects - Matrix + +Tests creation and manipulation of Matrix math objects. + +=cut + +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; + +loadMacros('MathObjects.pl'); + +Context('Matrix'); +use Data::Dumper; +subtest 'Creating Matrices' => sub { + my $values = [ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]; + my $A = Matrix($values); + is $A->class, 'Matrix', 'Input as array ref is a Matrix.'; + is [ $A->value ], $values, 'The entry values is correct.'; + my $B = Matrix('[[1,2,3,4],[5,6,7,8], [9,10,11,12]]'); + is $B->class, 'Matrix', 'Input as a string is a Matrix.'; + my $C = Compute('[[1,2,3,4],[5,6,7,8], [9,10,11,12]]'); + is $C->class, 'Matrix', 'Input using Compute is a Matrix.'; +}; + +subtest 'Matrix Dimensions' => sub { + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]); + my $C = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + my $row = Matrix([ 1, 2, 3, 4 ]); + my @dimsA = $A->dimensions; + my @dimsB = $B->dimensions; + my @dimsC = $C->dimensions; + my @dimsRow = $row->dimensions; + is \@dimsA, [ 3, 4 ], 'The dimensions of A are correct.'; + is \@dimsB, [ 3, 3 ], 'The dimensions of B are correct.'; + is \@dimsC, [ 2, 2, 2 ], 'The dimensions of C are correct.'; + is \@dimsRow, [4], 'The dimensions of a row vector are correct.'; +}; + +subtest 'isSquare and isOne' => sub { + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]); + ok !$A->isSquare, 'The matrix A is not square.'; + ok $B->isSquare, 'The matrix B is square.'; + + my $row_vect = Matrix([ 1, 2, 3, 4 ]); + ok $row_vect->isRow, 'The matrix [[1,2,3,4]] is a row vector.'; + ok !$A->isRow, 'The matrix A is not a row vector.'; + + ok !$A->isOne, 'The matrix A is not an identity matrix.'; + ok $B->isOne, 'The matrix B is an identity matrix.'; +}; + +subtest 'Triangular Matrices' => sub { + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 0, 6, 7, 8 ], [ 0, 0, 11, 12 ], [ 0, 0, 0, 16 ] ]); + my $A2 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ] ]); + ok $A1->isUpperTriangular, 'test for upper triangular matrix'; + ok !$A2->isUpperTriangular, 'not an upper triangular matrix'; + my $B1 = Matrix([ [ 1, 0, 0, 0 ], [ 5, 6, 0, 0 ], [ 9, 10, 11, 0 ], [ 13, 14, 15, 16 ] ]); + ok $B1->isLowerTriangular, 'test for lower triangular matrix'; + my $B2 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + ok !$B2->isLowerTriangular, 'not a lower triangular matrix.'; + +}; + +subtest 'Transpose' => sub { + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $B = Matrix([ [ 1, 5, 9 ], [ 2, 6, 10 ], [ 3, 7, 11 ], [ 4, 8, 12 ] ]); + is $A->transpose->value, $B->value, 'Test the tranpose of a matrix.'; + + my $row = Matrix([ 1, 2, 3, 4 ]); + my $row_trans = Matrix([ [1], [2], [3], [4] ]); + is $row->transpose->value, $row_trans->value, 'Transpose of a Matrix with one row.'; + + my $C = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + like dies { + $C->transpose; + }, qr/Can't transpose \d+-dimensional matrices/, "Can't tranpose a three-d matrix."; +}; + +subtest 'Extract an element' => sub { + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $B = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + my $row = Matrix([ 1, 2, 3, 4 ]); + + is $A->element(1, 1), 1, 'extract an element from a 2D matrix.'; + is $A->element(3, 2), 10, 'extract an element from a 2D matrix.'; + is $B->element(1, 2, 1), 3, 'extract an element from a 3D matrix.'; + is $row->element(2), 2, 'extract an element from a row matrix'; +}; + +subtest 'Set an individual element' => sub { + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $A2 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, -5, 8 ], [ 9, 10, 11, 12 ] ]); + $A1->setElement([ 2, 3 ], -5); + is $A1->value, $A2->value, 'Setting an individual element.'; + + my $B1 = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + $B1->setElement([ 1, 2, 2 ], 10); + my $B2 = Matrix([ [ [ 1, 2 ], [ 3, 10 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + is $B1->value, $B2->value, 'Setting an element in a 2x2x2 matrix.'; +}; + +subtest 'Extract a row' => sub { + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $row = Matrix([ 5, 6, 7, 8 ]); + is $A1->row(2)->value, $row->value, 'Extract a column from a matrix.'; + + like dies { + $A1->row(-1); + }, qr/Row must be a positive integer/, 'Test that an error is thrown for passing a non-positive integer.'; +}; + +subtest 'Extract a column' => sub { + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $col = Matrix([ [2], [6], [10] ]); + is $A1->column(2)->value, $col->value, 'Extract a column from a matrix.'; + + like dies { + $A1->column(-1); + }, qr/Column must be a positive integer/, 'Test that an error is thrown for passing a non-positive integer.'; +}; + +subtest 'Identity matrix' => sub { + my $I = Value::Matrix->I(3); + my $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]); + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + + is $I->value, $B->value, 'Create a 3 x 3 identity matrix.'; + is $A->I->value, $B->value, 'Create a 3 x 3 identity matrix by using an existing matrix.'; +}; + +subtest 'Permutation matrices' => sub { + my $P1 = Value::Matrix->P(3, [ 1, 2, 3 ]); + is $P1->value, Matrix([ [ 0, 1, 0 ], [ 0, 0, 1 ], [ 1, 0, 0 ] ])->value, + 'Create permuation matrix on cycle (123)'; + + my $P2 = Value::Matrix->P(6, [ 1, 3 ], [ 2, 4, 6 ]); + is $P2->value, + Matrix([ + [ 0, 0, 1, 0, 0, 0 ], + [ 0, 0, 0, 0, 0, 1 ], + [ 1, 0, 0, 0, 0, 0 ], + [ 0, 1, 0, 0, 0, 0 ], + [ 0, 0, 0, 0, 1, 0 ], + [ 0, 0, 0, 1, 0, 0 ] + ])->value, 'Create a permutation matrix on cycle product (13)(246)'; + + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ] ]); + my $P3 = $A->P([ 1, 4 ]); + is $P3->value, Matrix([ [ 0, 0, 0, 1 ], [ 0, 1, 0, 0 ], [ 0, 0, 1, 0 ], [ 1, 0, 0, 0 ] ])->value, + 'Create a permutation matrix based on an existing matrix.'; +}; + +subtest 'Zero matrix' => sub { + my $Z1 = Matrix([ [ 0, 0, 0, 0 ], [ 0, 0, 0, 0 ], [ 0, 0, 0, 0 ] ]); + my $Z2 = Matrix([ [ 0, 0, 0, 0 ], [ 0, 0, 0, 0 ], [ 0, 0, 0, 0 ], [ 0, 0, 0, 0 ] ]); + is Value::Matrix->Zero(3, 4)->value, $Z1->value, 'Create a 3 by 4 zero matrix.'; + is Value::Matrix->Zero(4)->value, $Z2->value, 'Create a 4 by 4 zero matrix.'; + + my $A1 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + is $A1->Zero->value, $Z1->value, 'Create a zero matrix with same size as the given one.'; + + like dies { + Value::Matrix->Zero(4, 0); + }, qr/Dimension must be a positive integer/, 'Test that an error is thrown for passing a non-positive integer.'; +}; + +subtest 'Elementary Matrices' => sub { + my $E1 = Value::Matrix->E(3, [ 1, 3 ]); + is $E1->value, Matrix([ [ 0, 0, 1 ], [ 0, 1, 0 ], [ 1, 0, 0 ] ])->value, 'Elementary Matrix with a row swap'; + + my $E2 = Value::Matrix->E(4, [2], 3); + is $E2->value, Matrix([ [ 1, 0, 0, 0 ], [ 0, 4, 0, 0 ], [ 0, 0, 1, 0 ], [ 0, 0, 0, 1 ] ])->value, + 'Elementary Matrix with row multiple.'; + + my $E3 = Value::Matrix->E(4, [ 3, 2 ], -3); + is $E3->value, Matrix([ [ 1, 0, 0, 0 ], [ 0, 1, 0, 0 ], [ 0, -3, 1, 0 ], [ 0, 0, 0, 1 ] ])->value, + 'Elementary Matrix with row multiple and add.'; + +}; + +subtest 'Submatrix' => sub { + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); + my $s1 = $A->subMatrix([ 2 .. 3 ], [ 2 .. 4 ]); + my $sub1 = Matrix([ [ 6, 7, 8 ], [ 10, 11, 12 ] ]); + my $s2 = $A->subMatrix(2, 3); + my $sub2 = Matrix([ [ 1, 2, 4 ], [ 9, 10, 12 ] ]); + my $s3 = $A->subMatrix([ 3, 1, 2 ], [ 1, 4, 2 ]); + my $sub3 = Matrix([ [ 9, 12, 10 ], [ 1, 4, 2 ], [ 5, 8, 6 ] ]); + + is $s1->value, $sub1->value, 'Finding a submatrix giving the rows/cols in ordered form.'; + is $s2->value, $sub2->value, 'Finding a submatrix given the row/col to remove.'; + is $s3->value, $sub3->value, 'Finding a submatrix with rearranging rows/cols.'; + + like dies { + $A->subMatrix(-1, 2); + }, qr/The input -?\d+ is not a valid row/, 'check that error is thrown for an invalid row.'; + like dies { + $A->subMatrix(10, 2); + }, qr/The input -?\d+ is not a valid row/, 'check that error is thrown for an invalid row.'; + like dies { + $A->subMatrix(2, -3); + }, qr/The input -?\d+ is not a valid column/, 'check that error is thrown for an invalid column.'; + like dies { + $A->subMatrix(2, 10); + }, qr/The input -?\d+ is not a valid column/, 'check that error is thrown for an invalid column.'; + + like dies { + $A->subMatrix(1.1, 2); + }, qr/The input -?[\.\d]+ is not a valid row/, 'check that error is thrown for an non integer row.'; + like dies { + $A->subMatrix(1, 2.5); + }, qr/The input -?[\.\d]+ is not a valid column/, 'check that error is thrown for an non integer column.'; + + like dies { + $A->subMatrix([ 1, 1.1, 2 ], [ 2, 3 ]); + }, qr/The input -?[\.\d]+ is not a valid row/, 'check that error is thrown for an non integer row.'; + like dies { + $A->subMatrix([ 1, 2 ], [ 2.5, 3 ]); + }, qr/The input -?[\.\d]+ is not a valid column/, 'check that error is thrown for an non integer column.'; + + like dies { + $A->subMatrix([ 1, 2, 3 ], 2); + }, qr/The inputs must both be integers or array refs/, 'check that error is thrown for mixing inputs.'; +}; + +subtest 'Remove Row/Col' => sub { + my $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ] ]); + is $A->removeRow(2)->value, Matrix([ [ 1, 2, 3, 4 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ] ])->value, + 'remove a row from a matrix.'; + + like dies { + $A->removeRow(5); + }, qr/The input (.*) is not a valid row/, 'Testing for a row that doesn\'t exist.'; + + like dies { + Matrix([ [ [ 1, 2 ], [ 3, 10 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ])->removeRow(2); + }, qr/The method removeRow is only valid for 2D matrices\./, 'Try to remove a row of a 3D matrix.'; + + is $A->removeColumn(3)->value, Matrix([ [ 1, 2, 4 ], [ 5, 6, 8 ], [ 9, 10, 12 ], [ 13, 14, 16 ] ])->value, + 'Remove a column from a matrix.'; + + like dies { + $A->removeColumn(7); + }, qr/The input (.*) is not a valid column/, 'Testing for a column that doesn\'t exist.'; + + like dies { + Matrix([ [ [ 1, 2 ], [ 3, 10 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ])->removeColumn(2); + }, qr/The method removeColumn is only valid for 2D matrices\./, 'Try to remove a column of a 3D matrix.'; + +}; + +done_testing;