Histogram2D.t

package Math::GSL::Histogram2D::Test;
use base q{Test::Class};
use Test::More tests => 88;
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 );
}

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;
    local $TODO = "gsl_histogram2d_clone does not return a gsl_histogram_t";
    my $copy = gsl_histogram2d_clone($self->{H});
    isa_ok( $copy, 'Math::GSL::Histogram');
}

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_YSIGMA : Tests {
 local $TODO = "Don't know how to test this function";
}

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;