t/Vector.t

   1 package Math::GSL::Vector::Test;
   2 use base q{Test::Class};
   3 use Test::More tests => 122;
   4 use Math::GSL          qw/:all/;
   5 use Math::GSL::Test    qw/:all/;
   6 use Math::GSL::Errno   qw/:all/;
   7 use Math::GSL::Vector  qw/:all/;
   8 use Math::GSL::Complex qw/:all/;
   9 use Test::Exception;
  10 use Data::Dumper;
  11 use strict;
  12
  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([1 .. 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     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}), 'non-null vector returns false' );
  52     map { gsl_vector_set($self->{vector}, $_, 0 ) } (0..4);
  53     ok( gsl_vector_isnull($self->{vector}),'null vector returns true' );
  54     gsl_vector_set($self->{vector}, 0, 5 );
  55     ok( !gsl_vector_isnull($self->{vector}), 'changed non-null vector returns false' );
  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     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 $fh = gsl_fopen("vector", 'w');
 118     my $status = gsl_vector_fwrite($fh, $self->{vector} );
 119     ok( ! $status, 'gsl_vector_fwrite' );
 120     ok( -f "vector", 'gsl_vector_fwrite' );
 121     ok_status(fclose($fh));
 122
 123     map { gsl_vector_set($self->{vector}, $_, $_ ** 3 ) } (0..4);
 124
 125     $fh = gsl_fopen("vector", 'r');
 126
 127     ok_status(gsl_vector_fread($fh, $self->{vector} ));
 128     is_deeply( [ map { gsl_vector_get($self->{vector}, $_) } (0..4) ],
 129                [ map { $_ ** 2 } (0..4) ],
 130              );
 131     ok_status(gsl_fclose($fh));
 132 }
 133
 134 sub GSL_VECTOR_SUBVECTOR : Tests {
 135     my $self = shift;
 136     map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 137     my $vec_sub = gsl_vector_subvector($self->{vector}, 2, 3);
 138
 139     ok_similar( [ map { gsl_vector_get($vec_sub->{vector}, $_) } (0..2) ],
 140                 [ 4, 9, 16 ],
 141               );
 142 }
 143
 144 sub GSL_VECTOR_CALLOC : Tests {
 145    my $vector = gsl_vector_calloc(5);
 146    isa_ok($vector, 'Math::GSL::Vector');
 147 }
 148
 149 sub GSL_VECTOR_SET_ALL : Tests {
 150    my $vec = Math::GSL::Vector->new(5);
 151    gsl_vector_set_all($vec->raw, 4);
 152    ok_similar( [ $vec->as_list ], [ (4) x 5 ] );
 153 }
 154
 155 sub GSL_VECTOR_SET_ZERO : Tests {
 156    my $self = shift;
 157    gsl_vector_set_zero($self->{vector});
 158    map { is(gsl_vector_get($self->{vector} , $_ ), 0) } (0..4);
 159 }
 160
 161 sub GSL_VECTOR_SET_BASIS : Tests {
 162    my $self = shift;
 163    ok_status(gsl_vector_set_basis($self->{vector}, 0));
 164    is (gsl_vector_get($self->{vector} , 0 ), 1);
 165    map { is(gsl_vector_get($self->{vector} , $_ ), 0) } (1..4);
 166 }
 167
 168 sub GSL_VECTOR_SUBVECTOR_WITH_STRIDE : Tests {
 169    my $self = shift;
 170    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 171    my $sub_stride = gsl_vector_subvector_with_stride($self->{vector}, 0, 2, 3);
 172    is(gsl_vector_get($sub_stride->{vector} , 0 ), 0, "first element");
 173    is(gsl_vector_get($sub_stride->{vector} , 1 ), 4, "second element");
 174    is(gsl_vector_get($sub_stride->{vector} , 2 ), 16, "third element");
 175 }
 176
 177 sub GSL_VECTOR_MAX_INDEX : Tests {
 178    my $self = shift;
 179    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 180    my $index = gsl_vector_max_index($self->{vector});
 181    is($index, 4, "Position of the maximum");
 182 }
 183
 184 sub GSL_VECTOR_MIN_INDEX : Tests {
 185    my $self = shift;
 186    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 187    my $index = gsl_vector_min_index($self->{vector});
 188    is($index, 0, "Position of the minimum");
 189 }
 190
 191 sub GSL_VECTOR_MINMAX_INDEX : Tests {
 192    my $self = shift;
 193    my ($min, $max);
 194    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4);
 195    ($min, $max) = gsl_vector_minmax_index($self->{vector});
 196    ok_similar( [ 0, 4 ], [ $min, $max], 'gsl_vector_minmax_index' );
 197 }
 198
 199 sub GSL_VECTOR_MINMAX : Tests {
 200    my ($min, $max);
 201    my $vector = gsl_vector_alloc(5);
 202    map { gsl_vector_set($vector, $_, $_ ** 2 ) } (0..4);
 203
 204    ($min, $max) = gsl_vector_minmax($vector);
 205
 206    ok_similar( [ 0, 16 ], [ $min, $max], 'gsl_vector_minmax' );
 207 }
 208
 209 sub GSL_VECTOR_MEMCPY : Tests {
 210    my $self = shift;
 211    my $copy = gsl_vector_alloc(5);
 212    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 213    ok_status( gsl_vector_memcpy($copy, $self->{vector}) );
 214    map { is(gsl_vector_get($copy, $_), $_ ** 2 ) } (0..4); ;
 215 }
 216
 217 sub GSL_VECTOR_VIEW_ARRAY : Tests {
 218    my @array = [1,2,3,4,5,6];
 219    my $vec_view = gsl_vector_view_array(@array, 2);
 220    map { is(gsl_vector_get($vec_view->{vector}, $_), $_+1 ) } (0..1); ;
 221 }
 222
 223 sub GSL_VECTOR_REVERSE : Tests {
 224    my $self = shift;
 225    map { gsl_vector_set($self->{vector}, $_, $_ ** 2 ) } (0..4); ;
 226    ok_status( gsl_vector_reverse($self->{vector}));
 227    ok_similar( [ 16, 9, 4, 1, 0], [ map { gsl_vector_get($self->{vector}, $_) } 0..4 ] );
 228 }
 229
 230 sub GSL_VECTOR_SWAP_ELEMENTS : Tests {
 231    my $v1 = Math::GSL::Vector->new( [ map { $_ ** 2 } (0 .. 4) ] );
 232    ok_status( gsl_vector_swap_elements($v1->raw, 0, 4));
 233
 234    is(gsl_vector_get($v1->raw, 0), 16);
 235    is(gsl_vector_get($v1->raw, 4), 0);
 236
 237    is_deeply( [ 16, 1, 4, 9, 0 ], [ $v1->as_list ] );
 238 }
 239
 240 sub GSL_VECTOR_ADD : Tests {
 241    my $v1 = Math::GSL::Vector->new([0 .. 4]);
 242    my $v2 = $v1->copy;
 243    ok_status( gsl_vector_reverse($v2->raw) );
 244    ok_status( gsl_vector_add($v1->raw, $v2->raw) );
 245    is_deeply( [ $v1->as_list ], [ (4) x 5 ] );
 246 }
 247
 248 sub GSL_VECTOR_SUB : Tests {
 249    my $self = shift;
 250    my $second_vec = gsl_vector_alloc(5);
 251    map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ;
 252    map { gsl_vector_set($second_vec, $_, 1) } (0..4); ;
 253    ok_status( gsl_vector_sub($self->{vector}, $second_vec));
 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 = gsl_vector_alloc(5);
 260    map { gsl_vector_set($self->{vector}, $_, $_ ) } (0..4); ;
 261    map { gsl_vector_set($second_vec, $_, 2) } (0..4); ;
 262    ok_status( gsl_vector_mul($self->{vector}, $second_vec));
 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 = gsl_vector_alloc(5);
 269    map { gsl_vector_set($self->{vector}, $_, $_*2 ) } (0..4); ;
 270    map { gsl_vector_set($second_vec, $_, 2) } (0..4); ;
 271    ok_status( gsl_vector_div($self->{vector}, $second_vec));
 272    map { is(gsl_vector_get($self->{vector}, $_), $_ ) } (0..4); ;
 273 }
 274
 275 sub GSL_VECTOR_SCALE : Tests {
 276    my $v = Math::GSL::Vector->new([0..4]);
 277    ok_status(gsl_vector_scale($v->raw, 2));
 278    ok_similar( [ $v->as_list ], [ 0,2,4,6,8 ] );
 279 }
 280
 281 sub GSL_VECTOR_SCALE_OVERLOAD : Tests {
 282    my $v = Math::GSL::Vector->new([0..4]);
 283    my $expected = [ map { $_*5} (0..4) ];
 284    $v = 5 * $v;
 285    ok_similar( [ $v->as_list ],  $expected );
 286
 287    my $w = Math::GSL::Vector->new([0..4]);
 288    $w = $w * 5;
 289    ok_similar( [ $w->as_list ], $expected );
 290 }
 291
 292 sub GSL_VECTOR_DOT_PRODUCT : Tests {
 293    my $v = Math::GSL::Vector->new([0..4]);
 294    my $w = Math::GSL::Vector->new([0..4]);
 295
 296    ok_similar( $v * $w ,  4*4 + 3*3 + 2*2 + 1*1, 'basic dot product');
 297
 298    my $z = Math::GSL::Vector->new([0..10]);
 299    dies_ok( sub { $z * $v; }, 'dot_product checks vector length' );
 300
 301    my $q = Math::GSL::Vector->new(5);
 302    ok_similar ( $q * $q, 0, 'newly created vectors are zero-filled');
 303
 304 }
 305
 306 sub GSL_VECTOR_SWAP : Tests {
 307
 308    my @idx  = (0..(5+int rand(5)));
 309    my $vec1 = gsl_vector_alloc($#idx+1);
 310    my $vec2 = gsl_vector_alloc($#idx+1);
 311
 312    map { gsl_vector_set($vec1, $_, $_**2 ) } @idx;
 313    map { gsl_vector_set($vec2, $_, $_)     } @idx;
 314
 315    ok_status( gsl_vector_swap($vec1, $vec2));
 316
 317    ok_similar( [ map { gsl_vector_get($vec1, $_)  } @idx ],
 318                [ @idx ],
 319              );
 320    ok_similar( [ map { gsl_vector_get($vec2, $_)  } @idx ],
 321                [ map { $_**2 } @idx ],
 322              );
 323 }
 324
 325 sub GSL_VECTOR_FPRINTF_FSCANF : Tests {
 326    my $vec1 = Math::GSL::Vector->new([ map { $_ ** 2 } (0..4) ]);
 327
 328    my $fh = gsl_fopen("vector", 'w');
 329    ok( defined $fh, 'fopen -  write');
 330    ok_status(gsl_vector_fprintf($fh, $vec1->raw, "%f"));
 331    ok_status(gsl_fclose($fh));
 332
 333    my $vec2 = Math::GSL::Vector->new([ map { $_ ** 3 } (0..4) ]);
 334
 335    $fh = gsl_fopen("vector", 'r');
 336    ok( defined $fh, 'fopen  - readonly');
 337
 338    ok_status(gsl_vector_fscanf($fh, $vec2->raw));
 339
 340    ok_similar( [ $vec2->as_list ], [ map { $_ ** 2 } (0..4) ]);
 341    ok_status(gsl_fclose($fh) );
 342 }
 343
 344 sub GSL_VECTOR_COMPLEX_ALLOC : Tests {
 345   my $vec = gsl_vector_complex_alloc(5);
 346   isa_ok($vec, 'Math::GSL::Vector');
 347 }
 348
 349 sub GSL_VECTOR_COMPLEX_CALLOC : Tests {
 350   my $vec = gsl_vector_complex_calloc(5);
 351   isa_ok($vec, 'Math::GSL::Vector');
 352 }
 353
 354 sub GSL_VECTOR_RAW : Tests {
 355     my $vec = Math::GSL::Vector->new(10);
 356     isa_ok($vec->raw, 'Math::GSL::Vector::gsl_vector');
 357 }
 358
 359 sub GSL_VECTOR_COMPLEX_SET_GET : Tests {
 360   my $vec = gsl_vector_complex_calloc(5);
 361   my $complex = gsl_complex_rect(2,1);
 362   gsl_vector_complex_set($vec, 0, $complex);
 363   my $result = gsl_complex_rect(5,5);
 364   $result = gsl_vector_complex_get($vec, 0);
 365   isa_ok($result, 'Math::GSL::Complex');
 366   print Dumper [ $result ];
 367   local $TODO = "don't know why the complex returned gsl_vector_complex_get is not usable";
 368 }
 369
 370 sub GSL_ADDITION : Tests {
 371   my $vec1 = Math::GSL::Vector->new([1,2,3]);
 372   my $vec2 = Math::GSL::Vector->new([2,3,4]);
 373   my $vec3 = $vec1 + $vec2;
 374   ok_similar([$vec3->as_list], [3,5,7]);
 375
 376
 377   my $vec4 = $vec2 + 5;
 378   ok_similar([$vec4->as_list], [7,8,9]);
 379
 380   my $vec5 = 5 + $vec2;
 381   ok_similar([$vec5->as_list], [7,8,9]);
 382
 383   my $z = Math::GSL::Vector->new([0..10]);
 384   dies_ok( sub { $z + $vec1; }, 'addition checks vector length' );
 385   ok_similar([$vec1->as_list], [1,2,3]);
 386
 387 }
 388 sub COPY : Tests {
 389     my $v1 = Math::GSL::Vector->new( [ 55 .. 65 ] );
 390     isa_ok( $v1->copy, 'Math::GSL::Vector' );
 391     ok_similar( [ $v1->copy->as_list ], [ $v1->as_list ] );
 392
 393 }
 394 sub GSL_SUBTRACTION : Tests {
 395     my $v1 = Math::GSL::Vector->new( [ 1 .. 5 ]);
 396     my $v2 = Math::GSL::Vector->new( [ 5 .. 9 ]);
 397
 398     ok_similar( [($v2-$v1)->as_list], [ (4) x 5 ] );
 399
 400     my $v3 = $v2 - 3;
 401     ok_similar( [ $v3->as_list  ], [ 2 .. 6 ] );
 402
 403     my $v4 = 4 - $v3;
 404     ok_similar( [ $v4->as_list ], [ 2, 1, 0, -1, -2 ] );
 405 }
 406
 407 sub GSL_MULTIPLICATION : Tests {
 408     my $v = Math::GSL::Vector->new([1,2,3]);
 409     my $v2 = $v * 5;
 410
 411     # check that original is not modified each time
 412     ok_similar ( [$v2->as_list], [5,10,15]);
 413     ok_similar ( [$v->as_list],  [1,2,3]);
 414
 415     my $v3 = 5 * $v;
 416     ok_similar ( [$v3->as_list], [5,10,15]);
 417     ok_similar ( [$v->as_list],  [1,2,3]);
 418
 419     my $w = $v3 * 0;
 420     ok_similar( [ $w->as_list ], [0,0,0], 'right overloaded zero-ify' );
 421
 422     my $z = 0 * $v3;
 423     ok_similar( [ $w->as_list ], [0,0,0], 'left overloaded zero-ify' );
 424 }
 425
 426 Test::Class->runtests;