lib/Math/GSL/Permutation/Test.pm

   1 package Math::GSL::Permutation::Test;
   2 use base q{Test::Class};
   3 use Data::Dumper;
   4 use Test::More;
   5 use Test::Exception;
   6 use Math::GSL              qw/:all/;
   7 use Math::GSL::Vector      qw/:all/;
   8 use Math::GSL::Test        qw/:all/;
   9 use Math::GSL::Errno       qw/:all/;
  10 use Math::GSL::Permutation qw/:all/;
  11 use strict;
  12
  13 BEGIN { gsl_set_error_handler_off(); }
  14 sub make_fixture : Test(setup) {
  15     my $self = shift;
  16     $self->{permutation} = gsl_permutation_alloc(6);
  17 }
  18
  19 sub teardown : Test(teardown) {
  20     my $self = shift;
  21     unlink 'permutation' if -f 'permutation';
  22
  23     gsl_permutation_free($self->{permutation});
  24 }
  25
  26 sub GSL_PERMUTATION_ALLOC : Tests {
  27     my $p = gsl_permutation_alloc(6);
  28     isa_ok($p, 'Math::GSL::Permutation');
  29 }
  30
  31 sub GSL_PERMUTATION_GET_INIT : Tests {
  32     my $self = shift;
  33     gsl_permutation_init($self->{permutation});
  34     map { is(gsl_permutation_get($self->{permutation}, $_), $_) } (0..5);
  35 }
  36
  37 sub GSL_PERMUTATION_CALLOC : Tests {
  38     my $p = gsl_permutation_calloc(6);
  39     isa_ok($p, 'Math::GSL::Permutation');
  40     map { is(gsl_permutation_get($p, $_), $_) } (0..5);
  41 }
  42
  43 sub GSL_PERMUTATION_MEMCPY : Tests {
  44     my $self = shift;
  45     my $p = gsl_permutation_alloc(6);
  46     gsl_permutation_init($self->{permutation});
  47     gsl_permutation_memcpy($p, $self->{permutation});
  48     map { is(gsl_permutation_get($p, $_), $_) } (0..5);
  49 }
  50
  51 sub GSL_PERMUTATION_SWAP : Tests {
  52     my $self=shift;
  53     gsl_permutation_init($self->{permutation});
  54     is(gsl_permutation_swap($self->{permutation}, 0, 5), 0);
  55     is(gsl_permutation_get($self->{permutation}, 0), 5);
  56     is(gsl_permutation_get($self->{permutation}, 5), 0);
  57     map { is(gsl_permutation_get($self->{permutation}, $_), $_) } (1..4);
  58 }
  59
  60 sub GSL_PERMUTATION_SIZE : Tests {
  61     my $self=shift;
  62     gsl_permutation_init($self->{permutation});
  63     is(gsl_permutation_size($self->{permutation}), 6);
  64 }
  65
  66 sub GSL_PERMUTATION_VALID : Tests {
  67     my $self=shift;
  68     gsl_permutation_init($self->{permutation});
  69     is(gsl_permutation_valid($self->{permutation}), 0);
  70 }
  71
  72 sub GSL_PERMUTATION_REVERSE : Tests {
  73     my $self=shift;
  74     gsl_permutation_init($self->{permutation});
  75     gsl_permutation_reverse($self->{permutation});
  76
  77     is(gsl_permutation_get($self->{permutation}, 0), 5);
  78     is(gsl_permutation_get($self->{permutation}, 1), 4);
  79     is(gsl_permutation_get($self->{permutation}, 2), 3);
  80     is(gsl_permutation_get($self->{permutation}, 3), 2);
  81     is(gsl_permutation_get($self->{permutation}, 4), 1);
  82     is(gsl_permutation_get($self->{permutation}, 5), 0);
  83 }
  84
  85 sub GSL_PERMUTATION_INVERSE : Tests {
  86     my $self = shift;
  87     my $p = gsl_permutation_alloc(6);
  88     gsl_permutation_init($self->{permutation});
  89
  90     gsl_permutation_inverse($p, $self->{permutation});
  91     map { is(gsl_permutation_get($p, $_), $_) } (0..5);
  92 }
  93
  94 sub GSL_PERMUTATION_NEXT : Tests {
  95     my $self = shift;
  96     gsl_permutation_init($self->{permutation});
  97     is(gsl_permutation_next($self->{permutation}), 0);
  98     map { is(gsl_permutation_get($self->{permutation}, $_), $_) } (0..3);
  99     is(gsl_permutation_get($self->{permutation}, 4), 5);
 100     is(gsl_permutation_get($self->{permutation}, 5), 4);
 101 }
 102
 103 sub GSL_PERMUTATION_PREV : Tests {
 104     my $self = shift;
 105     gsl_permutation_init($self->{permutation});
 106     gsl_permutation_swap($self->{permutation}, 4, 5);
 107     is(gsl_permutation_prev($self->{permutation}), 0);
 108     map { is(gsl_permutation_get($self->{permutation}, $_), $_) } (0..5);
 109 }
 110
 111 #sub GSL_PERMUTE : Tests {
 112 #    my $self = shift;
 113 #    my @data = [5, 4, 3, 2, 1, 0];
 114 #    gsl_permutation_init($self->{permutation});
 115 #    gsl_permute($self->{permutation}, \@data, 1); # need a typemap to input and output an array of double
 116 #    map { is($data[$_], $_) } (0..5);
 117 #}
 118
 119 #sub GSL_PERMUTE_INVERSE : Tests {
 120 #    my $self = shift;
 121 #    my @data = [5, 4, 3, 2, 1, 0];
 122 #    gsl_permutation_init($self->{permutation});
 123 #    gsl_permute_inverse($self->{permutation}, \@data, 1); # need a typemap to input and output an array of double
 124 #    map { is($data[$_], $_) } (0..5);
 125 #}
 126
 127 sub GSL_PERMUTE_VECTOR : Tests {
 128      my $self = shift;
 129      gsl_permutation_init($self->{permutation});
 130      gsl_permutation_swap($self->{permutation}, 0, 1);
 131
 132      my $vec = gsl_vector_alloc(6);
 133      map { gsl_vector_set($vec, $_, $_) } (0..5);
 134      gsl_permute_vector($self->{permutation}, $vec);
 135      is(gsl_vector_get($vec, 0), 1);
 136      is(gsl_vector_get($vec, 1), 0);
 137      map { is(gsl_vector_get($vec, $_), $_) } (2..5);
 138 }
 139
 140 sub GSL_PERMUTE_VECTOR_INVERSE : Tests {
 141      my $self = shift;
 142      gsl_permutation_init($self->{permutation});
 143      gsl_permutation_swap($self->{permutation}, 0, 1);
 144
 145      my $vec = gsl_vector_alloc(6);
 146      map { gsl_vector_set($vec, $_, $_) } (0..5);
 147      gsl_permute_vector_inverse($self->{permutation}, $vec);
 148      is(gsl_vector_get($vec, 0), 1);
 149      is(gsl_vector_get($vec, 1), 0);
 150      map { is(gsl_vector_get($vec, $_), $_) } (2..5);
 151 }
 152
 153 sub GSL_PERMUTATION_MUL : Tests {
 154      my $self = shift;
 155      gsl_permutation_init($self->{permutation});
 156      gsl_permutation_swap($self->{permutation}, 0, 1);
 157
 158      my $p2 = gsl_permutation_alloc(6);
 159      gsl_permutation_init($p2);
 160      gsl_permutation_swap($p2, 0, 5);
 161
 162      my $p = gsl_permutation_alloc(6) ;
 163      gsl_permutation_mul ($p, $p2, $self->{permutation});
 164      is(gsl_permutation_get($p, 0), 5);
 165      is(gsl_permutation_get($p, 1), 0);
 166      is(gsl_permutation_get($p, 5), 1);
 167      map {  is(gsl_permutation_get($p, $_), $_)} (2..4);
 168 }
 169
 170 sub GSL_PERMUTATION_FWRITE_FREAD : Tests {
 171     my $self = shift;
 172     gsl_permutation_init($self->{permutation});
 173     my $fh = gsl_fopen("permutation", 'w');
 174     gsl_permutation_fwrite($fh, $self->{permutation});
 175     fclose($fh);
 176
 177     my $p = gsl_permutation_alloc(6);
 178     $fh = gsl_fopen("permutation", 'r');
 179     gsl_permutation_fread($fh, $p);
 180     map { is(gsl_permutation_get($p, $_), $_) } (0..5);
 181     fclose($fh);
 182 }
 183
 184 sub GSL_PERMUTATION_FPRINTF_FSCANF : Tests {
 185     my $self = shift;
 186     my $fh = gsl_fopen("permutation", 'w');
 187     gsl_permutation_init($self->{permutation});
 188     ok_status( gsl_permutation_fprintf($fh, $self->{permutation}, "%f"));
 189     ok_status(gsl_fclose($fh));
 190
 191     local $TODO = "odd error with fscanf";
 192     $fh = gsl_fopen("permutation", 'r');
 193     my $p = gsl_permutation_alloc(6);
 194     ok_status(gsl_permutation_fscanf($fh, $p));
 195     is_deeply( [ map {gsl_permutation_get($p, $_) }  (0..5) ],
 196                [ 0 .. 5 ],
 197     );
 198     #ok_status(gsl_fclose($fh));
 199 }
 200
 201 sub NEW: Tests {
 202     my $perm = Math::GSL::Permutation->new(42);
 203     isa_ok($perm, 'Math::GSL::Permutation' );
 204 }
 205
 206 sub AS_LIST: Tests {
 207     my $perm = Math::GSL::Permutation->new(5);
 208     is_deeply( [ $perm->as_list ] , [ 0 .. 4 ] );
 209 }
 210 1;