t/Histogram.t

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