diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 5f53bf22f..07e3ff286 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -837,29 +837,155 @@ sub twiddle { return $self->make(@coords); } -=head3 C +=head3 C -Take the transpose of a matrix. +Apply this to a degree n Matrix, passing (m, k), and produce the degree (n-1) Matrix defined by +taking all entries whose position has mth index with value k. For example if C<$M> is a 4x5x6 +Matrix, then m can be 1, 2, or 3. If m is 2, then k can be 1, 2, 3, 4, or 5. C<$M-slice(2,3)> +is the 4x6 Matrix such that the entry at position (i,j) is the entry of C<$M> at position (i,3,j). Usage: $A = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); - $A->transpose; + $A->slice(1, 2) + # Index 1 identifies the 1st, 2nd, or 3rd row above, and with value 2 we get the second one: + # Matrix([5, 6, 7, 8]) + + $B = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]); + $B->slice(1, 2) + # Index 1 identifies the two arrays at depth 1, and with value 2 we get the second one: + # Matrix([ [ 5, 6 ], [ 7, 8 ] ]) + $B->slice(2, 1) + # Here we take all entries from $B where the 2nd index is 1: the 1 at position (1,1,1), + # the 2 at position (1,1,2), the 5 at position (2,1,1), and the 6 at position (2,1,2): + # Matrix([ [ 1, 2 ], [ 5, 6 ] ]) + $B->slice(3, 1) + # Here we take all entries from $B where the 3rd index is 1: the 1 at position (1,1,1), + # the 3 at position (1,2,1), the 5 at position (2,1,1), and the 7 at position (2,2,1): + # Matrix([ [ 1, 3 ], [ 5, 7 ] ]) =cut +sub slice { + my ($self, $index, $value) = @_; + my @d = $self->dimensions; + my $d = scalar(@d); + my $w = $d[0]; + Value::Error("index must be an integer from 1 to $d") unless ($index == int($index) && $index >= 1 && $index <= $d); + my $M = $self->data; + if ($index == 1) { + Value::Error("value must be an integer from 1 to $w") + unless ($value == int($value) && $value >= 1 && $value <= $w); + return $M->[ $value - 1 ]; + } else { + my @rows; + for (1 .. $w) { + push @rows, $M->[ $_ - 1 ]->slice($index - 1, $value); + } + return $self->make(@rows); + } +} + +=head3 C + +Take the transpose of a matrix. For a degree 1 Matrix, first promote to a degree 2 Matrix. +For a degree n Matrix, apply a permutation of the indices. The default permutation transposes the +last two indices. To specify a permutation, provide an array reference representing a cycle +or an array of array references that represents a product of cycles. If a permutation is not +specified, the default is the usual transposition of the last two indices. + +Usage: + + $A = Matrix([ + [ 1, 2, 3, 4 ], + [ 5, 6, 7, 8 ], + [ 9, 10, 11, 12 ] + ]); + $A->transpose + # will be + # [ + # [ 1, 5, 9 ], + # [ 2, 6, 10 ], + # [ 3, 7, 11 ], + # [ 4, 8, 12 ] + # ] + + $B = Matrix([ + [ [ 1, 2 ], [ 3, 4 ] ], + [ [ 5, 6 ], [ 7, 8 ] ] + ]); + $B->transpose([1, 2, 3]) + # will be + # [ + # [ [ 1, 3 ], [ 5, 7 ] ], + # [ [ 2, 4 ], [ 6, 8 ] ] + # ] + + $C = Matrix([ + [ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ], + [ [ [ 9, 10 ], [ 11, 12 ] ], [ [ 13, 14 ], [ 15, 16 ] ] ] + ]); + $C->transpose([ [ 1, 2], [3, 4] ]) + # will be + # [ + # [ [ [ 1, 3 ], [ 2, 4 ] ], [ [ 9, 11 ], [ 10, 12 ] ] ], + # [ [ [ 5, 7 ], [ 6, 8 ] ], [ [ 13, 15 ], [ 14, 16 ] ] ] + # ] +=cut + sub transpose { - my $self = promote(@_); + my $self = shift; + my $p = shift; my @d = $self->dimensions; - if (scalar(@d) == 1) { @d = (1, @d); $self = $self->make($self) } - Value::Error("Can't transpose %d-dimensional matrices", scalar(@d)) unless scalar(@d) == 2; + my $N = scalar(@d); + + # elevate a degree 1 Matrix to degree 2 + if ($N == 1) { @d = (1, @d); $N = 2; $self = $self->make($self) } + + # default to transpose last two indices + $p = [ [ $N - 1, $N ] ] unless $p; + + # build the permutation hash from cycles + my %p; + if (ref $p eq 'HASH') { + %p = %{$p}; + } else { + $p = [$p] unless ref($p->[0]); + my @p = (1 .. $N); + for my $cycle (@{$p}) { + next unless defined $cycle->[0]; + my $tmp = $p[ $cycle->[0] - 1 ]; + for my $i (0 .. $#{$cycle} - 1) { + $p[ $cycle->[$i] - 1 ] = $p[ $cycle->[ $i + 1 ] - 1 ]; + } + $p[ $cycle->[-1] - 1 ] = $tmp; + } + %p = map { $_ => $p[ $_ - 1 ] } (1 .. $N); + } + %p = reverse %p; my @M = (); - my $M = $self->data; - for my $j (0 .. $d[1] - 1) { - my @row = (); - for my $i (0 .. $d[0] - 1) { push(@row, $M->[$i]->data->[$j]) } - push(@M, $self->make(@row)); + if ($N == 2) { + return $self if ($p{1} == 1); + my $M = $self->data; + for my $j (0 .. $d[1] - 1) { + my @row = (); + for my $i (0 .. $d[0] - 1) { push(@row, $M->[$i]->data->[$j]) } + push(@M, $self->make(@row)); + } + } else { + # reduce the permutation hash + my @q = map { $p{$_} } (1 .. $N); + my $p1 = shift @q; + for (@q) { + $_-- if ($_ >= $p1); + } + my %q = map { $_ => $q[ $_ - 1 ] } (1 .. $N - 1); + + for my $j (1 .. $d[ $p1 - 1 ]) { + my $slice = $self->slice($p1, $j); + push(@M, $slice->class eq 'Matrix' ? $slice->transpose(\%q) : $slice); + } } return $self->make(@M); } diff --git a/t/math_objects/matrix.t b/t/math_objects/matrix.t index c2f42daa0..dfdc890c3 100644 --- a/t/math_objects/matrix.t +++ b/t/math_objects/matrix.t @@ -19,33 +19,31 @@ subtest 'Creating a degree 1 Matrix (row vector)' => sub { ok my $M1 = Matrix(1, 2, 3), 'Create a row vector'; is $M1->class, 'Matrix', 'M1 is a Matrix'; my $M2 = Compute('[1,2,3]'); - is $M2->class, 'Matrix', 'Creation using Compute results in a Matrix.'; + is $M2->class, 'Matrix', 'Creation using Compute results in a Matrix'; is [ $M1->value ], [ 1, 2, 3 ], 'M1 is the row matrix [1,2,3]'; is [ $M2->value ], [ 1, 2, 3 ], 'M2 is the row matrix [1,2,3]'; - is $M1->degree, 1, 'M1 is a degree 1 matrix.'; - is $M2->degree, 1, 'M2 is a degree 1 matrix.'; + is $M1->degree, 1, 'M1 is a degree 1 matrix'; + is $M2->degree, 1, 'M2 is a degree 1 matrix'; }; subtest 'Creating a degree 2 Matrix' => 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.'; + 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.'; + 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.'; - is $A->degree, 2, 'A is a degree 2 matrix.'; - is $C->degree, 2, 'C is a degree 2 matrix.'; + is $C->class, 'Matrix', 'Input using Compute is a Matrix'; + is $A->degree, 2, 'A is a degree 2 matrix'; + is $C->degree, 2, 'C is a degree 2 matrix'; }; subtest 'Creating a degree 3 Matrix (tensor)' => sub { my $values = [ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ]; ok my $M3 = Matrix([ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ]), 'Creation of a tensor'; - is $M3->class, 'Matrix', 'Checking the result is a Matrix'; - # is $M3->value, $values, 'yay'; - # print Dumper ref($M3->value); - is $M3->degree, 3, 'M3 is a degree 3 matrix.'; + is $M3->class, 'Matrix', 'Checking the result is a Matrix'; + is $M3->degree, 3, 'M3 is a degree 3 matrix'; }; subtest 'Get dimensions' => sub { @@ -57,51 +55,51 @@ subtest 'Get dimensions' => sub { 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.'; + 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 'Use isSquare, isOne, and isRow methods' => sub { my $A1 = Matrix([ 1, 2, 3, 4 ]); my $B1 = Matrix([1]); my $C1 = Matrix([2]); - ok !$A1->isSquare, 'The matrix A1 is not square.'; - ok $B1->isSquare, 'The matrix B1 is square.'; - ok $C1->isSquare, 'The matrix C1 is square.'; - ok !$A1->isOne, 'The matrix A1 is not an identity.'; - ok $B1->isOne, 'The matrix B1 is an identity.'; - ok !$C1->isOne, 'The matrix C1 is not an identity.'; - ok $A1->isRow, 'The matrix A1 is a row.'; - ok $B1->isRow, 'The matrix B1 is a row.'; - ok $C1->isRow, 'The matrix C1 is a row.'; + ok !$A1->isSquare, 'The matrix A1 is not square'; + ok $B1->isSquare, 'The matrix B1 is square'; + ok $C1->isSquare, 'The matrix C1 is square'; + ok !$A1->isOne, 'The matrix A1 is not an identity'; + ok $B1->isOne, 'The matrix B1 is an identity'; + ok !$C1->isOne, 'The matrix C1 is not an identity'; + ok $A1->isRow, 'The matrix A1 is a row'; + ok $B1->isRow, 'The matrix B1 is a row'; + ok $C1->isRow, 'The matrix C1 is a row'; my $A2 = Matrix([ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ]); my $B2 = Matrix([ 1, 0 ], [ 0, 1 ]); my $C2 = Matrix([ 2, 0 ], [ 1, 2 ]); - ok !$A2->isSquare, 'The matrix A2 is not square.'; - ok $B2->isSquare, 'The matrix B2 is square.'; - ok $C2->isSquare, 'The matrix C2 is square.'; - ok !$A2->isOne, 'The matrix A2 is not an identity.'; - ok $B2->isOne, 'The matrix B2 is an identity.'; - ok !$C2->isOne, 'The matrix C2 is not an identity.'; - ok !$A2->isRow, 'The matrix A2 is not a row.'; - ok !$B2->isRow, 'The matrix B2 is not a row.'; - ok !$C2->isRow, 'The matrix C2 is not a row.'; + ok !$A2->isSquare, 'The matrix A2 is not square'; + ok $B2->isSquare, 'The matrix B2 is square'; + ok $C2->isSquare, 'The matrix C2 is square'; + ok !$A2->isOne, 'The matrix A2 is not an identity'; + ok $B2->isOne, 'The matrix B2 is an identity'; + ok !$C2->isOne, 'The matrix C2 is not an identity'; + ok !$A2->isRow, 'The matrix A2 is not a row'; + ok !$B2->isRow, 'The matrix B2 is not a row'; + ok !$C2->isRow, 'The matrix C2 is not a row'; my $A3 = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ] ], [ [ 7, 8, 9 ], [ 10, 11, 12 ] ]); my $B3 = Matrix([ [ 1, 0 ], [ 0, 1 ] ], [ [ 1, 0 ], [ 0, 1 ] ]); my $C3 = Matrix([ [ 2, 0 ], [ 0, 1 ] ], [ [ 1, 0 ], [ 0, 1 ] ]); - ok !$A3->isSquare, 'The matrix A3 is not square.'; - ok $B3->isSquare, 'The matrix B3 is square.'; - ok $C3->isSquare, 'The matrix C3 is square.'; - ok !$A3->isOne, 'The matrix A3 is not an identity.'; - ok $B3->isOne, 'The matrix B3 is an identity.'; - ok !$C3->isOne, 'The matrix C3 is not an identity.'; - ok !$A3->isRow, 'The matrix A3 is not a row.'; - ok !$B3->isRow, 'The matrix B3 is not a row.'; - ok !$C3->isRow, 'The matrix C3 is not a row.'; + ok !$A3->isSquare, 'The matrix A3 is not square'; + ok $B3->isSquare, 'The matrix B3 is square'; + ok $C3->isSquare, 'The matrix C3 is square'; + ok !$A3->isOne, 'The matrix A3 is not an identity'; + ok $B3->isOne, 'The matrix B3 is an identity'; + ok !$C3->isOne, 'The matrix C3 is not an identity'; + ok !$A3->isRow, 'The matrix A3 is not a row'; + ok !$B3->isRow, 'The matrix B3 is not a row'; + ok !$C3->isRow, 'The matrix C3 is not a row'; }; subtest 'Use tests for triangular matrices' => sub { @@ -109,48 +107,47 @@ subtest 'Use tests for triangular matrices' => sub { my $A2 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], [ 13, 14, 15, 16 ] ]); my $A3 = Matrix($A1, $A1); my $A4 = Matrix($A2, $A1); - ok $A1->isUpperTriangular, 'test for upper triangular matrix'; - ok !$A2->isUpperTriangular, 'not an upper triangular matrix'; - ok $A3->isUpperTriangular, 'test for upper triangular degree 3 matrix'; - ok !$A4->isUpperTriangular, 'not an upper triangular degree 3 matrix'; + ok $A1->isUpperTriangular, 'Test for upper triangular matrix'; + ok !$A2->isUpperTriangular, 'Not an upper triangular matrix'; + ok $A3->isUpperTriangular, 'Test for upper triangular degree 3 matrix'; + ok !$A4->isUpperTriangular, 'Not an upper triangular degree 3 matrix'; my $B1 = Matrix([ [ 1, 0, 0, 0 ], [ 5, 6, 0, 0 ], [ 9, 10, 11, 0 ], [ 13, 14, 15, 16 ] ]); my $B2 = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ] ]); my $B3 = Matrix($B1, $B1); my $B4 = Matrix($B2, $B2); - ok $B1->isLowerTriangular, 'test for lower triangular matrix'; - ok !$B2->isLowerTriangular, 'not a lower triangular matrix.'; - ok $B3->isLowerTriangular, 'test for lower triangular degree 3 matrix'; - ok !$B4->isLowerTriangular, 'not a lower triangular degree 3 matrix.'; + ok $B1->isLowerTriangular, 'Test for lower triangular matrix'; + ok !$B2->isLowerTriangular, 'Not a lower triangular matrix'; + ok $B3->isLowerTriangular, 'Test for lower triangular degree 3 matrix'; + ok !$B4->isLowerTriangular, 'Not a lower triangular degree 3 matrix'; }; subtest 'Test if a Matrix is symmetric' => sub { my $A = Matrix(5); - ok $A->isSymmetric, 'test a degree 1 Matrix of length 1 is symmetric'; + ok $A->isSymmetric, 'Test a degree 1 Matrix of length 1 is symmetric'; my $B = Matrix([ 1, 2 ], [ 2, 3 ]); my $C = Matrix([ 1, 2 ], [ 3, 4 ]); - ok $B->isSymmetric, 'test a degree 2 symmetric Matrix'; - ok !$C->isSymmetric, 'test a degree 2 nonsymmetric Matrix'; + ok $B->isSymmetric, 'Test a degree 2 symmetric Matrix'; + ok !$C->isSymmetric, 'Test a degree 2 nonsymmetric Matrix'; my $D = Matrix($B, $B); my $E = Matrix($B, $C); - ok $D->isSymmetric, 'test a degree 3 symmetric Matrix'; - ok !$E->isSymmetric, 'test a degree 3 nonsymmetric Matrix'; + ok $D->isSymmetric, 'Test a degree 3 symmetric Matrix'; + ok !$E->isSymmetric, 'Test a degree 3 nonsymmetric Matrix'; }; subtest 'Test if a Matrix is orthogonal' => sub { my $A = Matrix(-1); my $B = Matrix( 2); - ok $A->isOrthogonal, 'test a degree 1 orthogonal Matrix'; - ok !$B->isOrthogonal, 'test a degree 1 nonorthogonal Matrix'; + ok $A->isOrthogonal, 'Test a degree 1 orthogonal Matrix'; + ok !$B->isOrthogonal, 'Test a degree 1 nonorthogonal Matrix'; my $C = Matrix([ 3 / 5, 4 / 5 ], [ -4 / 5, 3 / 5 ]); my $D = Matrix([ 1, 2 ], [ 3, 4 ]); - ok $C->isOrthogonal, 'test a degree 2 orthogonal Matrix'; - ok !$D->isOrthogonal, 'test a degree 2 nonorthogonal Matrix'; - # uncomment these once transposition is valid for higher degree Matrices - #my $E = Matrix($C, [ [ 0, 1 ], [ -1, 0 ] ]); - #my $F = Matrix($D, $C); - #ok $E->isOrthogonal, 'test a degree 3 orthogonal Matrix'; - #ok !$F->isOrthogonal, 'test a degree 3 nonorthogonal Matrix'; + ok $C->isOrthogonal, 'Test a degree 2 orthogonal Matrix'; + ok !$D->isOrthogonal, 'Test a degree 2 nonorthogonal Matrix'; + my $E = Matrix($C, [ [ 0, 1 ], [ -1, 0 ] ]); + my $F = Matrix($D, $C); + ok $E->isOrthogonal, 'Test a degree 3 orthogonal Matrix'; + ok !$F->isOrthogonal, 'Test a degree 3 nonorthogonal Matrix'; }; subtest 'Test if Matrix is in (R)REF' => sub { @@ -186,16 +183,15 @@ subtest 'Test if Matrix is in (R)REF' => sub { subtest 'Transpose a Matrix' => 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->TeX, $B->TeX, 'Test the tranpose of a matrix.'; + is $A->transpose->TeX, $B->TeX, 'Test the tranpose of a matrix'; my $row = Matrix([ 1, 2, 3, 4 ]); my $row_trans = Matrix([ [1], [2], [3], [4] ]); - is $row->transpose->TeX, $row_trans->TeX, 'Transpose of a degree 1 Matrix.'; + is $row->transpose->TeX, $row_trans->TeX, 'Transpose of a degree 1 Matrix'; 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."; + my $D = Matrix([ [ [ 1, 3 ], [ 2, 4 ] ], [ [ 5, 7 ], [ 6, 8 ] ] ]); + is $C->transpose->TeX, $D->TeX, 'Test the tranpose of a degree 3 tensor'; }; subtest 'Extract an element' => sub { @@ -203,20 +199,20 @@ subtest 'Extract an element' => sub { 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 degree 2 matrix.'; - is $A->element(3, 2), 10, 'extract an element from a degree 2 matrix.'; - is $B->element(1, 2, 1), 3, 'extract an element from a degree 3 matrix.'; - is $row->element(2), 2, 'extract an element from a degree 1 matrix.'; + is $A->element(1, 1), 1, 'Extract an element from a degree 2 matrix'; + is $A->element(3, 2), 10, 'Extract an element from a degree 2 matrix'; + is $B->element(1, 2, 1), 3, 'Extract an element from a degree 3 matrix'; + is $row->element(2), 2, 'Extract an element from a degree 1 matrix'; }; 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)->TeX, $col->TeX, 'Extract a column from a matrix.'; + is $A1->column(2)->TeX, $col->TeX, '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.'; + }, qr/Column must be a positive integer/, 'Test that an error is thrown for passing a non-positive integer'; }; subtest 'Construct an identity matrix' => sub { @@ -224,8 +220,8 @@ subtest 'Construct an identity matrix' => sub { 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->TeX, $B->TeX, 'Create a 3 x 3 identity matrix.'; - is $A->I->TeX, $B->TeX, 'Create a 3 x 3 identity matrix by using an existing matrix.'; + is $I->TeX, $B->TeX, 'Create a 3 x 3 identity matrix'; + is $A->I->TeX, $B->TeX, 'Create a 3 x 3 identity matrix by using an existing matrix'; }; subtest 'Construct a permutation matrix' => sub { @@ -247,33 +243,33 @@ subtest 'Construct a permutation matrix' => sub { my $P3 = $A->P([ 1, 4 ]); is $P3->TeX, Matrix([ [ 0, 0, 0, 1 ], [ 0, 1, 0, 0 ], [ 0, 0, 1, 0 ], [ 1, 0, 0, 0 ] ])->TeX, - 'Create a permutation matrix based on an existing matrix.'; + 'Create a permutation matrix based on an existing matrix'; }; subtest 'Construct a 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)->TeX, $Z1->TeX, 'Create a 3 by 4 zero matrix.'; - is Value::Matrix->Zero(4)->TeX, $Z2->TeX, 'Create a 4 by 4 zero matrix.'; + is Value::Matrix->Zero(3, 4)->TeX, $Z1->TeX, 'Create a 3 by 4 zero matrix'; + is Value::Matrix->Zero(4)->TeX, $Z2->TeX, '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->TeX, $Z1->TeX, 'Create a zero matrix with same size as the given one.'; + is $A1->Zero->TeX, $Z1->TeX, '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.'; + }, qr/Dimension must be a positive integer/, 'Test that an error is thrown for passing a non-positive integer'; }; subtest 'Add matrices' => sub { my $row1 = Matrix(1, 2, 3); my $row2 = Matrix(4, 5, 6); my $sum1 = Matrix(5, 7, 9); - ok $row1+ $row2 == $sum1, 'Checking the sum of two row matrices.'; + ok $row1+ $row2 == $sum1, 'Checking the sum of two row matrices'; my $A = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ]); my $B = Matrix([ [ 0, 1, 0 ], [ -1, 2, -3 ], [ -2, -1, 0 ] ]); my $sum2 = Matrix([ [ 1, 3, 3 ], [ 3, 7, 3 ], [ 5, 7, 9 ] ]); - ok $A+ $B == $sum2, 'Checking the sum of two 3 by 3 matrices.'; + ok $A+ $B == $sum2, 'Checking the sum of two 3 by 3 matrices'; #tensors my $M1 = Matrix([ [ [ 1, 0 ], [ 0, 1 ] ], [ [ 1, 0 ], [ 0, 1 ] ] ]); @@ -283,27 +279,27 @@ subtest 'Add matrices' => sub { my $row3 = Matrix([ 1, 2, 3, 4 ]); like dies { $row1 + $row3 }, qr/Can't add Matrices with different dimensions/, - 'Test that adding row matrices of different dimsensions throws an error.'; + 'Test that adding row matrices of different dimsensions throws an error'; my $C = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ] ]); like dies { $A + $C }, qr/Can't add Matrices with different dimensions/, - 'Test that adding matrices of different dimsensions throws an error.'; + 'Test that adding matrices of different dimsensions throws an error'; my $M4 = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ] ]); like dies { $M3 + $M4 }, qr/Can't add Matrices with different dimensions/, - 'Test that adding tensors of different dimsensions throws an error.'; + 'Test that adding tensors of different dimsensions throws an error'; }; subtest 'Subtract matrices' => sub { my $row1 = Matrix( 1, 2, 3); my $row2 = Matrix( 4, 5, 6); my $diff1 = Matrix(-3, -3, -3); - ok $row1 - $row2 == $diff1, 'Checking the difference of two row matrices.'; + ok $row1 - $row2 == $diff1, 'Checking the difference of two row matrices'; my $A = Matrix([ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ]); my $B = Matrix([ [ 0, 1, 0 ], [ -1, 2, -3 ], [ -2, -1, 0 ] ]); my $diff2 = Matrix([ [ 1, 1, 3 ], [ 5, 3, 9 ], [ 9, 9, 9 ] ]); - ok $A - $B == $diff2, 'Checking the difference of two 3 by 3 matrices.'; + ok $A - $B == $diff2, 'Checking the difference of two 3 by 3 matrices'; #tensors my $M1 = Matrix([ [ [ 1, 0 ], [ 0, 1 ] ], [ [ 1, 0 ], [ 0, 1 ] ] ]); @@ -313,15 +309,15 @@ subtest 'Subtract matrices' => sub { my $row3 = Matrix([ 1, 2, 3, 4 ]); like dies { $row1 - $row3 }, qr/Can't subtract Matrices with different dimensions/, - 'Test that subtracting row matrices of different dimsensions throws an error.'; + 'Test that subtracting row matrices of different dimsensions throws an error'; my $C = Matrix([ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ] ]); like dies { $A - $C }, qr/Can't subtract Matrices with different dimensions/, - 'Test that subtracting matrices of different dimsensions throws an error.'; + 'Test that subtracting matrices of different dimsensions throws an error'; my $M4 = Matrix([ [ [ 1, 2 ], [ 3, 4 ] ] ]); like dies { $M3 - $M4 }, qr/Can't subtract Matrices with different dimensions/, - 'Test that subtracting tensors of different dimsensions throws an error.'; + 'Test that subtracting tensors of different dimsensions throws an error'; }; subtest 'Multiply matrices' => sub { @@ -331,11 +327,11 @@ subtest 'Multiply matrices' => sub { my $prod1 = Matrix([ [ -8, 2, -6 ], [ -17, 8, -15 ], [ -26, 14, -24 ] ]); my $C = Matrix([ [ 1, -5, -2, -5 ], [ 0, -5, 5, -4 ], [ 4, 1, -1, 1 ] ]); my $prod2 = Matrix([ [ 13, -12, 5, -10 ], [ 28, -39, 11, -34 ], [ 43, -66, 17, -58 ] ]); - ok $A*$B == $prod1, 'Checking the product of two 3 by 3 matrices.'; + ok $A*$B == $prod1, 'Checking the product of two 3 by 3 matrices'; ok $A*$C == $prod2, 'Checking the product of a 3 by 3 and 3 by 4 matrix'; like dies { $C * $A }, qr/Matrices of dimensions \d+x\d+ and \d+x\d+ can't be multiplied/, - 'Test that multiplying row matrices of incompatible dimsensions throws an error.'; + 'Test that multiplying row matrices of incompatible dimsensions throws an error'; # multiply degree 2 and 1 matrices. @@ -358,11 +354,57 @@ subtest 'Construct an elementary matrix' => sub { my $E2 = Value::Matrix->E(4, [2], 3); is $E2->TeX, Matrix([ [ 1, 0, 0, 0 ], [ 0, 3, 0, 0 ], [ 0, 0, 1, 0 ], [ 0, 0, 0, 1 ] ])->TeX, - 'Elementary Matrix with row multiple.'; + 'Elementary Matrix with row multiple'; my $E3 = Value::Matrix->E(4, [ 3, 2 ], -3); is $E3->TeX, Matrix([ [ 1, 0, 0, 0 ], [ 0, 1, 0, 0 ], [ 0, -3, 1, 0 ], [ 0, 0, 0, 1 ] ])->TeX, - 'Elementary Matrix with row multiple and add.'; + 'Elementary Matrix with row multiple and add'; +}; + +subtest 'Extract a slice from a Matrix' => sub { + my $A = Matrix(1, 2, 3); + my $a = Real(3); + ok $a == $A->slice(1, 3), 'Get a slice from a degree 1 Matrix'; + + my $B = Matrix([ 2, 3, 4 ], [ 1, 2, 3 ]); + my $b = Matrix(3, 2); + ok $A == $B->slice(1, 2), 'Get a slice from a degree 2 Matrix'; + ok $b == $B->slice(2, 2), 'Get a slice from a degree 2 Matrix'; + + my $C = Matrix([ [ 2, 3, 4 ], [ 1, 2, 3 ] ], [ [ 2, 3, 4 ], [ 1, 2, 3 ] ], [ [ 1, 1, 1 ], [ 5, 6, 7 ] ]); + my $c = Matrix([ 2, 3, 4 ], [ 2, 3, 4 ], [ 1, 1, 1 ]); + my $d = Matrix([ 3, 2 ], [ 3, 2 ], [ 1, 6 ]); + ok $B == $C->slice(1, 1), 'Get a slice from a degree 3 Matrix'; + ok $c == $C->slice(2, 1), 'Get a slice from a degree 3 Matrix'; + ok $d == $C->slice(3, 2), 'Get a slice from a degree 3 Matrix'; +}; + +subtest 'Transpose a Matrix' => sub { + my $A = Matrix(1, 2); + my $At = Matrix([1], [2]); + ok $A->transpose == $At, 'Transpose a degree 1 matrix'; + + my $B = Matrix([ 1, 2, 3 ], [ 4, 5, 6 ]); + my $Bt = Matrix([ 1, 4 ], [ 2, 5 ], [ 3, 6 ]); + ok $B->transpose == $Bt, 'Transpose a degree 2 matrix'; + + my $C = Matrix($B, $B); + my $Ct = Matrix($Bt, $Bt); + ok $C->transpose == $Ct, 'Transpose a degree 3 matrix'; + + my $D = Matrix([ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ]); + my $Dt = Matrix([ [ 1, 3 ], [ 5, 7 ] ], [ [ 2, 4 ], [ 6, 8 ] ]); + ok $D->transpose([ 1, 2, 3 ]) == $Dt, 'Transpose a degree 3 matrix using a cycle'; + + my $E = Matrix( + [ [ [ 1, 2 ], [ 3, 4 ] ], [ [ 5, 6 ], [ 7, 8 ] ] ], + [ [ [ 9, 10 ], [ 11, 12 ] ], [ [ 13, 14 ], [ 15, 0 ] ] ] + ); + my $Et = Matrix( + [ [ [ 1, 3 ], [ 2, 4 ] ], [ [ 9, 11 ], [ 10, 12 ] ] ], + [ [ [ 5, 7 ], [ 6, 8 ] ], [ [ 13, 15 ], [ 14, 0 ] ] ] + ); + ok $E->transpose([ [ 1, 2 ], [ 3, 4 ] ]) == $Et, 'Transpose a degree 4 matrix using two cycles'; }; done_testing;