package Iterator::Array::Jagged;
use strict;
use warnings 'all';
our $VERSION = '0.05';
#==============================================================================
sub new
{
my ($class, %args) = @_;
my $s = bless {
idx => [
map { 0 } 0...scalar(@{$args{data}}) - 1
],
sizes => [
map { scalar(@$_) - 1 } @{$args{data}}
],
data => $args{data},
_max => scalar(@{$args{data}}),
_is_finished => 0,
}, $class;
return $s;
}# end new()
#==============================================================================
sub _increment
{
my ($s, $index) = @_;
if( $s->{idx}->[ $index ] < $s->{sizes}->[ $index ] )
{
$s->{idx}->[ $index ]++;
}
else
{
$s->{idx}->[ $index ] = 0;
if( $index + 1 < $s->{_max} )
{
$s->_increment( $index + 1 );
}
else
{
$s->{_is_finished} = 1;
}# end if()
}# end if()
}# end _increment()
#==============================================================================
sub next
{
my ($s) = @_;
return if $s->{_is_finished};
# Calculate and return the current value:
my @parts = ();
for( 0...$s->{_max} - 1 )
{
my $part_idx = $s->{idx}->[ $_ ];
push @parts, $s->{data}->[ $_ ]->[ $part_idx ];
}# end for()
$s->_increment( 0 );
return @parts;
}# end next()
#==============================================================================
sub permute
{
my ($class, $func, @data) = @_;
my @idx = map { 0 } 0...scalar(@data) - 1;
my @sizes = map { scalar(@$_) - 1 } @data;
my $max = scalar(@data);
PERMUTATION: while( 1 )
{
# Prepare a 'set':
my @parts = ();
for my $num ( 0...$max - 1 )
{
push @parts, $data[ $num ]->[ $idx[ $num ] ];
}# end for()
# Execute 'func':
$func->( @parts );
# Increment or finish:
my $to_increment = 0;
INCR: while( 1 )
{
if( $idx[ $to_increment ] < $sizes[ $to_increment ] )
{
$idx[ $to_increment ]++;
last INCR;
}
else
{
$idx[ $to_increment ] = 0;
if( $to_increment + 1 < $max )
{
$to_increment += 1;
next INCR;
}
else
{
last PERMUTATION;
}# end if()
}# end if()
}# end while()
next PERMUTATION;
}# end while()
}# end permute()
#==============================================================================
sub get_iterator
{
my ($class, @data) = @_;
my @idx = map { 0 } 0...scalar(@data) - 1;
my @sizes = map { scalar(@$_) - 1 } @data;
my $max = scalar(@data);
my $is_finished = 0;
return sub {
return if $is_finished;
# Prepare a 'set':
my @parts = ();
for my $num ( 0...$max - 1 )
{
push @parts, $data[ $num ]->[ $idx[ $num ] ];
}# end for()
# Increment or finish:
my $to_increment = 0;
INCR: while( 1 )
{
if( $idx[ $to_increment ] < $sizes[ $to_increment ] )
{
$idx[ $to_increment ]++;
last INCR;
}
else
{
$idx[ $to_increment ] = 0;
if( $to_increment + 1 < $max )
{
$to_increment += 1;
next INCR;
}
else
{
$is_finished = 1;
}# end if()
}# end if()
}# end while()
# Finally return the parts:
return @parts;
};# end sub{...}
}# end get_iterator()
1; #return true:
__END__
=pod
=head1 NAME
Iterator::Array::Jagged - Quickly permute and iterate through multiple jagged arrays.
=head1 SYNOPSIS
use Iterator::Array::Jagged;
# Build up a set of data:
my @data = (
[qw/ a b /],
[qw/ c d /],
[qw/ e f g /]
);
# Iterator in object-oriented mode:
my $iterator = Iterator::Array::Jagged->new( data => \@data );
while( my @set = $iterator->next )
{
print "Next set: '" . join("&", @set) . "'\n";
}# end while()
# Iterator is a subref:
my $itersub = Iterator::Array::Jagged->get_iterator( @data );
while( my @set = $itersub->() )
{
print "Next set: '" . join("&", @set) . "'\n";
}# end while()
# Functional callback style:
Iterator::Array::Jagged->permute(sub {
my (@set) = @_;
print "Next set: '" . join("&", @set) . "'\n";
}, @data );
Each example in the code above code prints the following:
Next set: b&c&e'
Next set: a&d&e'
Next set: b&d&e'
Next set: a&c&f'
Next set: b&c&f'
Next set: a&d&f'
Next set: b&d&f'
Next set: a&c&g'
Next set: b&c&g'
Next set: a&d&g'
Next set: b&d&g'
=head1 DESCRIPTION
C<Iterator::Array::Jagged> can permute through sets of "jagged" arrays - arrays of varying lengths.
C<Iterator::Array::Jagged> works much like the odometer in an automobile. Except that each set
of "numbers" can have any kind of data you want, and each set can contain 1 or more elements.
C<Iterator::Array::Jagged> is stable and ready for production use as of version C<0.05>.
=head1 METHODS
=head2 new( %args )
Constructor. C<%args> should included the element C<data> which contains the arrayref of arrayrefs
that you wish to iterate through.
=head2 next( )
Returns an array representing the next iteration of the permutation of your data set. See the synopsis for an example.
=head2 get_iterator( @data )
Returns a coderef that, when called, returns the next set of data until there are no more permutations. See the synopsis for an example.
=head2 permute( $subref, @data )
Calls C<$subref> for each permutation in C<@data>. This is currently B<BY FAR THE FASTEST METHOD AVAILABLE>.
=head1 BENCHMARKS
After the initial release of Iterator::Array::Jagged, some people were wondering if there was any benefit to using
I::A::J over another older module L<Algorithm::Loops> and its C<NestedLoops> method. So I did some benchmarking and found
some mixed results.
Rate I::A::J OO A::L::NL func I::A::J iterator A::L::NL iterator I::A::J permute
I::A::J OO 4.19/s -- -3% -19% -29% -45%
A::L::NL func 4.32/s 3% -- -16% -27% -43%
I::A::J iterator 5.15/s 23% 19% -- -12% -32%
A::L::NL iterator 5.88/s 40% 36% 14% -- -22%
I::A::J permute 7.58/s 81% 75% 47% 29% --
Depending on the size and depth of the jagged array data passed in, the results vary slightly. However, the order
in which each method finishes is the same. Iterator::Array::Jagged->permute is fastest by a signifigant margin over
C<Algorithm::Loops::NestedLoops>. On the opposite end of the spectrum we have the OO method of Iterator::Array::Jagged
which comes in at nearly half the speed of the C<permute> option.
The benchmark script that was used is shown in the next section.
Benchmarks were done on a server with the following specs:
=over 4
=item CPU:
Intel(R) Core(TM)2 CPU 6400 @ 2.13GHz stepping 02
=item RAM:
2Gb
=back
=head2 The Benchmark Script
#!/usr/bin/perl -w
use strict;
use Time::HiRes qw(gettimeofday);
use Benchmark qw' :all ';
use Algorithm::Loops 'NestedLoops';
use Iterator::Array::Jagged;
my @data = ();
for my $var ( 1...4 )
{
my @set = ();
my $max = $var % 2 ? 10 : 11;
for my $val ( 1...$max )
{
push @set, "var$var=val$val";
}# end for()
push @data, \@set;
}# end for()
cmpthese( 20, {
'I::A::J OO' => sub { do_iterator_array_jagged( @data ) },
'A::L::NL iterator' => sub { do_nestedloops_iterator( @data ) },
'A::L::NL func' => sub { do_nestedloops_func( @data ) },
'I::A::J permute' => sub { do_iaj_permute( @data ) },
'I::A::J iterator' => sub { do_iaj_iterator( @data ) },
});
sub do_iaj_iterator
{
my $iter = Iterator::Array::Jagged->get_iterator( @_ );
while( my @set = $iter->() )
{
}# end while()
}# end do_iaj_iterator()
sub do_iaj_permute
{
Iterator::Array::Jagged->permute( sub { }, @_ );
}# end do_iaj_permute()
sub do_iterator_array_jagged
{
my @data = @_;
my $iter = Iterator::Array::Jagged->new( data => \@data );
while( my $set = $iter->next )
{
}# end while()
}# end do_iterator_array_jagged()
sub do_nestedloops_func
{
NestedLoops( \@_, sub { } );
}# end do_nestedloops_func()
sub do_nestedloops_iterator
{
my @data = @_;
my $iter = NestedLoops( \@data );
while( my @set = $iter->() )
{
}# end while()
}# end do_nestedloops()
=head1 BUGS
It's possible that some bugs have found their way into this release.
Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Iterator-Array-Jagged> to submit bug reports.
=head1 AUTHOR
John Drago L<mailto:jdrago_999@yahoo.com>
=head1 COPYRIGHT AND LICENSE
Copyright 2007 John Drago, All rights reserved.
This software is free software. It may be used and distributed under the
same terms as Perl itself.
=cut