# Set::Partition.pm
#
# Copyright (c) 2006 David Landgren
# All rights reserved

package Set::Partition;
use strict;

use vars qw/$VERSION/;
$VERSION = '0.03';

use constant DEBUG => 0; # if you want to see what's going on

=head1 NAME

Set::Partition - Enumerate all arrangements of a set in fixed subsets

=head1 VERSION

This document describes version 0.03 of Set::Partition,
released 2006-10-11.

=head1 SYNOPSIS

  use Set::Partition;

  my $s = Set::Partition->new(
    list      => [qw(a b c d e)],
    partition => [2, 3],
  );
  while (my $p = $s->next) {
    print join( ' ', map { "(@$_)" } @$p ), $/;
  }
  # produces
  (a b) (c d e)
  (a c) (b d e)
  (a d) (b c e)
  (a e) (b c d)
  (b c) (a d e)
  (b d) (a c e)
  (b e) (a c d)
  (c d) (a b e)
  (c e) (a b d)
  (d e) (a b c)

  # or with a hash
  my $s = Set::Partition->new(
    list      => { b => 'bat', c => 'cat', d => 'dog' },
    partition => [2, 1],
  );
  while (my $p = $s->next) {
    ...
  }

=head1 DESCRIPTION

C<Set::Partition> takes a list or hash of elements  and a list
numbers that represent the sizes of the partitions into which the
list of elements should be arranged.

The resulting object can then be used as an iterator which returns
a reference to an array of lists, that represents the original list
arranged according to the given partitioning. All possible arrangements
are returned, and the object returns C<undef> when the entire
combination space has been exhausted.

=head1 METHODS

=over 8

=item new

Creates a new C<Set::Partition> object. A set of key/value parameters
can be supplied to control the finer details of the object's
behaviour.

B<list>, the list of elements in the set.

B<partition>, the list of integers representing the size of the
partitions used to arrange the set. The sum should be equal to the
number of elements given by B<list>. If it less than the number of
elements, a dummy partition will be added to equalise the count.
This partition will be returned during iteration. If the sum is
greater than the number of elements, C<new()> will C<croak> with a
fatal error.

=cut

sub new {
    my $class = shift;
    my %args = @_;
    my $part = $args{partition} || [];
    my $in   = $args{list};
    my $list;
    my $val;
    if ($in) {
        if (ref($in) eq 'HASH') {
            $list = [keys %$in];
            $val  = [values %$in];
        }
        else {
            $list = $in;
        }
    }
    else {
        $list = [];
    }
    my $sum  = 0;
    $sum += $_ for @$part;
    if ($sum > @$list) {
        my $list_nr = @$list;
        require Carp;
        Carp::croak("sum of partitions ($sum) exceeds available elements ($list_nr)\n");
    }
    elsif ($sum < @$list) {
        push @$part, @$list - $sum;
    }

    bless {
        list => $list,
        val  => $val,
        part => $args{partition},
        num  => [0..$#$list],
    },
    $class;
}

=item next

Returns the next arrangement of subsets, or C<undef> when all arrangements
have been enumerated.

=cut

sub next {
    my $self  = shift;
    my $list  = $self->{list};
    my $state = $self->{state};
    if ($state) {
        return unless $self->_bump();
    }
    else {
        my $s = 0;
        push @$state, ($s++) x $_ for @{$self->{part}};
        $state ||= [(0) x (@$list)] if @$list; # if no partition was given
        $self->{state} = $state;
    }
    my $out;
    if ($self->{val}) {
        $out->[$state->[$_]]{$list->[$_]} = $self->{val}[$_] for @{$self->{num}};
    }
    else {
        push @{$out->[$state->[$_]]}, $list->[$_] for @{$self->{num}};
    }
    DEBUG and print "@{$self->{state}}\n";
    return $out;
}

sub _bump {
    my $self = shift;
    my $in   = $self->{state};
    my $end  = $#$in;
    my $off  = $end-1;
    my $inc  = 0;
    while ($off >= 0) {
        my $sib = $off+1;
        ++$inc if $in->[$off] > $in->[$sib];
        if ($in->[$off] < $in->[$sib]) {
            if ($in->[$sib] > 1+$in->[$off]) {
                # find smallest in [$sib..$end] > $in->[$off];
                my $next = @$in;
                while (--$next) {
                    last if $in->[$next] > $in->[$off];
                }
                (@{$in}[$off, $next]) = (@{$in}[$next, $off]);
                if (DEBUG) {
                    print "@$in (reverse @{$in}[$sib..$end] needed)\n"
                        if $sib < $end;
                }
                @{$in}[$sib..$end] = reverse @{$in}[$sib..$end]
                    if $sib < $end;
            }
            else {
                # just have to flip the current and next
                DEBUG and print +(' ' x ($off*2)) . "^ ^\n";
                (@{$in}[$off, $sib]) = (@{$in}[$sib, $off]);
                if (DEBUG) {
                    print "@$in (sort @{$in}[$sib..$end] needed d=$inc)\n"
                        if $sib < $end and $inc;
                }
                # have to sort
                @{$in}[$sib..$end] = sort {$a <=> $b} @{$in}[$sib..$end]
                    if $sib < $end and $inc;
            }
            return 1;
        }
        --$off;
    }
    return 0;
}

=item reset

Resets the object, which causes it to enumerate the arrangements from the
beginning.

  $p->reset; # begin again

=cut

sub reset {
    my $self  = shift;
    delete $self->{state};
    return $self;
}

=back

=head1 DIAGNOSTICS

=head2 sum of partitions (%d) exceeds available elements (%d)

A list of partition sizes (for instance, 2, 3, 4) was given, along
with a list to partition (for instance, containing 8 elements),
however, the number of elements required to fill the different
partitions (9) exceeds the number available in the source list (8).

=head1 NOTES

The order within a set is unimportant, thus, if

  (a b) (c d)

is produced, then the following arrangement will never be encountered:

  (a b) (d c)

On the other hand, the order of the sets is important, which means
that the following arrangement I<will> be encountered:

  (c d) (a b)

=head1 SEE ALSO

=over 8

=item L<Algorithm::Combinatorics>

Permutations, combinations, derangements and more; all you need
for your set transformations.

=back

=head1 BUGS

Using a partition of length 0 is valid, although you get back an C<undef>,
rather than an empty array. This could be construed as a bug.

Please report all bugs at
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Set-Partition|rt.cpan.org>

Make sure you include the output from the following two commands:

  perl -MSet::Partition -le 'print Set::Partition::VERSION'
  perl -V

=head1 ACKNOWLEDGEMENTS

Ken Williams suggested the possibility to use a hash as a source
for partitioning.

=head1 AUTHOR

David Landgren, copyright (C) 2006. All rights reserved.

http://www.landgren.net/perl/

If you (find a) use this module, I'd love to hear about it. If you
want to be informed of updates, send me a note. You know my first
name, you know my domain. Can you guess my e-mail address?

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

'The Lusty Decadent Delights of Imperial Pompeii';
__END__