The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
BEGIN { use_ok('Math::SimpleHisto::XS') };

use lib 't/lib', 'lib';
use Test_Functions;

my $h = Math::SimpleHisto::XS->new(nbins => 10, min => 0, max => 1);
isa_ok($h, 'Math::SimpleHisto::XS');

$h->fill(0.11, 12.4);
pass("Alive");

is_approx($h->binsize, 0.1, "binsize default");
is_approx($h->binsize(0), 0.1, "binsize(0)");
is_approx($h->binsize(2), 0.1, "binsize(2)");
is_approx($h->binsize(5), 0.1, "binsize(5)");
ok(!eval{$h->binsize(-1); 1}, "binsize(-1) fails");
ok(!eval{$h->binsize(100); 1}, "binsize(100) fails");

my $data = $h->all_bin_contents;
ok(ref($data) && ref($data) eq 'ARRAY', "got ary ref");
is(scalar(@$data), 10, "10 bins");
is($h->nfills, 1, "1 fill");
is_approx($h->total, 12.4, "total is right");
SCOPE: {
  my $exp = [0,12.4,(0)x8];
  for (0..9) {
    is_approx($data->[$_], $exp->[$_], "Bin $_ is right");
    is_approx($h->bin_content($_), $exp->[$_], "Bin $_ is right (extra call)");
  }
}

$h->fill_by_bin(0);
$h->fill_by_bin(-1);
$h->fill_by_bin(1, 2.3);
$h->fill_by_bin([2, 5]);
$h->fill_by_bin([3,4], [2,3]);
$h->fill_by_bin(1e9, 1);

SCOPE: {
  my $exp = [0,12.4,(0)x8];
  for ([0, 1], [1, 2.3], [2, 1], [5, 1], [3, 2], [4, 3]) {
    $exp->[$_->[0]] += $_->[1];
  }

  my $data = $h->all_bin_contents;
  for (0..9) {
    is_approx($data->[$_], $exp->[$_], "Bin $_ is right (after fill_by_bin)");
    is_approx($h->bin_content($_), $exp->[$_], "Bin $_ is right (extra call, after fill_by_bin))");
  }
}

$h->fill(-2.);
$h->fill(0.5);
$h->fill(0.5, 13.);
$h->fill([0.5], [13.]);
$h->fill([0.5, 2.], [13., 1.]);
pass("alive");

# Test empty clone
my $hclone = $h->new_alike();
is($hclone->nfills, 0, "new_alike returns fresh object");
is($hclone->total, 0, "new_alike returns fresh object");
is_approx($hclone->overflow, 0, "new_alike returns fresh object");
is_approx($hclone->underflow, 0, "new_alike returns fresh object");

# Test addition
$hclone->set_bin_content(0, 23.4);
SCOPE: {
  my $hcloneclone = $hclone->clone;
  $hcloneclone->add_histogram($h);
  foreach my $meth (qw(total overflow underflow nfills)) {
    is_approx($hcloneclone->$meth, $hclone->$meth + $h->$meth);
  }
  foreach my $i (0..$h->nbins-1) {
    is_approx($hcloneclone->bin_content($i), $hclone->bin_content($i) + $h->bin_content($i));
  }
}

# Test subtraction
SCOPE: {
  my $hcloneclone = $hclone->clone;
  $hcloneclone->subtract_histogram($h);
  foreach my $meth (qw(total overflow underflow)) {
    is_approx($hcloneclone->$meth, $hclone->$meth - $h->$meth, "subtraction: $meth");
  }
  is_approx($hcloneclone->nfills, $hclone->nfills + $h->nfills, "subtraction: nfills");

  foreach my $i (0..$h->nbins-1) {
    is_approx($hcloneclone->bin_content($i), $hclone->bin_content($i) - $h->bin_content($i));
  }
}

# Test multiplication
SCOPE: {
  my $hcloneclone = $hclone->clone;
  $hcloneclone->multiply_histogram($h);
  foreach my $meth (qw(overflow underflow)) {
    is_approx($hcloneclone->$meth, $hclone->$meth * $h->$meth, "multiplication: $meth");
  }

  my $total = 0.;
  foreach my $i (0..$h->nbins-1) {
    my $x = $hclone->bin_content($i) * $h->bin_content($i);
    $total += $x;
    is_approx($hcloneclone->bin_content($i), $x, "multiplication: bin $i");
  }
  is_approx($hcloneclone->nfills, $hclone->nfills + $h->nfills, "multiplication: nfills");
  is_approx($hcloneclone->total, $total, "multiplication: total");
}

# Test division
SCOPE: {
  my $hcloneclone = $hclone->clone;
  my $h = $hclone->clone;
  $h->fill($_) for map 0.05 + $_/10, -2..11;

  $hcloneclone->divide_histogram($h);
  foreach my $meth (qw(overflow underflow)) {
    is_approx($hcloneclone->$meth, $hclone->$meth / $h->$meth, "division: $meth");
  }

  my $total = 0.;
  foreach my $i (0..$h->nbins-1) {
    my $x = eval {$hclone->bin_content($i) / $h->bin_content($i)};
    $total += $x;
    is_approx($hcloneclone->bin_content($i), $x, "division: bin $i");
  }
  is_approx($hcloneclone->nfills, $hclone->nfills + $h->nfills, "division: nfills");
  is_approx($hcloneclone->total, $total, "division: total");
}

SCOPE: {
  my $exp = [map $_/10, 0..9];
  my $c = $h->bin_centers();
  my $up = $h->bin_upper_boundaries();
  my $low = $h->bin_lower_boundaries();
  for (0..9) {
    is_approx($low->[$_], $exp->[$_], "Bin $_ is lower boundary is right");
    is_approx($h->bin_lower_boundary($_), $exp->[$_], "Bin $_ is lower boundary is right (extra call)");
    is_approx($c->[$_], $exp->[$_]+0.05, "Bin $_ center is right");
    is_approx($h->bin_center($_), $exp->[$_]+0.05, "Bin $_ center is right (extra call)");
    is_approx($up->[$_], $exp->[$_]+0.1, "Bin $_ upper boundary is right");
    is_approx($h->bin_upper_boundary($_), $exp->[$_]+0.1, "Bin $_ upper boundary is right (extra call)");
  }
}

# test clone from range
$h = Math::SimpleHisto::XS->new(nbins => 10, min => 0, max => 1);
$h->fill(-123., 99.1);
$h->fill(123., 199.1);
$h->set_bin_content($_, $_+1) for 0..9;
$hclone = $h->new_from_bin_range(2, 5);
my $hclone_empty = $h->new_alike_from_bin_range(2, 5);
isa_ok($h, "Math::SimpleHisto::XS") for ($hclone, $hclone_empty);

is($hclone->nfills, $h->nfills, "range clone nfills");
is($hclone_empty->nfills, 0, "range clone empty nfills");
is($hclone->nbins, 4, "range clone nbins");
is($hclone_empty->nbins, 4, "empty range clone nbins");
is_approx($hclone->total, $h->bin_content(2)+$h->bin_content(3)
                         +$h->bin_content(4)+$h->bin_content(5), "range clone total");
is_approx($hclone->underflow, $h->underflow+$h->bin_content(0)+$h->bin_content(1), "range clone underflow");
is_approx($hclone->overflow, $h->overflow+$h->bin_content(6)+$h->bin_content(7)
                                         +$h->bin_content(8)+$h->bin_content(9),
          "range clone overflow");
is_approx($hclone_empty->underflow, 0., "range clone empty underflow");
is_approx($hclone_empty->overflow, 0., "range clone empty overflow");

foreach my $i (2..5) {
  is_approx($hclone->bin_content($i-2), $h->bin_content($i), "range clone bin content $i or $i-2");
  is_approx($hclone->bin_lower_boundary($i-2), $h->bin_lower_boundary($i), "range clone bin lower bound $i or $i-2");
  is_approx($hclone->bin_upper_boundary($i-2), $h->bin_upper_boundary($i), "range clone bin upper bound $i or $i-2");
  is_approx($hclone->bin_center($i-2), $h->bin_center($i), "range clone bin center $i or $i-2");
}

is_deeply($hclone->bin_centers, $hclone_empty->bin_centers, "Cloned bin centers agree");

# memory leaks
#while (1) {do {my $x = $h->all_bin_contents()}}
#while (1) {  do {my $h = Math::SimpleHisto::XS->new(nbins => 100, min => 0, max => 1);};}
#while (1) {  do {$h->fill([0.5], [1.]);};}

done_testing;