t/Matrix.t

   1 package Math::GSL::Matrix::Test;
   2 use base q{Test::Class};
   3 use Test::More tests => 237;
   4 use strict;
   5 use warnings;
   6
   7 use Math::GSL           qw/:all/;
   8 use Math::GSL::Test     qw/:all/;
   9 use Math::GSL::Matrix   qw/:all/;
  10 use Math::GSL::Vector   qw/:all/;
  11 use Math::GSL::Complex  qw/:all/;
  12 use Math::GSL::Errno    qw/:all/;
  13 use Test::Exception;
  14 use Math::Complex;
  15 use Data::Dumper;
  16
  17 BEGIN{ gsl_set_error_handler_off(); }
  18
  19 sub make_fixture : Test(setup) {
  20     my $self = shift;
  21     $self->{matrix} = gsl_matrix_alloc(5,5);
  22     $self->{obj}    = Math::GSL::Matrix->new(5,5);
  23     gsl_matrix_set_zero($self->{matrix});
  24 }
  25
  26 sub teardown : Test(teardown) {
  27     unlink 'matrix' if -f 'matrix';
  28 }
  29
  30 sub GSL_MATRIX_ALLOC : Tests {
  31     my $matrix = gsl_matrix_alloc(5,5);
  32     isa_ok($matrix, 'Math::GSL::Matrix');
  33 }
  34
  35 sub GSL_MATRIX_SET : Tests {
  36     my $self = shift;
  37     map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
  38
  39     my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
  40     ok_similar( [ @got ], [ map { $_**2 } (0..4) ] );
  41 }
  42
  43 sub GSL_MATRIX_CALLOC : Tests {
  44    my $matrix = gsl_matrix_calloc(5,5);
  45    isa_ok($matrix, 'Math::GSL::Matrix');
  46
  47    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
  48    ok_similar( [ @got ], [ (0) x 5 ], 'gsl_matrix_calloc' );
  49 }
  50
  51 sub GSL_MATRIX_FREE : Tests {
  52    my $matrix = gsl_matrix_calloc(5,5);
  53    isa_ok($matrix, 'Math::GSL::Matrix');
  54
  55    is(gsl_matrix_get($matrix, 0, 0), 0);
  56    gsl_matrix_free($matrix);
  57 }
  58
  59 sub GSL_MATRIX_SUBMATRIX : Tests {
  60    my $matrix = gsl_matrix_alloc(5,5);
  61    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
  62    my $subMatrix = gsl_matrix_submatrix($matrix, 0, 0, 2, 2);
  63    my @got = map { gsl_matrix_get($matrix, $_, $_) } (0..2);
  64    ok_similar( [ @got ], [ 0..2 ] );
  65 }
  66
  67 sub GSL_MATRIX_ROW : Tests {
  68    my $self = shift;
  69    for my $line (0..4) {
  70         map { gsl_matrix_set($self->{matrix}, $_,$line, $_) } (0..4);
  71    }
  72
  73    my $vector_view = gsl_matrix_row($self->{matrix}, 2);
  74    my @got = map { gsl_vector_get($vector_view->{vector}, $_) } (0..4);
  75    ok_similar( [ @got ], [ (2)x 5], 'gsl_matrix_row' );
  76 }
  77
  78 sub GSL_MATRIX_COLUMN : Tests {
  79     my $self = shift;
  80     my $view = gsl_vector_alloc(5);
  81
  82     for my $line (0..4) {
  83         map { gsl_matrix_set($self->{matrix}, $line,$_, $line*$_) } (0..4);
  84     }
  85     $view = gsl_matrix_column($self->{matrix}, 2);
  86     my $vec = $view->swig_vector_get();
  87
  88     my @got = map { gsl_vector_get($vec, $_) } (0..4);
  89     ok_similar( [ @got ], [0,2,4,6,8 ], 'gsl_matrix_column' );
  90 }
  91
  92 sub GSL_MATRIX_DIAGONAL : Tests {
  93    my $matrix = gsl_matrix_alloc(4,4);
  94    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..3);
  95    my $view = gsl_matrix_diagonal($matrix);
  96    # better interface is needed
  97    my $vec = $view->swig_vector_get();
  98
  99    my @got = map { gsl_vector_get($vec, $_) } (0..3);
 100    ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_diagonal');
 101 }
 102
 103 sub GSL_MATRIX_SUBDIAGONAL : Tests {
 104    my $matrix = gsl_matrix_alloc(4,4);
 105
 106    map { gsl_matrix_set($matrix, $_,$_, $_)     } (0..3);
 107
 108    my $view = gsl_matrix_subdiagonal($matrix, 0);
 109    my $vec  = $view->swig_vector_get();
 110    my @got  = map { gsl_vector_get($vec, $_) } (0..3);
 111    ok_similar( [ @got ], [ 0 .. 3 ], 'gsl_matrix_subdiagonal');
 112 }
 113
 114 sub GSL_MATRIX_SWAP : Tests {
 115    my $self=shift;
 116    map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
 117    my $matrix = gsl_matrix_alloc(5,5);
 118    map { gsl_matrix_set($matrix, $_,$_, $_) } (0..4);
 119    ok_status(gsl_matrix_swap($self->{matrix}, $matrix));
 120
 121    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 122    map { is($got[$_], $_) } (0..4);
 123    @got = map { gsl_matrix_get($matrix, $_, $_) } (0..4);
 124    map { is($got[$_], $_** 2) } (0..4);
 125 }
 126
 127 sub GSL_MATRIX_MEMCPY : Tests {
 128    my $self = shift;
 129    my $matrix = gsl_matrix_alloc(5,5);
 130    map { gsl_matrix_set($self->{matrix}, $_,$_, $_ ** 2) } (0..4);
 131    ok_status(gsl_matrix_memcpy($matrix, $self->{matrix}));
 132    ok_similar( [ map { gsl_matrix_get($matrix, $_, $_) } (0..4) ],
 133                [ map {  $_** 2 } (0..4)                        ]
 134    );
 135 }
 136
 137 sub GSL_MATRIX_SWAP_ROWS : Tests {
 138    my $self = shift;
 139    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 140    map { gsl_matrix_set($self->{matrix}, 1,$_, 3) } (0..4);
 141    ok_status(gsl_matrix_swap_rows($self->{matrix}, 0, 1));
 142    my @got = map { gsl_matrix_get($self->{matrix}, 1, $_) } (0..4);
 143    map { is($got[$_], $_) } (0..4);
 144    @got = map { gsl_matrix_get($self->{matrix}, 0, $_) } (0..4);
 145    map { is($got[$_], 3) } (0..4);
 146 }
 147
 148 sub GSL_MATRIX_SWAP_COLUMNS : Tests {
 149    my $self = shift;
 150    map { gsl_matrix_set($self->{matrix}, $_,0, $_) } (0..4);
 151    map { gsl_matrix_set($self->{matrix}, $_,1, 3) } (0..4);
 152    ok_status(gsl_matrix_swap_columns($self->{matrix}, 0, 1));
 153    my @got = map { gsl_matrix_get($self->{matrix}, $_, 1) } (0..4);
 154    map { is($got[$_], $_) } (0..4);
 155    @got = map { gsl_matrix_get($self->{matrix}, $_, 0) } (0..4);
 156    map { is($got[$_], 3) } (0..4);
 157 }
 158
 159 sub GSL_MATRIX_SWAP_ROWCOL : Tests {
 160    my $self = shift;
 161    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 162    map { gsl_matrix_set($self->{matrix}, $_,2, 2) } (0..4);
 163    ok_status(gsl_matrix_swap_rowcol($self->{matrix}, 0, 2));
 164
 165    my @got = map { gsl_matrix_get($self->{matrix}, $_, 2) } (0..4);
 166    is_deeply( [ @got ], [ qw/2 1 0 3 4/  ] );
 167
 168    @got = map { gsl_matrix_get($self->{matrix}, 0, $_) } (0..4);
 169    is_deeply( [ @got ], [ qw/2 2 2 2 2/ ] );
 170 }
 171
 172 sub GSL_MATRIX_TRANSPOSE_MEMCPY : Tests {
 173    my $self = shift;
 174    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 175    my $matrix = gsl_matrix_alloc(5,5);
 176    ok_status(gsl_matrix_transpose_memcpy($matrix, $self->{matrix}));
 177    my @got = map { gsl_matrix_get($matrix, $_, 0) } (0..4);
 178    map { is($got[$_], $_) } (0..4);
 179 }
 180
 181 sub GSL_MATRIX_TRANSPOSE : Tests {
 182    my $self = shift;
 183    map { gsl_matrix_set($self->{matrix}, 0,$_, $_) } (0..4);
 184    is(gsl_matrix_transpose($self->{matrix}), 0);
 185    my @got = map { gsl_matrix_get($self->{matrix}, $_, 0) } (0..4);
 186    map { is($got[$_], $_) } (0..4);
 187 }
 188
 189 sub GSL_MATRIX_ADD : Tests {
 190    my $self = shift;
 191    my $matrix = gsl_matrix_alloc(5, 5);
 192    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 193    map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
 194    is(gsl_matrix_add($self->{matrix}, $matrix), 0);
 195    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 196    map { is($got[$_], $_*2) } (0..4);
 197 }
 198
 199 sub GSL_MATRIX_SUB : Tests {
 200    my $self = shift;
 201    my $matrix = gsl_matrix_alloc(5, 5);
 202    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 203    map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
 204    is(gsl_matrix_sub($self->{matrix}, $matrix), 0);
 205    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 206    map { is($got[$_], 0) } (0..4);
 207 }
 208
 209 sub GSL_MATRIX_MUL_ELEMENTS : Tests {
 210    my $self = shift;
 211    my $matrix = gsl_matrix_alloc(5, 5);
 212    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 213    map { gsl_matrix_set($matrix, $_, $_, $_) } (0..4);
 214    is(gsl_matrix_mul_elements($self->{matrix}, $matrix), 0);
 215    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 216    map { is($got[$_], $_**2) } (0..4);
 217 }
 218
 219 sub GSL_MATRIX_DIV_ELEMENTS : Tests {
 220    my $self = shift;
 221    my $matrix = gsl_matrix_alloc(5, 5);
 222    map { gsl_matrix_set($self->{matrix}, $_, $_, $_+1) } (0..4);
 223    map { gsl_matrix_set($matrix, $_, $_, $_+1) } (0..4);
 224    is(gsl_matrix_div_elements($self->{matrix}, $matrix), 0);
 225    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 226    map { is($got[$_], 1) } (0..4);
 227 }
 228
 229 sub GSL_MATRIX_SCALE : Tests {
 230    my $self = shift;
 231    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 232    is(gsl_matrix_scale($self->{matrix}, 4), 0);
 233    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 234    map { is($got[$_], $_*4) } (0..4);
 235 }
 236
 237 sub GSL_MATRIX_ADD_CONSTANT : Tests {
 238    my $self = shift;
 239    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 240    is(gsl_matrix_add_constant($self->{matrix}, 8), 0);
 241    my @got = map { gsl_matrix_get($self->{matrix}, $_, $_) } (0..4);
 242    map { is($got[$_], $_+8) } (0..4);
 243 }
 244
 245 sub GSL_MATRIX_MAX : Tests {
 246    my $self = shift;
 247    for my $row (0..4) {
 248         map { gsl_matrix_set($self->{matrix}, $row, $_, $_**2 ) } (0..4);
 249    }
 250    is(gsl_matrix_max($self->{matrix}), 16);
 251 }
 252
 253 sub GSL_MATRIX_MIN : Tests {
 254    my $self = shift;
 255    for my $row (0..4) {
 256         map { gsl_matrix_set($self->{matrix}, $row, $_, $_**2 ) } (0..4);
 257    }
 258    is(gsl_matrix_min($self->{matrix}), 0);
 259 }
 260
 261 sub GSL_MATRIX_MINMAX : Test {
 262    my $self = shift;
 263    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 264    my ($min, $max) = gsl_matrix_minmax($self->{matrix});
 265    ok_similar( [ $min, $max ], [ 0, 16], 'gsl_matrix_minmax' );
 266 }
 267
 268 sub GSL_MATRIX_MAX_INDEX : Tests {
 269    my $self = shift;
 270    for my $row (0..3) {
 271         map { gsl_matrix_set($self->{matrix}, $row, $_, $_) } (0..4);
 272    }
 273    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 274    my ($imax, $jmax) = gsl_matrix_max_index($self->{matrix});
 275    ok_similar( [ $imax, $jmax ], [ 4, 4 ], 'gsl_matrix_max_index' );
 276 }
 277
 278 sub GSL_MATRIX_MIN_INDEX : Tests {
 279    my $self = shift;
 280    map { gsl_matrix_set($self->{matrix}, $_, $_, $_**2) } (0..4);
 281    my ($imin, $jmin) = gsl_matrix_min_index($self->{matrix});
 282    ok_similar( [ $imin, $jmin ], [ 0, 0 ], 'gsl_matrix_min_index' );
 283
 284 }
 285
 286 sub GSL_MATRIX_ISNULL : Tests {
 287    my $self = shift;
 288    for my $line (0..4) {
 289         map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4);
 290    }
 291    is(gsl_matrix_isnull($self->{matrix}), 1);
 292
 293    for my $line (0..4) {
 294         map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4);
 295    }
 296
 297    is(gsl_matrix_isnull($self->{matrix}), 0);
 298 }
 299
 300 sub GSL_MATRIX_ISPOS : Tests {
 301    my $self = shift;
 302    my $line;
 303
 304    for($line=0; $line<5; $line++) {
 305    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 306    is(gsl_matrix_ispos($self->{matrix}), 0);
 307
 308    for($line=0; $line<5; $line++) {
 309    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 310    is(gsl_matrix_ispos($self->{matrix}), 1);
 311
 312    for($line=0; $line<5; $line++) {
 313    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 314    is(gsl_matrix_ispos($self->{matrix}), 0);
 315 }
 316
 317 sub GSL_MATRIX_ISNEG : Tests {
 318    my $self = shift;
 319    my $line;
 320
 321    for($line=0; $line<5; $line++) {
 322    map { gsl_matrix_set($self->{matrix}, $line, $_, -1) } (0..4); }
 323    is(gsl_matrix_isneg($self->{matrix}), 1);
 324
 325    for($line=0; $line<5; $line++) {
 326    map { gsl_matrix_set($self->{matrix}, $line, $_, 1) } (0..4); }
 327    is(gsl_matrix_isneg($self->{matrix}), 0);
 328
 329    for($line=0; $line<5; $line++) {
 330    map { gsl_matrix_set($self->{matrix}, $line, $_, 0) } (0..4); }
 331    is(gsl_matrix_isneg($self->{matrix}), 0);
 332 }
 333
 334 sub GSL_MATRIX_ISNONNEG : Tests {
 335     my $self = shift;
 336     for my $row (0..4) {
 337         map { gsl_matrix_set($self->{matrix}, $row, $_, -1) } (0..4);
 338     }
 339     is(gsl_matrix_isnonneg($self->{matrix}), 0);
 340
 341     for my $row (0..4) {
 342         map { gsl_matrix_set($self->{matrix}, $row, $_, 1) } (0..4);
 343     }
 344     is(gsl_matrix_isnonneg($self->{matrix}), 1);
 345
 346     for my $row (0..4) {
 347         map { gsl_matrix_set($self->{matrix}, $row, $_, 0) } (0..4);
 348     }
 349     is(gsl_matrix_isnonneg($self->{matrix}), 1);
 350
 351 }
 352
 353 sub GSL_MATRIX_GET_ROW : Tests {
 354    my $self = shift;
 355    my $vector = gsl_vector_alloc(5);
 356    map { gsl_matrix_set($self->{matrix}, 0, $_, $_) } (0..4);
 357    is(gsl_matrix_get_row($vector, $self->{matrix}, 0), 0);
 358    map { is(gsl_vector_get($vector, $_), $_) } (0..4);
 359 }
 360
 361 sub GSL_MATRIX_GET_COL : Tests {
 362    my $self = shift;
 363    my $vector = gsl_vector_alloc(5);
 364    map { gsl_matrix_set($self->{matrix}, $_, 0, $_) } (0..4);
 365    is(gsl_matrix_get_col($vector, $self->{matrix}, 0), 0);
 366    map { is(gsl_vector_get($vector, $_), $_) } (0..4);
 367 }
 368
 369 sub GSL_MATRIX_SET_ROW : Tests {
 370    my $self = shift;
 371    my $vector = gsl_vector_alloc(5);
 372    map { gsl_vector_set($vector, $_, $_**2) } (0..4);
 373    is(gsl_matrix_set_row($self->{matrix}, 1, $vector), 0);
 374
 375    ok_similar( [ map { gsl_matrix_get($self->{matrix}, 1, $_) } (0..4) ],
 376                [ map { $_ ** 2 } (0..4) ],
 377              );
 378 }
 379
 380 sub GSL_MATRIX_SET_COL : Tests {
 381    my $self = shift;
 382    my $vector = gsl_vector_alloc(5);
 383    map { gsl_vector_set($vector, $_, $_**2) } (0..4);
 384    is(gsl_matrix_set_col($self->{matrix}, 1, $vector), 0);
 385
 386    ok_similar( [ map { gsl_matrix_get($self->{matrix}, $_, 1) } (0..4) ],
 387                [ map { $_ ** 2 } (0..4) ],
 388              );
 389 }
 390
 391 sub GSL_MATRIX_FREAD_FWRITE : Tests {
 392    my $self = shift;
 393    for my $line (0..4) {
 394         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
 395    }
 396
 397    my $fh = gsl_fopen("matrix", 'w');
 398    is( gsl_matrix_fwrite($fh, $self->{matrix}), 0);
 399    gsl_fclose($fh);
 400
 401    for my $line (0..4) {
 402         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
 403    }
 404
 405    $fh = gsl_fopen("matrix", 'r');
 406
 407    is(gsl_matrix_fread($fh, $self->{matrix}), 0);
 408    for my $line (0..4) {
 409         ok_similar(
 410                     [ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
 411                     [ map { $_**2 } (0..4) ],
 412                   );
 413    }
 414    gsl_fclose($fh);
 415 }
 416
 417 sub GSL_MATRIX_FPRINTF_FSCANF : Tests {
 418    my $self = shift;
 419
 420    for my $line (0..4) {
 421         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**2) } (0..4);
 422    }
 423
 424    my $fh = gsl_fopen("matrix", 'w');
 425    is( gsl_matrix_fprintf($fh, $self->{matrix}, "%f"), 0);
 426    ok_status(gsl_fclose($fh));
 427
 428    for my $line (0..4) {
 429         map { gsl_matrix_set($self->{matrix}, $line, $_, $_**3) } (0..4);
 430    }
 431
 432    $fh = gsl_fopen("matrix", 'r');
 433    is(gsl_matrix_fscanf($fh, $self->{matrix}), 0);
 434    for my $line (0..4) {
 435         ok_similar(
 436                     [ map { gsl_matrix_get($self->{matrix}, $line, $_) } (0..4) ],
 437                     [ map { $_**2 } (0..4) ],
 438                   );
 439    }
 440    ok_status(gsl_fclose($fh));
 441 }
 442
 443 sub GSL_MATRIX_MINMAX_INDEX : Tests {
 444    my $self = shift;
 445    my $line;
 446    for ($line = 0; $line<4; $line ++) {
 447    map { gsl_matrix_set($self->{matrix}, $line, $_, $_) } (0..4); }
 448    map { gsl_matrix_set($self->{matrix}, 4, $_, $_**2) } (0..4);
 449    my ($imin, $jmin, $imax, $jmax) = gsl_matrix_minmax_index($self->{matrix});
 450    ok_similar( [ $imin, $jmin, $imax, $jmax ], [ 0, 0, 4, 4], 'gsl_matrix_minmax_index' );
 451 }
 452
 453 sub GSL_MATRIX_ADD_DIAGONAL : Tests {
 454    my $self = shift;
 455    map { gsl_matrix_set($self->{matrix}, $_, $_, $_) } (0..4);
 456    gsl_matrix_add_diagonal($self->{matrix}, 4);
 457    ok_similar( [ map { gsl_matrix_get($self->{matrix}, $_, $_)} (0..4) ],
 458                [ 4 .. 8 ],
 459              );
 460 }
 461
 462 sub GSL_MATRIX_NEW : Tests {
 463    my $self = shift;
 464    isa_ok( $self->{obj}, 'Math::GSL::Matrix' );
 465    isa_ok( $self->{obj}->raw, 'Math::GSL::Matrix::gsl_matrix' );
 466    ok( $self->{obj}->rows == 5, '->rows' );
 467    ok( $self->{obj}->cols == 5, '->cols' );
 468 }
 469
 470 sub AS_LIST_SQUARE : Tests {
 471     my $matrix = Math::GSL::Matrix->new(5,5);
 472     map { gsl_matrix_set($matrix->raw, $_, $_, 5 + $_**2) } (0..4);
 473     is_deeply( [
 474                 5, 0, 0, 0, 0,
 475                 0, 6, 0, 0, 0,
 476                 0, 0, 9, 0, 0,
 477                 0, 0, 0,14, 0,
 478                 0, 0, 0, 0, 21
 479                 ],
 480                [ $matrix->as_list],
 481                '$matrix->as_list',
 482     );
 483 }
 484
 485 sub AS_LIST_ROW : Tests {
 486     my $matrix = Math::GSL::Matrix->new(1,5);
 487     map { gsl_matrix_set($matrix->raw, 0 , $_, 5 + $_**2) } (0..4);
 488     is_deeply( [ 5, 6, 9, 14, 21, ],
 489                [ $matrix->as_list],
 490                '$matrix->as_list',
 491     );
 492 }
 493
 494 sub ROW : Tests {
 495     my $matrix = Math::GSL::Matrix->new(5,5);
 496     map { gsl_matrix_set($matrix->raw, $_, $_, 5 + $_**2) } (0..4);
 497     ok_similar( [qw/0 0 9 0 0/] , [$matrix->row(2)->as_list ] );
 498     map { gsl_matrix_set($matrix->raw, 0, $_, $_) } (0..4);
 499     ok_similar( [qw/0 1 2 3 4/] , [$matrix->row(0)->as_list ] );
 500 }
 501
 502 sub COL : Tests {
 503     my $matrix = Math::GSL::Matrix->new(3,3);
 504     map { gsl_matrix_set($matrix->raw, $_, $_, 7 + $_**2) } (0..2);
 505     ok_similar([7,0,0], [$matrix->col(0)->as_list]);
 506 }
 507
 508 sub NEW_SETS_VALUES_TO_ZERO : Tests {
 509     my $matrix = Math::GSL::Matrix->new(5,5);
 510     my $sum;
 511
 512     map { $sum += $_ } $matrix->as_list;
 513     ok( $sum == 0, 'new sets values to zero');
 514 }
 515
 516 sub SET_ROW : Tests {
 517     my $m = Math::GSL::Matrix->new(3,3);
 518     $m->set_row(0, [1,2,3]);
 519     ok_similar([$m->row(0)->as_list], [1,2,3]);
 520 }
 521 sub SET_ROW_CHAINED : Tests {
 522     my $m = Math::GSL::Matrix->new(3,3);
 523     $m->set_row(1, [4,5,6])
 524       ->set_row(2, [9,8,7]);
 525     ok_similar([$m->row(1)->as_list], [4,5,6]);
 526     ok_similar([$m->row(2)->as_list], [9,8,7]);
 527 }
 528
 529 sub SET_COL_CHAINED : Tests {
 530     my $m = Math::GSL::Matrix->new(3,3);
 531     $m->set_col(1, [4,5,6])
 532       ->set_col(2, [9,8,7]);
 533     ok_similar([$m->col(1)->as_list], [4,5,6]);
 534     ok_similar([$m->col(2)->as_list], [9,8,7]);
 535 }
 536
 537 sub GSL_MATRIX_VIEW_ARRAY : Tests {
 538     my $array = [8,4,3,7];
 539     my $matrix_view = gsl_matrix_view_array ($array, 2,2);
 540     ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 0, $_) } 0..1], [8, 4]);
 541     ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 1, $_) } 0..1], [3, 7]);
 542 }
 543
 544 sub GSL_MATRIX_VIEW_ARRAY_WITH_TDA : Tests {
 545     my $array = [8,4,3,7,5];
 546     my $matrix_view = gsl_matrix_view_array_with_tda ($array, 2,2, 3);
 547     ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 0, $_) } 0..1], [8, 4]);
 548     ok_similar([map { gsl_matrix_get($matrix_view->{matrix}, 1, $_) } 0..1], [7, 5]);
 549 }
 550
 551 sub GSL_MATRIX_OO_ADDITION_CONSTANT : Tests {
 552     my $m = Math::GSL::Matrix->new(3,3);
 553     $m->set_col(1, [4,5,6])
 554       ->set_col(2, [9,8,7]);
 555     my $m2 = $m + 4;
 556     ok_similar([$m->col(2)->as_list], [9,8,7]);
 557     ok_similar([$m->col(1)->as_list], [4,5,6]);
 558     ok_similar([$m->col(0)->as_list], [0,0,0]);
 559
 560     ok_similar([$m2->col(1)->as_list], [8,9,10]);
 561     ok_similar([$m2->col(2)->as_list], [13,12,11]);
 562     ok_similar([$m2->col(0)->as_list], [4,4,4]);
 563
 564     my $m3 = 4 + $m;
 565     ok_similar([$m3->col(1)->as_list], [8,9,10]);
 566     ok_similar([$m3->col(2)->as_list], [13,12,11]);
 567     ok_similar([$m3->col(0)->as_list], [4,4,4]);
 568 }
 569
 570 sub GSL_MATRIX_OO_ADDITION_MATRICES : Tests {
 571     my $m = Math::GSL::Matrix->new(3,3);
 572     $m->set_col(1, [4,5,6])
 573       ->set_col(2, [9,8,7])
 574       ->set_col(0, [1,2,3]);
 575     my $m2 = $m + $m;
 576     ok_similar([$m->col(0)->as_list], [1,2,3]);
 577     ok_similar([$m->col(2)->as_list], [9,8,7]);
 578     ok_similar([$m->col(1)->as_list], [4,5,6]);
 579
 580     ok_similar([$m2->col(0)->as_list], [2,4,6]);
 581     ok_similar([$m2->col(1)->as_list], [8,10,12]);
 582     ok_similar([$m2->col(2)->as_list], [18,16,14]);
 583 }
 584
 585 sub GSL_MATRIX_OO_SUBSTRACTION_CONSTANT : Tests {
 586     my $m = Math::GSL::Matrix->new(3,3);
 587     $m->set_col(1, [4,5,6])
 588       ->set_col(2, [9,8,7]);
 589     my $m2 = $m - 4;
 590     ok_similar([$m->col(2)->as_list], [9,8,7]);
 591     ok_similar([$m->col(1)->as_list], [4,5,6]);
 592     ok_similar([$m->col(0)->as_list], [0,0,0]);
 593
 594     ok_similar([$m2->col(1)->as_list], [0,1,2]);
 595     ok_similar([$m2->col(2)->as_list], [5,4,3]);
 596     ok_similar([$m2->col(0)->as_list], [-4,-4,-4]);
 597 }
 598
 599 sub GSL_MATRIX_OO_SUBSTRACTION_MATRICES : Tests {
 600     my $m = Math::GSL::Matrix->new(3,3);
 601     my $m3 = Math::GSL::Matrix->new(3,3);
 602     $m->set_col(1, [4,5,6])
 603       ->set_col(2, [9,8,7])
 604       ->set_col(0, [1,2,3]);
 605     $m3->set_col(1, [1,2,3])
 606        ->set_col(2, [9,8,7])
 607        ->set_col(0, [1,2,3]);
 608     my $m2 = $m - $m3;
 609     ok_similar([$m->col(0)->as_list], [1,2,3]);
 610     ok_similar([$m->col(2)->as_list], [9,8,7]);
 611     ok_similar([$m->col(1)->as_list], [4,5,6]);
 612
 613     ok_similar([$m2->col(0)->as_list], [0,0,0]);
 614     ok_similar([$m2->col(1)->as_list], [3,3,3]);
 615     ok_similar([$m2->col(2)->as_list], [0,0,0]);
 616 }
 617
 618 sub GSL_MATRIX_OO_MULTIPLICATION_CONSTANT : Tests {
 619     my $m = Math::GSL::Matrix->new(3,3);
 620     $m->set_col(1, [4,5,6])
 621       ->set_col(2, [9,8,7]);
 622     my $m2 = $m * 4;
 623     ok_similar([$m->col(2)->as_list], [9,8,7]);
 624     ok_similar([$m->col(1)->as_list], [4,5,6]);
 625     ok_similar([$m->col(0)->as_list], [0,0,0]);
 626
 627     ok_similar([$m2->col(1)->as_list], [16,20,24]);
 628     ok_similar([$m2->col(2)->as_list], [36,32,28]);
 629     ok_similar([$m2->col(0)->as_list], [0,0,0]);
 630
 631     my $m3 = 4 * $m;
 632     ok_similar([$m3->col(1)->as_list], [16,20,24]);
 633     ok_similar([$m3->col(2)->as_list], [36,32,28]);
 634     ok_similar([$m3->col(0)->as_list], [0,0,0]);
 635 }
 636
 637 sub GSL_MATRIX_EIGENVALUES: Tests(6) {
 638     my $matrix = Math::GSL::Matrix->new(2,2)
 639                               ->set_row(0, [0,-1] )
 640                               ->set_row(1, [1, 0] );
 641     my @eigs = $matrix->eigenvalues;
 642     ok_similar( [ Re($eigs[0]), Im($eigs[0]) ], [ 0,  1 ] ); #  i
 643     ok_similar( [ Re($eigs[1]), Im($eigs[1]) ], [ 0, -1 ] ); # -i
 644
 645     my $rect = Math::GSL::Matrix->new(2,4);
 646     dies_ok( sub { $rect->eigenvalues }, 'eigenvalues for square matrices only' );
 647
 648     my $matrix2 = Math::GSL::Matrix->new(2,2)
 649                               ->set_row(0, [1, 0] )
 650                               ->set_row(1, [0, 1] );
 651     my @eigs2 = $matrix2->eigenvalues;
 652     ok_similar( [ @eigs2 ], [ 1, 1 ] );
 653
 654     my $matrix3 = Math::GSL::Matrix->new(2,2);
 655     ok_similar( [ $matrix3->eigenvalues ], [ 0, 0 ], 'zero matrix eigenvalues = 0');
 656
 657     my $matrix4 = Math::GSL::Matrix->new(2,2)
 658                               ->set_row(0, [1, 3] )
 659                               ->set_row(1, [4, 2] );
 660     ok_similar( [ $matrix4->eigenvalues ], [ -2, 5 ] );
 661 }
 662
 663 sub GSL_MATRIX_EIGENPAIR : Tests(11) {
 664     my $matrix = Math::GSL::Matrix->new(2,2)
 665                               ->set_row(0, [0,-1] )
 666                               ->set_row(1, [1, 0] );
 667
 668     my ($eigenvalues, $eigenvectors) = $matrix->eigenpair;
 669     cmp_ok( $#$eigenvalues, '==', $#$eigenvectors, 'same # of values as vectors');
 670
 671     my ($eig1,$eig2) = @$eigenvalues;
 672     isa_ok( $eig1, 'Math::Complex');
 673     isa_ok( $eig2, 'Math::Complex');
 674
 675     ok_similar( [ Re $eig1 ], [ 0 ] );
 676     ok_similar( [ Im $eig1 ], [ 1 ] );
 677
 678     ok_similar( [ Re $eig2 ], [ 0   ] );
 679     ok_similar( [ Im $eig2 ], [ -1  ] );
 680
 681     my ($u,$v)       = @$eigenvectors;
 682
 683     isa_ok( $u, 'Math::GSL::VectorComplex' );
 684     isa_ok( $v, 'Math::GSL::VectorComplex' );
 685
 686     local $TODO = qq{ VectorComplex->as_list is funky };
 687     # we happen to know that these are real eigenvectors
 688     my ($u1,$u2)     = map { Re $_ } $u->as_list;
 689     my ($v1,$v2)     = map { Re $_ } $v->as_list;
 690     my $sqrt2by2     = sqrt(2)/2;
 691
 692     ok_similar( [ $u1, $u2 ], [ $sqrt2by2, - $sqrt2by2 ] );
 693     ok_similar( [ $v1, $v2 ], [ $sqrt2by2,   $sqrt2by2 ] );
 694
 695 }
 696
 697 sub MATRIX_MULTIPLICATION_OVERLOAD : Tests {
 698     my $A = Math::GSL::Matrix->new(2,2)
 699                              ->set_row(0, [1,3] )
 700                              ->set_row(1, [4, 2] );
 701     my $B = Math::GSL::Matrix->new(2,2)
 702                              ->set_row(0, [2,5] )
 703                              ->set_row(1, [1, 3] );
 704     my $C = $A * $B;
 705     ok_similar([ $C->as_list ], [5, 14, 10, 26 ]);
 706 }
 707
 708 sub MATRIX_IS_SQUARE : Tests(2) {
 709     my $A = Math::GSL::Matrix->new(2,2);
 710     ok( $A->is_square, 'is_square true for 2x2' );
 711     my $B = Math::GSL::Matrix->new(2,3);
 712     ok( ! $B->is_square, 'is_square false for 2x3' );
 713 }
 714
 715 sub MATRIX_DETERMINANT : Tests(2) {
 716     my $A = Math::GSL::Matrix->new(2,2)
 717                              ->set_row(0, [1,3] )
 718                              ->set_row(1, [4, 2] );
 719
 720     ok_similar( [ $A->det   ], [ -10 ], '->det() 2x2');
 721     ok_similar( [ $A->lndet ], [ log 10 ], '->lndet() 2x2');
 722
 723 }
 724
 725 sub MATRIX_ZERO : Tests(2) {
 726     my $A = Math::GSL::Matrix->new(2,2)
 727                              ->set_row(0, [1, 3] )
 728                              ->set_row(1, [4, 2] );
 729     isa_ok($A->zero, 'Math::GSL::Matrix');
 730     ok_similar( [ $A->zero->as_list ], [ 0, 0, 0, 0 ] );
 731 }
 732
 733 sub MATRIX_IDENTITY : Tests(6) {
 734     my $A = Math::GSL::Matrix->new(2,2)->identity;
 735     isa_ok($A, 'Math::GSL::Matrix');
 736     ok_similar([ $A->as_list ], [ 1, 0, 0, 1 ] );
 737     ok_similar([ $A->inverse->as_list ], [ 1, 0, 0, 1 ] );
 738     ok_similar([ $A->det     ] ,[ 1 ] );
 739     ok_similar([ map { Re $_ } $A->eigenvalues ], [ 1, 1 ], 'identity eigs=1' );
 740     ok_similar([ map { Im $_ } $A->eigenvalues ], [ 0, 0 ], 'identity eigs=1' );
 741 }
 742
 743 sub MATRIX_INVERSE : Tests(3) {
 744     my $A = Math::GSL::Matrix->new(2,2)
 745                              ->set_row(0, [1, 3] )
 746                              ->set_row(1, [4, 2] );
 747     my $Ainv = $A->inverse;
 748     isa_ok( $Ainv, 'Math::GSL::Matrix' );
 749     ok_similar([ $Ainv->as_list ] , [ map { -$_/10 } ( 2, -3, -4, 1 ) ] );
 750     my $B = Math::GSL::Matrix->new(2,3)
 751                              ->set_row(0, [1, 3, 5] )
 752                              ->set_row(1, [2, 4, 6] );
 753     dies_ok( sub { $B->inverse } , 'inverse of non square matrix dies' );
 754 }
 755
 756 sub OVERLOAD_EQUAL : Tests(2) {
 757     my $A = Math::GSL::Matrix->new(2,2)
 758                              ->set_row(0, [1, 3] )
 759                              ->set_row(1, [4, 2] );
 760     my $B = $A->copy;
 761     ok ( $A == $B, 'should be equal');
 762     $B->set_row(0, [1,2]);
 763     ok ( $A != $B, 'should not be equal');
 764 }
 765
 766 Test::Class->runtests;