Iterator::Array::Jagged - Quickly permute and iterate through multiple jagged arrays.

Iterator-Array-Jagged documentation Contained in the Iterator-Array-Jagged distribution.

Index

Code Index:

NAME

Top

Iterator::Array::Jagged - Quickly permute and iterate through multiple jagged arrays.

SYNOPSIS

Top

	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'

DESCRIPTION

Top

Iterator::Array::Jagged can permute through sets of "jagged" arrays - arrays of varying lengths.

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.

Iterator::Array::Jagged is stable and ready for production use as of version 0.05.

METHODS

Top

new( %args )

Constructor. %args should included the element data which contains the arrayref of arrayrefs that you wish to iterate through.

next( )

Returns an array representing the next iteration of the permutation of your data set. See the synopsis for an example.

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.

permute( $subref, @data )

Calls $subref for each permutation in @data. This is currently BY FAR THE FASTEST METHOD AVAILABLE.

BENCHMARKS

Top

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 Algorithm::Loops and its 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 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 permute option.

The benchmark script that was used is shown in the next section.

Benchmarks were done on a server with the following specs:

CPU:

Intel(R) Core(TM)2 CPU 6400 @ 2.13GHz stepping 02

RAM:

2Gb

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()

BUGS

Top

It's possible that some bugs have found their way into this release.

Use RT http://rt.cpan.org/NoAuth/Bugs.html?Dist=Iterator-Array-Jagged to submit bug reports.

AUTHOR

Top

John Drago mailto:jdrago_999@yahoo.com

COPYRIGHT AND LICENSE

Top

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.

Iterator-Array-Jagged documentation Contained in the Iterator-Array-Jagged distribution. 
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__