lib/Math/GSL/Matrix/Test.pm

   1 package Math::GSL::Matrix::Test;
   2 use base q{Test::Class};
   3 use Test::More;
   4 use Math::GSL::Matrix qw/:all/;
   5 use Math::GSL::Vector qw/:all/;
   6 use Math::GSL qw/:all/;
   7 use Data::Dumper;
   8 use strict;
   9
  10 sub make_fixture : Test(setup) {
  11     my $self = shift;
  12     $self->{matrix} = gsl_matrix_alloc(5,5);
  13     $self->{obj}    = Math::GSL::Matrix->new(5,5);
  14 }
  15
  16 sub teardown : Test(teardown) {
  17     unlink 'matrix' if -f 'matrix';
  18 }
  19
  20 sub GSL_MATRIX_ALLOC : Tests {
  21     my $matrix = gsl_matrix_alloc(5,5);
  22     isa_ok($matrix, 'Math::GSL::Matrix');
  23 }
  24
  25 sub GSL_MATRIX_SET : Tests {
  26     my $self = shift;
  27     map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
  28
  29     my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
  30     ok_similar( [ @got ], [ map { $_**2 } (0..4) ] );
  31 }
  32
  33 sub GSL_MATRIX_CALLOC : Tests {
  34    my $matrix = gsl_matrix_calloc(5,5);
  35    isa_ok($matrix, 'Math::GSL::Matrix');
  36
  37    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
  38    ok_similar( [ @got ], [ (0) x 5 ], 'gsl_matrix_calloc' );
  39 }
  40
  41 sub GSL_MATRIX_FREE : Tests {
  42    my $matrix = gsl_matrix_calloc(5,5);
  43    isa_ok($matrix, 'Math::GSL::Matrix');
  44
  45    is(gsl_matrix_get($matrix, 0, 0), 0);
  46    gsl_matrix_free($matrix);
  47 }
  48
  49 sub GSL_MATRIX_SUBMATRIX : Tests {
  50    my $matrix = gsl_matrix_alloc(5,5);
  51    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
  52    my $subMatrix = gsl_matrix_submatrix($matrix, 0, 0, 2, 2);
  53    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..2);
  54    ok_similar( [ @got ], [ 0..2 ] );
  55 }
  56
  57 sub GSL_MATRIX_ROW : Tests {
  58    my $self = shift;
  59    for my $line (0..4) {
  60         map { gsl_matrix_set($self->{matrix}, $_,$line, $_) } (0..4);
  61    }
  62
  63    my $vector_view = gsl_matrix_row($self->{matrix}, 2);
  64    my @got = map { gsl_vector_get($vector_view->{vector}, $_) } (0..4);
  65    ok_similar( [ @got ], [ (2)x 5], 'gsl_matrix_row' );
  66 }
  67
  68 sub GSL_MATRIX_COLUMN : Tests {
  69     my $self = shift;
  70     my $view = gsl_vector_alloc(5);
  71
  72     for my $line (0..4) {
  73         map { gsl_matrix_set($self->{matrix}, $line,$_, $line*$_) } (0..4);
  74     }
  75     $view = gsl_matrix_column($self->{matrix}, 2);
  76     my $vec = $view->swig_vector_get();
  77
  78     my @got = map { gsl_vector_get($vec, $_) } (0..4);
  79     ok_similar( [ @got ], [0,2,4,6,8 ], 'gsl_matrix_column' );
  80 }
  81
  82 sub GSL_MATRIX_DIAGONAL : Tests {
  83    my $matrix = gsl_matrix_alloc(4,4);
  84    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..3);
  85    my $view = gsl_matrix_diagonal($matrix);
  86    my $vec = $view->swig_vector_get();
  87
  88    my @got = map { gsl_vector_get($vec, $_) } (0..3);
  89    ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_diagonal');
  90 }
  91
  92 sub GSL_MATRIX_SUBDIAGONAL : Tests {
  93    my $matrix = gsl_matrix_alloc(4,4);
  94
  95    map { gsl_matrix_set($matrix, $_,$_, $_)     } (0..3);
  96
  97    my $view = gsl_matrix_subdiagonal($matrix, 0);
  98    my $vec  = $view->swig_vector_get();
  99    my @got  = map { gsl_vector_get($vec, $_) } (0..3);
 100    ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_subdiagonal');
 101 }
 102
 103 sub GSL_MATRIX_SWAP : Tests {
 104    my $self=shift;
 105    map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
 106    my $matrix = gsl_matrix_alloc(5,5);
 107    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
 108    is(gsl_matrix_swap($self->{matrix}, $matrix) ,0);
 109    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 110    map { is($got[$_], $_) } (0..4);
 111    @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
 112    map { is($got[$_], $_** 2) } (0..4);
 113 }
 114
 115 sub GSL_MATRIX_MEMCPY : Tests {
 116    my $self = shift;
 117    my $matrix = gsl_matrix_alloc(5,5);
 118    map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
 119    is(gsl_matrix_memcpy($matrix, $self->{matrix}), 0);
 120    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
 121    map { is($got[$_], $_** 2) } (0..4);
 122 }
 123
 124 sub GSL_MATRIX_SWAP_ROWS : Tests {
 125    my $self = shift;
 126    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 127    map { gsl_matrix_set($self->{matrix}, 1,$_, 3) } (0..4);
 128    is(gsl_matrix_swap_rows($self->{matrix}, 0, 1), 0);
 129    my @got = map { gsl_matrix_get($self->{matrix}, 1, $_) } (0..4);
 130    map { is($got[$_], $_) } (0..4);
 131    @got = map { gsl_matrix_get($self->{matrix}, 0, $_) } (0..4);
 132    map { is($got[$_], 3) } (0..4);
 133 }
 134
 135 sub GSL_MATRIX_SWAP_COLUMNS : Tests {
 136    my $self = shift;
 137    map { gsl_matrix_set($self->{matrix}, $_,0, $_) } (0..4);
 138    map { gsl_matrix_set($self->{matrix}, $_,1, 3) } (0..4);
 139    is(gsl_matrix_swap_columns($self->{matrix}, 0, 1), 0);
 140    my @got = map { gsl_matrix_get($self->{matrix}, $_, 1) } (0..4);
 141    map { is($got[$_], $_) } (0..4);
 142    @got = map { gsl_matrix_get($self->{matrix}, $_, 0) } (0..4);
 143    map { is($got[$_], 3) } (0..4);
 144 }
 145
 146 sub GSL_MATRIX_SWAP_ROWCOL : Tests {
 147    my $self = shift;
 148    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 149    map { gsl_matrix_set($self->{matrix}, $_,2, 2) } (0..4);
 150    is(gsl_matrix_swap_rowcol($self->{matrix}, 0, 2), 0);
 151
 152    my @got = map { gsl_matrix_get($self->{matrix}, $_, 2) } (0..4);
 153    is_deeply( [ @got ], [ qw/2 1 0 3 4/  ] );
 154
 155    @got = map { gsl_matrix_get($self->{matrix}, 0, $_) } (0..4);
 156    is_deeply( [ @got ], [ qw/2 2 2 2 2/ ] );
 157 }
 158
 159 sub GSL_MATRIX_TRANSPOSE_MEMCPY : Tests {
 160    my $self = shift;
 161    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 162    my $matrix = gsl_matrix_alloc(5,5);
 163    is(gsl_matrix_transpose_memcpy($matrix, $self->{matrix}), 0);
 164    my @got = map { gsl_matrix_get($matrix, $_, 0) } (0..4);
 165    map { is($got[$_], $_) } (0..4);
 166 }
 167
 168 sub GSL_MATRIX_TRANSPOSE : Tests {
 169    my $self = shift;
 170    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 171    is(gsl_matrix_transpose($self->{matrix}), 0);
 172    my @got = map { gsl_matrix_get($self->{matrix}, $_, 0) } (0..4);
 173    map { is($got[$_], $_) } (0..4);
 174 }
 175
 176 sub GSL_MATRIX_ADD : Tests {
 177    my $self = shift;
 178    my $matrix = gsl_matrix_alloc(5, 5);
 179    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 180    map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
 181    is(gsl_matrix_add($self->{matrix}, $matrix), 0);
 182    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 183    map { is($got[$_], $_*2) } (0..4);
 184 }
 185
 186 sub GSL_MATRIX_SUB : Tests {
 187    my $self = shift;
 188    my $matrix = gsl_matrix_alloc(5, 5);
 189    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 190    map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
 191    is(gsl_matrix_sub($self->{matrix}, $matrix), 0);
 192    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 193    map { is($got[$_], 0) } (0..4);
 194 }
 195
 196 sub GSL_MATRIX_MUL_ELEMENTS : Tests {
 197    my $self = shift;
 198    my $matrix = gsl_matrix_alloc(5, 5);
 199    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 200    map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
 201    is(gsl_matrix_mul_elements($self->{matrix}, $matrix), 0);
 202    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 203    map { is($got[$_], $_**2) } (0..4);
 204 }
 205
 206 sub GSL_MATRIX_DIV_ELEMENTS : Tests {
 207    my $self = shift;
 208    my $matrix = gsl_matrix_alloc(5, 5);
 209    map { gsl_matrix_set($self->{matrix}, $_, $_, $_+1) } (0..4);
 210    map { gsl_matrix_set($matrix, $_, $_, $_+1) } (0..4);
 211    is(gsl_matrix_div_elements($self->{matrix}, $matrix), 0);
 212    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 213    map { is($got[$_], 1) } (0..4);
 214 }
 215
 216 sub GSL_MATRIX_SCALE : Tests {
 217    my $self = shift;
 218    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 219    is(gsl_matrix_scale($self->{matrix}, 4), 0);
 220    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 221    map { is($got[$_], $_*4) } (0..4);
 222 }
 223
 224 sub GSL_MATRIX_ADD_CONSTANT : Tests {
 225    my $self = shift;
 226    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 227    is(gsl_matrix_add_constant($self->{matrix}, 8), 0);
 228    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 229    map { is($got[$_], $_+8) } (0..4);
 230 }
 231
 232 sub GSL_MATRIX_MAX : Tests {
 233    my $self = shift;
 234    my $line;
 235    for($line=0; $line<5; $line++) {
 236    map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2 ) } (0..4); }
 237    is(gsl_matrix_max($self->{matrix}), 16);
 238 }
 239
 240 sub GSL_MATRIX_MIN : Tests {
 241    my $self = shift;
 242    my $line;
 243    for($line=0; $line<5; $line++) {
 244    map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2 ) } (0..4); }
 245    is(gsl_matrix_min($self->{matrix}), 0);
 246 }
 247
 248 sub GSL_MATRIX_MINMAX : Test {
 249    my $self = shift;
 250    my ($min, $max);
 251    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 252    ($min, $max) = gsl_matrix_minmax($self->{matrix});
 253    ok_similar( [ $min, $max ], [ 0, 16], 'gsl_matrix_minmax' );
 254 }
 255
 256 sub GSL_MATRIX_MAX_INDEX : Tests {
 257    my $self = shift;
 258    my $line;
 259    my ($imax, $jmax);
 260    for( $line =0; $line<4; $line++) {
 261    map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4); } # the matrix has to be clompletely filled or the function will return strange value... bug?
 262    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 263    ($imax, $jmax) = gsl_matrix_max_index($self->{matrix});
 264    ok_similar( [ $imax, $jmax ], [ 4, 4 ], 'gsl_matrix_max_index' );
 265 }
 266
 267 sub GSL_MATRIX_MIN_INDEX : Tests {
 268    my $self = shift;
 269    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 270    my ($imin, $jmin) = gsl_matrix_min_index($self->{matrix});
 271    ok_similar( [ $imin, $jmin ], [ 0, 0 ], 'gsl_matrix_min_index' );
 272 }
 273
 274 sub GSL_MATRIX_ISNULL : Tests {
 275    my $self = shift;
 276    for my $line (0..4) {
 277         map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4);
 278    }
 279    is(gsl_matrix_isnull($self->{matrix}), 1);
 280
 281    for my $line (0..4) {
 282         map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4);
 283    }
 284
 285    is(gsl_matrix_isnull($self->{matrix}), 0);
 286 }
 287
 288 sub GSL_MATRIX_ISPOS : Tests {
 289    my $self = shift;
 290    my $line;
 291
 292    for($line=0; $line<5; $line++) {
 293    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 294    is(gsl_matrix_ispos($self->{matrix}), 0);
 295
 296    for($line=0; $line<5; $line++) {
 297    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 298    is(gsl_matrix_ispos($self->{matrix}), 1);
 299
 300    for($line=0; $line<5; $line++) {
 301    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 302    is(gsl_matrix_ispos($self->{matrix}), 0);
 303 }
 304
 305 sub GSL_MATRIX_ISNEG : Tests {
 306    my $self = shift;
 307    my $line;
 308
 309    for($line=0; $line<5; $line++) {
 310    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 311    is(gsl_matrix_isneg($self->{matrix}), 1);
 312
 313    for($line=0; $line<5; $line++) {
 314    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 315    is(gsl_matrix_isneg($self->{matrix}), 0);
 316
 317    for($line=0; $line<5; $line++) {
 318    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 319    is(gsl_matrix_isneg($self->{matrix}), 0);
 320 }
 321
 322 sub GSL_MATRIX_ISNONNEG : Tests {
 323     my $self = shift;
 324     for my $row (0..4) {
 325         map { gsl_matrix_set($self->{matrix}, $row, $_, -1) } (0..4);
 326     }
 327     is(gsl_matrix_isnonneg($self->{matrix}), 0);
 328
 329     for my $row (0..4) {
 330         map { gsl_matrix_set($self->{matrix}, $row, $_, 1) } (0..4);
 331     }
 332     is(gsl_matrix_isnonneg($self->{matrix}), 1);
 333
 334     for my $row (0..4) {
 335         map { gsl_matrix_set($self->{matrix}, $row, $_, 0) } (0..4);
 336     }
 337     is(gsl_matrix_isnonneg($self->{matrix}), 1);
 338
 339 }
 340
 341 sub GSL_MATRIX_GET_ROW : Tests {
 342    my $self = shift;
 343    my $vector->{vector} = gsl_vector_alloc(5);
 344    map { gsl_matrix_set($self->{matrix}, 0, $_, $_) } (0..4);
 345    is(gsl_matrix_get_row($vector->{vector}, $self->{matrix}, 0), 0);
 346    map { is(gsl_vector_get($vector->{vector}, $_), $_) } (0..4);
 347 }
 348
 349 sub GSL_MATRIX_GET_COL : Tests {
 350    my $self = shift;
 351    my $vector->{vector} = gsl_vector_alloc(5);
 352    map { gsl_matrix_set($self->{matrix}, $_, 0, $_) } (0..4);
 353    is(gsl_matrix_get_col($vector->{vector}, $self->{matrix}, 0), 0);
 354    map { is(gsl_vector_get($vector->{vector}, $_), $_) } (0..4);
 355 }
 356
 357 sub GSL_MATRIX_SET_ROW : Tests {
 358    my $self = shift;
 359    my $vector->{vector} = gsl_vector_alloc(5);
 360    map { gsl_vector_set($vector->{vector}, $_, $_**2) } (0..4);
 361    is(gsl_matrix_set_row($self->{matrix}, 1, $vector->{vector}), 0);
 362
 363    ok_similar( [ map { gsl_matrix_get($self->{matrix}, 1, $_) } (0..4) ],
 364                [ map { $_ ** 2 } (0..4) ],
 365              );
 366 }
 367
 368 sub GSL_MATRIX_SET_COL : Tests {
 369    my $self = shift;
 370    my $vector->{vector} = gsl_vector_alloc(5);
 371    map { gsl_vector_set($vector->{vector}, $_, $_**2) } (0..4);
 372    is(gsl_matrix_set_col($self->{matrix}, 1, $vector->{vector}), 0);
 373
 374    ok_similar( [ map { gsl_matrix_get($self->{matrix}, $_, 1) } (0..4) ],
 375                [ map { $_ ** 2 } (0..4) ],
 376              );
 377 }
 378
 379 sub GSL_MATRIX_FREAD_FWRITE : Tests {
 380    my $self = shift;
 381    for my $line (0..4) {
 382         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
 383    }
 384
 385    my $fh = fopen("matrix", "w");
 386    is( gsl_matrix_fwrite($fh, $self->{matrix}), 0);
 387    fclose($fh);
 388
 389    for my $line (0..4) {
 390         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
 391    }
 392
 393    $fh = fopen("matrix", "r");
 394
 395    is(gsl_matrix_fread($fh, $self->{matrix}), 0);
 396    for my $line (0..4) {
 397         ok_similar(
 398                     [ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
 399                     [ map { $_**2 } (0..4) ],
 400                   );
 401    }
 402    fclose($fh);
 403 }
 404
 405 sub GSL_MATRIX_FPRINTF_FSCANF : Tests {
 406    my $self = shift;
 407
 408    for my $line (0..4) {
 409         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
 410    }
 411
 412    my $fh = fopen("matrix", "w");
 413    is( gsl_matrix_fprintf($fh, $self->{matrix}, "%f"), 0);
 414    fclose($fh);
 415
 416    for my $line (0..4) {
 417         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
 418    }
 419
 420    $fh = fopen("matrix", "r");
 421
 422    is(gsl_matrix_fscanf($fh, $self->{matrix}), 0);
 423    for my $line (0..4) {
 424         ok_similar(
 425                     [ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
 426                     [ map { $_**2 } (0..4) ],
 427                   );
 428    }
 429    fclose($fh);
 430 }
 431
 432 sub GSL_MATRIX_MINMAX_INDEX : Tests {
 433    my $self = shift;
 434    my $line;
 435    for ($line = 0; $line<4; $line ++) {
 436    map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4); }
 437    map { gsl_matrix_set($self->{matrix}, 4, $_, $_**2) } (0..4);
 438    my ($imin, $jmin, $imax, $jmax) = gsl_matrix_minmax_index($self->{matrix});
 439    ok_similar( [ $imin, $jmin, $imax, $jmax ], [ 0, 0, 4, 4], 'gsl_matrix_minmax_index' );
 440 }
 441
 442 sub GSL_MATRIX_ADD_DIAGONAL : Tests {
 443    my $self = shift;
 444    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 445    gsl_matrix_add_diagonal($self->{matrix}, 4);
 446    ok_similar( [ map { gsl_matrix_get($self->{matrix}, $_, $_)} (0..4) ],
 447                [ 4 .. 8 ],
 448              );
 449 }
 450
 451 sub GSL_MATRIX_NEW : Tests {
 452    my $self = shift;
 453    isa_ok( $self->{obj}, 'Math::GSL::Matrix' );
 454    isa_ok( $self->{obj}->raw, 'Math::GSL::Matrix::gsl_matrix' );
 455    ok( $self->{obj}->rows == 5, '->rows' );
 456    ok( $self->{obj}->cols == 5, '->cols' );
 457 }
 458 1;