lib/Math/GSL/Vector/Test.pm

   1 package Math::GSL::Vector::Test;
   2 use base q{Test::Class};
   3 use Test::More;
   4 use Math::GSL::Vector qw/:all/;
   5 use Math::GSL qw/:all/;
   6 use Data::Dumper;
   7 use Math::GSL::Errno qw/:all/;
   8 use strict;
   9
  10 # This allows us to eval code
  11 BEGIN{ gsl_set_error_handler_off(); }
  12
  13 sub make_fixture : Test(setup) {
  14     my $self = shift;
  15     $self->{vector} = gsl_vector_alloc(5);
  16 }
  17
  18 sub teardown : Test(teardown) {
  19     unlink 'vector' if -f 'vector';
  20 }
  21
  22 sub GSL_VECTOR_ALLOC : Tests {
  23     my $vector = gsl_vector_alloc(5);
  24     isa_ok($vector, 'Math::GSL::Vector');
  25 }
  26 sub GSL_VECTOR_SET_GET: Tests {
  27     my $self = shift;
  28     gsl_vector_set($self->{vector}, 0, 42 );
  29     my $elem   = gsl_vector_get($self->{vector}, 0);
  30     ok( $elem == 42, 'gsl_vector_set/gsl_vector_get' );
  31 }
  32
  33 sub GSL_VECTOR_ISNONNEG: Tests {
  34     my $self = shift;
  35     map { gsl_vector_set($self->{vector}, $_, -1 ) } (0..4);
  36     ok( !gsl_vector_isnonneg($self->{vector}),'gsl_vector_isnonneg' );
  37     map { gsl_vector_set($self->{vector}, $_, 1 ) } (0..4);
  38     ok( gsl_vector_isnonneg($self->{vector}),'gsl_vector_isnonneg' );
  39 }
  40
  41 sub GSL_VECTOR_ISNULL: Tests {
  42     my $self = shift;
  43     ok( !gsl_vector_isnull($self->{vector}), 'gsl_vector_isnull' );
  44     map { gsl_vector_set($self->{vector}, $_, 0 ) } (0..4);
  45     ok( gsl_vector_isnull($self->{vector}),'gsl_vector_isnull' );
  46     gsl_vector_set($self->{vector}, 0, 5 );
  47     ok( !gsl_vector_isnull($self->{vector}), 'gsl_vector_isnull' );
  48 }
  49
  50 sub GSL_VECTOR_ISPOS: Tests {
  51     my $self = shift;
  52     map { gsl_vector_set($self->{vector}, $_, -1 ) } (0..4);
  53     ok( !gsl_vector_ispos($self->{vector}),'gsl_vector_pos' );
  54     map { gsl_vector_set($self->{vector}, $_, 1 ) } (0..4);
  55     ok( gsl_vector_ispos($self->{vector}),'gsl_vector_pos' );
  56 }
  57
  58 sub GSL_VECTOR_ISNEG: Tests {
  59     my $self = shift;
  60
  61     map { gsl_vector_set($self->{vector}, $_, -$_ ) } (0..4);
  62     ok( !gsl_vector_isneg($self->{vector}),'gsl_vector_neg' );
  63
  64     gsl_vector_set($self->{vector}, 0, -1 );
  65
  66     ok( gsl_vector_isneg($self->{vector}),'gsl_vector_neg' );
  67 }
  68
  69 sub GSL_VECTOR_MAX: Tests {
  70     my $self = shift;
  71     map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
  72     ok( is_similar( gsl_vector_max($self->{vector}) ,16), 'gsl_vector_max' );
  73 }
  74 sub GSL_VECTOR_NEW: Tests {
  75     my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (1..10) ] );
  76     isa_ok( $vec, 'Math::GSL::Vector', 'Math::GSL::Vector->new($values)' );
  77
  78     eval { Math::GSL::Vector->new(-1) };
  79     ok( $@, 'new takes only positive indices');
  80
  81     eval { Math::GSL::Vector->new(3.14) };
  82     ok( $@, 'new takes only integer indices');
  83
  84     eval { Math::GSL::Vector->new([]) };
  85     ok( $@, 'new takes only nonempty array refs');
  86 }
  87 sub GSL_VECTOR_GET: Tests {
  88     my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (reverse 1..10) ] );
  89     my @x = $vec->get([0..9]);
  90     is_deeply( \@x, [map { $_ ** 2 } (reverse 1..10)] );
  91 }
  92
  93 sub GSL_VECTOR_SET: Tests {
  94     my $vec = Math::GSL::Vector->new( [ map { $_ ** 2 } (1..10) ] );
  95     $vec->set( [ 0..4] , [ reverse 1..5 ] );
  96     my ($x) = $vec->get([0]);
  97     ok( $x == 5, "gsl_vector_set: $x ?= 5" );
  98 }
  99 sub GSL_VECTOR_MIN: Tests {
 100     my $self = shift;
 101     map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 102     ok( is_similar( gsl_vector_min($self->{vector}) ,0), 'gsl_vector_min' );
 103 }
 104
 105 sub GSL_VECTOR_FREAD_FWRITE: Tests {
 106     my $self = shift;
 107     map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 108
 109     my $fh = fopen("vector", "w");
 110     my $status = gsl_vector_fwrite($fh, $self->{vector} );
 111     ok( ! $status, 'gsl_vector_fwrite' );
 112     ok( -f "vector", 'gsl_vector_fwrite' );
 113     fclose($fh);
 114
 115     map { gsl_vector_set($self->{vector}, $_, $_ ** 3 ) } (0..4);
 116
 117     $fh = fopen("vector", "r");
 118
 119     gsl_vector_fread($fh, $self->{vector} );
 120     is_deeply( [ map { gsl_vector_get($self->{vector}, $_) } (0..4) ],
 121                [ map { $_ ** 2 } (0..4) ],
 122              );
 123     fclose($fh);
 124 }
 125
 126 sub GSL_VECTOR_SUBVECTOR : Tests {
 127     my $self = shift;
 128     map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 129     my $vec_sub = gsl_vector_subvector($self->{vector}, 2, 3);
 130
 131     ok_similar( [ map { gsl_vector_get($vec_sub->{vector}, $_) } (0..2) ],
 132                 [ 4, 9, 16 ],
 133               );
 134 }
 135
 136 sub GSL_VECTOR_CALLOC : Tests {
 137    my $vector = gsl_vector_calloc(5);
 138    isa_ok($vector, 'Math::GSL::Vector');
 139
 140    my @got = map { gsl_vector_get($vector, $_) } (0..4);
 141
 142    map { is($got[$_] , 0 ) } (0..4);
 143 }
 144
 145 sub GSL_VECTOR_SET_ALL : Tests {
 146    my $self = shift;
 147    gsl_vector_set_all($self->{vector}, 4);
 148    map { is(gsl_vector_get($self->{vector} , $_ ), 4) } (0..4);
 149 }
 150
 151 sub GSL_VECTOR_SET_ZERO : Tests {
 152    my $self = shift;
 153    gsl_vector_set_zero($self->{vector});
 154    map { is(gsl_vector_get($self->{vector} , $_ ), 0) } (0..4);
 155 }
 156
 157 sub GSL_VECTOR_SET_BASIS : Tests {
 158    my $self = shift;
 159    my $x = gsl_vector_set_basis($self->{vector}, 0);
 160    is (gsl_vector_get($self->{vector} , 0 ), 1);
 161    is ($x, 0, "output");
 162    map { is(gsl_vector_get($self->{vector} , $_ ), 0) } (1..4);
 163 }
 164
 165 sub GSL_VECTOR_SUBVECTOR_WITH_STRIDE : Tests {
 166    my $self = shift;
 167    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 168    my $sub_stride = gsl_vector_subvector_with_stride($self->{vector}, 0, 2, 3);
 169    is(gsl_vector_get($sub_stride->{vector} , 0 ), 0, "first element");
 170    is(gsl_vector_get($sub_stride->{vector} , 1 ), 4, "second element");
 171    is(gsl_vector_get($sub_stride->{vector} , 2 ), 16, "third element");
 172 }
 173
 174 sub GSL_VECTOR_MAX_INDEX : Tests {
 175    my $self = shift;
 176    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 177    my $index = gsl_vector_max_index($self->{vector});
 178    is($index, 4, "Position of the maximum");
 179 }
 180
 181 sub GSL_VECTOR_MIN_INDEX : Tests {
 182    my $self = shift;
 183    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 184    my $index = gsl_vector_min_index($self->{vector});
 185    is($index, 0, "Position of the minimum");
 186 }
 187
 188 sub GSL_VECTOR_MINMAX_INDEX : Tests {
 189    my $self = shift;
 190    my ($min,$max)=(0,0);
 191    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 192
 193    ($min, $max) = Math::GSL::Vector::gsl_vector_minmax_index($self->{vector}, $min, $max);
 194    ok_similar( [ 0, 4 ], [ $min, $max], 'gsl_vector_minmax_index' );
 195 }
 196
 197 sub GSL_VECTOR_MINMAX : Tests {
 198    my ($min, $max) = (17,42);
 199    my $vector->{vector} = gsl_vector_alloc(5);
 200    map { gsl_vector_set($vector->{vector}, $_, $_ ** 2 ) } (0..4); ;
 201
 202    ($min, $max) = Math::GSL::Vector::gsl_vector_minmax($vector->{vector}, $min, $max);
 203
 204    ok_similar( [ 0, 16 ], [ $min, $max], 'gsl_vector_minmax' );
 205 }
 206
 207 sub GSL_VECTOR_MEMCPY : Tests {
 208    my $self = shift;
 209    my $copy->{vector} = gsl_vector_alloc(5);
 210    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 211    is( gsl_vector_memcpy($copy->{vector}, $self->{vector}), 0);
 212    map { is(gsl_vector_get($copy->{vector}, $_), $_ ** 2 ) } (0..4); ;
 213 }
 214
 215 sub GSL_VECTOR_VIEW_ARRAY : Tests {
 216    my @array = [1,2,3,4,5,6];
 217    my $vec_view->{vector} = gsl_vector_alloc(2);
 218    $vec_view = gsl_vector_view_array(@array, 2);
 219    map { is(gsl_vector_get($vec_view->{vector}, $_), $_+1 ) } (0..1); ;
 220 }
 221
 222 sub GSL_VECTOR_REVERSE : Tests {
 223    my $self = shift;
 224    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 225    is( gsl_vector_reverse($self->{vector}), 0);
 226    ok_similar( [ 16, 9, 4, 1, 0], [ map { gsl_vector_get($self->{vector}, $_) } 0..4 ] );
 227 }
 228
 229 sub GSL_VECTOR_SWAP_ELEMENTS : Tests {
 230    my $self = shift;
 231    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 232    is( gsl_vector_swap_elements($self->{vector}, 0, 4), 0);
 233    is(gsl_vector_get($self->{vector}, 0), 16);
 234    is(gsl_vector_get($self->{vector}, 4), 0);
 235    map { is(gsl_vector_get($self->{vector}, $_), $_ ** 2 ) } (1..3); ;
 236 }
 237
 238 sub GSL_VECTOR_ADD : Tests {
 239    my $self = shift;
 240    my $second_vec->{vector} = gsl_vector_alloc(5);
 241    map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ;
 242    map { gsl_vector_set($second_vec->{vector}, $_, $_ ) } (0..4); ;
 243    is(gsl_vector_reverse($second_vec->{vector}),0);
 244    is( gsl_vector_add($self->{vector}, $second_vec->{vector}), 0);
 245    map { is(gsl_vector_get($self->{vector}, $_), 4 ) } (0..4); ;
 246 }
 247
 248 sub GSL_VECTOR_SUB : Tests {
 249    my $self = shift;
 250    my $second_vec->{vector} = gsl_vector_alloc(5);
 251    map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ;
 252    map { gsl_vector_set($second_vec->{vector}, $_, 1) } (0..4); ;
 253    is( gsl_vector_sub($self->{vector}, $second_vec->{vector}), 0);
 254    map { is(gsl_vector_get($self->{vector}, $_), $_ - 1 ) } (0..4); ;
 255 }
 256
 257 sub GSL_VECTOR_MUL : Tests {
 258    my $self = shift;
 259    my $second_vec->{vector} = gsl_vector_alloc(5);
 260    map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ;
 261    map { gsl_vector_set($second_vec->{vector}, $_, 2) } (0..4); ;
 262    is( gsl_vector_mul($self->{vector}, $second_vec->{vector}), 0);
 263    map { is(gsl_vector_get($self->{vector}, $_), $_ * 2 ) } (0..4); ;
 264 }
 265
 266 sub GSL_VECTOR_DIV : Tests {
 267    my $self = shift;
 268    my $second_vec->{vector} = gsl_vector_alloc(5);
 269    map { gsl_vector_set($self->{vector}, $_, $_*2 ) } (0..4); ;
 270    map { gsl_vector_set($second_vec->{vector}, $_, 2) } (0..4); ;
 271    is( gsl_vector_div($self->{vector}, $second_vec->{vector}), 0);
 272    map { is(gsl_vector_get($self->{vector}, $_), $_ ) } (0..4); ;
 273 }
 274
 275 sub GSL_VECTOR_SCALE : Tests {
 276    my $self = shift;
 277    map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ;
 278    is( gsl_vector_scale($self->{vector}, 2), 0);
 279    map { is(gsl_vector_get($self->{vector}, $_), $_ * 2 ) } (0..4); ;
 280 }
 281
 282 sub GSL_VECTOR_SWAP : Tests {
 283
 284    my @idx  = (0..(5+int rand(5)));
 285    my $vec1 = gsl_vector_alloc($#idx+1);
 286    my $vec2 = gsl_vector_alloc($#idx+1);
 287
 288    map { gsl_vector_set($vec1, $_, $_**2 ) } @idx;
 289    map { gsl_vector_set($vec2, $_, $_)     } @idx;
 290
 291    is( gsl_vector_swap($vec1, $vec2), 0);
 292
 293    ok_similar( [ map { gsl_vector_get($vec1, $_)  } @idx ],
 294                [ @idx ],
 295              );
 296    ok_similar( [ map { gsl_vector_get($vec2, $_)  } @idx ],
 297                [ map { $_**2 } @idx ],
 298              );
 299 }
 300
 301 sub GSL_VECTOR_FPRINTF_FSCANF : Tests {
 302    my $self = shift;
 303    map { gsl_vector_set($self->{vector}, $_, $_**2) } (0..4);
 304
 305    my $fh = fopen("vector", "w");
 306    is( gsl_vector_fprintf($fh, $self->{vector}, "%f"), 0);
 307    fclose($fh);
 308
 309    map { gsl_vector_set($self->{vector}, $_, $_**3) } (0..4);
 310
 311    $fh = fopen("vector", "r");
 312
 313    is(gsl_vector_fscanf($fh, $self->{vector}), 0);
 314    map { is(gsl_vector_get($self->{vector}, $_), $_**2) } (0..4);
 315    fclose($fh);
 316 }
 317 1;