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 }
  14
  15 sub teardown : Test(teardown) {
  16     unlink 'matrix' if -f 'matrix';
  17 }
  18
  19 sub GSL_MATRIX_ALLOC : Tests {
  20     my $matrix = gsl_matrix_alloc(5,5);
  21     isa_ok($matrix, 'Math::GSL::Matrix');
  22 }
  23
  24 sub GSL_MATRIX_SET : Tests {
  25     my $self = shift;
  26     map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
  27
  28     my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
  29     ok_similar( [ @got ], [ map { $_**2 } (0..4) ] );
  30 }
  31
  32 sub GSL_MATRIX_CALLOC : Tests {
  33    my $matrix = gsl_matrix_calloc(5,5);
  34    isa_ok($matrix, 'Math::GSL::Matrix');
  35
  36    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
  37    ok_similar( [ @got ], [ 0,0,0,0,0 ], 'gsl_matrix_calloc' );
  38 }
  39
  40 sub GSL_MATRIX_FREE : Tests {
  41    my $matrix = gsl_matrix_calloc(5,5);
  42    isa_ok($matrix, 'Math::GSL::Matrix');
  43
  44    is(gsl_matrix_get($matrix, 0, 0), 0);
  45    gsl_matrix_free($matrix);
  46 }
  47
  48 sub GSL_MATRIX_SUBMATRIX : Tests {
  49    my $matrix = gsl_matrix_alloc(5,5);
  50    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
  51    my $subMatrix = gsl_matrix_submatrix($matrix, 0, 0, 2, 2);
  52    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..2);
  53    ok_similar( [ @got ], [ 0..2 ] );
  54 }
  55
  56 sub GSL_MATRIX_ROW : Tests {
  57    my $self = shift;
  58    my $line;
  59    for ($line=0; $line<5; $line++) {
  60    map { gsl_matrix_set($self->{matrix}, $_,$line, $_) } (0..4); }
  61
  62    my $vector_view = gsl_matrix_row($self->{matrix}, 1);
  63    my @got = map { gsl_vector_get($vector_view->{vector}, $_) } (0..4);
  64    map { is($got[$_], $_) } (0..4);
  65 }
  66
  67 sub GSL_MATRIX_COLUMN : Tests {
  68     my $self = shift;
  69     my $view = gsl_vector_alloc(5);
  70
  71     for my $line (0..4) {
  72         map { gsl_matrix_set($self->{matrix}, $line,$_, $_) } (0..4);
  73     }
  74     $view = gsl_matrix_column($self->{matrix}, 1);
  75
  76     print Dumper [ $view ];
  77     my @got = map { gsl_vector_get($view, $_) } (0..4);
  78     ok_similar( [ @got ], [ 0 .. 4 ], 'gsl_matrix_column' );
  79 }
  80
  81 sub GSL_MATRIX_DIAGONAL : Tests {
  82    my $matrix = gsl_matrix_alloc(4,4);
  83    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..3);
  84    my $vector = gsl_matrix_diagonal($matrix);
  85    print Dumper [ $vector ];
  86    my @got = map { gsl_vector_get($vector, $_) } (0..3);
  87    ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_diagonal');
  88 }
  89
  90 sub GSL_MATRIX_SUBDIAGONAL : Tests {
  91    my $matrix = gsl_matrix_alloc(4,4);
  92    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..3);
  93    my $vector = gsl_matrix_subdiagonal($matrix, 0);
  94    my @got = map { gsl_vector_get($vector, $_) } (0..3);
  95    ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_subdiagonal');
  96
  97    $vector = gsl_matrix_subdiagonal($matrix, 1);
  98    print Dumper [ $vector->{vector} ];
  99    @got = map { gsl_vector_get($vector->{vector}, $_) } (0..2);
 100    ok_similar( [ @got ], [ 1 .. 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    gsl_matrix_minmax($self->{matrix}, \$min, \$max);
 253    is($min, 0);
 254    is($max, 16);
 255 }
 256
 257 sub GSL_MATRIX_MAX_INDEX : Tests {
 258    my $self = shift;
 259    my ($imax, $jmax);
 260    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 261    ($imax, $jmax) = gsl_matrix_max_index($self->{matrix}, $imax, $jmax);
 262    ok_similar( [ $imax, $jmax ], [ 0 .. 4 ], 'gsl_matrix_max_index' );
 263 }
 264
 265 sub GSL_MATRIX_ISNULL : Tests {
 266    my $self = shift;
 267
 268    is(gsl_matrix_isnull($self->{matrix}), 1);
 269
 270    for my $line (0..4) {
 271         map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4);
 272    }
 273
 274    is(gsl_matrix_isnull($self->{matrix}), 0);
 275 }
 276
 277 sub GSL_MATRIX_ISPOS : Tests {
 278    my $self = shift;
 279    my $line;
 280
 281    for($line=0; $line<5; $line++) {
 282    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 283    is(gsl_matrix_ispos($self->{matrix}), 0);
 284
 285    for($line=0; $line<5; $line++) {
 286    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 287    is(gsl_matrix_ispos($self->{matrix}), 1);
 288
 289    for($line=0; $line<5; $line++) {
 290    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 291    is(gsl_matrix_ispos($self->{matrix}), 0);
 292 }
 293
 294 sub GSL_MATRIX_ISNEG : Tests {
 295    my $self = shift;
 296    my $line;
 297
 298    for($line=0; $line<5; $line++) {
 299    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 300    is(gsl_matrix_isneg($self->{matrix}), 1);
 301
 302    for($line=0; $line<5; $line++) {
 303    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 304    is(gsl_matrix_isneg($self->{matrix}), 0);
 305
 306    for($line=0; $line<5; $line++) {
 307    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 308    is(gsl_matrix_isneg($self->{matrix}), 0);
 309 }
 310
 311 sub GSL_MATRIX_ISNONNEG : Tests {
 312    my $self = shift;
 313    my $line;
 314
 315    for($line=0; $line<5; $line++) {
 316    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 317    is(gsl_matrix_isnonneg($self->{matrix}), 0);
 318
 319    for($line=0; $line<5; $line++) {
 320    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 321    is(gsl_matrix_isnonneg($self->{matrix}), 1);
 322
 323    for($line=0; $line<5; $line++) {
 324    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 325    is(gsl_matrix_isnonneg($self->{matrix}), 1);
 326 }
 327
 328 sub GSL_MATRIX_GET_ROW : Tests {
 329    my $self = shift;
 330    my $vector->{vector} = gsl_vector_alloc(5);
 331    map { gsl_matrix_set($self->{matrix}, 0, $_, $_) } (0..4);
 332    is(gsl_matrix_get_row($vector->{vector}, $self->{matrix}, 0), 0);
 333    map { is(gsl_vector_get($vector->{vector}, $_), $_) } (0..4);
 334 }
 335
 336 sub GSL_MATRIX_GET_COL : Tests {
 337    my $self = shift;
 338    my $vector->{vector} = gsl_vector_alloc(5);
 339    map { gsl_matrix_set($self->{matrix}, $_, 0, $_) } (0..4);
 340    is(gsl_matrix_get_col($vector->{vector}, $self->{matrix}, 0), 0);
 341    map { is(gsl_vector_get($vector->{vector}, $_), $_) } (0..4);
 342 }
 343
 344 sub GSL_MATRIX_SET_ROW : Tests {
 345    my $self = shift;
 346    my $vector->{vector} = gsl_vector_alloc(5);
 347    map { gsl_vector_set($vector->{vector}, $_, $_**2) } (0..4);
 348    is(gsl_matrix_set_row($self->{matrix}, 1, $vector->{vector}), 0);
 349    map { is(gsl_matrix_get($self->{matrix}, 1, $_), $_**2) } (0..4);
 350 }
 351
 352 sub GSL_MATRIX_SET_COL : Tests {
 353    my $self = shift;
 354    my $vector->{vector} = gsl_vector_alloc(5);
 355    map { gsl_vector_set($vector->{vector}, $_, $_**2) } (0..4);
 356    is(gsl_matrix_set_col($self->{matrix}, 1, $vector->{vector}), 0);
 357    map { is(gsl_matrix_get($self->{matrix}, $_, 1), $_**2) } (0..4);
 358 }
 359
 360 sub GSL_MATRIX_FREAD_FWRITE : Tests {
 361    my $self = shift;
 362    for my $line (0..4) {
 363         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
 364    }
 365
 366    my $fh = fopen("matrix", "w");
 367    is( gsl_matrix_fwrite($fh, $self->{matrix}), 0);
 368    fclose($fh);
 369
 370    for my $line (0..4) {
 371         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
 372    }
 373
 374    $fh = fopen("matrix", "r");
 375
 376    is(gsl_matrix_fread($fh, $self->{matrix}), 0);
 377    for my $line (0..4) {
 378         ok_similar(
 379                     [ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
 380                     [ map { $_**2 } (0..4) ],
 381                   );
 382    }
 383    fclose($fh);
 384 }
 385
 386 sub GSL_MATRIX_FPRINTF_FSCANF : Tests {
 387    my $self = shift;
 388
 389    for my $line (0..4) {
 390         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
 391    }
 392
 393    my $fh = fopen("matrix", "w");
 394    is( gsl_matrix_fprintf($fh, $self->{matrix}, "%f"), 0);
 395    fclose($fh);
 396
 397    for my $line (0..4) {
 398         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
 399    }
 400
 401    $fh = fopen("matrix", "r");
 402
 403    is(gsl_matrix_fscanf($fh, $self->{matrix}), 0);
 404    for my $line (0..4) {
 405         ok_similar(
 406                     [ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
 407                     [ map { $_**2 } (0..4) ],
 408                   );
 409    }
 410    fclose($fh);
 411 }
 412
 413 1;