lib/Math/GSL/Histogram2D/Test.pm

   1 package Math::GSL::Histogram2D::Test;
   2 use base q{Test::Class};
   3 use Test::More;
   4 use Math::GSL qw/:all/;
   5 use Math::GSL::Histogram2D 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_histogram2d_alloc( 100, 100 );
  15 }
  16
  17 sub teardown : Test(teardown) {
  18     unlink 'histogram2d' if -f 'histogram2d';
  19 }
  20
  21 sub GSL_HISTOGRAM2D_ALLOC : Tests {
  22     my $h = gsl_histogram2d_alloc(100,100);
  23     isa_ok($h, 'Math::GSL::Histogram2D');
  24     gsl_histogram2d_free($h);
  25     ok(!$@, 'gsl_histogram_free');
  26 }
  27
  28 sub GSL_HISTOGRAM2D_SET_RANGES : Tests {
  29     my $self = shift;
  30     my $ranges = [ 0 .. 100];
  31     ok_status(gsl_histogram2d_set_ranges($self->{H}, $ranges, 100 + 1, $ranges, 100+1), $GSL_SUCCESS);
  32 }
  33
  34 sub GSL_HISTOGRAM2D_SET_RANGES_UNIFORM : Tests {
  35     my $self = shift;
  36     ok_status(gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100), $GSL_SUCCESS);
  37 }
  38
  39 sub MEMCPY : Tests {
  40     my $self = shift;
  41     my $copy = gsl_histogram2d_alloc(100,100);
  42
  43     ok_status(gsl_histogram2d_memcpy($copy, $self->{H}), $GSL_SUCCESS);
  44
  45     my $bob = gsl_histogram2d_alloc(50,50);
  46     ok_status(gsl_histogram2d_memcpy($bob, $self->{H}), $GSL_EINVAL);
  47 }
  48
  49 sub CLONE : Tests {
  50     my $self = shift;
  51     local $TODO = "gsl_histogram2d_clone does not return a gsl_histogram_t";
  52     my $copy = gsl_histogram2d_clone($self->{H});
  53     isa_ok( $copy, 'Math::GSL::Histogram');
  54 }
  55
  56 sub INCREMENT : Tests {
  57     my $self = shift;
  58     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
  59
  60     ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ), $GSL_SUCCESS);
  61     ok_status(gsl_histogram2d_increment($self->{H}, -150.5, -150.5 ), $GSL_EDOM);
  62     ok_status(gsl_histogram2d_increment($self->{H}, 150.5, 150.5 ), $GSL_EDOM);
  63 }
  64
  65 sub GET : Tests {
  66     my $self = shift;
  67     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
  68
  69     ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ), $GSL_SUCCESS);
  70     cmp_ok(1,'==', gsl_histogram2d_get($self->{H}, 50, 50 ) );
  71 }
  72
  73 sub XMIN_XMAX_YMIN_YMAX : Tests {
  74     my $self = shift;
  75     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
  76     cmp_ok(100,'==', gsl_histogram2d_xmax($self->{H}));
  77     cmp_ok(0,'==', gsl_histogram2d_xmin($self->{H}));
  78     cmp_ok(100,'==', gsl_histogram2d_ymax($self->{H}));
  79     cmp_ok(0,'==', gsl_histogram2d_ymin($self->{H}));
  80 }
  81
  82 sub MIN_VAL_MAX_VAL : Tests {
  83     my $self = shift;
  84     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
  85     ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ), $GSL_SUCCESS);
  86
  87     cmp_ok(1,'==', gsl_histogram2d_max_val($self->{H}));
  88     cmp_ok(0,'==', gsl_histogram2d_min_val($self->{H}));
  89 }
  90
  91 sub MEAN : Tests {
  92     my $self = shift;
  93     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
  94     ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ), $GSL_SUCCESS);
  95     ok_status(gsl_histogram2d_increment($self->{H}, 11.5, 11.5 ), $GSL_SUCCESS);
  96
  97     ok_similar(31, gsl_histogram2d_xmean($self->{H}));
  98     ok_similar(31, gsl_histogram2d_ymean($self->{H}));
  99 }
 100
 101 sub SUM : Tests {
 102     my $self = shift;
 103     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 104
 105     ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ), $GSL_SUCCESS);
 106     ok_status(gsl_histogram2d_increment($self->{H}, 11.5, 11.5 ), $GSL_SUCCESS);
 107     ok_similar(2, gsl_histogram2d_sum($self->{H}));
 108 }
 109
 110 sub SHIFT : Tests {
 111     my $h = gsl_histogram2d_alloc(5,5);
 112     gsl_histogram2d_set_ranges_uniform($h, 0, 5, 0, 5);
 113     ok_status(gsl_histogram2d_shift($h, 2), $GSL_SUCCESS);
 114     for my $i (0..4) {
 115     is_deeply( [ map { gsl_histogram2d_get($h, $_, $i) } (0..4) ],
 116                [ (2) x 5 ]
 117     );}
 118 }
 119
 120 sub FWRITE_FREAD : Tests {
 121     my $H = gsl_histogram2d_alloc(5,5);
 122     my $stream = fopen("histogram2d", "w");
 123     gsl_histogram2d_set_ranges_uniform($H, 0, 5, 0, 5);
 124     ok_status(gsl_histogram2d_increment($H, 0.5, 1.5 ), $GSL_SUCCESS);
 125
 126     ok_status(gsl_histogram2d_fwrite($stream, $H),$GSL_SUCCESS);
 127     fclose($stream);
 128
 129     $stream = fopen("histogram2d", "r");
 130     my $h = gsl_histogram2d_alloc(5, 5);
 131     ok_status(gsl_histogram2d_fread($stream, $h),$GSL_SUCCESS);
 132     is_deeply( [ map { gsl_histogram2d_get($h, 0, $_) } (0..4) ],
 133                [ 0, 1, (0) x 3 ]
 134     );
 135     for my $i (1..4) {
 136     is_deeply( [ map { gsl_histogram2d_get($h, $i, $_) } (0..4) ],
 137                [ (0) x 5 ]
 138     );}
 139     fclose($stream);
 140 }
 141
 142 sub GET_XRANGE_YRANGE : Tests {
 143     my $self = shift;
 144     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 145     my @got = gsl_histogram2d_get_xrange($self->{H}, 50);
 146     ok_status($got[0], $GSL_SUCCESS);
 147     @got = gsl_histogram2d_get_yrange($self->{H}, 50);
 148     ok_status($got[0], $GSL_SUCCESS);
 149     is_deeply( [ $got[1], $got[2]], [50, 51]);
 150     is_deeply( [ $got[1], $got[2]], [50, 51]);
 151 }
 152
 153 sub FIND : Tests {
 154     my $self = shift;
 155     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 156     my @got = gsl_histogram2d_find($self->{H}, 1, 1);
 157     ok_status($got[0], $GSL_SUCCESS);
 158     cmp_ok($got[1], '==', 1);
 159     cmp_ok($got[2], '==', 1);
 160 }
 161
 162 sub ACCUMULATE : Tests {
 163     my $self = shift;
 164     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 165
 166     ok_status(gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 3 ), $GSL_SUCCESS);
 167     cmp_ok(3,'==', gsl_histogram2d_get($self->{H}, 50, 50 ) );
 168     ok_status(gsl_histogram2d_accumulate($self->{H}, -150.5, -150.5, 3 ), $GSL_EDOM);
 169 }
 170
 171 sub NX_NY : Tests {
 172     my $self = shift;
 173     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 174     cmp_ok(gsl_histogram2d_nx($self->{H}), '==', 100);
 175     cmp_ok(gsl_histogram2d_ny($self->{H}), '==', 100);
 176 }
 177
 178 sub RESET : Tests {
 179     my $h = gsl_histogram2d_alloc(5,5);
 180     gsl_histogram2d_set_ranges_uniform($h, 0, 5, 0, 5);
 181     gsl_histogram2d_shift($h, 2);
 182     gsl_histogram2d_reset($h);
 183     for my $i (0..4) {
 184     is_deeply( [ map { gsl_histogram2d_get($h, $i, $_) } (0..4) ],
 185                [ (0) x 5 ]
 186     );}
 187 }
 188
 189 sub MIN_BIN_MAX_BIN : Tests {
 190     my $self = shift;
 191     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 192     gsl_histogram2d_increment($self->{H}, 50.5, 50.5);
 193     cmp_ok(gsl_histogram2d_min_bin($self->{H}), '==', 0);
 194     cmp_ok(gsl_histogram2d_max_bin($self->{H}), '==', 50);
 195 }
 196
 197 sub GSL_HISTOGRAM2D_XSIGMA_YSIGMA : Tests {
 198  local $TODO = "Don't know how to test this function";
 199 }
 200
 201 sub EQUAL_BINS_P : Tests {
 202     my $self = shift;
 203     my $h2 = gsl_histogram2d_alloc(100,100);
 204     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 205     gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
 206     cmp_ok(gsl_histogram2d_equal_bins_p($self->{H}, $h2), '==', 1);
 207     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 50, 0, 50);
 208     cmp_ok(gsl_histogram2d_equal_bins_p($self->{H}, $h2), '==', 0);
 209 }
 210
 211 sub ADD : Tests {
 212     my $self = shift;
 213     my $h2 = gsl_histogram2d_alloc(100, 100);
 214     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 215     gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
 216     gsl_histogram2d_increment($h2, 50.5, 50.5 );
 217     ok_status(gsl_histogram2d_add($self->{H}, $h2), $GSL_SUCCESS);
 218     cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 1);
 219 }
 220
 221 sub SUB : Tests {
 222     my $self = shift;
 223     my $h2 = gsl_histogram2d_alloc(100, 100);
 224     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 225     gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
 226     gsl_histogram2d_increment($h2, 50.5, 50.5 );
 227     gsl_histogram2d_increment($self->{H}, 50.5, 50.5 );
 228     ok_status(gsl_histogram2d_sub($self->{H}, $h2), $GSL_SUCCESS);
 229     cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 0);
 230 }
 231
 232 sub MUL : Tests {
 233     my $self = shift;
 234     my $h2 = gsl_histogram2d_alloc(100, 100);
 235     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 236     gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
 237     gsl_histogram2d_accumulate($h2, 50.5, 50.5, 2);
 238     gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 3);
 239     ok_status(gsl_histogram2d_mul($self->{H}, $h2), $GSL_SUCCESS);
 240     cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 6);
 241 }
 242
 243 sub DIV : Tests {
 244     my $self = shift;
 245     my $h2 = gsl_histogram2d_alloc(100, 100);
 246     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 247     gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
 248     gsl_histogram2d_accumulate($h2, 50.5, 50.5, 2);
 249     gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 4);
 250     ok_status(gsl_histogram2d_div($self->{H}, $h2), $GSL_SUCCESS);
 251     cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 2);
 252 }
 253
 254 sub SCALE : Tests {
 255     my $self = shift;
 256     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 257     gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 4);
 258     gsl_histogram2d_increment($self->{H}, 33.5, 33.5 );
 259     ok_status(gsl_histogram2d_scale($self->{H}, 2), $GSL_SUCCESS);
 260     cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 8);
 261     cmp_ok(gsl_histogram2d_get($self->{H}, 33, 33), '==', 2);
 262 }
 263
 264 sub FPRINTF_FSCANF : Tests {
 265     my $H = gsl_histogram2d_alloc(5,5);
 266     my $stream = fopen("histogram2d", "w");
 267     gsl_histogram2d_set_ranges_uniform($H, 0, 5, 0, 5);
 268     ok_status(gsl_histogram2d_increment($H, 0.5, 0.5 ), $GSL_SUCCESS);
 269
 270     ok_status(gsl_histogram2d_fprintf($stream, $H, "%e", "%e"),$GSL_SUCCESS);
 271     fclose($stream);
 272
 273     $stream = fopen("histogram2d", "r");
 274     my $h = gsl_histogram2d_alloc(5,5);
 275     ok_status(gsl_histogram2d_fscanf($stream, $h),$GSL_SUCCESS);
 276     is_deeply( [ map { gsl_histogram2d_get($h, 0, $_) } (0..4) ],
 277                [ 1, (0) x 4 ]
 278     );
 279     for my $i (1..4) {
 280     is_deeply( [ map { gsl_histogram2d_get($h, $i, $_) } (0..4) ],
 281                [ (0) x 5 ]
 282     );}
 283     fclose($stream);
 284 }
 285
 286 sub PDF_ALLOC : Tests {
 287     my $pdf = gsl_histogram2d_pdf_alloc(100,100);
 288     isa_ok($pdf, 'Math::GSL::Histogram2D' );
 289     gsl_histogram2d_pdf_free($pdf);
 290     ok(!$@, 'gsl_histogram2d_free');
 291 }
 292
 293 sub PDF_INIT : Tests {
 294     my $self = shift;
 295     my $p = gsl_histogram2d_pdf_alloc(100, 100);
 296     gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
 297     ok_status(gsl_histogram2d_pdf_init ($p, $self->{H}),$GSL_SUCCESS);
 298     gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, -4);
 299     ok_status(gsl_histogram2d_pdf_init ($p, $self->{H}), $GSL_EDOM);
 300 }
 301
 302 sub GSL_HISTOGRAM_PDF_SAMPLE : Tests {
 303  local $TODO = "Don't know how to test this function";
 304 }
 305 42;