File Coverage

blib/lib/PDL/NDBin/Iterator.pm
Criterion Covered Total %
statement 67 68 98.5
branch 7 8 87.5
condition n/a
subroutine 24 24 100.0
pod 13 13 100.0
total 111 113 98.2


line stmt bran cond sub pod time code
1             package PDL::NDBin::Iterator;
2             # ABSTRACT: Iterator object for PDL::NDBin
3             $PDL::NDBin::Iterator::VERSION = '0.019';
4 5     5   623912 use strict;
  5         18  
  5         168  
5 5     5   31 use warnings;
  5         9  
  5         135  
6 5     5   27 use Carp;
  5         11  
  5         299  
7 5     5   33 use List::Util qw( reduce );
  5         8  
  5         265  
8 5     5   1228 use List::MoreUtils qw( all );
  5         25559  
  5         33  
9 5     5   4117 use XSLoader;
  5         9  
  5         147  
10 5     5   2753 use Params::Validate qw( validate ARRAYREF );
  5         46621  
  5         3422  
11              
12              
13              
14             sub new
15             {
16 478     478 1 95700 my $class = shift;
17             my %params = validate( @_, {
18             bins => {
19             type => ARRAYREF,
20 478     478   946 callbacks => { 'have at least one bin along every dimension' => sub { my $bins = shift; all { $_ > 0 } @$bins } },
  478         2014  
  514         5803  
21             },
22             array => {
23             type => ARRAYREF,
24 478     478   991 callbacks => { 'have at least one element' => sub { my $array = shift; @$array } },
  478         3959  
25             },
26 478         11119 idx => { can => [ qw( eq which ) ] },
27             } );
28             my $self = {
29             bins => $params{bins},
30             array => $params{array},
31             idx => $params{idx},
32 478         1847 active => [ (1) x @{ $params{array} } ],
33             bin => 0,
34             var => -1,
35 36     36   81 nbins => (reduce { $a * $b } @{ $params{bins} }),
  478         2094  
36 478         4077 nvars => (scalar @{ $params{array} }),
  478         2161  
37             };
38 478         2821 return bless $self, $class;
39             }
40              
41              
42             # advance() is implemented in XS
43              
44              
45 300     300 1 4100 sub bin { $_[0]->{bin} }
46 557     557 1 1147 sub var { $_[0]->{var} }
47 8     8 1 718 sub done { $_[0]->{bin} >= $_[0]->{nbins} }
48 36     36 1 44 sub bins { @{ $_[0]->{bins} } }
  36         73  
49 97     97 1 758 sub nbins { $_[0]->{nbins} }
50 7     7 1 37 sub nvars { $_[0]->{nvars} }
51 719     719 1 3252 sub data { $_[0]->{array}->[ $_[0]->{var} ] }
52 592     592 1 8227 sub idx { $_[0]->{idx} }
53              
54              
55             sub var_active
56             {
57 515     515 1 1015 my $self = shift;
58 515         767 my $i = $self->{var};
59 515 50       1070 if( @_ ) { $self->{active}->[ $i ] = shift }
  515         1085  
60 0         0 else { $self->{active}->[ $i ] }
61             }
62              
63              
64             sub want
65             {
66 225     225 1 879 my $self = shift;
67 225 100       471 unless( defined $self->{want} ) {
68 166         311 $self->{want} = PDL::which $self->idx == $self->{bin};
69             }
70 225         6506 return $self->{want};
71             }
72              
73              
74             sub selection
75             {
76 138     138 1 8276 my $self = shift;
77 138 100       343 unless( defined $self->{selection} ) {
78 106         211 $self->{selection} = $self->data->index( $self->want );
79             }
80 138         482 return $self->{selection};
81             }
82              
83              
84             sub unflatten
85             {
86 42     42 1 113 my $self = shift;
87 42 100       80 unless( defined $self->{unflattened} ) {
88 36         48 my $q = $self->{bin}; # quotient
89             $self->{unflattened} =
90             [ map {
91 5     5   2681 ( $q, my $r ) = do { use integer; ( $q / $_, $q % $_ ) };
  5         74  
  5         35  
  36         62  
  102         150  
  102         154  
92 102         159 $r
93             } $self->bins
94             ];
95             }
96 42         54 return @{ $self->{unflattened} };
  42         92  
97             }
98              
99             XSLoader::load( __PACKAGE__ );
100              
101             1;
102              
103             __END__