| 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__ |