package List::Combination;
$VERSION = '1.00';

require 5.003;

=head1 NAME

List::Combination - Provide an iterator over the combinations of an array

=head1 SYNOPSIS

	use List::Combination;

	my @foo = qw(tom dick harry joe);

	#Create an iterator over all pairs of values in @foo
	my $iter = new List::Combination \@foo, 2;

	my @pair;
	while (@pair = $iter->next)
	{
	  visit(@pair);
	}

=head1 DESCRIPTION

This class provides the ability to iterate over all the combinations, of
a given size, of the objects in an array. The first parameter to the
constructor is a reference to the array; the second parameter is the
size of the combinations. Using the example in the synopsis, we're asking
the iterator to provide us all the "4 choose 2" combinations of the given
array. It is an error if the second parameter is less than or equal to 0
or greater than the size of the array.

Each call to the next method returns a new array that represents the new
combination. When all the combinations have been returned, the next method
returns an empty array.

Note that the array is NOT treated as a set. If the same object occurs
many times in the array, it will occur many times in the combinations.

=head1 AUTHOR

Clark Cooper E<lt>F<coopercc@netheaven.com>E<gt>

=cut
	
use Carp;
use strict;

sub new
{
  my ($class, $lref, $choose) = @_;
  croak "Wrong number of parameters to List::Combination::new"
    unless @_ == 3;
  croak "Expected an array ref for the 1st parameter to List::Combination::new"
    unless UNIVERSAL::isa($lref, 'ARRAY');
  croak "The 2nd parameter is out of range"
    if ($choose <= 0 or $choose > @$lref);

  my $combo = [$lref, 0 .. ($choose - 1)];
  bless $combo, $class;
}

# Intended for internal use only
sub fixup
{
  my ($combo, $index, $lsize) = @_;

  if ($combo->[$index] < $lsize)
  {
    $combo->[$index]++;
  }
  else
  {
    if ($index <= 1)
    {
      $combo->[0] = undef;
    }
    else
    {
      $combo->fixup($index - 1, $lsize - 1);
      $combo->[$index] = $combo->[$index - 1] + 1
        if defined($combo->[0]);
    }
  }
}

sub next
{
  my ($combo) = @_;

  return () unless defined($combo->[0]);

  my @ret = @{$combo->[0]}[@{$combo}[1 .. $#$combo]];
  $combo->fixup($#$combo, $#{$combo->[0]});
  return @ret;
}

1;