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     gsl_histogram_set_ranges_uniform($self->{H}, 0, 100);
  16 }
  17
  18 sub teardown : Test(teardown) {
  19     unlink 'histogram' if -f 'histogram';
  20 }
  21
  22 sub ALLOC_FREE : Tests {
  23     my $H = gsl_histogram_alloc( 100 );
  24     isa_ok($H, 'Math::GSL::Histogram' );
  25     gsl_histogram_free($H);
  26     ok(!$@, 'gsl_histogram_free');
  27 }
  28
  29 sub SET_RANGES_UNIFORM : Tests {
  30     my $H = gsl_histogram_alloc(100);
  31     ok_status(gsl_histogram_set_ranges_uniform($H, 0, 100));
  32     ok_status(gsl_histogram_set_ranges_uniform($H, 0, -100), $GSL_EINVAL);
  33 }
  34
  35 sub SET_RANGES : Tests {
  36     my $self = shift;
  37     my $ranges = [ 0 .. 100 ];
  38
  39     ok_status(gsl_histogram_set_ranges($self->{H}, $ranges, 100 + 1));
  40     ok_status(gsl_histogram_set_ranges($self->{H}, $ranges, 42), $GSL_EINVAL);
  41 }
  42
  43 sub CLONE : Tests {
  44     my $self = shift;
  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}));
  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
  63     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
  64     ok_status(gsl_histogram_increment($self->{H}, -150.5 ), $GSL_EDOM);
  65     ok_status(gsl_histogram_increment($self->{H}, 150.5 ), $GSL_EDOM);
  66 }
  67
  68 sub GET : Tests {
  69     my $self = shift;
  70
  71     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
  72     cmp_ok(1,'==', gsl_histogram_get($self->{H}, 50 ) );
  73 }
  74
  75 sub MIN_MAX : Tests {
  76     my $self = shift;
  77     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
  78
  79     cmp_ok(100,'==', gsl_histogram_max($self->{H}));
  80     cmp_ok(0,'==', gsl_histogram_min($self->{H}));
  81 }
  82
  83 sub MIN_VAL_MAX_VAL : Tests {
  84     my $self = shift;
  85     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
  86
  87     cmp_ok(1,'==', gsl_histogram_max_val($self->{H}));
  88     cmp_ok(0,'==', gsl_histogram_min_val($self->{H}));
  89 }
  90
  91 sub MEAN : Tests {
  92     my $self = shift;
  93     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
  94     ok_status(gsl_histogram_increment($self->{H}, 11.5 ));
  95
  96     ok_similar(31, gsl_histogram_mean($self->{H}));
  97 }
  98
  99 sub SUM : Tests {
 100     my $self = shift;
 101     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
 102     ok_status(gsl_histogram_increment($self->{H}, 11.5 ));
 103     ok_similar(2, gsl_histogram_sum($self->{H}));
 104 }
 105
 106 sub SHIFT : Tests {
 107     my $self = shift;
 108     ok_status(gsl_histogram_shift($self->{H}, 2));
 109     is_deeply( [ map { gsl_histogram_get($self->{H}, $_) } (0..99) ],
 110                [ (2) x 100 ]
 111     );
 112 }
 113
 114 sub FWRITE_FREAD : Tests {
 115     my $self = shift;
 116     my $stream = fopen("histogram", "w");
 117     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
 118
 119     ok_status(gsl_histogram_fwrite($stream, $self->{H}));
 120     ok_status(fclose($stream));
 121
 122     $stream = fopen("histogram", "r");
 123     my $h = gsl_histogram_alloc(100);
 124     ok_status(gsl_histogram_fread($stream, $h));
 125     is_deeply( [ map { gsl_histogram_get($h, $_) } (0..99) ],
 126                [ (0) x 50, 1, (0) x 49 ]
 127     );
 128     ok_status(fclose($stream));
 129 }
 130
 131 sub GET_RANGE : Tests {
 132     my $self = shift;
 133     my @got = gsl_histogram_get_range($self->{H}, 50);
 134     ok_status($got[0]);
 135     is_deeply( [ $got[1], $got[2]], [50, 51]);
 136 }
 137
 138 sub FIND : Tests {
 139     my $self = shift;
 140     my @got = gsl_histogram_find($self->{H}, 1);
 141     ok_status($got[0]);
 142     cmp_ok($got[1], '==', 1);
 143 }
 144
 145 sub ACCUMULATE : Tests {
 146     my $self = shift;
 147
 148     ok_status(gsl_histogram_accumulate($self->{H}, 50.5, 3 ));
 149     cmp_ok(3,'==', gsl_histogram_get($self->{H}, 50 ) );
 150     ok_status(gsl_histogram_accumulate($self->{H}, -150.5, 3 ), $GSL_EDOM);
 151 }
 152
 153 sub BINS : Tests {
 154     my $self = shift;
 155     cmp_ok(gsl_histogram_bins($self->{H}), '==', 100);
 156 }
 157
 158 sub RESET : Tests {
 159     my $self = shift;
 160     ok_status(gsl_histogram_shift($self->{H}, 2));
 161     ok_status(gsl_histogram_reset($self->{H}));
 162     is_deeply( [ map { gsl_histogram_get($self->{H}, $_) } (0..99) ],
 163                [ (0) x 100 ]
 164     );
 165 }
 166
 167 sub MIN_BIN_MAX_BIN : Tests {
 168     my $self = shift;
 169     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
 170     cmp_ok(gsl_histogram_min_bin($self->{H}), '==', 0);
 171     cmp_ok(gsl_histogram_max_bin($self->{H}), '==', 50);
 172 }
 173
 174 sub GSL_HISTOGRAM_SIGMA : Tests {
 175     my $self = shift;
 176     map { gsl_histogram_increment($self->{H}, $_ ) } (0,1);
 177     my $standard_deviation = gsl_histogram_sigma($self->{H});
 178     ok_similar ( 0.5, $standard_deviation );
 179 }
 180
 181 sub EQUAL_BINS_P : Tests {
 182     my $self = shift;
 183     my $h2 = gsl_histogram_alloc(100);
 184     gsl_histogram_set_ranges_uniform($h2, 0, 100);
 185     cmp_ok(gsl_histogram_equal_bins_p($self->{H}, $h2), '==', 1);
 186     gsl_histogram_set_ranges_uniform($self->{H}, 0, 50);
 187     cmp_ok(gsl_histogram_equal_bins_p($self->{H}, $h2), '==', 0);
 188 }
 189
 190 sub ADD : Tests {
 191     my $self = shift;
 192     my $h2 = gsl_histogram_alloc(100);
 193     gsl_histogram_set_ranges_uniform($h2, 0, 100);
 194     gsl_histogram_increment($h2, 50.5 );
 195     ok_status(gsl_histogram_add($self->{H}, $h2));
 196     cmp_ok(gsl_histogram_get($self->{H}, 50), '==', 1);
 197 }
 198
 199 sub SUB : Tests {
 200     my $self = shift;
 201     my $h2 = gsl_histogram_alloc(100);
 202     gsl_histogram_set_ranges_uniform($h2, 0, 100);
 203     gsl_histogram_increment($h2, 50.5 );
 204     gsl_histogram_increment($self->{H}, 50.5 );
 205     ok_status(gsl_histogram_sub($self->{H}, $h2));
 206     cmp_ok(gsl_histogram_get($self->{H}, 50), '==', 0);
 207 }
 208
 209 sub MUL : Tests {
 210     my $self = shift;
 211     my $h2 = gsl_histogram_alloc(100);
 212     gsl_histogram_set_ranges_uniform($h2, 0, 100);
 213     gsl_histogram_accumulate($h2, 50.5, 2);
 214     gsl_histogram_accumulate($self->{H}, 50.5, 3);
 215     ok_status(gsl_histogram_mul($self->{H}, $h2));
 216     cmp_ok(gsl_histogram_get($self->{H}, 50), '==', 6);
 217 }
 218
 219 sub DIV : Tests {
 220     my $self = shift;
 221     my $h2 = gsl_histogram_alloc(100);
 222     ok_status(gsl_histogram_set_ranges_uniform($h2, 0, 100));
 223     ok_status(gsl_histogram_accumulate($h2, 50.5, 2));
 224     ok_status(gsl_histogram_accumulate($self->{H}, 50.5, 4));
 225     ok_status(gsl_histogram_div($self->{H}, $h2));
 226     cmp_ok(gsl_histogram_get($self->{H}, 50), '==', 2);
 227 }
 228
 229 sub SCALE : Tests {
 230     my $self = shift;
 231     gsl_histogram_accumulate($self->{H}, 50.5, 4);
 232     gsl_histogram_increment($self->{H}, 33.5 );
 233     ok_status(gsl_histogram_scale($self->{H}, 2));
 234     cmp_ok(gsl_histogram_get($self->{H}, 50), '==', 8);
 235     cmp_ok(gsl_histogram_get($self->{H}, 33), '==', 2);
 236 }
 237
 238 sub FPRINTF_FSCANF : Tests {
 239     my $self = shift;
 240     my $stream = fopen("histogram", "w");
 241     ok_status(gsl_histogram_increment($self->{H}, 50.5 ));
 242
 243     ok_status(gsl_histogram_fprintf($stream, $self->{H}, "%e", "%e"));
 244     ok_status(fclose($stream));
 245
 246     $stream = fopen("histogram", "r");
 247     my $h = gsl_histogram_alloc(100);
 248     ok_status(gsl_histogram_fscanf($stream, $h));
 249     is_deeply( [ map { gsl_histogram_get($h, $_) } (0..99) ],
 250                [ (0) x 50, 1, (0) x 49 ]
 251     );
 252     ok_status(fclose($stream));
 253 }
 254
 255 sub PDF_ALLOC : Tests {
 256     my $pdf = gsl_histogram_pdf_alloc(100);
 257     isa_ok($pdf, 'Math::GSL::Histogram' );
 258     gsl_histogram_pdf_free($pdf);
 259     ok(!$@, 'gsl_histogram_free');
 260 }
 261
 262 sub PDF_INIT : Tests {
 263     my $self = shift;
 264     my $p = gsl_histogram_pdf_alloc(100);
 265     ok_status(gsl_histogram_pdf_init ($p, $self->{H}));
 266     gsl_histogram_accumulate($self->{H}, 50.5, -4);
 267     ok_status(gsl_histogram_pdf_init ($p, $self->{H}), $GSL_EDOM);
 268 }
 269
 270 sub GSL_HISTOGRAM_PDF_SAMPLE : Tests {
 271     my $p = gsl_histogram_pdf_alloc(100);
 272     ok_status(gsl_histogram_pdf_sample( $p, 0.5 ));
 273 }
 274 42;