lib/Math/GSL/Histogram/Test.pm

   1 package Math::GSL::Histogram::Test;
   2 use base q{Test::Class};
   3 use Test::More;
   4 use Math::GSL qw/:all/;
   5 use Math::GSL::Histogram qw/:all/;
   6 use Math::GSL::Errno qw/:all/;
   7 use Data::Dumper;
   8 use strict;
   9
  10 BEGIN{ gsl_set_error_handler_off(); }
  11
  12 sub make_fixture : Test(setup) {
  13     my $self = shift;
  14     $self->{H} = gsl_histogram_alloc( 100 );
  15 }
  16
  17 sub teardown : Test(teardown) {
  18     unlink 'histogram' if -f 'histogram';
  19 }
  20
  21 sub ALLOC_FREE : Tests {
  22     my $H = gsl_histogram_alloc( 100 );
  23     isa_ok($H, 'Math::GSL::Histogram' );
  24     gsl_histogram_free($H);
  25     ok(!$@, 'gsl_histogram_free');
  26 }
  27
  28 sub SET_RANGES_UNIFORM : Tests {
  29     my $self = shift;
  30     ok_status(gsl_histogram_set_ranges_uniform($self->{H}, 0, 100), $GSL_SUCCESS);
  31     ok_status(gsl_histogram_set_ranges_uniform($self->{H}, 0, -100), $GSL_EINVAL);
  32 }
  33
  34 sub SET_RANGES : Tests {
  35     my $self = shift;
  36     my $ranges = [ 0 .. 100 ];
  37
  38     ok_status(gsl_histogram_set_ranges($self->{H}, $ranges, 100 + 1), $GSL_SUCCESS);
  39     ok_status(gsl_histogram_set_ranges($self->{H}, $ranges, 42), $GSL_EINVAL);
  40 }
  41
  42 sub CLONE : Tests {
  43     my $self = shift;
  44     local $TODO = "gsl_histogram_clone does not return a gsl_histogram_t";
  45     my $copy = gsl_histogram_clone($self->{H});
  46     isa_ok( $copy, 'Math::GSL::Histogram');
  47 }
  48
  49 sub MEMCPY : Tests {
  50     my $self = shift;
  51     my $copy = gsl_histogram_alloc(100);
  52
  53     ok_status(gsl_histogram_memcpy($copy, $self->{H}), $GSL_SUCCESS);
  54
  55     my $bob = gsl_histogram_alloc(50);
  56     ok_status(gsl_histogram_memcpy($bob, $self->{H}), $GSL_EINVAL);
  57
  58 }
  59
  60 sub INCREMENT : Tests {
  61     my $self = shift;
  62     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
  63
  64     ok_status(gsl_histogram_increment($self->{H}, 50.5 ), $GSL_SUCCESS);
  65     ok_status(gsl_histogram_increment($self->{H}, -150.5 ), $GSL_EDOM);
  66     ok_status(gsl_histogram_increment($self->{H}, 150.5 ), $GSL_EDOM);
  67 }
  68
  69 sub GET : Tests {
  70     my $self = shift;
  71     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
  72
  73     ok_status(gsl_histogram_increment($self->{H}, 50.5 ), $GSL_SUCCESS);
  74     cmp_ok(1,'==', gsl_histogram_get($self->{H}, 50 ) );
  75 }
  76
  77 sub MIN_MAX : Tests {
  78     my $self = shift;
  79     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
  80     ok_status(gsl_histogram_increment($self->{H}, 50.5 ), $GSL_SUCCESS);
  81
  82     cmp_ok(100,'==', gsl_histogram_max($self->{H}));
  83     cmp_ok(0,'==', gsl_histogram_min($self->{H}));
  84 }
  85
  86 sub MIN_VAL_MAX_VAL : Tests {
  87     my $self = shift;
  88     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
  89     ok_status(gsl_histogram_increment($self->{H}, 50.5 ), $GSL_SUCCESS);
  90
  91     cmp_ok(1,'==', gsl_histogram_max_val($self->{H}));
  92     cmp_ok(0,'==', gsl_histogram_min_val($self->{H}));
  93 }
  94
  95 sub MEAN : Tests {
  96     my $self = shift;
  97     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
  98     ok_status(gsl_histogram_increment($self->{H}, 50.5 ), $GSL_SUCCESS);
  99     ok_status(gsl_histogram_increment($self->{H}, 11.5 ), $GSL_SUCCESS);
 100
 101     ok_similar(31, gsl_histogram_mean($self->{H}));
 102 }
 103
 104 sub SUM : Tests {
 105     my $self = shift;
 106     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
 107
 108 ok_status(gsl_histogram_increment($self->{H}, 50.5 ), $GSL_SUCCESS);
 109     ok_status(gsl_histogram_increment($self->{H}, 11.5 ), $GSL_SUCCESS);
 110     ok_similar(2, gsl_histogram_sum($self->{H}));
 111 }
 112
 113 sub SHIFT : Tests {
 114     my $self = shift;
 115     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
 116     ok_status(gsl_histogram_shift($self->{H}, 2), $GSL_SUCCESS);
 117     map { is(gsl_histogram_get($self->{H}, $_), 2, "shifted values")} (0..99);
 118 }
 119
 120 sub FWRITE_FREAD : Tests {
 121     my $self = shift;
 122     my $stream = fopen("histogram", "w");
 123     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
 124
 125     is(gsl_histogram_fwrite($stream, $self->{H}),0);
 126     fclose($stream);
 127
 128     $stream = fopen("histogram", "r");
 129     my $h = gsl_histogram_alloc(100);
 130     is(gsl_histogram_fread($stream, $h),0);
 131     map { is(gsl_histogram_get($h, $_), 0)} (0..99);
 132     fclose($stream);
 133 }
 134 42;