lib/Math/GSL/Permutation/Test.pm

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