Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
151 changes: 148 additions & 3 deletions lib/Value/Matrix.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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<i> and C<j>.

Usage:
Expand All @@ -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<i>, by constant C<k>.
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<i>, by constant C<k>.

Usage:

Expand Down Expand Up @@ -1342,6 +1342,151 @@ sub element {
return $M->extract(@_);
}

=head3 C<subMatrix>

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<removeRow>

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<removeColumn>

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 @@@
Expand Down
119 changes: 119 additions & 0 deletions t/math_objects/matrix.t
Original file line number Diff line number Diff line change
Expand Up @@ -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 ] ]);
Expand Down
Loading