t/Vector.t

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