Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
777 lines (651 sloc) 24.9 KB
package Math::GSL::Matrix::Test;
use base q{Test::Class};
use Test::More tests => 238;
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_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' );
}
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(2,2)
->set_row(0, [1,3] )
->set_row(1, [4, 2] );
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 ]);
}
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 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');
}
Test::Class->runtests;
Something went wrong with that request. Please try again.