t/Sort.t

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