package Math::GSL::Histogram2D::Test;
use base q{Test::Class};
use Test::More tests => 89;
use Math::GSL qw/:all/;
use Math::GSL::Test qw/:all/;
use Math::GSL::Errno qw/:all/;
use Math::GSL::Histogram2D qw/:all/;
use Data::Dumper;
use strict;
BEGIN{ gsl_set_error_handler_off(); }
sub make_fixture : Test(setup) {
my $self = shift;
$self->{H} = gsl_histogram2d_alloc( 100, 100 );
gsl_histogram2d_set_ranges_uniform($self->{H}, 1, 100, 1, 100);
}
sub teardown : Test(teardown) {
unlink 'histogram2d' if -f 'histogram2d';
}
sub GSL_HISTOGRAM2D_ALLOC : Tests {
my $h = gsl_histogram2d_alloc(100,100);
isa_ok($h, 'Math::GSL::Histogram2D');
gsl_histogram2d_free($h);
ok(!$@, 'gsl_histogram_free');
}
sub GSL_HISTOGRAM2D_SET_RANGES : Tests {
my $self = shift;
my $ranges = [ 0 .. 100];
ok_status(gsl_histogram2d_set_ranges($self->{H}, $ranges, 100 + 1, $ranges, 100+1));
}
sub GSL_HISTOGRAM2D_SET_RANGES_UNIFORM : Tests {
my $self = shift;
ok_status(gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100));
}
sub MEMCPY : Tests {
my $self = shift;
my $copy = gsl_histogram2d_alloc(100,100);
ok_status(gsl_histogram2d_memcpy($copy, $self->{H}));
my $bob = gsl_histogram2d_alloc(50,50);
ok_status(gsl_histogram2d_memcpy($bob, $self->{H}), $GSL_EINVAL);
}
sub CLONE : Tests {
my $self = shift;
my $copy = gsl_histogram2d_clone($self->{H});
isa_ok( $copy, 'Math::GSL::Histogram2D::gsl_histogram2d');
}
sub INCREMENT : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ));
ok_status(gsl_histogram2d_increment($self->{H}, -150.5, -150.5 ), $GSL_EDOM);
ok_status(gsl_histogram2d_increment($self->{H}, 150.5, 150.5 ), $GSL_EDOM);
}
sub GET : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ));
cmp_ok(1,'==', gsl_histogram2d_get($self->{H}, 50, 50 ) );
}
sub XMIN_XMAX_YMIN_YMAX : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
cmp_ok(100,'==', gsl_histogram2d_xmax($self->{H}));
cmp_ok(0,'==', gsl_histogram2d_xmin($self->{H}));
cmp_ok(100,'==', gsl_histogram2d_ymax($self->{H}));
cmp_ok(0,'==', gsl_histogram2d_ymin($self->{H}));
}
sub MIN_VAL_MAX_VAL : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ));
cmp_ok(1,'==', gsl_histogram2d_max_val($self->{H}));
cmp_ok(0,'==', gsl_histogram2d_min_val($self->{H}));
}
sub MEAN : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ));
ok_status(gsl_histogram2d_increment($self->{H}, 11.5, 11.5 ));
ok_similar(31, gsl_histogram2d_xmean($self->{H}));
ok_similar(31, gsl_histogram2d_ymean($self->{H}));
}
sub SUM : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_increment($self->{H}, 50.5, 50.5 ));
ok_status(gsl_histogram2d_increment($self->{H}, 11.5, 11.5 ));
ok_similar(2, gsl_histogram2d_sum($self->{H}));
}
sub SHIFT : Tests {
my $h = gsl_histogram2d_alloc(5,5);
gsl_histogram2d_set_ranges_uniform($h, 0, 5, 0, 5);
ok_status(gsl_histogram2d_shift($h, 2));
for my $i (0..4) {
is_deeply( [ map { gsl_histogram2d_get($h, $_, $i) } (0..4) ],
[ (2) x 5 ]
);}
}
sub FWRITE_FREAD : Tests {
my $H = gsl_histogram2d_alloc(5,5);
my $stream = gsl_fopen("histogram2d", 'w');
gsl_histogram2d_set_ranges_uniform($H, 0, 5, 0, 5);
ok_status(gsl_histogram2d_increment($H, 0.5, 1.5 ));
ok_status(gsl_histogram2d_fwrite($stream, $H));
ok_status(gsl_fclose($stream));
$stream = gsl_fopen("histogram2d", 'r');
my $h = gsl_histogram2d_alloc(5, 5);
ok_status(gsl_histogram2d_fread($stream, $h));
is_deeply( [ map { gsl_histogram2d_get($h, 0, $_) } (0..4) ],
[ 0, 1, (0) x 3 ]
);
for my $i (1..4) {
is_deeply( [ map { gsl_histogram2d_get($h, $i, $_) } (0..4) ],
[ (0) x 5 ]
);}
ok_status(gsl_fclose($stream));
}
sub GET_XRANGE_YRANGE : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
my @got = gsl_histogram2d_get_xrange($self->{H}, 50);
ok_status($got[0]);
@got = gsl_histogram2d_get_yrange($self->{H}, 50);
ok_status($got[0]);
is_deeply( [ $got[1], $got[2]], [50, 51]);
is_deeply( [ $got[1], $got[2]], [50, 51]);
}
sub FIND : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
my @got = gsl_histogram2d_find($self->{H}, 1, 1);
ok_status($got[0]);
cmp_ok($got[1], '==', 1);
cmp_ok($got[2], '==', 1);
}
sub ACCUMULATE : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 3 ));
cmp_ok(3,'==', gsl_histogram2d_get($self->{H}, 50, 50 ) );
ok_status(gsl_histogram2d_accumulate($self->{H}, -150.5, -150.5, 3 ), $GSL_EDOM);
}
sub NX_NY : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
cmp_ok(gsl_histogram2d_nx($self->{H}), '==', 100);
cmp_ok(gsl_histogram2d_ny($self->{H}), '==', 100);
}
sub RESET : Tests {
my $h = gsl_histogram2d_alloc(5,5);
gsl_histogram2d_set_ranges_uniform($h, 0, 5, 0, 5);
gsl_histogram2d_shift($h, 2);
gsl_histogram2d_reset($h);
for my $i (0..4) {
is_deeply( [ map { gsl_histogram2d_get($h, $i, $_) } (0..4) ],
[ (0) x 5 ]
);}
}
sub MIN_BIN_MAX_BIN : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_increment($self->{H}, 50.5, 50.5);
cmp_ok(gsl_histogram2d_min_bin($self->{H}), '==', 0);
cmp_ok(gsl_histogram2d_max_bin($self->{H}), '==', 50);
}
sub GSL_HISTOGRAM2D_XSIGMA : Tests(1) {
my $self = shift;
local $TODO = "gsl_histogram2d_xsigma";
gsl_histogram2d_increment($self->{H}, 0, 42);
gsl_histogram2d_increment($self->{H}, 42, 1);
my $xsigma = gsl_histogram2d_xsigma($self->{H});
# what is the correct answer?
is_similar(42, $xsigma, 1e-8, 'gsl_histogram2d_xsigma');
}
sub EQUAL_BINS_P : Tests {
my $self = shift;
my $h2 = gsl_histogram2d_alloc(100,100);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
cmp_ok(gsl_histogram2d_equal_bins_p($self->{H}, $h2), '==', 1);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 50, 0, 50);
cmp_ok(gsl_histogram2d_equal_bins_p($self->{H}, $h2), '==', 0);
}
sub ADD : Tests {
my $self = shift;
my $h2 = gsl_histogram2d_alloc(100, 100);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
gsl_histogram2d_increment($h2, 50.5, 50.5 );
ok_status(gsl_histogram2d_add($self->{H}, $h2));
cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 1);
}
sub SUB : Tests {
my $self = shift;
my $h2 = gsl_histogram2d_alloc(100, 100);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
gsl_histogram2d_increment($h2, 50.5, 50.5 );
gsl_histogram2d_increment($self->{H}, 50.5, 50.5 );
ok_status(gsl_histogram2d_sub($self->{H}, $h2));
cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 0);
}
sub MUL : Tests {
my $self = shift;
my $h2 = gsl_histogram2d_alloc(100, 100);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
gsl_histogram2d_accumulate($h2, 50.5, 50.5, 2);
gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 3);
ok_status(gsl_histogram2d_mul($self->{H}, $h2));
cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 6);
}
sub DIV : Tests {
my $self = shift;
my $h2 = gsl_histogram2d_alloc(100, 100);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_set_ranges_uniform($h2, 0, 100, 0, 100);
gsl_histogram2d_accumulate($h2, 50.5, 50.5, 2);
gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 4);
ok_status(gsl_histogram2d_div($self->{H}, $h2));
cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 2);
}
sub SCALE : Tests {
my $self = shift;
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, 4);
gsl_histogram2d_increment($self->{H}, 33.5, 33.5 );
ok_status(gsl_histogram2d_scale($self->{H}, 2));
cmp_ok(gsl_histogram2d_get($self->{H}, 50, 50), '==', 8);
cmp_ok(gsl_histogram2d_get($self->{H}, 33, 33), '==', 2);
}
sub FPRINTF_FSCANF : Tests {
my $H = gsl_histogram2d_alloc(5,5);
my $stream = gsl_fopen("histogram2d", 'w');
gsl_histogram2d_set_ranges_uniform($H, 0, 5, 0, 5);
ok_status(gsl_histogram2d_increment($H, 0.5, 0.5 ));
ok_status(gsl_histogram2d_fprintf($stream, $H, "%e", "%e"));
ok_status(gsl_fclose($stream));
$stream = gsl_fopen("histogram2d", 'r');
my $h = gsl_histogram2d_alloc(5,5);
ok_status(gsl_histogram2d_fscanf($stream, $h));
is_deeply( [ map { gsl_histogram2d_get($h, 0, $_) } (0..4) ],
[ 1, (0) x 4 ]
);
for my $i (1..4) {
is_deeply( [ map { gsl_histogram2d_get($h, $i, $_) } (0..4) ],
[ (0) x 5 ]
);}
ok_status(gsl_fclose($stream));
}
sub PDF_ALLOC : Tests {
my $pdf = gsl_histogram2d_pdf_alloc(100,100);
isa_ok($pdf, 'Math::GSL::Histogram2D' );
gsl_histogram2d_pdf_free($pdf);
ok(!$@, 'gsl_histogram2d_free');
}
sub PDF_INIT : Tests {
my $self = shift;
my $p = gsl_histogram2d_pdf_alloc(100, 100);
gsl_histogram2d_set_ranges_uniform($self->{H}, 0, 100, 0, 100);
ok_status(gsl_histogram2d_pdf_init ($p, $self->{H}));
gsl_histogram2d_accumulate($self->{H}, 50.5, 50.5, -4);
ok_status(gsl_histogram2d_pdf_init ($p, $self->{H}), $GSL_EDOM);
}
sub GSL_HISTOGRAM_PDF_SAMPLE : Tests {
local $TODO = "Don't know how to test this function";
}
Test::Class->runtests;