t/Vector.t

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