view release on metacpan or  search on metacpan

Combinatorics.pm  view on Meta::CPAN

    my $i = 0;
    foreach my $x (@$data) {
        push @{$partition[$k->[$i]]}, $x;
        ++$i;
    }
    return \@partition;
}

# We use @k and $p here and sacrifice the uniform usage of $k
# to follow the notation in [3].
sub __slice_partition_of_size_p {
    my ($k, $p, $data) = @_;
    my @partition = ();
    push @partition, [] for 1..$p;
    my $i = 0;
    foreach my $x (@$data) {
        push @{$partition[$k->[$i]]}, $x;
        ++$i;
    }
    return \@partition;
}


sub __check_params {
    my ($data, $k, $k_is_not_required) = @_;
    if (not defined $data) {
        croak("Missing parameter data");
    }
    unless ($k_is_not_required || defined $k) {
        croak("Missing parameter k");
    }

    my $type = reftype $data;
    if (!defined($type) || $type ne "ARRAY") {
        croak("Parameter data is not an arrayref");
    }

    carp("Parameter k is negative") if !$k_is_not_required && $k < 0;
}


# Given an iterator that responds to the next() method this
# subrutine returns the iterator in scalar context, loops
# over the iterator to build and return an array of results
# in list context, and does nothing but issue a warning in
# void context.
sub __contextualize {
    my $iter = shift;
    my $w = wantarray;
    if (defined $w) {
        if ($w) {
            my @result = ();
            while (my $c = $iter->next) {
                push @result, $c;
            }
            return @result;
        } else {
            return $iter;
        }
    } else {
        my $sub = (caller(1))[3];
        carp("Useless use of $sub in void context");
    }
}

sub __null_iter {
    return Algorithm::Combinatorics::Iterator->new(sub { return });
}


sub __once_iter {
    my $tuple = shift;
    $tuple ? Algorithm::Combinatorics::Iterator->new(sub { return }, $tuple) :
             Algorithm::Combinatorics::Iterator->new(sub { return }, []);
}



# This is a bit dirty by now, the objective is to be able to
# pass an initial sequence to the iterator and avoid a test
# in each iteration saying whether the sequence was already
# returned or not, since that might potentially be done a lot
# of times.
#
# The solution is to return an iterator that has a first sequence
# associated. The first time you call it that sequence is returned
# and the iterator rebless itself to become just a wrapped coderef.
#
# Note that the public contract is that responds to next(), no
# iterator class name is documented.
package Algorithm::Combinatorics::Iterator;

sub new {
    my ($class, $coderef, $first_seq) = @_;
    if (defined $first_seq) {
        return bless [$coderef, $first_seq], $class;
    } else {
        return bless $coderef, 'Algorithm::Combinatorics::JustCoderef';
    }
}

sub next {
    my ($self) = @_;
    $_[0] = $self->[0];
    bless $_[0], 'Algorithm::Combinatorics::JustCoderef';
    return $self->[1];
}

package Algorithm::Combinatorics::JustCoderef;

sub next {
    my ($self) = @_;
    return $self->();
}


1;

__END__