t/Histogram2D.t

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