package Math::GSL::Vector::Test; use base q{Test::Class}; use Test::More tests => 142; use Math::GSL qw/:all/; use Math::GSL::Test qw/:all/; use Math::GSL::Errno qw/:all/; use Math::GSL::Vector qw/:all/; use Test::Exception; use Data::Dumper; use strict; BEGIN{ gsl_set_error_handler_off(); } sub make_fixture : Test(setup) { my $self = shift; $self->{vector} = gsl_vector_alloc(5); $self->{object} = Math::GSL::Vector->new([1 .. 5 ]); } sub teardown : Test(teardown) { unlink 'vector' if -f 'vector'; } sub GSL_VECTOR_RAW : Tests { my $vec = Math::GSL::Vector->new(10); isa_ok($vec->raw, 'Math::GSL::Vector::gsl_vector'); } sub GSL_VECTOR_ALLOC : Tests { my $vector = gsl_vector_alloc(5); isa_ok($vector, 'Math::GSL::Vector'); } sub GSL_VECTOR_LENGTH: Tests { my $self = shift; my $vector = $self->{object}; ok( $vector->length == 5, '$vector->length' ); } sub GSL_VECTOR_SET_GET: Tests { my $self = shift; gsl_vector_set($self->{vector}, 0, 42 ); my $elem = gsl_vector_get($self->{vector}, 0); ok( $elem == 42, 'gsl_vector_set/gsl_vector_get' ); } sub GSL_VECTOR_ISNONNEG: Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, -1 ) } (0..4); ok( !gsl_vector_isnonneg($self->{vector}),'gsl_vector_isnonneg' ); map { gsl_vector_set($self->{vector}, $_, 1 ) } (0..4); ok( gsl_vector_isnonneg($self->{vector}),'gsl_vector_isnonneg' ); } sub GSL_VECTOR_ISNULL: Tests(2) { my $self = shift; map { gsl_vector_set($self->{vector}, $_, 0 ) } (0..4); ok( gsl_vector_isnull($self->{vector}),'null vector returns true' ); gsl_vector_set($self->{vector}, 0, 5 ); ok( !gsl_vector_isnull($self->{vector}), 'changed non-null vector returns false' ); } sub GSL_VECTOR_ISPOS: Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, -1 ) } (0..4); ok( !gsl_vector_ispos($self->{vector}),'gsl_vector_pos' ); map { gsl_vector_set($self->{vector}, $_, 1 ) } (0..4); ok( gsl_vector_ispos($self->{vector}),'gsl_vector_pos' ); } sub GSL_VECTOR_ISNEG: Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, -$_ ) } (0..4); ok( !gsl_vector_isneg($self->{vector}),'gsl_vector_neg' ); gsl_vector_set($self->{vector}, 0, -1 ); ok( gsl_vector_isneg($self->{vector}),'gsl_vector_neg' ); } sub GSL_VECTOR_NEW: Tests { my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (1..10) ] ); isa_ok( $vec, 'Math::GSL::Vector', 'Math::GSL::Vector->new($values)' ); dies_ok( sub { Math::GSL::Vector->new(-1) }, 'new takes only positive indices'); dies_ok( sub { Math::GSL::Vector->new(3.14) }, 'new takes only integer indices'); dies_ok( sub { Math::GSL::Vector->new([]) },'new takes only nonempty array refs'); $vec = Math::GSL::Vector->new(42); ok( $vec->length == 42 , 'new creates empty vectors of a given length'); } sub GSL_VECTOR_AS_LIST: Tests { my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (reverse 1..10) ] ); my @x = $vec->as_list; is_deeply( \@x, [map { $_ ** 2 } (reverse 1..10)] ); } sub GSL_VECTOR_SET: Tests { my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (1..10) ] ); $vec->set( [ 0..4] , [ reverse 1..5 ] ); my ($x) = $vec->get([0]); ok( $x == 5, "gsl_vector_set: $x ?= 5" ); } sub GSL_VECTOR_MIN: Tests { my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (0..4) ] ); ok_similar( $vec->min ,0, '$vec->min' ); ok_similar( gsl_vector_min($vec->raw) ,0, 'gsl_vector_min' ); } sub GSL_VECTOR_MAX: Tests { my $vec = Math::GSL::Vector->new( [ 3, 567, 4200 ]); ok_similar( $vec->max ,4200, '$vec->min' ); ok_similar( gsl_vector_max($vec->raw) ,4200, 'gsl_vector_max' ); } sub GSL_VECTOR_FREAD_FWRITE: Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; my $fh = gsl_fopen("vector", 'w'); my $status = gsl_vector_fwrite($fh, $self->{vector} ); ok( ! $status, 'gsl_vector_fwrite' ); ok( -f "vector", 'gsl_vector_fwrite' ); ok_status(fclose($fh)); map { gsl_vector_set($self->{vector}, $_, $_ ** 3 ) } (0..4); $fh = gsl_fopen("vector", 'r'); ok_status(gsl_vector_fread($fh, $self->{vector} )); is_deeply( [ map { gsl_vector_get($self->{vector}, $_) } (0..4) ], [ map { $_ ** 2 } (0..4) ], ); ok_status(gsl_fclose($fh)); } sub GSL_VECTOR_SUBVECTOR : Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; my $vec_sub = gsl_vector_subvector($self->{vector}, 2, 3); ok_similar( [ map { gsl_vector_get($vec_sub->{vector}, $_) } (0..2) ], [ 4, 9, 16 ], ); } sub GSL_VECTOR_CALLOC : Tests { my $vector = gsl_vector_calloc(5); isa_ok($vector, 'Math::GSL::Vector'); } sub GSL_VECTOR_SET_ALL : Tests { my $vec = Math::GSL::Vector->new(5); gsl_vector_set_all($vec->raw, 4); ok_similar( [ $vec->as_list ], [ (4) x 5 ] ); } sub GSL_VECTOR_SET_ZERO : Tests { my $self = shift; gsl_vector_set_zero($self->{vector}); map { is(gsl_vector_get($self->{vector} , $_ ), 0) } (0..4); } sub GSL_VECTOR_SET_BASIS : Tests { my $self = shift; ok_status(gsl_vector_set_basis($self->{vector}, 0)); is (gsl_vector_get($self->{vector} , 0 ), 1); map { is(gsl_vector_get($self->{vector} , $_ ), 0) } (1..4); } sub GSL_VECTOR_SUBVECTOR_WITH_STRIDE : Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; my $sub_stride = gsl_vector_subvector_with_stride($self->{vector}, 0, 2, 3); is(gsl_vector_get($sub_stride->{vector} , 0 ), 0, "first element"); is(gsl_vector_get($sub_stride->{vector} , 1 ), 4, "second element"); is(gsl_vector_get($sub_stride->{vector} , 2 ), 16, "third element"); } sub GSL_VECTOR_MAX_INDEX : Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; my $index = gsl_vector_max_index($self->{vector}); is($index, 4, "Position of the maximum"); } sub GSL_VECTOR_MIN_INDEX : Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; my $index = gsl_vector_min_index($self->{vector}); is($index, 0, "Position of the minimum"); } sub GSL_VECTOR_MINMAX_INDEX : Tests { my $self = shift; my ($min, $max); map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ($min, $max) = gsl_vector_minmax_index($self->{vector}); ok_similar( [ 0, 4 ], [ $min, $max], 'gsl_vector_minmax_index' ); } sub GSL_VECTOR_MINMAX : Tests { my ($min, $max); my $vector = gsl_vector_alloc(5); map { gsl_vector_set($vector, $_, $_ ** 2 ) } (0..4); ($min, $max) = gsl_vector_minmax($vector); ok_similar( [ 0, 16 ], [ $min, $max], 'gsl_vector_minmax' ); } sub GSL_VECTOR_MEMCPY : Tests { my $self = shift; my $copy = gsl_vector_alloc(5); map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; ok_status( gsl_vector_memcpy($copy, $self->{vector}) ); map { is(gsl_vector_get($copy, $_), $_ ** 2 ) } (0..4); ; } sub GSL_VECTOR_VIEW_ARRAY : Tests { local $TODO = "memory management for view_array* functions is being worked on"; my @array = [1,2,3,4,5,6]; my $vec_view = gsl_vector_view_array(@array, 2); map { is(gsl_vector_get($vec_view->{vector}, $_), $_+1 ) } (0..1); ; } sub GSL_VECTOR_REVERSE : Tests { my $self = shift; map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ; ok_status( gsl_vector_reverse($self->{vector})); ok_similar( [ 16, 9, 4, 1, 0], [ map { gsl_vector_get($self->{vector}, $_) } 0..4 ] ); } sub GSL_VECTOR_SWAP_ELEMENTS : Tests { my $v1 = Math::GSL::Vector->new( [ map { $_ ** 2 } (0 .. 4) ] ); ok_status( gsl_vector_swap_elements($v1->raw, 0, 4)); is(gsl_vector_get($v1->raw, 0), 16); is(gsl_vector_get($v1->raw, 4), 0); is_deeply( [ 16, 1, 4, 9, 0 ], [ $v1->as_list ] ); } sub GSL_VECTOR_ADD : Tests { my $v1 = Math::GSL::Vector->new([0 .. 4]); my $v2 = $v1->copy; ok_status( gsl_vector_reverse($v2->raw) ); ok_status( gsl_vector_add($v1->raw, $v2->raw) ); is_deeply( [ $v1->as_list ], [ (4) x 5 ] ); } sub GSL_VECTOR_SUB : Tests { my $self = shift; my $second_vec = gsl_vector_alloc(5); map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ; map { gsl_vector_set($second_vec, $_, 1) } (0..4); ; ok_status( gsl_vector_sub($self->{vector}, $second_vec)); map { is(gsl_vector_get($self->{vector}, $_), $_ - 1 ) } (0..4); ; } sub GSL_VECTOR_MUL : Tests { my $self = shift; my $second_vec = gsl_vector_alloc(5); map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ; map { gsl_vector_set($second_vec, $_, 2) } (0..4); ; ok_status( gsl_vector_mul($self->{vector}, $second_vec)); map { is(gsl_vector_get($self->{vector}, $_), $_ * 2 ) } (0..4); ; } sub GSL_VECTOR_DIV : Tests { my $self = shift; my $second_vec = gsl_vector_alloc(5); map { gsl_vector_set($self->{vector}, $_, $_*2 ) } (0..4); ; map { gsl_vector_set($second_vec, $_, 2) } (0..4); ; ok_status( gsl_vector_div($self->{vector}, $second_vec)); map { is(gsl_vector_get($self->{vector}, $_), $_ ) } (0..4); ; } sub GSL_VECTOR_SCALE : Tests { my $v = Math::GSL::Vector->new([0..4]); ok_status(gsl_vector_scale($v->raw, 2)); ok_similar( [ $v->as_list ], [ 0,2,4,6,8 ] ); } sub GSL_VECTOR_SCALE_OVERLOAD : Tests { my $v = Math::GSL::Vector->new([0..4]); my $expected = [ map { $_*5} (0..4) ]; $v = 5 * $v; ok_similar( [ $v->as_list ], $expected ); my $w = Math::GSL::Vector->new([0..4]); $w = $w * 5; ok_similar( [ $w->as_list ], $expected ); } sub GSL_VECTOR_DOT_PRODUCT : Tests { my $v = Math::GSL::Vector->new([0..4]); my $w = Math::GSL::Vector->new([0..4]); ok_similar( $v * $w , 4*4 + 3*3 + 2*2 + 1*1, 'basic dot product'); my $z = Math::GSL::Vector->new([0..10]); dies_ok( sub { $z * $v; }, 'dot_product checks vector length' ); my $q = Math::GSL::Vector->new(5); ok_similar ( $q * $q, 0, 'newly created vectors are zero-filled'); } sub GSL_VECTOR_SWAP : Tests { my @idx = (0..(5+int rand(5))); my $vec1 = gsl_vector_alloc($#idx+1); my $vec2 = gsl_vector_alloc($#idx+1); map { gsl_vector_set($vec1, $_, $_**2 ) } @idx; map { gsl_vector_set($vec2, $_, $_) } @idx; ok_status( gsl_vector_swap($vec1, $vec2)); ok_similar( [ map { gsl_vector_get($vec1, $_) } @idx ], [ @idx ], ); ok_similar( [ map { gsl_vector_get($vec2, $_) } @idx ], [ map { $_**2 } @idx ], ); } sub GSL_VECTOR_FPRINTF_FSCANF : Tests { my $vec1 = Math::GSL::Vector->new([ map { $_ ** 2 } (0..4) ]); my $fh = gsl_fopen("vector", 'w'); ok( defined $fh, 'fopen - write'); ok_status(gsl_vector_fprintf($fh, $vec1->raw, "%f")); ok_status(gsl_fclose($fh)); my $vec2 = Math::GSL::Vector->new([ map { $_ ** 3 } (0..4) ]); $fh = gsl_fopen("vector", 'r'); ok( defined $fh, 'fopen - readonly'); ok_status(gsl_vector_fscanf($fh, $vec2->raw)); ok_similar( [ $vec2->as_list ], [ map { $_ ** 2 } (0..4) ]); ok_status(gsl_fclose($fh) ); } sub GSL_ADDITION : Tests { my $vec1 = Math::GSL::Vector->new([1,2,3]); my $vec2 = Math::GSL::Vector->new([2,3,4]); my $vec3 = $vec1 + $vec2; ok_similar([$vec3->as_list], [3,5,7]); my $vec4 = $vec2 + 5; ok_similar([$vec4->as_list], [7,8,9]); my $vec5 = 5 + $vec2; ok_similar([$vec5->as_list], [7,8,9]); my $z = Math::GSL::Vector->new([0..10]); dies_ok( sub { $z + $vec1; }, 'addition checks vector length' ); ok_similar([$vec1->as_list], [1,2,3]); } sub COPY : Tests { my $v1 = Math::GSL::Vector->new( [ 55 .. 65 ] ); isa_ok( $v1->copy, 'Math::GSL::Vector' ); ok_similar( [ $v1->copy->as_list ], [ $v1->as_list ] ); } sub GSL_SUBTRACTION : Tests(3) { my $v1 = Math::GSL::Vector->new( [ 1 .. 5 ]); my $v2 = Math::GSL::Vector->new( [ 5 .. 9 ]); ok_similar( [($v2-$v1)->as_list], [ (4) x 5 ] ); my $v3 = $v2 - 3; ok_similar( [ $v3->as_list ], [ 2 .. 6 ] ); my $v4 = 4 - $v3; ok_similar( [ $v4->as_list ], [ 2, 1, 0, -1, -2 ] ); } sub GSL_MULTIPLICATION : Tests(6) { my $v = Math::GSL::Vector->new([1,2,3]); my $v2 = $v * 5; # check that original is not modified each time ok_similar ( [$v2->as_list], [5,10,15]); ok_similar ( [$v->as_list], [1,2,3]); my $v3 = 5 * $v; ok_similar ( [$v3->as_list], [5,10,15]); ok_similar ( [$v->as_list], [1,2,3]); my $w = $v3 * 0; ok_similar( [ $w->as_list ], [0,0,0], 'right overloaded zero-ify' ); my $z = 0 * $v3; ok_similar( [ $w->as_list ], [0,0,0], 'left overloaded zero-ify' ); } sub GSL_VECTOR_SWAP_OBJECTS : Tests(3) { my $v = Math::GSL::Vector->new([1,2,3]); my $w = Math::GSL::Vector->new([42,69,18]); isa_ok( $v->swap($w), 'Math::GSL::Vector' ); ok_similar( [ $v->as_list ], [ 42, 69, 18 ] ); ok_similar( [ $w->as_list ], [ 1, 2, 3 ] ); } sub GSL_VECTOR_REVERSE_OBJECTS : Tests(4) { my @elements = map { int(rand(100)) } (1..10); my $v = Math::GSL::Vector->new([@elements]); ok_similar( [ $v->reverse->as_list ], [ reverse @elements ] ); isa_ok($v->reverse, 'Math::GSL::Vector'); ok_similar( [ $v->as_list ], [ @elements ] ); ok_similar( [ $v->reverse->reverse->as_list ], [ $v->as_list ] ); } sub GSL_VECTOR_NORM : Tests(5) { my $v = Math::GSL::Vector->new([ (0) x 5 ]); ok_similar( $v->norm, 0 , 'zero vector norm = 0' ); isa_ok( $v->normalize, 'Math::GSL::Vector'); my $w = Math::GSL::Vector->new([1,2,3]); my $z = Math::GSL::Vector->new([1,2,-3]); ok_similar( [ $w->norm ], [ sqrt(14) ], '2-norm' ); ok_similar( [ $w->norm(1) ], [ 6 ], '1-norm' ); ok_similar( [ $z->norm(1) ], [ 6 ], '1-norm with neg. elems.' ); } sub GSL_VECTOR_NORMALIZE : Tests(4) { my $w = Math::GSL::Vector->new([1,2,3]); isa_ok( $w->normalize, 'Math::GSL::Vector'); ok_similar( $w->norm , 1, 'normalize default p=2'); my $v = Math::GSL::Vector->new([1,2,3]); isa_ok( $v->normalize(3), 'Math::GSL::Vector' ); ok_similar ( $v->norm(3), 1, 'normalize p=3'); } sub GSL_VECTOR_NORM_OVERLOAD: Tests(2) { my $v = Math::GSL::Vector->new([1,2,3]); my $w = Math::GSL::Vector->new([10,0,1]); ok_similar( [ $v->norm ], [ abs $v ], 'abs overload'); ok_similar( [ abs $w ], [ sqrt(101) ], 'abs = norm' ) } sub GSL_VECTOR_EQUAL : Tests(3){ my $v = Math::GSL::Vector->new([1,2,3]); my $w = Math::GSL::Vector->new([10,0,1]); my $x = Math::GSL::Vector->new([1,2,3,0]); ok_similar($v == $v, 1); ok_similar($v == $w, 0); ok_similar($v == $x, 0); } sub GSL_VECTOR_NOT_EQUAL : Tests(3){ my $v = Math::GSL::Vector->new([1,2,3]); my $w = Math::GSL::Vector->new([10,0,1]); my $x = Math::GSL::Vector->new([1,2,3,0]); ok_similar($v != $v, 0); ok_similar($v != $w, 1); ok_similar($v != $x, 1); } Test::Class->runtests;