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