Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
946 lines (791 sloc) 31 KB
package Math::GSL::Matrix::Test;
use base q{Test::Class};
use Test::Most;
use strict;
use warnings;
use Math::GSL qw/:all/;
use Math::GSL::Test qw/:all/;
use Math::GSL::Matrix qw/:all/;
use Math::GSL::Vector qw/:all/;
use Math::GSL::Complex qw/:all/;
use Math::GSL::Errno qw/:all/;
use Test::Exception;
use Math::Complex;
use Data::Dumper;
BEGIN{ gsl_set_error_handler_off(); }
sub make_fixture : Test(setup) {
my $self = shift;
$self->{matrix} = gsl_matrix_alloc(5,5);
$self->{obj} = Math::GSL::Matrix->new(5,5);
gsl_matrix_set_zero($self->{matrix});
}
sub teardown : Test(teardown) {
unlink 'matrix' if -f 'matrix';
}
sub GSL_MATRIX_ALLOC : Tests {
my $matrix = gsl_matrix_alloc(5,5);
isa_ok($matrix, 'Math::GSL::Matrix');
}
sub GSL_MATRIX_SET : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
ok_similar( [ @got ], [ map { $_**2 } (0..4) ] );
}
sub GSL_MATRIX_CALLOC : Tests {
my $matrix = gsl_matrix_calloc(5,5);
isa_ok($matrix, 'Math::GSL::Matrix');
my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
ok_similar( [ @got ], [ (0) x 5 ], 'gsl_matrix_calloc' );
}
sub GSL_MATRIX_FREE : Tests {
my $matrix = gsl_matrix_calloc(5,5);
isa_ok($matrix, 'Math::GSL::Matrix');
is(gsl_matrix_get($matrix, 0, 0), 0);
gsl_matrix_free($matrix);
}
sub GSL_MATRIX_SUBMATRIX : Tests {
my $matrix = gsl_matrix_alloc(5,5);
map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
my $subMatrix = gsl_matrix_submatrix($matrix, 0, 0, 2, 2);
my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..2);
ok_similar( [ @got ], [ 0..2 ] );
}
sub GSL_MATRIX_ROW : Tests {
my $self = shift;
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $_,$line, $_) } (0..4);
}
my $vector_view = gsl_matrix_row($self->{matrix}, 2);
my @got = map { gsl_vector_get($vector_view->{vector}, $_) } (0..4);
ok_similar( [ @got ], [ (2)x 5], 'gsl_matrix_row' );
}
sub GSL_MATRIX_COLUMN : Tests {
my $self = shift;
my $view = gsl_vector_alloc(5);
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line,$_, $line*$_) } (0..4);
}
$view = gsl_matrix_column($self->{matrix}, 2);
my $vec = $view->swig_vector_get();
my @got = map { gsl_vector_get($vec, $_) } (0..4);
ok_similar( [ @got ], [0,2,4,6,8 ], 'gsl_matrix_column' );
}
sub GSL_MATRIX_DIAGONAL : Tests {
my $matrix = gsl_matrix_alloc(4,4);
map { gsl_matrix_set($matrix, $_,$_, $_) } (0..3);
my $view = gsl_matrix_diagonal($matrix);
# better interface is needed
my $vec = $view->swig_vector_get();
my @got = map { gsl_vector_get($vec, $_) } (0..3);
ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_diagonal');
}
sub GSL_MATRIX_SUBDIAGONAL : Tests {
my $matrix = gsl_matrix_alloc(4,4);
map { gsl_matrix_set($matrix, $_,$_, $_) } (0..3);
my $view = gsl_matrix_subdiagonal($matrix, 0);
my $vec = $view->swig_vector_get();
my @got = map { gsl_vector_get($vec, $_) } (0..3);
ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_subdiagonal');
}
sub GSL_MATRIX_SWAP : Tests {
my $self=shift;
map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
my $matrix = gsl_matrix_alloc(5,5);
map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
ok_status(gsl_matrix_swap($self->{matrix}, $matrix));
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], $_) } (0..4);
@got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
map { is($got[$_], $_** 2) } (0..4);
}
sub GSL_MATRIX_MEMCPY : Tests {
my $self = shift;
my $matrix = gsl_matrix_alloc(5,5);
map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
ok_status(gsl_matrix_memcpy($matrix, $self->{matrix}));
ok_similar( [ map { gsl_matrix_get($matrix, $_, $_) } (0..4) ],
[ map { $_** 2 } (0..4) ]
);
}
sub GSL_MATRIX_SWAP_ROWS : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
map { gsl_matrix_set($self->{matrix}, 1,$_, 3) } (0..4);
ok_status(gsl_matrix_swap_rows($self->{matrix}, 0, 1));
my @got = map { gsl_matrix_get($self->{matrix}, 1, $_) } (0..4);
map { is($got[$_], $_) } (0..4);
@got = map { gsl_matrix_get($self->{matrix}, 0, $_) } (0..4);
map { is($got[$_], 3) } (0..4);
}
sub GSL_MATRIX_SWAP_COLUMNS : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_,0, $_) } (0..4);
map { gsl_matrix_set($self->{matrix}, $_,1, 3) } (0..4);
ok_status(gsl_matrix_swap_columns($self->{matrix}, 0, 1));
my @got = map { gsl_matrix_get($self->{matrix}, $_, 1) } (0..4);
map { is($got[$_], $_) } (0..4);
@got = map { gsl_matrix_get($self->{matrix}, $_, 0) } (0..4);
map { is($got[$_], 3) } (0..4);
}
sub GSL_MATRIX_SWAP_ROWCOL : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
map { gsl_matrix_set($self->{matrix}, $_,2, 2) } (0..4);
ok_status(gsl_matrix_swap_rowcol($self->{matrix}, 0, 2));
my @got = map { gsl_matrix_get($self->{matrix}, $_, 2) } (0..4);
is_deeply( [ @got ], [ qw/2 1 0 3 4/ ] );
@got = map { gsl_matrix_get($self->{matrix}, 0, $_) } (0..4);
is_deeply( [ @got ], [ qw/2 2 2 2 2/ ] );
}
sub GSL_MATRIX_TRANSPOSE_MEMCPY : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
my $matrix = gsl_matrix_alloc(5,5);
ok_status(gsl_matrix_transpose_memcpy($matrix, $self->{matrix}));
my @got = map { gsl_matrix_get($matrix, $_, 0) } (0..4);
map { is($got[$_], $_) } (0..4);
}
sub GSL_MATRIX_TRANSPOSE : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
is(gsl_matrix_transpose($self->{matrix}), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, 0) } (0..4);
map { is($got[$_], $_) } (0..4);
}
sub GSL_MATRIX_ADD : Tests {
my $self = shift;
my $matrix = gsl_matrix_alloc(5, 5);
map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
is(gsl_matrix_add($self->{matrix}, $matrix), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], $_*2) } (0..4);
}
sub GSL_MATRIX_SUB : Tests {
my $self = shift;
my $matrix = gsl_matrix_alloc(5, 5);
map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
is(gsl_matrix_sub($self->{matrix}, $matrix), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], 0) } (0..4);
}
sub GSL_MATRIX_MUL_ELEMENTS : Tests {
my $self = shift;
my $matrix = gsl_matrix_alloc(5, 5);
map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
is(gsl_matrix_mul_elements($self->{matrix}, $matrix), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], $_**2) } (0..4);
}
sub GSL_MATRIX_DIV_ELEMENTS : Tests {
my $self = shift;
my $matrix = gsl_matrix_alloc(5, 5);
map { gsl_matrix_set($self->{matrix}, $_, $_, $_+1) } (0..4);
map { gsl_matrix_set($matrix, $_, $_, $_+1) } (0..4);
is(gsl_matrix_div_elements($self->{matrix}, $matrix), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], 1) } (0..4);
}
sub GSL_MATRIX_SCALE : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
is(gsl_matrix_scale($self->{matrix}, 4), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], $_*4) } (0..4);
}
sub GSL_MATRIX_ADD_CONSTANT : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
is(gsl_matrix_add_constant($self->{matrix}, 8), 0);
my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
map { is($got[$_], $_+8) } (0..4);
}
sub GSL_MATRIX_MAX : Tests {
my $self = shift;
for my $row (0..4) {
map { gsl_matrix_set($self->{matrix}, $row, $_, $_**2 ) } (0..4);
}
is(gsl_matrix_max($self->{matrix}), 16);
}
sub GSL_MATRIX_MIN : Tests {
my $self = shift;
for my $row (0..4) {
map { gsl_matrix_set($self->{matrix}, $row, $_, $_**2 ) } (0..4);
}
is(gsl_matrix_min($self->{matrix}), 0);
}
sub GSL_MATRIX_MINMAX : Test {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
my ($min, $max) = gsl_matrix_minmax($self->{matrix});
ok_similar( [ $min, $max ], [ 0, 16], 'gsl_matrix_minmax' );
}
sub GSL_MATRIX_MAX_INDEX : Tests {
my $self = shift;
for my $row (0..3) {
map { gsl_matrix_set($self->{matrix}, $row, $_, $_) } (0..4);
}
map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
my ($imax, $jmax) = gsl_matrix_max_index($self->{matrix});
ok_similar( [ $imax, $jmax ], [ 4, 4 ], 'gsl_matrix_max_index' );
}
sub GSL_MATRIX_MIN_INDEX : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
my ($imin, $jmin) = gsl_matrix_min_index($self->{matrix});
ok_similar( [ $imin, $jmin ], [ 0, 0 ], 'gsl_matrix_min_index' );
}
sub GSL_MATRIX_ISNULL : Tests {
my $self = shift;
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4);
}
is(gsl_matrix_isnull($self->{matrix}), 1);
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4);
}
is(gsl_matrix_isnull($self->{matrix}), 0);
}
sub GSL_MATRIX_ISPOS : Tests {
my $self = shift;
my $line;
for($line=0; $line<5; $line++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
is(gsl_matrix_ispos($self->{matrix}), 0);
for($line=0; $line<5; $line++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
is(gsl_matrix_ispos($self->{matrix}), 1);
for($line=0; $line<5; $line++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
is(gsl_matrix_ispos($self->{matrix}), 0);
}
sub GSL_MATRIX_ISNEG : Tests {
my $self = shift;
my $line;
for($line=0; $line<5; $line++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
is(gsl_matrix_isneg($self->{matrix}), 1);
for($line=0; $line<5; $line++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
is(gsl_matrix_isneg($self->{matrix}), 0);
for($line=0; $line<5; $line++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
is(gsl_matrix_isneg($self->{matrix}), 0);
}
sub GSL_MATRIX_ISNONNEG : Tests {
my $self = shift;
for my $row (0..4) {
map { gsl_matrix_set($self->{matrix}, $row, $_, -1) } (0..4);
}
is(gsl_matrix_isnonneg($self->{matrix}), 0);
for my $row (0..4) {
map { gsl_matrix_set($self->{matrix}, $row, $_, 1) } (0..4);
}
is(gsl_matrix_isnonneg($self->{matrix}), 1);
for my $row (0..4) {
map { gsl_matrix_set($self->{matrix}, $row, $_, 0) } (0..4);
}
is(gsl_matrix_isnonneg($self->{matrix}), 1);
}
sub GSL_MATRIX_GET_ROW : Tests {
my $self = shift;
my $vector = gsl_vector_alloc(5);
map { gsl_matrix_set($self->{matrix}, 0, $_, $_) } (0..4);
is(gsl_matrix_get_row($vector, $self->{matrix}, 0), 0);
map { is(gsl_vector_get($vector, $_), $_) } (0..4);
}
sub GSL_MATRIX_GET_COL : Tests {
my $self = shift;
my $vector = gsl_vector_alloc(5);
map { gsl_matrix_set($self->{matrix}, $_, 0, $_) } (0..4);
is(gsl_matrix_get_col($vector, $self->{matrix}, 0), 0);
map { is(gsl_vector_get($vector, $_), $_) } (0..4);
}
sub GSL_MATRIX_SET_ROW : Tests {
my $self = shift;
my $vector = gsl_vector_alloc(5);
map { gsl_vector_set($vector, $_, $_**2) } (0..4);
is(gsl_matrix_set_row($self->{matrix}, 1, $vector), 0);
ok_similar( [ map { gsl_matrix_get($self->{matrix}, 1, $_) } (0..4) ],
[ map { $_ ** 2 } (0..4) ],
);
}
sub GSL_MATRIX_SET_COL : Tests {
my $self = shift;
my $vector = gsl_vector_alloc(5);
map { gsl_vector_set($vector, $_, $_**2) } (0..4);
is(gsl_matrix_set_col($self->{matrix}, 1, $vector), 0);
ok_similar( [ map { gsl_matrix_get($self->{matrix}, $_, 1) } (0..4) ],
[ map { $_ ** 2 } (0..4) ],
);
}
sub GSL_MATRIX_FREAD_FWRITE : Tests {
my $self = shift;
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
}
my $fh = gsl_fopen("matrix", 'w');
is( gsl_matrix_fwrite($fh, $self->{matrix}), 0);
gsl_fclose($fh);
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
}
$fh = gsl_fopen("matrix", 'r');
is(gsl_matrix_fread($fh, $self->{matrix}), 0);
for my $line (0..4) {
ok_similar(
[ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
[ map { $_**2 } (0..4) ],
);
}
gsl_fclose($fh);
}
sub GSL_MATRIX_WRITE_LOAD : Tests {
my $matrix = Math::GSL::Matrix->new(2,3);
for (0..2) {
$matrix->set_elem(0, $_, $_);
$matrix->set_elem(1, $_, $_**2);
}
$matrix->write('matrix');
ok(-f "matrix", "written file exists");
my $m2 = Math::GSL::Matrix->read('matrix');
isa_ok $m2, "Math::GSL::Matrix";
# Check dimensions
my ($r, $c) = $m2->dim;
is( $r, 2, "nr rows is correct $r");
is( $c, 3, "nr columns is correct $c");
# Check some values
is($matrix->get_elem(0, 1), 1, "element at (0,1) is OK");
is($matrix->get_elem(1, 2), 4, "element at (1,2) is OK");
}
sub GSL_MATRIX_FPRINTF_FSCANF : Tests {
my $self = shift;
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
}
my $fh = gsl_fopen("matrix", 'w');
is( gsl_matrix_fprintf($fh, $self->{matrix}, "%f"), 0);
ok_status(gsl_fclose($fh));
for my $line (0..4) {
map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
}
$fh = gsl_fopen("matrix", 'r');
is(gsl_matrix_fscanf($fh, $self->{matrix}), 0);
for my $line (0..4) {
ok_similar(
[ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
[ map { $_**2 } (0..4) ],
);
}
ok_status(gsl_fclose($fh));
}
sub GSL_MATRIX_MINMAX_INDEX : Tests {
my $self = shift;
my $line;
for ($line = 0; $line<4; $line ++) {
map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4); }
map { gsl_matrix_set($self->{matrix}, 4, $_, $_**2) } (0..4);
my ($imin, $jmin, $imax, $jmax) = gsl_matrix_minmax_index($self->{matrix});
ok_similar( [ $imin, $jmin, $imax, $jmax ], [ 0, 0, 4, 4], 'gsl_matrix_minmax_index' );
}
sub GSL_MATRIX_ADD_DIAGONAL : Tests {
my $self = shift;
map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
gsl_matrix_add_diagonal($self->{matrix}, 4);
ok_similar( [ map { gsl_matrix_get($self->{matrix}, $_, $_)} (0..4) ],
[ 4 .. 8 ],
);
}
sub GSL_MATRIX_NEW : Tests {
my $self = shift;
isa_ok( $self->{obj}, 'Math::GSL::Matrix' );
isa_ok( $self->{obj}->raw, 'Math::GSL::Matrix::gsl_matrix' );
ok( $self->{obj}->rows == 5, '->rows' );
ok( $self->{obj}->cols == 5, '->cols' );
my $m = gsl_matrix_alloc(10, 10);
my $new = Math::GSL::Matrix->new($m);
isa_ok( $new, 'Math::GSL::Matrix' );
isa_ok( $new->raw, 'Math::GSL::Matrix::gsl_matrix' );
ok( $new->rows == 10, '->rows' );
ok( $new->cols == 10, '->cols' );
dies_ok( sub { Math::GSL::Matrix->new(1,2,3); }, '::new(...) - unknown Matrix constructor with 3 args' );
dies_ok( sub { Math::GSL::Matrix->new(2); }, '::new($m) - $m should be a gsl_matrix');
}
sub GSL_MATRIX_SET_ELEM : Tests(5) {
my $self = shift;
my $m = Math::GSL::Matrix->new(1,1);
$m->set_elem(0,0,99);
ok( gsl_matrix_get($m->raw, 0, 0) == 99, "OO set_elem");
dies_ok( sub { $m->set_elem(1,0,99); }, 'must be a valid row number' );
dies_ok( sub { $m->set_elem(0,1,99); }, 'must be a valid column number' );
dies_ok( sub { $m->set_elem(-1,0,99); }, 'must be a valid row number' );
dies_ok( sub { $m->set_elem(0,-1,99); }, 'must be a valid column number' );
}
sub GSL_MATRIX_GET_ELEM : Tests(5) {
my $self = shift;
my $m = Math::GSL::Matrix->new(1,1);
gsl_matrix_set($m->raw, 0, 0, 99);
ok( $m->get_elem(0,0) == 99, "OO get_elem");
dies_ok( sub { $m->get_elem(1,0,99); }, 'must be a valid row number' );
dies_ok( sub { $m->get_elem(0,1,99); }, 'must be a valid column number' );
dies_ok( sub { $m->get_elem(-1,0,99); }, 'must be a valid row number' );
dies_ok( sub { $m->get_elem(0,-1,99); }, 'must be a valid column number' );
}
sub AS_LIST_SQUARE : Tests {
my $matrix = Math::GSL::Matrix->new(5,5);
map { gsl_matrix_set($matrix->raw, $_, $_, 5 + $_**2) } (0..4);
is_deeply( [
5, 0, 0, 0, 0,
0, 6, 0, 0, 0,
0, 0, 9, 0, 0,
0, 0, 0,14, 0,
0, 0, 0, 0, 21
],
[ $matrix->as_list],
'$matrix->as_list',
);
}
sub AS_LIST_ROW : Tests {
my $matrix = Math::GSL::Matrix->new(1,5);
map { gsl_matrix_set($matrix->raw, 0 , $_, 5 + $_**2) } (0..4);
is_deeply( [ 5, 6, 9, 14, 21, ],
[ $matrix->as_list],
'$matrix->as_list',
);
}
sub ROW : Tests {
my $matrix = Math::GSL::Matrix->new(5,5);
map { gsl_matrix_set($matrix->raw, $_, $_, 5 + $_**2) } (0..4);
ok_similar( [qw/0 0 9 0 0/] , [$matrix->row(2)->as_list ] );
map { gsl_matrix_set($matrix->raw, 0, $_, $_) } (0..4);
ok_similar( [qw/0 1 2 3 4/] , [$matrix->row(0)->as_list ] );
}
sub COL : Tests {
my $matrix = Math::GSL::Matrix->new(3,3);
map { gsl_matrix_set($matrix->raw, $_, $_, 7 + $_**2) } (0..2);
ok_similar([7,0,0], [$matrix->col(0)->as_list]);
}
sub NEW_SETS_VALUES_TO_ZERO : Tests {
my $matrix = Math::GSL::Matrix->new(5,5);
my $sum;
map { $sum += $_ } $matrix->as_list;
ok( $sum == 0, 'new sets values to zero');
}
sub SET_ROW : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_row(0, [1,2,3]);
ok_similar([$m->row(0)->as_list], [1,2,3]);
}
sub SET_ROW_CHAINED : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_row(1, [4,5,6])
->set_row(2, [9,8,7]);
ok_similar([$m->row(1)->as_list], [4,5,6]);
ok_similar([$m->row(2)->as_list], [9,8,7]);
}
sub SET_COL_CHAINED : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_col(1, [4,5,6])
->set_col(2, [9,8,7]);
ok_similar([$m->col(1)->as_list], [4,5,6]);
ok_similar([$m->col(2)->as_list], [9,8,7]);
}
sub GSL_MATRIX_VIEW_ARRAY : Tests {
local $TODO = "memory management for view_array* functions is being worked on";
my $array = [8,4,3,7];
my $matrix_view = gsl_matrix_view_array ($array, 2,2);
ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 0, $_) } 0..1], [8, 4]);
ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 1, $_) } 0..1], [3, 7]);
}
sub GSL_MATRIX_VIEW_ARRAY_WITH_TDA : Tests {
local $TODO = "memory management for view_array* functions is being worked on";
my $array = [8,4,3,7,5];
my $matrix_view = gsl_matrix_view_array_with_tda ($array, 2,2, 3);
ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 0, $_) } 0..1], [8, 4]);
ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 1, $_) } 0..1], [7, 5]);
}
sub GSL_MATRIX_OO_ADDITION_CONSTANT : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_col(1, [4,5,6])
->set_col(2, [9,8,7]);
my $m2 = $m + 4;
ok_similar([$m->col(2)->as_list], [9,8,7]);
ok_similar([$m->col(1)->as_list], [4,5,6]);
ok_similar([$m->col(0)->as_list], [0,0,0]);
ok_similar([$m2->col(1)->as_list], [8,9,10]);
ok_similar([$m2->col(2)->as_list], [13,12,11]);
ok_similar([$m2->col(0)->as_list], [4,4,4]);
my $m3 = 4 + $m;
ok_similar([$m3->col(1)->as_list], [8,9,10]);
ok_similar([$m3->col(2)->as_list], [13,12,11]);
ok_similar([$m3->col(0)->as_list], [4,4,4]);
}
sub GSL_MATRIX_OO_ADDITION_MATRICES : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_col(1, [4,5,6])
->set_col(2, [9,8,7])
->set_col(0, [1,2,3]);
my $m2 = $m + $m;
ok_similar([$m->col(0)->as_list], [1,2,3]);
ok_similar([$m->col(2)->as_list], [9,8,7]);
ok_similar([$m->col(1)->as_list], [4,5,6]);
ok_similar([$m2->col(0)->as_list], [2,4,6]);
ok_similar([$m2->col(1)->as_list], [8,10,12]);
ok_similar([$m2->col(2)->as_list], [18,16,14]);
}
sub GSL_MATRIX_OO_SUBSTRACTION_CONSTANT : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_col(1, [4,5,6])
->set_col(2, [9,8,7]);
my $m2 = $m - 4;
ok_similar([$m->col(2)->as_list], [9,8,7]);
ok_similar([$m->col(1)->as_list], [4,5,6]);
ok_similar([$m->col(0)->as_list], [0,0,0]);
ok_similar([$m2->col(1)->as_list], [0,1,2]);
ok_similar([$m2->col(2)->as_list], [5,4,3]);
ok_similar([$m2->col(0)->as_list], [-4,-4,-4]);
}
sub GSL_MATRIX_OO_SUBSTRACTION_MATRICES : Tests {
my $m = Math::GSL::Matrix->new(3,3);
my $m3 = Math::GSL::Matrix->new(3,3);
$m->set_col(1, [4,5,6])
->set_col(2, [9,8,7])
->set_col(0, [1,2,3]);
$m3->set_col(1, [1,2,3])
->set_col(2, [9,8,7])
->set_col(0, [1,2,3]);
my $m2 = $m - $m3;
ok_similar([$m->col(0)->as_list], [1,2,3]);
ok_similar([$m->col(2)->as_list], [9,8,7]);
ok_similar([$m->col(1)->as_list], [4,5,6]);
ok_similar([$m2->col(0)->as_list], [0,0,0]);
ok_similar([$m2->col(1)->as_list], [3,3,3]);
ok_similar([$m2->col(2)->as_list], [0,0,0]);
}
sub GSL_MATRIX_OO_MULTIPLICATION_CONSTANT : Tests {
my $m = Math::GSL::Matrix->new(3,3);
$m->set_col(1, [4,5,6])
->set_col(2, [9,8,7]);
my $m2 = $m * 4;
ok_similar([$m->col(2)->as_list], [9,8,7]);
ok_similar([$m->col(1)->as_list], [4,5,6]);
ok_similar([$m->col(0)->as_list], [0,0,0]);
ok_similar([$m2->col(1)->as_list], [16,20,24]);
ok_similar([$m2->col(2)->as_list], [36,32,28]);
ok_similar([$m2->col(0)->as_list], [0,0,0]);
my $m3 = 4 * $m;
ok_similar([$m3->col(1)->as_list], [16,20,24]);
ok_similar([$m3->col(2)->as_list], [36,32,28]);
ok_similar([$m3->col(0)->as_list], [0,0,0]);
}
sub GSL_MATRIX_EIGENVALUES: Tests(6) {
my $matrix = Math::GSL::Matrix->new(2,2)
->set_row(0, [0,-1] )
->set_row(1, [1, 0] );
my @eigs = $matrix->eigenvalues;
ok_similar( [ Re($eigs[0]), Im($eigs[0]) ], [ 0, 1 ] ); # i
ok_similar( [ Re($eigs[1]), Im($eigs[1]) ], [ 0, -1 ] ); # -i
my $rect = Math::GSL::Matrix->new(2,4);
dies_ok( sub { $rect->eigenvalues }, 'eigenvalues for square matrices only' );
my $matrix2 = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 0] )
->set_row(1, [0, 1] );
my @eigs2 = $matrix2->eigenvalues;
ok_similar( [ @eigs2 ], [ 1, 1 ] );
my $matrix3 = Math::GSL::Matrix->new(2,2);
ok_similar( [ $matrix3->eigenvalues ], [ 0, 0 ], 'zero matrix eigenvalues = 0');
my $matrix4 = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 3] )
->set_row(1, [4, 2] );
ok_similar( [ $matrix4->eigenvalues ], [ -2, 5 ] );
}
sub GSL_MATRIX_EIGENPAIR : Tests(11) {
my $matrix = Math::GSL::Matrix->new(2,2)
->set_row(0, [0,-1] )
->set_row(1, [1, 0] );
my ($eigenvalues, $eigenvectors) = $matrix->eigenpair;
cmp_ok( $#$eigenvalues, '==', $#$eigenvectors, 'same # of values as vectors');
my ($eig1,$eig2) = @$eigenvalues;
isa_ok( $eig1, 'Math::Complex');
isa_ok( $eig2, 'Math::Complex');
ok_similar( [ Re $eig1 ], [ 0 ] );
ok_similar( [ Im $eig1 ], [ 1 ] );
ok_similar( [ Re $eig2 ], [ 0 ] );
ok_similar( [ Im $eig2 ], [ -1 ] );
my ($u,$v) = @$eigenvectors;
isa_ok( $u, 'Math::GSL::VectorComplex' );
isa_ok( $v, 'Math::GSL::VectorComplex' );
local $TODO = qq{ VectorComplex->as_list is funky };
# we happen to know that these are real eigenvectors
my ($u1,$u2) = map { Re $_ } $u->as_list;
my ($v1,$v2) = map { Re $_ } $v->as_list;
my $sqrt2by2 = sqrt(2)/2;
ok_similar( [ $u1, $u2 ], [ $sqrt2by2, - $sqrt2by2 ] );
ok_similar( [ $v1, $v2 ], [ $sqrt2by2, $sqrt2by2 ] );
}
sub GSL_MATRIX_EIGENPAIR_RT45044 : Tests(1) {
my $matrix = Math::GSL::Matrix->new(3,3)
->set_row(0, [1,0,0] )
->set_row(1, [0,1,0] )
->set_row(2, [0,0,1] );
my ($eigs, $eigv) = $matrix->eigenpair;
cmp_ok( scalar(@$eigv), '==', 3, 'got 3 eigenvectors');
}
sub MATRIX_MULTIPLICATION_OVERLOAD : Tests {
my $A = Math::GSL::Matrix->new(3,2)
->set_row(0, [1,3] )
->set_row(1, [4,2] )
->set_row(2, [6,1] );
my $B = Math::GSL::Matrix->new(2,2)
->set_row(0, [2,5] )
->set_row(1, [1, 3] );
my $C = $A * $B;
ok_similar([ $C->as_list ], [5, 14, 10, 26, 13, 33 ]);
}
sub MATRIX_IS_SQUARE : Tests(2) {
my $A = Math::GSL::Matrix->new(2,2);
ok( $A->is_square, 'is_square true for 2x2' );
my $B = Math::GSL::Matrix->new(2,3);
ok( ! $B->is_square, 'is_square false for 2x3' );
}
sub MATRIX_DETERMINANT : Tests(2) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1,3] )
->set_row(1, [4, 2] );
ok_similar( [ $A->det ], [ -10 ], '->det() 2x2');
ok_similar( [ $A->lndet ], [ log 10 ], '->lndet() 2x2');
}
sub MATRIX_ZERO : Tests(2) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 3] )
->set_row(1, [4, 2] );
isa_ok($A->zero, 'Math::GSL::Matrix');
ok_similar( [ $A->zero->as_list ], [ 0, 0, 0, 0 ] );
}
sub MATRIX_IDENTITY : Tests(6) {
my $A = Math::GSL::Matrix->new(2,2)->identity;
isa_ok($A, 'Math::GSL::Matrix');
ok_similar([ $A->as_list ], [ 1, 0, 0, 1 ] );
ok_similar([ $A->inverse->as_list ], [ 1, 0, 0, 1 ] );
ok_similar([ $A->det ] ,[ 1 ] );
ok_similar([ map { Re $_ } $A->eigenvalues ], [ 1, 1 ], 'identity eigs=1' );
ok_similar([ map { Im $_ } $A->eigenvalues ], [ 0, 0 ], 'identity eigs=1' );
}
sub MATRIX_INVERSE : Tests(3) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 3] )
->set_row(1, [4, 2] );
my $Ainv = $A->inverse;
isa_ok( $Ainv, 'Math::GSL::Matrix' );
ok_similar([ $Ainv->as_list ] , [ map { -$_/10 } ( 2, -3, -4, 1 ) ] );
my $B = Math::GSL::Matrix->new(2,3)
->set_row(0, [1, 3, 5] )
->set_row(1, [2, 4, 6] );
dies_ok( sub { $B->inverse } , 'inverse of non square matrix dies' );
}
sub MATRIX_TRANSPOSE : Tests(3) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 2] )
->set_row(1, [3, 4] );
my $Atr = $A->transpose;
isa_ok( $Atr, 'Math::GSL::Matrix' );
ok_similar([ $Atr->as_list ] , [ ( 1, 3, 2, 4 ) ] );
my $B = Math::GSL::Matrix->new(2,3)
->set_row(0, [1, 3, 5] )
->set_row(1, [2, 4, 6] );
dies_ok( sub { $B->transpose } , 'transposeof non square matrix dies' );
}
sub OVERLOAD_EQUAL : Tests(2) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 3] )
->set_row(1, [4, 2] );
my $B = $A->copy;
ok ( $A == $B, 'should be equal');
$B->set_row(0, [1,2]);
ok ( $A != $B, 'should not be equal');
}
sub MATRIX_MAX : Tests(4) {
my $A = Math::GSL::Matrix->new(3,3)
->set_row(0, [1, 2, 3])
->set_row(1, [8, 7, 4])
->set_row(2, [9, 6, 5]);
ok ($A->max == 9, '->max in scalar context');
my @list = $A->max;
is_deeply ([@list], [9, 2, 0], '->max in list context');
my $B = Math::GSL::Matrix->new(1, 3)->set_row(0, [1, 9, 3]);
@list = $B->max;
is_deeply ([@list], [9, 1], '->max in list context for vector (1)');
my $C = Math::GSL::Matrix->new(3, 1)->set_row(0, [9])->set_row(1, [4])->set_row(2, [3]);
@list = $C->max;
is_deeply ([@list], [9, 0], '->max in list context for vector (2)');
}
sub MATRIX_MIN : Tests(4) {
my $A = Math::GSL::Matrix->new(3,3)
->set_row(0, [1, 2, 3])
->set_row(1, [8, 7, 4])
->set_row(2, [9, 6, 5]);
ok ($A->min == 1, '->min in scalar context');
my @list = $A->min;
is_deeply ([@list], [1, 0, 0], '->min in list context');
my $B = Math::GSL::Matrix->new(1, 3)->set_row(0, [1, 9, 3]);
@list = $B->min;
is_deeply ([@list], [1, 0], '->min in list context for vector (1)');
my $C = Math::GSL::Matrix->new(3, 1)->set_row(0, [9])->set_row(1, [4])->set_row(2, [3]);
@list = $C->min;
is_deeply ([@list], [3, 2], '->min in list context for vector (2)');
}
sub MATRIX_IEACH : Tests(2) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 2])
->set_row(1, [3, 4]);
dies_ok( sub { $A->ieach("foo") }, 'must be a code reference' );
$A = $A->ieach(sub { shift()**2 });
ok_similar( [$A->as_list], [1, 4, 9, 16], "->ieach");
}
sub MATRIX_EACH : Tests(3) {
my $A = Math::GSL::Matrix->new(2,2)
->set_row(0, [1, 2])
->set_row(1, [3, 4]);
dies_ok( sub { $A->each("foo") }, 'must be a code reference' );
my $B = $A->each(sub { shift()**2 });
ok_similar( [$A->as_list], [ 1, 2, 3, 4], "->each keeps object intact");
ok_similar( [$B->as_list], [ 1, 4, 9, 16], "->each does what it should");
}
sub MATRIX_DIMENSIONS : Tests(2) {
my $A = Math::GSL::Matrix->new(5,6);
my ($r, $c) = $A->dim;
ok ($r == 5, '->dim (rows)');
ok ($c == 6, '->dim (cols)');
}
sub CONCAT_VERTICALLY : Tests(5) {
my $a = Math::GSL::Matrix->new(2,2)->set_row(0, [1, 2])->set_row(1, [3, 4]);
my $b = Math::GSL::Matrix->new(2,2)->set_row(0, [5, 6])->set_row(1, [7, 8]);
my $c = $a->vconcat($b);
ok($c->rows == 4, "vconcat - number of lines");
ok_similar([$c->as_list], [1..8], "vconcat - values");
ok_similar([$a->as_list], [1..4], "vconcat - obj is unmodified");
# Exceptions
dies_ok( sub { $a->vconcat("foo"); },
"must be a Math::GSL::Matrix object");
my $tmp = Math::GSL::Matrix->new(1,1);
dies_ok( sub { $tmp->vconcat($a); },
"should have same number of columns");
}
sub CONCAT_HORIZONTALLY : Tests(5) {
my $a = Math::GSL::Matrix->new(2,2)->set_row(0, [1, 2])->set_row(1, [5, 6]);
my $b = Math::GSL::Matrix->new(2,2)->set_row(0, [3, 4])->set_row(1, [7, 8]);
my $c = $a->hconcat($b);
ok($c->cols == 4, "hconcat - number of columns");
ok_similar([$c->as_list], [1..8], "hconcat - values");
ok_similar([$a->as_list], [1,2,5,6], "hconcat - obj is unmodified");
# Exceptions
dies_ok( sub { $a->hconcat("foo"); },
"must be a Math::GSL::Matrix object");
my $tmp = Math::GSL::Matrix->new(1,1);
dies_ok( sub { $tmp->hconcat($a); },
"should have same number of rows");
}
Test::Class->runtests;
Something went wrong with that request. Please try again.