# multidimensional binning & histogramming - iterator tests
use strict;
use warnings;
use Test::More tests => 48;
use Test::PDL;
use Test::Exception;
use Test::NoWarnings;
use PDL;
use PDL::NDBin::Iterator;
# variable declarations
my( $iter, @bins, @variables, $idx, $bin, $var, @expected, @got, $k );
#
@bins = ( 4 );
@variables = ( null );
$idx = null;
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
isa_ok $iter, 'PDL::NDBin::Iterator', 'return value from constructor';
# test iteration
@bins = ( 4 );
@variables = ( null );
$idx = null;
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
$k = 4;
while( $iter->advance ) { last if $k-- == 0 }
is $k, 0, 'advance() in boolean context';
ok $iter->done, 'iteration complete';
ok !$iter->advance, "doesn't reset";
#
@bins = ( 4 );
@variables = ( 'one', 'two', 'three' );
$idx = 'this is my secret list';
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins, 4, 'number of bins';
is $iter->nvars, 3, 'number of variables';
@got = ();
@expected = (
[ 0, 0, 'one', $idx ],
[ 0, 1, 'two', $idx ],
[ 0, 2, 'three', $idx ],
[ 1, 0, 'one', $idx ],
[ 1, 1, 'two', $idx ],
[ 1, 2, 'three', $idx ],
[ 2, 0, 'one', $idx ],
[ 2, 1, 'two', $idx ],
[ 2, 2, 'three', $idx ],
[ 3, 0, 'one', $idx ],
[ 3, 1, 'two', $idx ],
[ 3, 2, 'three', $idx ],
);
$k = 12;
while( $iter->advance ) {
my $bin = $iter->bin;
my $var = $iter->var;
push @got, [ $bin, $var, $iter->data, $iter->idx ];
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
is_deeply \@got, \@expected, 'data(), idx()';
#
@bins = ( 3, 2 );
@variables = ( sequence(20), 20-sequence(20) );
$idx = 2*sequence( 20 )->long;
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins, 6, 'number of bins';
is $iter->nvars, 2, 'number of vars';
@got = ();
@expected = (
[ 0, 0, [ 0, 0 ] ],
[ 0, 1, [ 0, 0 ] ],
[ 1, 0, [ 1, 0 ] ],
[ 1, 1, [ 1, 0 ] ],
[ 2, 0, [ 2, 0 ] ],
[ 2, 1, [ 2, 0 ] ],
[ 3, 0, [ 0, 1 ] ],
[ 3, 1, [ 0, 1 ] ],
[ 4, 0, [ 1, 1 ] ],
[ 4, 1, [ 1, 1 ] ],
[ 5, 0, [ 2, 1 ] ],
[ 5, 1, [ 2, 1 ] ],
);
$k = 12;
while( $iter->advance ) {
my $bin = $iter->bin;
my $var = $iter->var;
push @got, [ $bin, $var, [ $iter->unflatten ] ];
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
is_deeply \@got, \@expected, 'unflatten()';
#
@bins = ( 3, 2 );
@variables = ( sequence(20) );
$idx = sequence( 20 )->long % 6;
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins*$iter->nvars, 6, 'nbins() * nvars()';
@got = ();
@expected = (
long( 0,6,12,18 ),
long( 1,7,13,19 ),
long( 2,8,14 ),
long( 3,9,15 ),
long( 4,10,16 ),
long( 5,11,17 ),
);
$k = 6;
while( $iter->advance ) {
push @got, $iter->want;
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
for( 0 .. $#got ) {
is_pdl $got[ $_ ], $expected[ $_ ], "want() iteration $_";
}
#
@bins = ( 2, 4 );
@variables = ( sequence(20), 20-sequence(20) );
# # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
# idx 0 1 2 3 4 5 6 7 0 1 2 3 4 5 6 7 0 1 2 3
# var1 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
# var2 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
$idx = sequence( 20 )->long % 8;
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins*$iter->nvars, 16, 'nbins() * nvars()';
@got = ();
@expected = (
pdl( 0,8,16 ),
pdl( 20,12,4 ),
pdl( 1,9,17 ),
pdl( 19,11,3 ),
pdl( 2,10,18 ),
pdl( 18,10,2 ),
pdl( 3,11,19 ),
pdl( 17,9,1 ),
pdl( 4,12 ),
pdl( 16,8 ),
pdl( 5,13 ),
pdl( 15,7 ),
pdl( 6,14 ),
pdl( 14,6 ),
pdl( 7,15 ),
pdl( 13,5 ),
);
$k = 16;
while( $iter->advance ) {
push @got, $iter->selection;
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
for( 0 .. $#got ) {
is_pdl $got[ $_ ], $expected[ $_ ], "selection() iteration $_";
}
# test variable deactivation
@bins = ( 2, 4, 3 );
@variables = ( random(20), random(20), random(20), random(20) );
$idx = 24*random( 20 )->long;
{
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins*$iter->nvars, 96, 'nbins() * nvars()';
my @visited = (0) x @variables;
$k = 96;
while( $iter->advance ) {
my $var = $iter->var;
$visited[ $var ]++;
$iter->var_active( 1 );
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
is_deeply \@visited, [ ($iter->nbins) x @variables ], 'all variables visited n times, where n = number of bins';
}
{
$iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins*$iter->nvars, 96, 'nbins() * nvars()';
my @visited = (0) x @variables;
$k = 4;
while( $iter->advance ) {
my $var = $iter->var;
$visited[ $var ]++;
$iter->var_active( 0 );
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
is_deeply \@visited, [ (1) x @variables ], 'all variables visited once';
}
# test mixed variable deactivation
{
my @bins = ( 3, 1, 6 );
# the second variable will deactivate after having been called once
my @variables = ( random(30), random(30), random(30) );
my @deactivates = ( 0, 1, 0 );
my $idx = 18*random( 20 )->long;
my $iter = PDL::NDBin::Iterator->new( \@bins, \@variables, $idx );
is $iter->nbins*$iter->nvars, 54, 'nbins() * nvars()';
my $expected = [
[ 1,1,1 ],
map [ 1,0,1 ], 1 .. $iter->nbins-1
];
my $got = [
map [ 0,0,0 ], 1 .. $iter->nbins
];
my $k = 37;
while( $iter->advance ) {
my $bin = $iter->bin;
my $var = $iter->var;
$got->[ $bin ][ $var ]++;
if( $deactivates[ $var ] ) { $iter->var_active( 0 ) }
last if $k-- == 0; # prevent endless loops
};
ok $k == 0 && $iter->done, 'number of iterations';
is_deeply $got, $expected, 'mixed active/non-active variables: bins/variables visited as expected';
}