1 package Math
::GSL
::Permutation
::Test
;
2 use base
q{Test::Class};
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/;
12 BEGIN { gsl_set_error_handler_off
(); }
13 sub make_fixture
: Test
(setup
) {
15 $self->{permutation
} = gsl_permutation_alloc
(6);
18 sub teardown
: Test
(teardown
) {
20 unlink 'permutation' if -f
'permutation';
22 gsl_permutation_free
($self->{permutation
});
25 sub GSL_PERMUTATION_ALLOC
: Tests
{
26 my $p = gsl_permutation_alloc
(6);
27 isa_ok
($p, 'Math::GSL::Permutation');
30 sub GSL_PERMUTATION_GET_INIT
: Tests
{
32 gsl_permutation_init
($self->{permutation
});
33 map { is
(gsl_permutation_get
($self->{permutation
}, $_), $_) } (0..5);
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);
42 sub GSL_PERMUTATION_MEMCPY
: Tests
{
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);
50 sub GSL_PERMUTATION_SWAP
: Tests
{
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);
59 sub GSL_PERMUTATION_SIZE
: Tests
{
61 gsl_permutation_init
($self->{permutation
});
62 is
(gsl_permutation_size
($self->{permutation
}), 6);
65 sub GSL_PERMUTATION_VALID
: Tests
{
67 gsl_permutation_init
($self->{permutation
});
68 is
(gsl_permutation_valid
($self->{permutation
}), 0);
71 sub GSL_PERMUTATION_REVERSE
: Tests
{
73 gsl_permutation_init
($self->{permutation
});
74 gsl_permutation_reverse
($self->{permutation
});
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);
84 sub GSL_PERMUTATION_INVERSE
: Tests
{
86 my $p = gsl_permutation_alloc
(6);
87 gsl_permutation_init
($self->{permutation
});
89 gsl_permutation_inverse
($p, $self->{permutation
});
90 map { is
(gsl_permutation_get
($p, $_), $_) } (0..5);
93 sub GSL_PERMUTATION_NEXT
: Tests
{
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);
102 sub GSL_PERMUTATION_PREV
: Tests
{
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);
110 #sub GSL_PERMUTE : Tests {
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);
118 #sub GSL_PERMUTE_INVERSE : Tests {
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);
126 sub GSL_PERMUTE_VECTOR
: Tests
{
128 gsl_permutation_init
($self->{permutation
});
129 gsl_permutation_swap
($self->{permutation
}, 0, 1);
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);
139 sub GSL_PERMUTE_VECTOR_INVERSE
: Tests
{
141 gsl_permutation_init
($self->{permutation
});
142 gsl_permutation_swap
($self->{permutation
}, 0, 1);
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);
152 sub GSL_PERMUTATION_MUL
: Tests
{
154 gsl_permutation_init
($self->{permutation
});
155 gsl_permutation_swap
($self->{permutation
}, 0, 1);
157 my $p2 = gsl_permutation_alloc
(6);
158 gsl_permutation_init
($p2);
159 gsl_permutation_swap
($p2, 0, 5);
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);
169 sub GSL_PERMUTATION_FWRITE_FREAD
: Tests
{
171 gsl_permutation_init
($self->{permutation
});
172 my $fh = gsl_fopen
("permutation", 'w');
173 gsl_permutation_fwrite
($fh, $self->{permutation
});
176 my $p = gsl_permutation_alloc
(6);
177 $fh = gsl_fopen
("permutation", 'r');
178 gsl_permutation_fread
($fh, $p);
179 map { is
(gsl_permutation_get
($p, $_), $_) } (0..5);
183 sub GSL_PERMUTATION_FPRINTF_FSCANF
: Tests
{
185 my $fh = gsl_fopen
("permutation", 'w');
186 gsl_permutation_init
($self->{permutation
});
187 ok_status
( gsl_permutation_fprintf
($fh, $self->{permutation
}, "%f"));
188 ok_status
(gsl_fclose
($fh));
190 local $TODO = "odd error with fscanf";
191 $fh = gsl_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) ],
197 #ok_status(gsl_fclose($fh));
201 my $perm = Math
::GSL
::Permutation
->new(42);
202 isa_ok
($perm, 'Math::GSL::Permutation' );
206 my $perm = Math
::GSL
::Permutation
->new(5);
207 is_deeply
( [ $perm->as_list ] , [ 0 .. 4 ] );