1package Math::GSL::Sort::Test;
2use Math::GSL::Test qw/:all/;
3use base q{Test::Class};
4use Test::More tests => 20;
5use Math::GSL::RNG         qw/:all/;
6use Math::GSL::Sort        qw/:all/;
7use Math::GSL::Errno       qw/:all/;
8use Math::GSL::Vector      qw/:all/;
9use Math::GSL::Permutation qw/:all/;
10use Data::Dumper;
11use strict;
12
13BEGIN { gsl_set_error_handler_off(); }
14
15sub make_fixture : Test(setup) {
16    my $self = shift;
17    $self->{data} = [ 2**15, 1, 42.7, -17, 6900, 3e-10 , 4242, 0e0];
18}
19
20sub teardown : Test(teardown) {
21}
22
23sub GSL_SORT_VECTOR : Tests(1) {
24   my $vec = Math::GSL::Vector->new([6,4,2,3,1,5]);
25   gsl_sort_vector($vec->raw);
26   ok_similar( [ $vec->as_list ], [ 1 .. 6 ] );
27}
28
29sub GSL_SORT_VECTOR_LARGEST : Tests(2) {
30   my $vec = Math::GSL::Vector->new([reverse 0..50]);
31   my $largest10 = [1..10];
32   # $largest10 should not have to be passed in
33   my ($status, $stuff) = gsl_sort_vector_largest($largest10, 10, $vec->raw);
34   ok_status( $status);
35   ok_similar( $stuff, [ reverse (41 .. 50) ] );
36}
37
38sub GSL_SORT_VECTOR_SMALLEST : Tests(2) {
39   my $vec = Math::GSL::Vector->new([reverse 0..50]);
40   my $smallest10 = [1..10];
41   # $smallest10 should not have to be passed in
42   my ($status, $stuff) = gsl_sort_vector_smallest($smallest10, 10, $vec->raw);
43   ok_status( $status);
44   ok_similar( $stuff, [ 0 .. 9 ] );
45}
46
47sub GSL_SORT_VECTOR_INDEX : Tests(2) {
48  my $vec = Math::GSL::Vector->new([4,2,3,1,5]);
49  my $p = Math::GSL::Permutation->new(5);
50  ok_status(gsl_sort_vector_index($p->raw, $vec->raw));
51  # indices in ascending order
52  ok_similar( [ $p->as_list ], [ 3, 1, 2, 0 , 4] );
53}
54
55sub GSL_SORT_VECTOR_SMALLEST_INDEX : Tests(2) {
56    my $self   = shift;
57    my $p      = [ 1 .. $#{$self->{data}} ];
58    my $vector = Math::GSL::Vector->new([4,2,3,1,5]);
59    my ($status, $stuff) = gsl_sort_vector_smallest_index($p, 3, $vector->raw);
60    ok_status($status);
61    ok_similar( $stuff , [ 3, 1, 2] );
62}
63
64sub GSL_SORT_VECTOR_LARGEST_INDEX : Tests(2) {
65    my $self   = shift;
66    my $p      = [ 1 .. $#{$self->{data}} ];
67    my $vector = Math::GSL::Vector->new([4,2,3,1,5]);
68    my ($status, $stuff) = gsl_sort_vector_largest_index($p, 3, $vector->raw);
69    ok_status($status);
70    ok_similar( $stuff , [ 4,0,2] );
71}
72
73sub GSL_SORT : Tests {
74   my $self = shift;
75   my $sorted = gsl_sort($self->{data}, 1, $#{$self->{data}} + 1 );
76   ok_similar ( $sorted , [ -17, 0e0, 3e-10, 1, 42.7, 4242, 6900, 2**15 ], 'gsl_sort' );
77}
78
79sub GSL_SORT_SMALLEST : Tests(2) {
80   my $self = shift;
81   my $out = [1..10];
82   my ($status, $sorted) = gsl_sort_smallest($out, 3, $self->{data}, 1, $#{$self->{data}}+1 );
83   ok_status($status);
84   ok_similar ( $sorted , [ -17, 0e0, 3e-10 ], 'gsl_sort_smallest' );
85}
86
87sub GSL_SORT_LARGEST : Tests(2) {
88   my $self = shift;
89   my $out = [1..10];
90   my ($status, $sorted) = gsl_sort_largest($out, 3, $self->{data}, 1, $#{$self->{data}}+1 );
91   ok_status($status);
92   ok_similar ( $sorted , [ 2**15,  6900, 4242 ], 'gsl_sort_largest' );
93}
94
95sub GSL_SORT_INDEX : Tests(1) {
96    my $self = shift;
97    my $p = [ 1 .. $#{$self->{data}} ];
98    my $sorted = gsl_sort_index($p, $self->{data}, 1, $#{$self->{data}}+1 );
99    ok_similar( $sorted, [ 3, 7, 5, 1, 2, 6, 4, 0 ] );
100}
101
102sub GSL_SORT_SMALLEST_INDEX : Tests(1) {
103    my $self = shift;
104    my $p = [ 1 .. $#{$self->{data}} ];
105    my $sorted = gsl_sort_smallest_index($p, 3, $self->{data}, 1, $#{$self->{data}}+1 );
106    ok_similar( $sorted, [ 3, 7, 5 ] );
107}
108
109sub GSL_SORT_LARGEST_INDEX : Tests(1) {
110    my $self = shift;
111    my $p = [ 1 .. $#{$self->{data}} ];
112    my $sorted = gsl_sort_largest_index($p, 3, $self->{data}, 1, $#{$self->{data}}+1 );
113    ok_similar( $sorted, [ 0,4,6 ] );
114}
115
116sub GSL_SORT_AGREES_WITH_PERL_SORT : Tests(1) {
117    my $self = shift;
118    my $rng = Math::GSL::RNG->new;
119    my @data = map { (-1) ** $_ * $rng->get } (1..100);
120    my @sorted = sort { $a <=> $b } @data;
121    ok_similar( gsl_sort([@data], 1, $#data+1) , \@sorted , 'gsl_sort agrees with sort');
122}
123
124Test::Class->runtests;
125