From 1a1af3a684133dbc90da5377c50d50023cf5e9b4 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Wed, 27 May 2026 17:23:46 -0700 Subject: [PATCH 1/3] subMatrix method for Matrix Math Objects --- lib/Value/Matrix.pm | 81 +++++++++++++++++++++++++++++++++++++++++ t/math_objects/matrix.t | 59 ++++++++++++++++++++++++++++++ 2 files changed, 140 insertions(+) diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 5b1892cdd..bf51c9f2c 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -1342,6 +1342,87 @@ sub element { return $M->extract(@_); } +=head3 C + +Return a submatrix of a Matrix. If the indices are array refs, the given rows and +columns (or more) of the Matrix are returned as a Matrix of the same degree. + +Note this can be used to permute rows/columns/etc by including all rows/columns/etc +in a different order. + +If the input are integers, then return submatrix with those rows/columns/etc removed. + +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([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([1, 2], [1, 2], [1, 3]); # returns Matrix([ [ [ 1, 3 ], [ 4, 6 ] ], [ [ 7, 9 ], [ 10, 12 ] ] ]); + $C->subMatrix(1, 2, 3); # returns Matrix([ [ [ 7, 8 ] ] ]); + +=cut + +sub subMatrix { + my ($self, @ind) = @_; + my @dim = $self->dimensions; + my @indices; # Indices to keep for submatrix. + + # check that the input is appropriate for the size of the matrix. + Value::Error("The indices must be array refs the same size as the dimension of the matrix.") unless $#dim == $#ind; + + # check that inputs are either all integers or all array refs + my @index_types = keys %{ { map { ref $_, 1 } @ind } }; + + Value::Error('The inputs must both be integers or array refs.') + unless scalar(@index_types) == 1 && ($index_types[0] eq '' || $index_types[0] eq 'ARRAY'); + + for my $i (0 .. $#ind) { + if ($index_types[0] eq '') { # input is a scalar (integer) + Value::Error("The input $ind[$i] is not a valid index") + unless $ind[$i] >= 1 && $ind[$i] <= $dim[$i] && int($ind[$i]) == $ind[$i]; + push(@indices, [ grep { $_ != $ind[$i] } (1 .. $dim[$i]) ]); + + } elsif ($index_types[0] eq 'ARRAY') { # input are array refs + for my $j (@{ $ind[$i] }) { + Value::Error("The input $j is not a valid index") unless int($j) == $j && $j >= 1 && $j <= $dim[$i]; + } + push(@indices, $ind[$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); +} + # @@@ assign @@@ # @@@ removeRow, removeColumn @@@ # @@@ Minor @@@ diff --git a/t/math_objects/matrix.t b/t/math_objects/matrix.t index 32dfe3d45..26dbbd4e0 100644 --- a/t/math_objects/matrix.t +++ b/t/math_objects/matrix.t @@ -215,6 +215,65 @@ 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 ] ]); + 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->TeX, $sub1->TeX, 'Finding a submatrix giving the rows/cols in ordered form.'; + is $s2->TeX, $sub2->TeX, 'Finding a submatrix given the row/col to remove.'; + is $s3->TeX, $sub3->TeX, 'Finding a submatrix with rearranging rows/cols.'; + + my $B = Matrix([ 2, 4, 6, 8 ]); + + is $B->subMatrix([3])->TeX, Matrix([6])->TeX, 'Finding a submatrix of a 1D matrix by passing in arrayref'; + is $B->subMatrix(3)->TeX, Matrix([ 2, 4, 8 ])->TeX, + 'Finding a submatrix of a 1D matrix by passing in an integer'; + + my $B3 = Matrix([ [ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ] ]); + my $B3sub1 = Matrix([ [ [ 1, 3 ], [ 4, 6 ] ], [ [ 7, 9 ], [ 10, 12 ] ] ]); + my $B3sub2 = Matrix([ [ [ 7, 8 ] ] ]); + is $B3->subMatrix([ 1, 2 ], [ 1, 2 ], [ 1, 3 ])->TeX, $B3sub1->TeX, + 'Finding a submatrix of a 3D matrix by specifying indices.'; + is $B3->subMatrix(1, 2, 3)->TeX, $B3sub2->TeX, + 'Finding a submatrix of a 3D matrix by specifying integers (indices to eliminate).'; + + like dies { + $A->subMatrix(-1, 2); + }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid row.'; + like dies { + $A->subMatrix(10, 2); + }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid row.'; + like dies { + $A->subMatrix(2, -3); + }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid column.'; + like dies { + $A->subMatrix(2, 10); + }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid column.'; + + like dies { + $A->subMatrix(1.1, 2); + }, qr/The input -?[\.\d]+ is not a valid index/, '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 index/, '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 index/, '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 index/, '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 'Construct an identity matrix' => sub { my $I = Value::Matrix->I(3); my $B = Matrix([ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]); From 7c81d67aa8782c4d1b54136d09b3d7f9c7b083fc Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Thu, 28 May 2026 10:34:27 -0700 Subject: [PATCH 2/3] changes to subMatrix method --- lib/Value/Matrix.pm | 64 ++++++++++++++++------------ t/math_objects/matrix.t | 93 ++++++++++++++++++++++------------------- 2 files changed, 86 insertions(+), 71 deletions(-) diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index bf51c9f2c..9a1afa099 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -1344,65 +1344,75 @@ sub element { =head3 C -Return a submatrix of a Matrix. If the indices are array refs, the given rows and -columns (or more) of the Matrix are returned as a Matrix of the same degree. +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 including all rows/columns/etc +Note this can be used to permute rows, columns, etc by specifying all rows, columns, etc. in a different order. -If the input are integers, then return submatrix with those rows/columns/etc removed. +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]); + $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([1, 2], [1, 2], [1, 3]); # returns Matrix([ [ [ 1, 3 ], [ 4, 6 ] ], [ [ 7, 9 ], [ 10, 12 ] ] ]); + $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 @indices; # Indices to keep for submatrix. - - # check that the input is appropriate for the size of the matrix. - Value::Error("The indices must be array refs the same size as the dimension of the matrix.") unless $#dim == $#ind; + my @dim = $self->dimensions; + my $degree = scalar @dim; - # check that inputs are either all integers or all array refs - my @index_types = keys %{ { map { ref $_, 1 } @ind } }; + # indices to keep for submatrix + my @indices; - Value::Error('The inputs must both be integers or array refs.') - unless scalar(@index_types) == 1 && ($index_types[0] eq '' || $index_types[0] eq 'ARRAY'); + # 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 ($index_types[0] eq '') { # input is a scalar (integer) + 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] >= 1 && $ind[$i] <= $dim[$i] && int($ind[$i]) == $ind[$i]; - push(@indices, [ grep { $_ != $ind[$i] } (1 .. $dim[$i]) ]); + unless $ind[$i] =~ /^\d+$/ && $ind[$i] >= 0 && $ind[$i] <= $dim[$i]; + push @indices, [ grep { $_ != $ind[$i] } (1 .. $dim[$i]) ]; + } + } - } elsif ($index_types[0] eq 'ARRAY') { # input are array refs - for my $j (@{ $ind[$i] }) { - Value::Error("The input $j is not a valid index") unless int($j) == $j && $j >= 1 && $j <= $dim[$i]; - } - push(@indices, $ind[$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. + # these need to be copies of the array arguments my @ind_copy = @$indices; my @elements_copy = @$elements; diff --git a/t/math_objects/matrix.t b/t/math_objects/matrix.t index 26dbbd4e0..38acea4a4 100644 --- a/t/math_objects/matrix.t +++ b/t/math_objects/matrix.t @@ -216,62 +216,67 @@ subtest 'Extract a column' => sub { }; 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->TeX, $sub1->TeX, 'Finding a submatrix giving the rows/cols in ordered form.'; - is $s2->TeX, $sub2->TeX, 'Finding a submatrix given the row/col to remove.'; - is $s3->TeX, $sub3->TeX, 'Finding a submatrix with rearranging rows/cols.'; - - my $B = Matrix([ 2, 4, 6, 8 ]); - - is $B->subMatrix([3])->TeX, Matrix([6])->TeX, 'Finding a submatrix of a 1D matrix by passing in arrayref'; - is $B->subMatrix(3)->TeX, Matrix([ 2, 4, 8 ])->TeX, - 'Finding a submatrix of a 1D matrix by passing in an integer'; - - my $B3 = Matrix([ [ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ] ]); - my $B3sub1 = Matrix([ [ [ 1, 3 ], [ 4, 6 ] ], [ [ 7, 9 ], [ 10, 12 ] ] ]); - my $B3sub2 = Matrix([ [ [ 7, 8 ] ] ]); - is $B3->subMatrix([ 1, 2 ], [ 1, 2 ], [ 1, 3 ])->TeX, $B3sub1->TeX, - 'Finding a submatrix of a 3D matrix by specifying indices.'; - is $B3->subMatrix(1, 2, 3)->TeX, $B3sub2->TeX, - 'Finding a submatrix of a 3D matrix by specifying integers (indices to eliminate).'; + 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, 2); - }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid row.'; + $A->subMatrix(1, 1, 1); + }, qr/There must be 2 arguments/, 'check that error is thrown for too many arguments.'; like dies { - $A->subMatrix(10, 2); - }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid row.'; + $A->subMatrix(1); + }, qr/There must be 2 arguments/, 'check that error is thrown for too few arguments.'; + like dies { - $A->subMatrix(2, -3); - }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid column.'; + $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(2, 10); - }, qr/The input -?\d+ is not a valid index/, 'check that error is thrown for an invalid column.'; - + $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.1, 2); - }, qr/The input -?[\.\d]+ is not a valid index/, 'check that error is thrown for an non integer row.'; + $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, 2.5); - }, qr/The input -?[\.\d]+ is not a valid index/, 'check that error is thrown for an non integer column.'; - + $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 -?[\.\d]+ is not a valid index/, 'check that error is thrown for an non integer row.'; + }, 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 -?[\.\d]+ is not a valid index/, 'check that error is thrown for an non integer column.'; - + }, 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([ 1, 2, 3 ], 2); - }, qr/The inputs must both be integers or array refs/, 'check that error is thrown for mixing inputs.'; + $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 'Construct an identity matrix' => sub { From bae317a496768403c9a4e50548d6e95ae2734257 Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Thu, 28 May 2026 10:56:07 -0700 Subject: [PATCH 3/3] removeRow and removeColumn methods --- lib/Value/Matrix.pm | 60 ++++++++++++++++++++++++++++++++++++++--- t/math_objects/matrix.t | 55 +++++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+), 3 deletions(-) diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 9a1afa099..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: @@ -1433,6 +1433,60 @@ sub subMatrix { 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 38acea4a4..7e7f534ea 100644 --- a/t/math_objects/matrix.t +++ b/t/math_objects/matrix.t @@ -279,6 +279,61 @@ subtest 'Submatrix' => sub { '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 ] ]);