diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 5b1892cdd..282b4f168 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -1052,7 +1052,7 @@ perform row operations. =item * Row Swap -The method C<< Value::Matrix->E(n,[i, j]) >> returns the n by n elementary matrix that +The method C<< Value::Matrix->E(n,[i, j]) >> returns the n by n elementary matrix that upon right multiplication performs the row swap between rows C and C. Usage: @@ -1073,8 +1073,8 @@ where the size of the resulting matrix is the number of rows of C<$A>. =item * Multiply a row by a constant -The method C<< Value::Matrix->E(n, [i], k) >> returns the n by n elementary matrix that upon -right multiplication will multiply a row C, by constant C. +The method C<< Value::Matrix->E(n, [i], k) >> returns the n by n elementary matrix that upon +right multiplication will multiply a row C, by constant C. Usage: @@ -1342,6 +1342,151 @@ sub element { return $M->extract(@_); } +=head3 C + +Return a submatrix of a Matrix. If the indices are array referencess, the rows, columns, +etc. that are indicated are kept and used to return a Matrix of the same degree. Other +rows, columns, etc. are removed. + +Note this can be used to permute rows, columns, etc by specifying all rows, columns, etc. +in a different order. + +Each input can be an integer instead of an array reference, and the complement of that +integer is used for the rows to keep. In other words, using an integer for input indicates +that you wish for that one row, column, etc. to be removed. Using 0 as an input indicates +that all rows, columns, etc. for that dimension should be kept. + +You can mix and match using array references and integers. + +Usage: + + $A = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ]); + $A->subMatrix([2 .. 3], [2 .. 4]); # returns Matrix([ 6, 7, 8 ], [ 10, 11, 12 ]) + $A->subMatrix(2, 3); # returns Matrix([ 1, 2, 4 ], [ 9, 10, 12 ]); + $A->subMatrix([1], 0); # returns Matrix([ [ 1, 2, 3, 4 ] ]); + $A->subMatrix([3, 1, 2], [1, 4, 2]); # returns Matrix([ 9, 12, 10 ], [ 1, 4, 2 ] ,[ 5, 8, 6 ]); + +This can also be used on Matrix objects that are not degree 2. + + $B = Matrix(2, 4, 6, 8); + $B->subMatrix([1, 3]); # returns Matrix(2, 6); + $B->subMatrix(2); # returns Matrix(2, 6, 8); + + $C = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); + $C->subMatrix(0, 1, [1, 3]); # returns Matrix([ [ 4, 6 ] ], [ [ 10, 12 ] ]); + $C->subMatrix(1, 2, 3); # returns Matrix([ [ [ 7, 8 ] ] ]); + +=cut + +sub subMatrix { + my ($self, @ind) = @_; + my @dim = $self->dimensions; + my $degree = scalar @dim; + + # indices to keep for submatrix + my @indices; + + # check that the input is appropriate for the size of the matrix + Value::Error("There must be $degree arguments") unless $#dim == $#ind; + + # convert any integer arguments to array references + for my $i (0 .. $#ind) { + if (ref $ind[$i] eq 'ARRAY') { + push @indices, $ind[$i]; + } else { + # check that $ind[$i] is an integer in the appopriate range + Value::Error("The input $ind[$i] is not a valid index") + unless $ind[$i] =~ /^\d+$/ && $ind[$i] >= 0 && $ind[$i] <= $dim[$i]; + push @indices, [ grep { $_ != $ind[$i] } (1 .. $dim[$i]) ]; + } + } + + # check that all indices are integers in the appropriate range and that all array references are nonempty + for my $i (0 .. $#indices) { + Value::Error("Cannot use empty array reference for indices to keep") unless (@{ $indices[$i] }); + for my $j (@{ $indices[$i] }) { + Value::Error("The input $j is not a valid index") unless $j =~ /^\d+$/ && $j >= 1 && $j <= $dim[$i]; + } + } + + sub extractElements { + my ($self, $indices, $elements) = @_; + + # these need to be copies of the array arguments + my @ind_copy = @$indices; + my @elements_copy = @$elements; + + my $ind = shift @elements_copy; + push(@ind_copy, [ 1 .. scalar(@$ind) ]); + + my @M; + for my $i (@$ind) { + push(@M, + ref $self->element($i) eq 'Value::Matrix' + ? $self->element($i)->extractElements(\@ind_copy, \@elements_copy) + : $self->element($i)); + } + + return $self->make($self->context, @M); + } + + return $self->extractElements([], \@indices); +} + +=head3 C + +Return a new Matrix, where a row has been removed from a Matrix. This is only valid for Matrix +Math Objects with degree 2 or higher. Removing a ith "row" from a Matrix of degree 3 or higher +means to remove all entries with first index i. + +Usage: + + $A = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16]); + $A->removeRow(3); # returns Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [13, 14, 15, 16]); + + $B = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); + $B->removeRow(2); # returns Matrix([ [ [ 1, 2, 3 ], [ 4, 5, 6 ] ] ]); + +=cut + +sub removeRow { + my ($self, $r) = @_; + my @dim = $self->dimensions; + my $degree = scalar @dim; + Value::Error("removeRow cannot be used on a Matrix of degree 1") if $degree == 1; + my @indices = map { [ 1 .. $_ ] } @dim; + Value::Error("Can only remove rows 1 through $indices[0][-1]") + unless $r >= 1 && $r <= $indices[0][-1] && $r =~ /^\d+$/; + return $self->subMatrix([ grep { $_ != $r } @{ $indices[0] } ], @indices[ 1 .. $#indices ]); +} + +=head3 C + +Return a new Matrix, where a column has been removed from a Matrix. This is only valid for Matrix +Math Objects with degree 2 or higher. Removing a jth "column" from a Matrix of degree 3 or higher +means to remove all entries with second index j. + +Usage: + + $A = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [13, 14, 15, 16]); + $A->removeColumn(3); # returns Matrix([ 1, 2, 4 ], [ 5, 6, 8 ], [ 9, 10, 12 ], [13, 14, 16]); + + $B = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); + $B->removeColumn(2); # returns Matrix([ [ 1, 2, 3 ] ], [ [ 7, 8, 9 ] ]); + +=cut + +sub removeColumn { + my ($self, $r) = @_; + my @dim = $self->dimensions; + my $degree = scalar @dim; + Value::Error("removeColumn cannot be used on a Matrix of degree 1") if $degree == 1; + my @indices = map { [ 1 .. $_ ] } @dim; + Value::Error("Can only remove columns 1 through $indices[1][-1]") + unless $r >= 1 && $r <= $indices[1][-1] && $r =~ /^\d+$/; + return $self->subMatrix($indices[0], [ grep { $_ != $r } @{ $indices[1] } ], @indices[ 2 .. $#indices ]); +} + # @@@ assign @@@ # @@@ removeRow, removeColumn @@@ # @@@ Minor @@@ diff --git a/t/math_objects/matrix.t b/t/math_objects/matrix.t index 32dfe3d45..7e7f534ea 100644 --- a/t/math_objects/matrix.t +++ b/t/math_objects/matrix.t @@ -215,6 +215,125 @@ subtest 'Extract a column' => sub { }, qr/Column must be a positive integer/, 'Test that an error is thrown for passing a non-positive integer'; }; +subtest 'Submatrix' => sub { + my $A = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ]); + is $A->subMatrix([ 2 .. 3 ], [ 2 .. 4 ])->TeX, Matrix([ 6, 7, 8 ], [ 10, 11, 12 ])->TeX, + 'Submatrix from specifing rows/cols to keep'; + is $A->subMatrix(2, 3)->TeX, Matrix([ 1, 2, 4 ], [ 9, 10, 12 ])->TeX, + 'Submatrix from specifing row/col to remove'; + is $A->subMatrix([1], 0)->TeX, Matrix([ [ 1, 2, 3, 4 ] ])->TeX, + 'Submatrix from specifing rows/cols with mixed syntax'; + is $A->subMatrix([ 3, 1, 2 ], [ 1, 4, 2 ])->TeX, Matrix([ 9, 12, 10 ], [ 1, 4, 2 ], [ 5, 8, 6 ])->TeX, + 'Submatrix from permuting rows and columns, droppping one column'; + + my $B = Matrix(2, 4, 6, 8); + is $B->subMatrix([ 1, 3 ])->TeX, Matrix(2, 6)->TeX, + 'Submatrix of degree 1 matrix from specifing entries to keep'; + is $B->subMatrix(2)->TeX, Matrix(2, 6, 8)->TeX, 'Submatrix of degree 1 matrix from specifing entry to remove'; + + my $C = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); + is $C->subMatrix(0, 1, [ 1, 3 ])->TeX, Matrix([ [ 4, 6 ] ], [ [ 10, 12 ] ])->TeX, + 'Submatrix of degree 3 matrix from specifing indices to keep'; + is $C->subMatrix(1, 2, 3)->TeX, Matrix([ [ [ 7, 8 ] ] ])->TeX, + 'Submatrix of degree 3 matrix from specifing indices to remove'; + + like dies { + $A->subMatrix(1, 1, 1); + }, qr/There must be 2 arguments/, 'check that error is thrown for too many arguments.'; + like dies { + $A->subMatrix(1); + }, qr/There must be 2 arguments/, 'check that error is thrown for too few arguments.'; + + like dies { + $A->subMatrix(-1, 2); + }, qr/The input -1 is not a valid index/, 'check that error is thrown for an invalid integer argument.'; + like dies { + $A->subMatrix(1.5, 2); + }, qr/The input 1\.5 is not a valid index/, 'check that error is thrown for an invalid integer argument.'; + like dies { + $A->subMatrix(1, 5); + }, qr/The input 5 is not a valid index/, 'check that error is thrown for an invalid integer argument.'; + like dies { + $A->subMatrix(1, 'a'); + }, qr/The input a is not a valid index/, 'check that error is thrown for an invalid integer argument.'; + like dies { + $A->subMatrix(1, []); + }, qr/Cannot use empty array reference for indices to keep/, + 'check that error is thrown for empty array reference argument.'; + like dies { + $A->subMatrix([ 1, 1.1, 2 ], [ 2, 3 ]); + }, qr/The input 1\.1 is not a valid index/, 'check that error is thrown for an non integer row.'; + like dies { + $A->subMatrix([ 1, 2 ], [ 2.5, 3 ]); + }, qr/The input 2\.5 is not a valid index/, 'check that error is thrown for an non integer column.'; + like dies { + $A->subMatrix([ 0, 1 ], [ 2, 3 ]); + }, qr/The input 0 is not a valid index/, 'check that error is thrown for zero in an array ref.'; + like dies { + $A->subMatrix([ -2, 1 ], [ 2, 3 ]); + }, qr/The input -2 is not a valid index/, + 'check that error is thrown for integer in an array ref that is out of bounds.'; + like dies { + $A->subMatrix([ 5, 1 ], [ 2, 3 ]); + }, qr/The input 5 is not a valid index/, + 'check that error is thrown for integer in an array ref that is out of bounds.'; +}; + +subtest 'Remove row' => sub { + my $A = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ]); + is $A->removeRow(3)->TeX, Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 13, 14, 15, 16 ])->TeX, + 'Remove a row from a degree 2 Matrix'; + + my $B = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); + is $B->removeRow(2)->TeX, Matrix([ [ [ 1, 2, 3 ], [ 4, 5, 6 ] ] ])->TeX, 'Remove a row from a degree 3 Matrix'; + + my $C = Matrix(1, 2, 3); + like dies { + $C->removeRow(1); + }, qr/cannot be used on a Matrix of degree 1/, + 'check that error is thrown if removeRow used on degree 1 Matrix'; + like dies { + $A->removeRow(0); + }, qr/Can only remove rows 1 through 4/, 'check that error is thrown for bad row specification'; + like dies { + $A->removeRow(5); + }, qr/Can only remove rows 1 through 4/, 'check that error is thrown for bad row specification'; + like dies { + $A->removeRow(1.5); + }, qr/Can only remove rows 1 through 4/, 'check that error is thrown for bad row specification'; + like dies { + $A->removeRow('a'); + }, qr/Can only remove rows 1 through 4/, 'check that error is thrown for bad row specification'; +}; + +subtest 'Remove column' => sub { + my $A = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ]); + is $A->removeColumn(3)->TeX, Matrix([ 1, 2, 4 ], [ 5, 6, 8 ], [ 9, 10, 12 ], [ 13, 14, 16 ])->TeX, + 'Remove a column from a degree 2 Matrix'; + + my $B = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); + is $B->removeColumn(2)->TeX, Matrix([ [ 1, 2, 3 ] ], [ [ 7, 8, 9 ] ])->TeX, + 'Remove a column from a degree 3 Matrix'; + + my $C = Matrix(1, 2, 3); + like dies { + $C->removeColumn(1); + }, qr/cannot be used on a Matrix of degree 1/, + 'check that error is thrown if removeColumn used on degree 1 Matrix'; + like dies { + $A->removeColumn(0); + }, qr/Can only remove columns 1 through 4/, 'check that error is thrown for bad column specification'; + like dies { + $A->removeColumn(5); + }, qr/Can only remove columns 1 through 4/, 'check that error is thrown for bad column specification'; + like dies { + $A->removeColumn(1.5); + }, qr/Can only remove columns 1 through 4/, 'check that error is thrown for bad column specification'; + like dies { + $A->removeColumn('a'); + }, qr/Can only remove columns 1 through 4/, 'check that error is thrown for bad column specification'; +}; + subtest 'Construct an identity matrix' => sub { my $I = Value::Matrix->I(3); my $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]);