Algorithm-Combinatorics-0.26/000755 000765 000024 00000000000 11520627512 016120 5ustar00fxnstaff000000 000000 Algorithm-Combinatorics-0.26/benchmarks/000755 000765 000024 00000000000 11520627512 020235 5ustar00fxnstaff000000 000000 Algorithm-Combinatorics-0.26/Changes000644 000765 000024 00000011117 11520626270 017414 0ustar00fxnstaff000000 000000 Revision history for Algorithm-Combinatorics 0.26 Jan 28 2011 * Fixes a memory leak in subsets(), thanks to Oliver Seeliger. [closes RT#65207] * Updates Copyright. * README documents now the module itself, better for GitHub. 0.25 Nov 30 2007 * Improved speed of subsets() copying the algorithm in List::PowerSet. 0.24 Jul 14 2007 * Added subsets(). 0.23 May 19 2007 * We do not longer assume indices com to XS as IVs, that broke partitions() in 5.6.2. * Small touches to the code. * Added a few tests. 0.22 May 15 2007 * The previous release was built with Apple's version of tar, which adds some custom extra files that prevent building the module in some systems. I built this one with GNU tar. 0.21 May 14 2007 * Added a directory with some benchmarks. * A maintenance release to indicate the module is maintained. 0.20 June 6 2006 * Jumped version to 0.2x. * Added pointer to Sloane's encyclopedia for the sequence of numbers of circular permutations * Added complete_permutations(). * Simplified explanation of circular permutations. 0.16 June 5 2006 * Added circular_permutations(). * Added some pointers to The On-Line Encyclopedia of Integer Sequences * Added a few more tests for partitions(). 0.15 May 23 2006 * Added partitions(). * Added some comments. 0.14 December 19 2005 * Small rewordings in POD. * Added TAOCP Vol 4, Fasc 3 to REFERENCES. * Added tuples* as alias to variations* to add the nomenclature in Knuth's, Mathematica, etc. to the interface. * Code cleanup. 0.13 November 20 2005 * Added derangements(), code, tests, and docs. * Benchmarked permutations() against permutations() with loop variables declared as registers. No measurable difference. * Removed "install" from the cpan(1) example in README. 0.12 November 13 2005 * DESCRIPTION was reworded. * Refactored as regular XS-based module. 0.11 November 8 2005 * CPAN.pm does not resolve the dependency with Inline before Makefile.PL is executed, and it fails to generate the Makefile because the module Inline::MakeMaker is not found. Due to this ExtUtils::MakeMaker is back. 0.10 November 6 2005 * permutations() has been edited to match Algorithm L from [1] * Added REFERENCES to POD * Added a workaround to Makefile.PL for "No rule to make target ... needed by `pure_all'" so that the Makefile generated by Inline::MakeMaker's WriteInlineMakefile() works, and thus the C part behaves like a plain XS extension instead of generating caches on the user machine 0.08 November 6 2005 * Changed hyphens in test filenames with underscores * The module is known to run under 5.6.2, so the corresponding use VERSION has been added * variations(\@data, $k) is delegated to permutations(\@data) for @data == $k, since permutations() is more efficient * Changed AV* in signatures to SV* plus a cast (SV*) SvRV(array) due to problems reported regarding AVPtrs. I copied the trick from the Changes of Digest::SHA. (Thanks to Aaron Dalton for reporting the problem.) * variations() is much better, almost twice as fast and does not create SVs 0.07 November 5 2005 * Documented the corresponding formulas * Slicing is done now in Perl. The code is much more clear and in my benchmarks no significant difference is measured * The iterator now may receive an initial arrayref (this is private implementation), which simplifies the set up of the iterator when the first tuple is known 0.06 November 5 2005 * permutations() is about 3-4 times faster 0.05 November 4 2005 * Rewrote the test suite, and relevant documentation * Added the helper module t/Tester.pm to factor out a common test code pattern * If k is "out of natural range"" the empty set is returned and a warning is issued * The iterators return an arrayref, and the implementation was revised accordingly to be mathematically correct in edge-cases and more forgiving * I can't stand that DIAGNOSTICS::Errors section, so many croaks on boundary conditions are so unperlish! The module has just a couple of days so I am on time to fix this 0.02 November 3 2005 * README revised * DEPENDENCIES added to POD * DIAGNOSTICS added to POD * VERSION added to POD * Added some code documentation * Minor tweaks on the XS code 0.01 November 2 2005 * First version, released on an unsuspecting world. Algorithm-Combinatorics-0.26/Combinatorics.pm000644 000765 000024 00000054557 11520626050 021266 0ustar00fxnstaff000000 000000 package Algorithm::Combinatorics; use 5.006002; use strict; our $VERSION = '0.26'; use XSLoader; XSLoader::load('Algorithm::Combinatorics', $VERSION); use Carp; use Scalar::Util qw(reftype); use Exporter; use base 'Exporter'; our @EXPORT_OK = qw( combinations combinations_with_repetition variations variations_with_repetition tuples tuples_with_repetition permutations circular_permutations derangements complete_permutations partitions subsets ); our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); sub combinations { my ($data, $k) = @_; __check_params($data, $k); return __contextualize(__null_iter()) if $k < 0; return __contextualize(__once_iter()) if $k == 0; if ($k > @$data) { carp("Parameter k is greater than the size of data"); return __contextualize(__null_iter()); } my @indices = 0..($k-1); my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_combination(\@indices, @$data-1) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } sub combinations_with_repetition { my ($data, $k) = @_; __check_params($data, $k); return __contextualize(__null_iter()) if $k < 0; return __contextualize(__once_iter()) if $k == 0; my @indices = (0) x $k; my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_combination_with_repetition(\@indices, @$data-1) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } sub subsets { my ($data, $k) = @_; __check_params($data, $k, 1); return combinations($data, $k) if defined $k; my $finished = 0; my @odometer = (1) x @$data; my $iter = Algorithm::Combinatorics::Iterator->new(sub { return if $finished; my $subset = __next_subset($data, \@odometer); $finished = 1 if @$subset == 0; $subset; }); return __contextualize($iter); } sub variations { my ($data, $k) = @_; __check_params($data, $k); return __contextualize(__null_iter()) if $k < 0; return __contextualize(__once_iter()) if $k == 0; if ($k > @$data) { carp("Parameter k is greater than the size of data"); return __contextualize(__null_iter()); } # permutations() is more efficient because it knows # all indices are always used return permutations($data) if @$data == $k; my @indices = 0..($k-1); my @used = ((1) x $k, (0) x (@$data-$k)); my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_variation(\@indices, \@used, @$data-1) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } *tuples = \&variations; sub variations_with_repetition { my ($data, $k) = @_; __check_params($data, $k); return __contextualize(__null_iter()) if $k < 0; return __contextualize(__once_iter()) if $k == 0; my @indices = (0) x $k; my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_variation_with_repetition(\@indices, @$data-1) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } *tuples_with_repetition = \&variations_with_repetition; sub __variations_with_repetition_gray_code { my ($data, $k) = @_; __check_params($data, $k); return __contextualize(__null_iter()) if $k < 0; return __contextualize(__once_iter()) if $k == 0; my @indices = (0) x $k; my @focus_pointers = 0..$k; # yeah, length $k+1 my @directions = (1) x $k; my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_variation_with_repetition_gray_code( \@indices, \@focus_pointers, \@directions, @$data-1, ) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } sub permutations { my ($data) = @_; __check_params($data, 0); return __contextualize(__once_iter()) if @$data == 0; my @indices = 0..(@$data-1); my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_permutation(\@indices) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } sub circular_permutations { my ($data) = @_; __check_params($data, 0); return __contextualize(__once_iter()) if @$data == 0; return __contextualize(__once_iter([@$data])) if @$data == 1 || @$data == 2; my @indices = 1..(@$data-1); my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_permutation(\@indices) == -1 ? undef : [ @{$data}[0, @indices] ]; }, [ @{$data}[0, @indices] ]); return __contextualize($iter); } sub __permutations_heap { my ($data) = @_; __check_params($data, 0); return __contextualize(__once_iter()) if @$data == 0; my @a = 0..(@$data-1); my @c = (0) x (@$data+1); # yeah, there's an spurious $c[0] to make the notation coincide my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_permutation_heap(\@a, \@c) == -1 ? undef : [ @{$data}[@a] ]; }, [ @{$data}[@a] ]); return __contextualize($iter); } sub derangements { my ($data) = @_; __check_params($data, 0); return __contextualize(__once_iter()) if @$data == 0; return __contextualize(__null_iter()) if @$data == 1; my @indices = 0..(@$data-1); @indices[$_, $_+1] = @indices[$_+1, $_] for map { 2*$_ } 0..((@$data-2)/2); @indices[-1, -2] = @indices[-2, -1] if @$data % 2; my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_derangement(\@indices) == -1 ? undef : [ @{$data}[@indices] ]; }, [ @{$data}[@indices] ]); return __contextualize($iter); } *complete_permutations = \&derangements; sub partitions { my ($data, $k) = @_; if (defined $k) { __partitions_of_size_p($data, $k); } else { __partitions_of_all_sizes($data); } } sub __partitions_of_all_sizes { my ($data) = @_; __check_params($data, 0); return __contextualize(__once_iter()) if @$data == 0; my @k = (0) x @$data; my @M = (0) x @$data; my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_partition(\@k, \@M) == -1 ? undef : __slice_partition(\@k, \@M, $data); }, __slice_partition(\@k, \@M, $data)); return __contextualize($iter); } # We use @k and $p here and sacrifice the uniform usage of $k # to follow the notation in [3]. sub __partitions_of_size_p { my ($data, $p) = @_; __check_params($data, $p); return __contextualize(__null_iter()) if $p < 0; return __contextualize(__once_iter()) if @$data == 0 && $p == 0; return __contextualize(__null_iter()) if $p == 0; if ($p > @$data) { carp("Parameter k is greater than the size of data"); return __contextualize(__null_iter()); } my $q = @$data - $p + 1; my @k = (0) x $q; my @M = (0) x $q; push @k, $_ - $q + 1 for $q..(@$data-1); push @M, $_ - $q + 1 for $q..(@$data-1); my $iter = Algorithm::Combinatorics::Iterator->new(sub { __next_partition_of_size_p(\@k, \@M, $p) == -1 ? undef : __slice_partition_of_size_p(\@k, $p, $data); }, __slice_partition_of_size_p(\@k, $p, $data)); return __contextualize($iter); } sub __slice_partition { my ($k, $M, $data) = @_; my @partition = (); my $size = $M->[-1] + 1; # $M->[0] is always 0 in our code push @partition, [] for 1..$size; 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__ =head1 NAME Algorithm::Combinatorics - Efficient generation of combinatorial sequences =head1 SYNOPSIS use Algorithm::Combinatorics qw(permutations); my @data = qw(a b c); # scalar context gives an iterator my $iter = permutations(\@data); while (my $p = $iter->next) { # ... } # list context slurps my @all_permutations = permutations(\@data); =head1 VERSION This documentation refers to Algorithm::Combinatorics version 0.26. =head1 DESCRIPTION Algorithm::Combinatorics is an efficient generator of combinatorial sequences. Algorithms are selected from the literature (work in progress, see L). Iterators do not use recursion, nor stacks, and are written in C. Tuples are generated in lexicographic order, except in C. =head1 SUBROUTINES Algorithm::Combinatorics provides these subroutines: permutations(\@data) circular_permutations(\@data) derangements(\@data) complete_permutations(\@data) variations(\@data, $k) variations_with_repetition(\@data, $k) tuples(\@data, $k) tuples_with_repetition(\@data, $k) combinations(\@data, $k) combinations_with_repetition(\@data, $k) partitions(\@data[, $k]) subsets(\@data[, $k]) All of them are context-sensitive: =over 4 =item * In scalar context subroutines return an iterator that responds to the C method. Using this object you can iterate over the sequence of tuples one by one this way: my $iter = combinations(\@data, $k); while (my $c = $iter->next) { # ... } The C method returns an arrayref to the next tuple, if any, or C if the sequence is exhausted. Memory usage is minimal, no recursion and no stacks are involved. =item * In list context subroutines slurp the entire set of tuples. This behaviour is offered for convenience, but take into account that the resulting array may be really huge: my @all_combinations = combinations(\@data, $k); =back =head2 permutations(\@data) The permutations of C<@data> are all its reorderings. For example, the permutations of C<@data = (1, 2, 3)> are: (1, 2, 3) (1, 3, 2) (2, 1, 3) (2, 3, 1) (3, 1, 2) (3, 2, 1) The number of permutations of C elements is: n! = 1, if n = 0 n! = n*(n-1)*...*1, if n > 0 See some values at L. =head2 circular_permutations(\@data) The circular permutations of C<@data> are its arrangements around a circle, where only relative order of elements matter, rather than their actual position. Think possible arrangements of people around a circular table for dinner according to whom they have to their right and left, no matter the actual chair they sit on. For example the circular permutations of C<@data = (1, 2, 3, 4)> are: (1, 2, 3, 4) (1, 2, 4, 3) (1, 3, 2, 4) (1, 3, 4, 2) (1, 4, 2, 3) (1, 4, 3, 2) The number of circular permutations of C elements is: n! = 1, if 0 <= n <= 1 (n-1)! = (n-1)*(n-2)*...*1, if n > 1 See a few numbers in a comment of L. =head2 derangements(\@data) The derangements of C<@data> are those reorderings that have no element in its original place. In jargon those are the permutations of C<@data> with no fixed points. For example, the derangements of C<@data = (1, 2, 3)> are: (2, 3, 1) (3, 1, 2) The number of derangements of C elements is: d(n) = 1, if n = 0 d(n) = n*d(n-1) + (-1)**n, if n > 0 See some values at L. =head2 complete_permutations(\@data) This is an alias for C, documented above. =head2 variations(\@data, $k) The variations of length C<$k> of C<@data> are all the tuples of length C<$k> consisting of elements of C<@data>. For example, for C<@data = (1, 2, 3)> and C<$k = 2>: (1, 2) (1, 3) (2, 1) (2, 3) (3, 1) (3, 2) For this to make sense, C<$k> has to be less than or equal to the length of C<@data>. Note that permutations(\@data); is equivalent to variations(\@data, scalar @data); The number of variations of C elements taken in groups of C is: v(n, k) = 1, if k = 0 v(n, k) = n*(n-1)*...*(n-k+1), if 0 < k <= n =head2 variations_with_repetition(\@data, $k) The variations with repetition of length C<$k> of C<@data> are all the tuples of length C<$k> consisting of elements of C<@data>, including repetitions. For example, for C<@data = (1, 2, 3)> and C<$k = 2>: (1, 1) (1, 2) (1, 3) (2, 1) (2, 2) (2, 3) (3, 1) (3, 2) (3, 3) Note that C<$k> can be greater than the length of C<@data>. For example, for C<@data = (1, 2)> and C<$k = 3>: (1, 1, 1) (1, 1, 2) (1, 2, 1) (1, 2, 2) (2, 1, 1) (2, 1, 2) (2, 2, 1) (2, 2, 2) The number of variations with repetition of C elements taken in groups of C<< k >= 0 >> is: vr(n, k) = n**k =head2 tuples(\@data, $k) This is an alias for C, documented above. =head2 tuples_with_repetition(\@data, $k) This is an alias for C, documented above. =head2 combinations(\@data, $k) The combinations of length C<$k> of C<@data> are all the sets of size C<$k> consisting of elements of C<@data>. For example, for C<@data = (1, 2, 3, 4)> and C<$k = 3>: (1, 2, 3) (1, 2, 4) (1, 3, 4) (2, 3, 4) For this to make sense, C<$k> has to be less than or equal to the length of C<@data>. The number of combinations of C elements taken in groups of C<< 0 <= k <= n >> is: n choose k = n!/(k!*(n-k)!) =head2 combinations_with_repetition(\@data, $k); The combinations of length C<$k> of an array C<@data> are all the bags of size C<$k> consisting of elements of C<@data>, with repetitions. For example, for C<@data = (1, 2, 3)> and C<$k = 2>: (1, 1) (1, 2) (1, 3) (2, 2) (2, 3) (3, 3) Note that C<$k> can be greater than the length of C<@data>. For example, for C<@data = (1, 2, 3)> and C<$k = 4>: (1, 1, 1, 1) (1, 1, 1, 2) (1, 1, 1, 3) (1, 1, 2, 2) (1, 1, 2, 3) (1, 1, 3, 3) (1, 2, 2, 2) (1, 2, 2, 3) (1, 2, 3, 3) (1, 3, 3, 3) (2, 2, 2, 2) (2, 2, 2, 3) (2, 2, 3, 3) (2, 3, 3, 3) (3, 3, 3, 3) The number of combinations with repetition of C elements taken in groups of C<< k >= 0 >> is: n+k-1 over k = (n+k-1)!/(k!*(n-1)!) =head2 partitions(\@data[, $k]) A partition of C<@data> is a division of C<@data> in separate pieces. Technically that's a set of subsets of C<@data> which are non-empty, disjoint, and whose union is C<@data>. For example, the partitions of C<@data = (1, 2, 3)> are: ((1, 2, 3)) ((1, 2), (3)) ((1, 3), (2)) ((1), (2, 3)) ((1), (2), (3)) This subroutine returns in consequence tuples of tuples. The top-level tuple (an arrayref) represents the partition itself, whose elements are tuples (arrayrefs) in turn, each one representing a subset of C<@data>. The number of partitions of a set of C elements are known as Bell numbers, and satisfy the recursion: B(0) = 1 B(n+1) = (n over 0)B(0) + (n over 1)B(1) + ... + (n over n)B(n) See some values at L. If you pass the optional parameter C<$k>, the subroutine generates only partitions of size C<$k>. This uses an specific algorithm for partitions of known size, which is more efficient than generating all partitions and filtering them by size. Note that in that case the subsets themselves may have several sizes, it is the number of elements I which is C<$k>. For instance if C<@data> has 5 elements there are partitions of size 2 that consist of a subset of size 2 and its complement of size 3; and partitions of size 2 that consist of a subset of size 1 and its complement of size 4. In both cases the partitions have the same size, they have two elements. The number of partitions of size C of a set of C elements are known as Stirling numbers of the second kind, and satisfy the recursion: S(0, 0) = 1 S(n, 0) = 0 if n > 0 S(n, 1) = S(n, n) = 1 S(n, k) = S(n-1, k-1) + kS(n-1, k) =head2 subsets(\@data[, $k]) This subroutine iterates over the subsets of data, which is assumed to represent a set. If you pass the optional parameter C<$k> the iteration runs over subsets of data of size C<$k>. The number of subsets of a set of C elements is 2**n See some values at L. =head1 CORNER CASES Since version 0.05 subroutines are more forgiving for unsual values of C<$k>: =over 4 =item * If C<$k> is less than zero no tuple exists. Thus, the very first call to the iterator's C method returns C, and a call in list context returns the empty list. (See L.) =item * If C<$k> is zero we have one tuple, the empty tuple. This is a different case than the former: when C<$k> is negative there are no tuples at all, when C<$k> is zero there is one tuple. The rationale for this behaviour is the same rationale for n choose 0 = 1: the empty tuple is a subset of C<@data> with C<$k = 0> elements, so it complies with the definition. =item * If C<$k> is greater than the size of C<@data>, and we are calling a subroutine that does not generate tuples with repetitions, no tuple exists. Thus, the very first call to the iterator's C method returns C, and a call in list context returns the empty list. (See L.) =back In addition, since 0.05 empty C<@data>s are supported as well. =head1 EXPORT Algorithm::Combinatorics exports nothing by default. Each of the subroutines can be exported on demand, as in use Algorithm::Combinatorics qw(combinations); and the tag C exports them all: use Algorithm::Combinatorics qw(:all); =head1 DIAGNOSTICS =head2 Warnings The following warnings may be issued: =over =item Useless use of %s in void context A subroutine was called in void context. =item Parameter k is negative A subroutine was called with a negative k. =item Parameter k is greater than the size of data A subroutine that does not generate tuples with repetitions was called with a k greater than the size of data. =back =head2 Errors The following errors may be thrown: =over =item Missing parameter data A subroutine was called with no parameters. =item Missing parameter k A subroutine that requires a second parameter k was called without one. =item Parameter data is not an arrayref The first parameter is not an arrayref (tested with "reftype()" from Scalar::Util.) =back =head1 DEPENDENCIES Algorithm::Combinatorics is known to run under perl 5.6.2. The distribution uses L and L for testing, L for C, and L for XS. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. =head1 SEE ALSO L is a pure Perl module that offers similar features. L offers a fast pure-Perl generator of power sets that Algorithm::Combinatorics copies and translates to XS. =head1 BENCHMARKS There are some benchmarks in the F directory of the distribution. =head1 REFERENCES [1] Donald E. Knuth, I. Addison Wesley Professional, 2005. ISBN 0201853930. [2] Donald E. Knuth, I. Addison Wesley Professional, 2005. ISBN 0201853949. [3] Michael Orlov, I, L. =head1 AUTHOR Xavier Noria (FXN), Efxn@cpan.orgE =head1 COPYRIGHT & LICENSE Copyright 2005-2011 Xavier Noria, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Algorithm-Combinatorics-0.26/Combinatorics.xs000644 000765 000024 00000027565 11520626602 021306 0ustar00fxnstaff000000 000000 /** * These subroutines implement the actual iterators. * * The real combinatorics are done in-place on a private array of indices * that is guaranteed to hold integers. We cannot assume they are IVs though, * because in a few places in the Perl side there's some simple arithmetic * that is enough to give NVs in 5.6.x. * * Once the next tuple has been computed the corresponding slice of data is * copied in the Perl side. I tried to slice data here in C but it was in * fact slightly slower. I think we would need to pass aliases to gain * some more speed. * * All the subroutines return -1 when the sequence has been exhausted. */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #define SETIV(av, i, n) (sv_setiv(*av_fetch(av, i, 0), n)) #define GETIV(av, i) (SvIV(*av_fetch(av, i, 0))) #define INCR(av, i) (SETIV(av, i, 1 + GETIV(av, i))) #define GETAV(avptr) ((AV*) SvRV(avptr)) /** * Swap the ith and jth elements in av. * * Assumes av contains IVs. */ void __swap(AV* av, int i, int j) { IV tmp = GETIV(av, i); SETIV(av, i, GETIV(av, j)); SETIV(av, j, tmp); } /** * This implementation emulates what we do by hand. It is faster than * Algorithm T from [2], which gives another lexicographic ordering. */ int __next_combination(SV* tuple_avptr, int max_n) { AV* tuple = GETAV(tuple_avptr); int i, j; IV n; I32 offset, len_tuple; SV* e; len_tuple = av_len(tuple); offset = max_n - len_tuple; for (i = len_tuple; i >= 0; --i) { e = *av_fetch(tuple, i, 0); n = SvIV(e); if (n < i + offset) { sv_setiv(e, ++n); for (j = i+1; j <= len_tuple; ++j) SETIV(tuple, j, ++n); return i; } } return -1; } /** * This provisional implementation emulates what we do by hand. */ int __next_combination_with_repetition(SV* tuple_avptr, int max_n) { AV* tuple = GETAV(tuple_avptr); int i, j; IV n; I32 len_tuple; len_tuple = av_len(tuple); for (i = len_tuple; i >= 0; --i) { n = GETIV(tuple, i); if (n < max_n) { ++n; for (j = i; j <= len_tuple; ++j) SETIV(tuple, j, n); return i; } } return -1; } /** * This provisional implementation emulates what we do by hand, keeping * and array of booleans (used) to keep track of the indices in use. * That is, used[n] == 1 if and only if tuple[i] == n for some i. * */ int __next_variation(SV* tuple_avptr, SV* used_avptr, int max_n) { AV* tuple = GETAV(tuple_avptr); AV* used = GETAV(used_avptr); int i, j; I32 len_tuple; SV* e; IV n; len_tuple = av_len(tuple); for (i = len_tuple; i >= 0; --i) { /* from right to left, find the first position that can be incremented */ e = *av_fetch(tuple, i, 0); n = SvIV(e); SETIV(used, n, 0); while (++n <= max_n) { if (!GETIV(used, n)) { /* if we get here we nececessarily exit the subrutine, so forget about the outer while and for */ sv_setiv(e, n); SETIV(used, n, 1); for (j = i+1; j <= len_tuple; ++j) { /* from there to the right, fill the tuple with the lowest available numbers */ n = -1; while (++n <= max_n) { if (!GETIV(used, n)) { SETIV(tuple, j, n); SETIV(used, n, 1); break; } } } return i; } } } return -1; } /** * This provisional implementation emulates what we do by hand. */ int __next_variation_with_repetition(SV* tuple_avptr, int max_n) { AV* tuple = GETAV(tuple_avptr); int i; I32 len_tuple; SV* e; len_tuple = av_len(tuple); for (i = len_tuple; i >= 0; --i) { e = *av_fetch(tuple, i, 0); if (SvIV(e) < max_n) { sv_setiv(e, 1 + SvIV(e)); return i; } sv_setiv(e, 0); } return -1; } /** * Algorithm H (Loopless reflected mixed-radix Gray generation), from [1]. * * [Initialize.] and [Visit.] are done in the Perl side. */ int __next_variation_with_repetition_gray_code(SV* tuple_avptr, SV* f_avptr, SV* o_avptr, int max_m) { AV* tuple = GETAV(tuple_avptr); AV* f = GETAV(f_avptr); AV* o = GETAV(o_avptr); I32 n; IV j, aj; n = av_len(tuple) + 1; /* [Choose j.] */ j = GETIV(f, 0); SETIV(f, 0, 0); /* [Change coordinate j.] */ if (j == n) return -1; else SETIV(tuple, j, GETIV(tuple, j) + GETIV(o, j)); /* [Reflect?] */ aj = GETIV(tuple, j); if (aj == 0 || aj == max_m) { SETIV(o, j, -GETIV(o, j)); SETIV(f, j, GETIV(f, j+1)); SETIV(f, j+1, j+1); } return j; } /** * Algorithm L (Lexicographic permutation generation), adapted from [1]. * I used "h" instead of the letter "l" for the sake of readability. * * This algorithm goes back at least to the 18th century, and has been rediscovered * ever since. */ int __next_permutation(SV* tuple_avptr) { AV* tuple = GETAV(tuple_avptr); I32 max_n, j, h, k; IV aj; max_n = av_len(tuple); /* [Find j.] Find the element a(j) behind the longest decreasing tail. */ for (j = max_n-1; j >= 0 && GETIV(tuple, j) > GETIV(tuple, j+1); --j) ; if (j == -1) return -1; /* [Increase a(j).] Find the rightmost element a(h) greater than a(j) and swap them. */ aj = GETIV(tuple, j); for (h = max_n; aj > GETIV(tuple, h); --h) ; __swap(tuple, j, h); /* [Reverse a(j+1)...a(max_n)] Reverse the tail. */ for (k = j+1, h = max_n; k < h; ++k, --h) __swap(tuple, k, h); /* Done. */ return 1; } int __next_permutation_heap(SV* a_avptr, SV* c_avptr) { AV* a = GETAV(a_avptr); AV* c = GETAV(c_avptr); int k; I32 n; IV ck; n = av_len(a) + 1; for (k = 1, ck = GETIV(c, k); ck == k; ++k, ck = GETIV(c, k)) SETIV(c, k, 0); if (k == n) return -1; ++ck; SETIV(c, k, ck); k % 2 == 0 ? __swap(a, k, 0) : __swap(a, k, ck-1); return k; } /** * The only algorithms I have found by now are either recursive, or a * naive wrapper around permutations() that loops over all of them and * discards the ones with fixed-points. * * We take here a mixed-approach, which consists on starting with the * algorithm in __next_permutation() and tweak a couple of places that * allow us to skip a significant number of permutations sometimes. * * Benchmarking shows this subroutine makes derangements() more than * two and a half times faster than permutations() for n = 8. */ int __next_derangement(SV* tuple_avptr) { AV* tuple = GETAV(tuple_avptr); I32 max_n, min_j, j, h, k; IV aj; max_n = av_len(tuple); min_j = max_n; THERE_IS_A_FIXED_POINT: /* Find the element a(j) behind the longest decreasing tail. */ for (j = max_n-1; j >= 0 && GETIV(tuple, j) > GETIV(tuple, j+1); --j) ; if (j == -1) return -1; if (min_j > j) min_j = j; /* Find the rightmost element a(h) greater than a(j) and swap them. */ aj = GETIV(tuple, j); for (h = max_n; aj > GETIV(tuple, h); --h) ; __swap(tuple, j, h); /* If a(h) was j leave the tail in decreasing order and try again. */ if (GETIV(tuple, j) == j) goto THERE_IS_A_FIXED_POINT; /* I tried an alternative approach that would in theory avoid the generation of some permutations with fixed-points: keeping track of the leftmost fixed-point, and reversing the elements to its right. But benchmarks up to n = 11 showed no difference whatsoever. Thus, I left this version, which is simpler. That n = 11 does not mean there was a difference for n = 12, it means I stopped benchmarking at n = 11. */ /* Otherwise reverse the tail and return if there's no fixed point. */ for (k = j+1, h = max_n; k < h; ++k, --h) __swap(tuple, k, h); for (k = max_n; k > min_j; --k) if (GETIV(tuple, k) == k) goto THERE_IS_A_FIXED_POINT; return 1; } /* * This is a transcription of algorithm 3 from [3]. * * It is a classical approach based on restricted growth strings, which are * introduced in the paper. */ int __next_partition(SV* k_avptr, SV* M_avptr) { AV* k = GETAV(k_avptr); /* follows notation in [3] */ AV* M = GETAV(M_avptr); /* follows notation in [3] */ int i, j; IV mi; I32 len_k; len_k = av_len(k); for (i = len_k; i > 0; --i) { if (GETIV(k, i) <= GETIV(M, i-1)) { INCR(k, i); if (GETIV(k, i) > GETIV(M, i)) SETIV(M, i, GETIV(k, i)); mi = GETIV(M, i); for (j = i+1; j <= len_k; ++j) { SETIV(k, j, 0); SETIV(M, j, mi); } return i; } } return -1; } /* * This is a transcription of algorithm 8 from [3]. * * It is an adaptation of the previous one. */ int __next_partition_of_size_p(SV* k_avptr, SV* M_avptr, int p) { AV* k = GETAV(k_avptr); /* follows notation in [3] */ AV* M = GETAV(M_avptr); /* follows notation in [3] */ int i, j; IV mi, x; I32 len_k, n_minus_p; len_k = av_len(k); for (i = len_k; i > 0; --i) { if (GETIV(k, i) < p-1 && GETIV(k, i) <= GETIV(M, i-1)) { INCR(k, i); if (GETIV(k, i) > GETIV(M, i)) SETIV(M, i, GETIV(k, i)); n_minus_p = len_k + 1 - p; mi = GETIV(M, i); x = n_minus_p + mi; for (j = i+1; j <= x; ++j) { SETIV(k, j, 0); SETIV(M, j, mi); } for (j = x+1; j <= len_k; ++j) { SETIV(k, j, j - n_minus_p); SETIV(M, j, j - n_minus_p); } return i; } } return -1; } /* * This subroutine has been copied from List::PowerSet. * * It uses a vector of bits "odometer" to indicate which elements to include * in each iteration. The odometer runs and eventually exhausts all possible * combinations of 0s and 1s. */ AV* __next_subset(SV* data_avptr, SV* odometer_avptr) { AV* data = GETAV(data_avptr); AV* odometer = GETAV(odometer_avptr); I32 len_data = av_len(data); AV* subset = newAV(); IV adjust = 1; int i; IV n; for (i = 0; i <= len_data; ++i) { n = GETIV(odometer, i); if (n) { av_push(subset, newSVsv(*av_fetch(data, i, 0))); } if (adjust) { adjust = 1 - n; SETIV(odometer, i, adjust); } } return (AV*) sv_2mortal((SV*) subset); } /** ------------------------------------------------------------------- * * XS stuff starts here. * */ MODULE = Algorithm::Combinatorics PACKAGE = Algorithm::Combinatorics PROTOTYPES: DISABLE int __next_combination(tuple_avptr, max_n) SV* tuple_avptr int max_n int __next_combination_with_repetition(tuple_avptr, max_n) SV* tuple_avptr int max_n int __next_variation(tuple_avptr, used_avptr, max_n) SV* tuple_avptr SV* used_avptr int max_n int __next_variation_with_repetition(tuple_avptr, max_n) SV* tuple_avptr int max_n int __next_variation_with_repetition_gray_code(tuple_avptr, f_avptr, o_avptr, max_m) SV* tuple_avptr SV* f_avptr SV* o_avptr int max_m int __next_permutation(tuple_avptr) SV* tuple_avptr int __next_permutation_heap(a_avptr, c_avptr) SV* a_avptr SV* c_avptr int __next_derangement(tuple_avptr) SV* tuple_avptr int __next_partition(k_avptr, M_avptr) SV* k_avptr SV* M_avptr int __next_partition_of_size_p(k_avptr, M_avptr, p) SV* k_avptr SV* M_avptr int p AV* __next_subset(data_avptr, odometer_avptr) SV* data_avptr SV* odometer_avptr Algorithm-Combinatorics-0.26/Makefile.PL000644 000765 000024 00000001214 11520552415 020067 0ustar00fxnstaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; # I copied this trick from Text::CSV_XS's Makefile.PL. my $def = ''; $def .= '-Wall' if $ENV{"__RUNNING_IN_FXN_LAPTOP"}; WriteMakefile( NAME => 'Algorithm::Combinatorics', AUTHOR => 'Xavier Noria ', VERSION_FROM => 'Combinatorics.pm', ABSTRACT_FROM => 'Combinatorics.pm', PREREQ_PM => { 'XSLoader' => 0, 'FindBin' => 0, 'Test::More' => 0, 'Scalar::Util' => 0, }, DEFINE => $def, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Algorithm-Combinatorics-*' }, ); Algorithm-Combinatorics-0.26/MANIFEST000644 000765 000024 00000001130 11520552415 017243 0ustar00fxnstaff000000 000000 Changes MANIFEST META.yml # Will be created by "make dist" Makefile.PL README Combinatorics.xs Combinatorics.pm t/Tester.pm t/00_load.t t/01_combinations.t t/02_combinations_with_repetition.t t/03_variations.t t/04_variations_with_repetition.t t/05_tuples.t t/06_tuples_with_repetition.t t/07_permutations.t t/08_derangements.t t/09_partitions.t t/10_partitions_of_size_p.t t/11_circular_permutations.t t/12_complete_permutations.t t/13_subsets.t t/14_subsets_of_size_k.t t/pod-coverage.t t/pod.t benchmarks/combinations.pl benchmarks/permutations.pl benchmarks/derangements.pl benchmarks/subsets.pl Algorithm-Combinatorics-0.26/META.yml000644 000765 000024 00000001175 11520627512 017375 0ustar00fxnstaff000000 000000 --- #YAML:1.0 name: Algorithm-Combinatorics version: 0.26 abstract: Efficient generation of combinatorial sequences author: - Xavier Noria license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: FindBin: 0 Scalar::Util: 0 Test::More: 0 XSLoader: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Algorithm-Combinatorics-0.26/README000644 000765 000024 00000031341 11520626161 017001 0ustar00fxnstaff000000 000000 NAME Algorithm::Combinatorics - Efficient generation of combinatorial sequences SYNOPSIS use Algorithm::Combinatorics qw(permutations); my @data = qw(a b c); # scalar context gives an iterator my $iter = permutations(\@data); while (my $p = $iter->next) { # ... } # list context slurps my @all_permutations = permutations(\@data); VERSION This documentation refers to Algorithm::Combinatorics version 0.26. DESCRIPTION Algorithm::Combinatorics is an efficient generator of combinatorial sequences. Algorithms are selected from the literature (work in progress, see REFERENCES). Iterators do not use recursion, nor stacks, and are written in C. Tuples are generated in lexicographic order, except in `subsets()'. SUBROUTINES Algorithm::Combinatorics provides these subroutines: permutations(\@data) circular_permutations(\@data) derangements(\@data) complete_permutations(\@data) variations(\@data, $k) variations_with_repetition(\@data, $k) tuples(\@data, $k) tuples_with_repetition(\@data, $k) combinations(\@data, $k) combinations_with_repetition(\@data, $k) partitions(\@data[, $k]) subsets(\@data[, $k]) All of them are context-sensitive: * In scalar context subroutines return an iterator that responds to the `next()' method. Using this object you can iterate over the sequence of tuples one by one this way: my $iter = combinations(\@data, $k); while (my $c = $iter->next) { # ... } The `next()' method returns an arrayref to the next tuple, if any, or `undef' if the sequence is exhausted. Memory usage is minimal, no recursion and no stacks are involved. * In list context subroutines slurp the entire set of tuples. This behaviour is offered for convenience, but take into account that the resulting array may be really huge: my @all_combinations = combinations(\@data, $k); permutations(\@data) The permutations of `@data' are all its reorderings. For example, the permutations of `@data = (1, 2, 3)' are: (1, 2, 3) (1, 3, 2) (2, 1, 3) (2, 3, 1) (3, 1, 2) (3, 2, 1) The number of permutations of `n' elements is: n! = 1, if n = 0 n! = n*(n-1)*...*1, if n > 0 See some values at http://www.research.att.com/~njas/sequences/A000142. circular_permutations(\@data) The circular permutations of `@data' are its arrangements around a circle, where only relative order of elements matter, rather than their actual position. Think possible arrangements of people around a circular table for dinner according to whom they have to their right and left, no matter the actual chair they sit on. For example the circular permutations of `@data = (1, 2, 3, 4)' are: (1, 2, 3, 4) (1, 2, 4, 3) (1, 3, 2, 4) (1, 3, 4, 2) (1, 4, 2, 3) (1, 4, 3, 2) The number of circular permutations of `n' elements is: n! = 1, if 0 <= n <= 1 (n-1)! = (n-1)*(n-2)*...*1, if n > 1 See a few numbers in a comment of http://www.research.att.com/~njas/sequences/A000142. derangements(\@data) The derangements of `@data' are those reorderings that have no element in its original place. In jargon those are the permutations of `@data' with no fixed points. For example, the derangements of `@data = (1, 2, 3)' are: (2, 3, 1) (3, 1, 2) The number of derangements of `n' elements is: d(n) = 1, if n = 0 d(n) = n*d(n-1) + (-1)**n, if n > 0 See some values at http://www.research.att.com/~njas/sequences/A000166. complete_permutations(\@data) This is an alias for `derangements', documented above. variations(\@data, $k) The variations of length `$k' of `@data' are all the tuples of length `$k' consisting of elements of `@data'. For example, for `@data = (1, 2, 3)' and `$k = 2': (1, 2) (1, 3) (2, 1) (2, 3) (3, 1) (3, 2) For this to make sense, `$k' has to be less than or equal to the length of `@data'. Note that permutations(\@data); is equivalent to variations(\@data, scalar @data); The number of variations of `n' elements taken in groups of `k' is: v(n, k) = 1, if k = 0 v(n, k) = n*(n-1)*...*(n-k+1), if 0 < k <= n variations_with_repetition(\@data, $k) The variations with repetition of length `$k' of `@data' are all the tuples of length `$k' consisting of elements of `@data', including repetitions. For example, for `@data = (1, 2, 3)' and `$k = 2': (1, 1) (1, 2) (1, 3) (2, 1) (2, 2) (2, 3) (3, 1) (3, 2) (3, 3) Note that `$k' can be greater than the length of `@data'. For example, for `@data = (1, 2)' and `$k = 3': (1, 1, 1) (1, 1, 2) (1, 2, 1) (1, 2, 2) (2, 1, 1) (2, 1, 2) (2, 2, 1) (2, 2, 2) The number of variations with repetition of `n' elements taken in groups of `k >= 0' is: vr(n, k) = n**k tuples(\@data, $k) This is an alias for `variations', documented above. tuples_with_repetition(\@data, $k) This is an alias for `variations_with_repetition', documented above. combinations(\@data, $k) The combinations of length `$k' of `@data' are all the sets of size `$k' consisting of elements of `@data'. For example, for `@data = (1, 2, 3, 4)' and `$k = 3': (1, 2, 3) (1, 2, 4) (1, 3, 4) (2, 3, 4) For this to make sense, `$k' has to be less than or equal to the length of `@data'. The number of combinations of `n' elements taken in groups of `0 <= k <= n' is: n choose k = n!/(k!*(n-k)!) combinations_with_repetition(\@data, $k); The combinations of length `$k' of an array `@data' are all the bags of size `$k' consisting of elements of `@data', with repetitions. For example, for `@data = (1, 2, 3)' and `$k = 2': (1, 1) (1, 2) (1, 3) (2, 2) (2, 3) (3, 3) Note that `$k' can be greater than the length of `@data'. For example, for `@data = (1, 2, 3)' and `$k = 4': (1, 1, 1, 1) (1, 1, 1, 2) (1, 1, 1, 3) (1, 1, 2, 2) (1, 1, 2, 3) (1, 1, 3, 3) (1, 2, 2, 2) (1, 2, 2, 3) (1, 2, 3, 3) (1, 3, 3, 3) (2, 2, 2, 2) (2, 2, 2, 3) (2, 2, 3, 3) (2, 3, 3, 3) (3, 3, 3, 3) The number of combinations with repetition of `n' elements taken in groups of `k >= 0' is: n+k-1 over k = (n+k-1)!/(k!*(n-1)!) partitions(\@data[, $k]) A partition of `@data' is a division of `@data' in separate pieces. Technically that's a set of subsets of `@data' which are non-empty, disjoint, and whose union is `@data'. For example, the partitions of `@data = (1, 2, 3)' are: ((1, 2, 3)) ((1, 2), (3)) ((1, 3), (2)) ((1), (2, 3)) ((1), (2), (3)) This subroutine returns in consequence tuples of tuples. The top-level tuple (an arrayref) represents the partition itself, whose elements are tuples (arrayrefs) in turn, each one representing a subset of `@data'. The number of partitions of a set of `n' elements are known as Bell numbers, and satisfy the recursion: B(0) = 1 B(n+1) = (n over 0)B(0) + (n over 1)B(1) + ... + (n over n)B(n) See some values at http://www.research.att.com/~njas/sequences/A000110. If you pass the optional parameter `$k', the subroutine generates only partitions of size `$k'. This uses an specific algorithm for partitions of known size, which is more efficient than generating all partitions and filtering them by size. Note that in that case the subsets themselves may have several sizes, it is the number of elements *of the partition* which is `$k'. For instance if `@data' has 5 elements there are partitions of size 2 that consist of a subset of size 2 and its complement of size 3; and partitions of size 2 that consist of a subset of size 1 and its complement of size 4. In both cases the partitions have the same size, they have two elements. The number of partitions of size `k' of a set of `n' elements are known as Stirling numbers of the second kind, and satisfy the recursion: S(0, 0) = 1 S(n, 0) = 0 if n > 0 S(n, 1) = S(n, n) = 1 S(n, k) = S(n-1, k-1) + kS(n-1, k) subsets(\@data[, $k]) This subroutine iterates over the subsets of data, which is assumed to represent a set. If you pass the optional parameter `$k' the iteration runs over subsets of data of size `$k'. The number of subsets of a set of `n' elements is 2**n See some values at http://www.research.att.com/~njas/sequences/A000079. CORNER CASES Since version 0.05 subroutines are more forgiving for unsual values of `$k': * If `$k' is less than zero no tuple exists. Thus, the very first call to the iterator's `next()' method returns `undef', and a call in list context returns the empty list. (See DIAGNOSTICS.) * If `$k' is zero we have one tuple, the empty tuple. This is a different case than the former: when `$k' is negative there are no tuples at all, when `$k' is zero there is one tuple. The rationale for this behaviour is the same rationale for n choose 0 = 1: the empty tuple is a subset of `@data' with `$k = 0' elements, so it complies with the definition. * If `$k' is greater than the size of `@data', and we are calling a subroutine that does not generate tuples with repetitions, no tuple exists. Thus, the very first call to the iterator's `next()' method returns `undef', and a call in list context returns the empty list. (See DIAGNOSTICS.) In addition, since 0.05 empty `@data's are supported as well. EXPORT Algorithm::Combinatorics exports nothing by default. Each of the subroutines can be exported on demand, as in use Algorithm::Combinatorics qw(combinations); and the tag `all' exports them all: use Algorithm::Combinatorics qw(:all); DIAGNOSTICS Warnings The following warnings may be issued: Useless use of %s in void context A subroutine was called in void context. Parameter k is negative A subroutine was called with a negative k. Parameter k is greater than the size of data A subroutine that does not generate tuples with repetitions was called with a k greater than the size of data. Errors The following errors may be thrown: Missing parameter data A subroutine was called with no parameters. Missing parameter k A subroutine that requires a second parameter k was called without one. Parameter data is not an arrayref The first parameter is not an arrayref (tested with "reftype()" from Scalar::Util.) DEPENDENCIES Algorithm::Combinatorics is known to run under perl 5.6.2. The distribution uses Test::More and FindBin for testing, Scalar::Util for `reftype()', and XSLoader for XS. BUGS Please report any bugs or feature requests to `bug-algorithm-combinatorics@rt.cpan.org', or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-Combinatorics. SEE ALSO Math::Combinatorics is a pure Perl module that offers similar features. List::PowerSet offers a fast pure-Perl generator of power sets that Algorithm::Combinatorics copies and translates to XS. BENCHMARKS There are some benchmarks in the benchmarks directory of the distribution. REFERENCES [1] Donald E. Knuth, *The Art of Computer Programming, Volume 4, Fascicle 2: Generating All Tuples and Permutations*. Addison Wesley Professional, 2005. ISBN 0201853930. [2] Donald E. Knuth, *The Art of Computer Programming, Volume 4, Fascicle 3: Generating All Combinations and Partitions*. Addison Wesley Professional, 2005. ISBN 0201853949. [3] Michael Orlov, *Efficient Generation of Set Partitions*, http://www.informatik.uni-ulm.de/ni/Lehre/WS03/DMM/Software/partitions.p df. AUTHOR Xavier Noria (FXN), COPYRIGHT & LICENSE Copyright 2005-2011 Xavier Noria, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Algorithm-Combinatorics-0.26/t/000755 000765 000024 00000000000 11520627512 016363 5ustar00fxnstaff000000 000000 Algorithm-Combinatorics-0.26/t/00_load.t000644 000765 000024 00000000126 11520552415 017764 0ustar00fxnstaff000000 000000 #!perl use Test::More qw(no_plan); BEGIN { use_ok( 'Algorithm::Combinatorics' ); } Algorithm-Combinatorics-0.26/t/01_combinations.t000644 000765 000024 00000003712 11520552415 021537 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(combinations); use Tester; my $tester = Tester->__new(\&combinations); my (@result, @expected); # --------------------------------------------------------------------- eval { combinations() }; ok($@, ''); eval { combinations([1]) }; ok($@, ''); eval { combinations(0, 0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = (["foo", "bar"]); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["foo", "baz"], ["bar", "baz"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "bar", "baz"], ["foo", "bar", "zoo"], ["foo", "baz", "zoo"], ["bar", "baz", "zoo"], ); $tester->__test(\@expected, ["foo", "bar", "baz", "zoo"], 3); # ---------------------------------------------------------------------- @expected = ( [1, 2, 3], [1, 2, 4], [1, 2, 5], [1, 3, 4], [1, 3, 5], [1, 4, 5], [2, 3, 4], [2, 3, 5], [2, 4, 5], [3, 4, 5], ); $tester->__test(\@expected, [1..5], 3); # ---------------------------------------------------------------------- my $ncomb = 0; my $iter = combinations([1..20], 15); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 15504, ""); Algorithm-Combinatorics-0.26/t/02_combinations_with_repetition.t000644 000765 000024 00000004656 11520552415 025045 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(combinations_with_repetition); use Tester; my $tester = Tester->__new(\&combinations_with_repetition); my (@result, @expected); # --------------------------------------------------------------------- eval { combinations_with_repetition() }; ok($@, ''); eval { combinations_with_repetition([1]) }; ok($@, ''); eval { combinations_with_repetition(0, 0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = ( ["foo", "foo"], ["foo", "bar"], ["bar", "bar"], ); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "foo", "foo"], ["foo", "foo", "bar"], ["foo", "bar", "bar"], ["bar", "bar", "bar"], ); $tester->__test(\@expected, ["foo", "bar"], 3); # --------------------------------------------------------------------- @expected = ( ["foo", "foo"], ["foo", "bar"], ["foo", "baz"], ["bar", "bar"], ["bar", "baz"], ["baz", "baz"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( [0, 0, 0], [0, 0, 1], [0, 0, 2], [0, 0, 3], [0, 1, 1], [0, 1, 2], [0, 1, 3], [0, 2, 2], [0, 2, 3], [0, 3, 3], [1, 1, 1], [1, 1, 2], [1, 1, 3], [1, 2, 2], [1, 2, 3], [1, 3, 3], [2, 2, 2], [2, 2, 3], [2, 3, 3], [3, 3, 3], ); $tester->__test(\@expected, [0..3], 3); # ---------------------------------------------------------------------- # n+k-1 over k my $ncomb = 0; my $iter = combinations_with_repetition([1..15], 5); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 11628, ""); $ncomb = 0; $iter = combinations_with_repetition([1..7], 11); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 12376, ""); Algorithm-Combinatorics-0.26/t/03_variations.t000644 000765 000024 00000006636 11520552415 021243 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(variations); use Tester; my $tester = Tester->__new(\&variations); my (@result, @expected); # --------------------------------------------------------------------- eval { variations() }; ok($@, ''); eval { variations([1]) }; ok($@, ''); eval { variations(0, 0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["bar", "foo"], ); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["foo", "baz"], ["bar", "foo"], ["bar", "baz"], ["baz", "foo"], ["baz", "bar"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( [0, 1, 2], [0, 1, 3], [0, 2, 1], [0, 2, 3], [0, 3, 1], [0, 3, 2], [1, 0, 2], [1, 0, 3], [1, 2, 0], [1, 2, 3], [1, 3, 0], [1, 3, 2], [2, 0, 1], [2, 0, 3], [2, 1, 0], [2, 1, 3], [2, 3, 0], [2, 3, 1], [3, 0, 1], [3, 0, 2], [3, 1, 0], [3, 1, 2], [3, 2, 0], [3, 2, 1], ); $tester->__test(\@expected, [0..3], 3); # ---------------------------------------------------------------------- @expected = ( [0, 1], [0, 2], [0, 3], [0, 4], [1, 0], [1, 2], [1, 3], [1, 4], [2, 0], [2, 1], [2, 3], [2, 4], [3, 0], [3, 1], [3, 2], [3, 4], [4, 0], [4, 1], [4, 2], [4, 3], ); $tester->__test(\@expected, [0..4], 2); # ---------------------------------------------------------------------- @expected = ( [0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 1], [0, 2, 3], [0, 2, 4], [0, 3, 1], [0, 3, 2], [0, 3, 4], [0, 4, 1], [0, 4, 2], [0, 4, 3], [1, 0, 2], [1, 0, 3], [1, 0, 4], [1, 2, 0], [1, 2, 3], [1, 2, 4], [1, 3, 0], [1, 3, 2], [1, 3, 4], [1, 4, 0], [1, 4, 2], [1, 4, 3], [2, 0, 1], [2, 0, 3], [2, 0, 4], [2, 1, 0], [2, 1, 3], [2, 1, 4], [2, 3, 0], [2, 3, 1], [2, 3, 4], [2, 4, 0], [2, 4, 1], [2, 4, 3], [3, 0, 1], [3, 0, 2], [3, 0, 4], [3, 1, 0], [3, 1, 2], [3, 1, 4], [3, 2, 0], [3, 2, 1], [3, 2, 4], [3, 4, 0], [3, 4, 1], [3, 4, 2], [4, 0, 1], [4, 0, 2], [4, 0, 3], [4, 1, 0], [4, 1, 2], [4, 1, 3], [4, 2, 0], [4, 2, 1], [4, 2, 3], [4, 3, 0], [4, 3, 1], [4, 3, 2], ); $tester->__test(\@expected, [0..4], 3); # ---------------------------------------------------------------------- # n*(n-1)*(n-2)* ... *(n-p+1) my $ncomb = 0; my $iter = variations([1..9], 5); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 15120, ""); Algorithm-Combinatorics-0.26/t/04_variations_with_repetition.t000644 000765 000024 00000006351 11520552415 024533 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(variations_with_repetition); use Tester; my $tester = Tester->__new(\&variations_with_repetition); my (@result, @expected); # --------------------------------------------------------------------- eval { variations_with_repetition() }; ok($@, ''); eval { variations_with_repetition([1]) }; ok($@, ''); eval { variations_with_repetition(0, 0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = ( ["foo", "foo"], ["foo", "bar"], ["bar", "foo"], ["bar", "bar"], ); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "foo", "foo"], ["foo", "foo", "bar"], ["foo", "bar", "foo"], ["foo", "bar", "bar"], ["bar", "foo", "foo"], ["bar", "foo", "bar"], ["bar", "bar", "foo"], ["bar", "bar", "bar"], ); $tester->__test(\@expected, ["foo", "bar"], 3); # --------------------------------------------------------------------- @expected = ( ["foo", "foo"], ["foo", "bar"], ["foo", "baz"], ["bar", "foo"], ["bar", "bar"], ["bar", "baz"], ["baz", "foo"], ["baz", "bar"], ["baz", "baz"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( [0, 0, 0], [0, 0, 1], [0, 0, 2], [0, 0, 3], [0, 1, 0], [0, 1, 1], [0, 1, 2], [0, 1, 3], [0, 2, 0], [0, 2, 1], [0, 2, 2], [0, 2, 3], [0, 3, 0], [0, 3, 1], [0, 3, 2], [0, 3, 3], [1, 0, 0], [1, 0, 1], [1, 0, 2], [1, 0, 3], [1, 1, 0], [1, 1, 1], [1, 1, 2], [1, 1, 3], [1, 2, 0], [1, 2, 1], [1, 2, 2], [1, 2, 3], [1, 3, 0], [1, 3, 1], [1, 3, 2], [1, 3, 3], [2, 0, 0], [2, 0, 1], [2, 0, 2], [2, 0, 3], [2, 1, 0], [2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 2, 0], [2, 2, 1], [2, 2, 2], [2, 2, 3], [2, 3, 0], [2, 3, 1], [2, 3, 2], [2, 3, 3], [3, 0, 0], [3, 0, 1], [3, 0, 2], [3, 0, 3], [3, 1, 0], [3, 1, 1], [3, 1, 2], [3, 1, 3], [3, 2, 0], [3, 2, 1], [3, 2, 2], [3, 2, 3], [3, 3, 0], [3, 3, 1], [3, 3, 2], [3, 3, 3], ); $tester->__test(\@expected, [0..3], 3); # ---------------------------------------------------------------------- # n^k my $ncomb = 0; my $iter = variations_with_repetition([1..7], 5); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 16807, ""); $ncomb = 0; $iter = variations_with_repetition([1..4], 7); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 16384, ""); Algorithm-Combinatorics-0.26/t/05_tuples.t000644 000765 000024 00000003750 11520552415 020374 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(tuples); use Tester; my $tester = Tester->__new(\&tuples); my (@result, @expected); # --------------------------------------------------------------------- eval { tuples() }; ok($@, ''); eval { tuples([1]) }; ok($@, ''); eval { tuples(0, 0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["bar", "foo"], ); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["foo", "baz"], ["bar", "foo"], ["bar", "baz"], ["baz", "foo"], ["baz", "bar"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( [0, 1, 2], [0, 1, 3], [0, 2, 1], [0, 2, 3], [0, 3, 1], [0, 3, 2], [1, 0, 2], [1, 0, 3], [1, 2, 0], [1, 2, 3], [1, 3, 0], [1, 3, 2], [2, 0, 1], [2, 0, 3], [2, 1, 0], [2, 1, 3], [2, 3, 0], [2, 3, 1], [3, 0, 1], [3, 0, 2], [3, 1, 0], [3, 1, 2], [3, 2, 0], [3, 2, 1], ); $tester->__test(\@expected, [0..3], 3); # ---------------------------------------------------------------------- # n*(n-1)*(n-2)* ... *(n-p+1) my $ncomb = 0; my $iter = tuples([1..9], 5); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 15120, ""); Algorithm-Combinatorics-0.26/t/06_tuples_with_repetition.t000644 000765 000024 00000006315 11520552415 023672 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(tuples_with_repetition); use Tester; my $tester = Tester->__new(\&tuples_with_repetition); my (@result, @expected); # --------------------------------------------------------------------- eval { tuples_with_repetition() }; ok($@, ''); eval { tuples_with_repetition([1]) }; ok($@, ''); eval { tuples_with_repetition(0, 0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = ( ["foo", "foo"], ["foo", "bar"], ["bar", "foo"], ["bar", "bar"], ); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "foo", "foo"], ["foo", "foo", "bar"], ["foo", "bar", "foo"], ["foo", "bar", "bar"], ["bar", "foo", "foo"], ["bar", "foo", "bar"], ["bar", "bar", "foo"], ["bar", "bar", "bar"], ); $tester->__test(\@expected, ["foo", "bar"], 3); # --------------------------------------------------------------------- @expected = ( ["foo", "foo"], ["foo", "bar"], ["foo", "baz"], ["bar", "foo"], ["bar", "bar"], ["bar", "baz"], ["baz", "foo"], ["baz", "bar"], ["baz", "baz"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( [0, 0, 0], [0, 0, 1], [0, 0, 2], [0, 0, 3], [0, 1, 0], [0, 1, 1], [0, 1, 2], [0, 1, 3], [0, 2, 0], [0, 2, 1], [0, 2, 2], [0, 2, 3], [0, 3, 0], [0, 3, 1], [0, 3, 2], [0, 3, 3], [1, 0, 0], [1, 0, 1], [1, 0, 2], [1, 0, 3], [1, 1, 0], [1, 1, 1], [1, 1, 2], [1, 1, 3], [1, 2, 0], [1, 2, 1], [1, 2, 2], [1, 2, 3], [1, 3, 0], [1, 3, 1], [1, 3, 2], [1, 3, 3], [2, 0, 0], [2, 0, 1], [2, 0, 2], [2, 0, 3], [2, 1, 0], [2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 2, 0], [2, 2, 1], [2, 2, 2], [2, 2, 3], [2, 3, 0], [2, 3, 1], [2, 3, 2], [2, 3, 3], [3, 0, 0], [3, 0, 1], [3, 0, 2], [3, 0, 3], [3, 1, 0], [3, 1, 1], [3, 1, 2], [3, 1, 3], [3, 2, 0], [3, 2, 1], [3, 2, 2], [3, 2, 3], [3, 3, 0], [3, 3, 1], [3, 3, 2], [3, 3, 3], ); $tester->__test(\@expected, [0..3], 3); # ---------------------------------------------------------------------- # n^k my $ncomb = 0; my $iter = tuples_with_repetition([1..7], 5); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 16807, ""); $ncomb = 0; $iter = tuples_with_repetition([1..4], 7); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 16384, ""); Algorithm-Combinatorics-0.26/t/07_permutations.t000644 000765 000024 00000002437 11520552415 021615 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(permutations); use Tester; my $tester = Tester->__new(\&permutations); my (@result, @expected); # --------------------------------------------------------------------- eval { permutations() }; ok($@, ''); eval { permutations(0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, []); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"]); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["bar", "foo"], ); $tester->__test(\@expected, ["foo", "bar"]); # --------------------------------------------------------------------- @expected = ( ["foo", "bar", "baz"], ["foo", "baz", "bar"], ["bar", "foo", "baz"], ["bar", "baz", "foo"], ["baz", "foo", "bar"], ["baz", "bar", "foo"], ); $tester->__test(\@expected, ["foo", "bar", "baz"]); # ---------------------------------------------------------------------- # n! my $ncomb = 0; my $iter = permutations([1..8]); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 40320, ""); Algorithm-Combinatorics-0.26/t/08_derangements.t000644 000765 000024 00000003133 11520552415 021532 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(derangements); use Tester; my $tester = Tester->__new(\&derangements); my (@result, @expected); # --------------------------------------------------------------------- eval { derangements() }; ok($@, ''); eval { derangements(0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, []); # --------------------------------------------------------------------- @expected = (); $tester->__test(\@expected, ["foo"]); # --------------------------------------------------------------------- @expected = ( ["bar", "foo"], ); $tester->__test(\@expected, ["foo", "bar"]); # --------------------------------------------------------------------- @expected = ( ["bar", "baz", "foo"], ["baz", "foo", "bar"], ); $tester->__test(\@expected, ["foo", "bar", "baz"]); # --------------------------------------------------------------------- @expected = ( [2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3], [3, 1, 4, 2], [3, 4, 1, 2], [3, 4, 2, 1], [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1], ); $tester->__test(\@expected, [1, 2, 3, 4]); # ---------------------------------------------------------------------- # d(n) = n*d(n-1) + (-1)**n if n > 0, d(0) = 1. my $ncomb = 0; my $iter = derangements([1..8]); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 14833, ""); $ncomb = 0; $iter = derangements([1..9]); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 133496, "");Algorithm-Combinatorics-0.26/t/09_partitions.t000644 000765 000024 00000003621 11520552415 021255 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(partitions); use Tester; my $tester = Tester->__new(\&partitions); my (@result, @expected); # --------------------------------------------------------------------- eval { partitions() }; ok($@, ''); eval { partitions(0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, []); # --------------------------------------------------------------------- @expected = ([["foo"]]); $tester->__test(\@expected, ["foo"]); # --------------------------------------------------------------------- @expected = ([["foo", "bar"]], [["foo"], ["bar"]]); $tester->__test(\@expected, ["foo", "bar"]); # --------------------------------------------------------------------- @expected = ( [["foo", "bar", "baz"]], [["foo", "bar"], ["baz"]], [["foo", "baz"], ["bar"]], [["foo"], ["bar", "baz"]], [["foo"], ["bar"], ["baz"]], ); $tester->__test(\@expected, ["foo", "bar", "baz"]); # --------------------------------------------------------------------- @expected = ( [[qw(a b c d)]], [[qw(a b c)], ["d"]], [[qw(a b d)], ["c"]], [[qw(a b)], [qw(c d)]], [[qw(a b)], ["c"], ["d"]], [[qw(a c d)], ["b"]], [[qw(a c)], [qw(b d)]], [[qw(a c)], ["b"], ["d"]], [[qw(a d)], [qw(b c)]], [["a"], [qw(b c d)]], [["a"], [qw(b c)], ["d"]], [[qw(a d)], ["b"], ["c"]], [["a"], [qw(b d)], ["c"]], [["a"], ["b"], [qw(c d)]], [["a"], ["b"], ["c"], ["d"]], ); $tester->__test(\@expected, [qw(a b c d)]); # --------------------------------------------------------------------- my $n = 0; my $iter = partitions([1..9]); while (my $p = $iter->next) { ++$n; } is($n, 21147, ""); $n = 0; $iter = partitions([1..10]); while (my $p = $iter->next) { ++$n; } is($n, 115975, ""); Algorithm-Combinatorics-0.26/t/10_partitions_of_size_p.t000644 000765 000024 00000003241 11520552415 023300 0ustar00fxnstaff000000 000000 use strict; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(partitions); use Tester; my $tester = Tester->__new(\&partitions); my (@result, @expected); # --------------------------------------------------------------------- eval { partitions() }; ok($@, ''); eval { partitions(0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); # --------------------------------------------------------------------- @expected = (); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = ([["foo"]]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = ([["foo"], ["bar"]]); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( [["foo"], ["bar"], ["baz"]], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 3); # --------------------------------------------------------------------- @expected = ( [["a", "b"], ["c"], ["d"]], [["a", "c"], ["b"], ["d"]], [["a"], ["b", "c"], ["d"]], [["a", "d"], ["b"], ["c"]], [["a"], ["b", "d"], ["c"]], [["a"], ["b"], ["c", "d"]], ); $tester->__test(\@expected, [qw(a b c d)], 3); # --------------------------------------------------------------------- my $n = 0; my $iter = partitions([1..10], 4); while (my $p = $iter->next) { ++$n; } is($n, 34105, ""); $n = 0; $iter = partitions([1..11], 4); while (my $p = $iter->next) { ++$n; } is($n, 145750, "");Algorithm-Combinatorics-0.26/t/11_circular_permutations.t000644 000765 000024 00000002660 11520552415 023472 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(circular_permutations); use Tester; my $tester = Tester->__new(\&circular_permutations); my (@result, @expected); # --------------------------------------------------------------------- eval { permutations() }; ok($@, ''); eval { permutations(0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, []); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"]); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ); $tester->__test(\@expected, ["foo", "bar"]); # --------------------------------------------------------------------- @expected = ( ["foo", "bar", "baz"], ["foo", "baz", "bar"], ); $tester->__test(\@expected, ["foo", "bar", "baz"]); # --------------------------------------------------------------------- @expected = ( [1, 2, 3, 4], [1, 2, 4, 3], [1, 3, 2, 4], [1, 3, 4, 2], [1, 4, 2, 3], [1, 4, 3, 2], ); $tester->__test(\@expected, [1, 2, 3, 4]); # ---------------------------------------------------------------------- # (n-1)! my $ncomb = 0; my $iter = circular_permutations([1..9]); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 40320, ""); Algorithm-Combinatorics-0.26/t/12_complete_permutations.t000644 000765 000024 00000003221 11520552415 023471 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(complete_permutations); use Tester; my $tester = Tester->__new(\&complete_permutations); my (@result, @expected); # --------------------------------------------------------------------- eval { complete_permutations() }; ok($@, ''); eval { complete_permutations(0) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, []); # --------------------------------------------------------------------- @expected = (); $tester->__test(\@expected, ["foo"]); # --------------------------------------------------------------------- @expected = ( ["bar", "foo"], ); $tester->__test(\@expected, ["foo", "bar"]); # --------------------------------------------------------------------- @expected = ( ["bar", "baz", "foo"], ["baz", "foo", "bar"], ); $tester->__test(\@expected, ["foo", "bar", "baz"]); # --------------------------------------------------------------------- @expected = ( [2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3], [3, 1, 4, 2], [3, 4, 1, 2], [3, 4, 2, 1], [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1], ); $tester->__test(\@expected, [1, 2, 3, 4]); # ---------------------------------------------------------------------- # d(n) = n*d(n-1) + (-1)**n if n > 0, d(0) = 1. my $ncomb = 0; my $iter = complete_permutations([1..8]); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 14833, ""); $ncomb = 0; $iter = complete_permutations([1..9]); while (my $c = $iter->next) { ++$ncomb; } is($ncomb, 133496, "");Algorithm-Combinatorics-0.26/t/13_subsets.t000644 000765 000024 00000002505 11520552415 020544 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(subsets); use Tester; my $tester = Tester->__new(\&subsets); my (@result, @expected); # --------------------------------------------------------------------- eval { subsets() }; ok($@, ''); eval { subsets(1) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, []); @expected = ([1, 2], [2], [1], []); $tester->__test(\@expected, [1, 2]); # --------------------------------------------------------------------- @expected = ( ["foo", "bar", "baz"], ["bar", "baz"], ["foo", "baz"], ["baz"], ["foo", "bar"], ["bar"], ["foo"], [], ); $tester->__test(\@expected, ["foo", "bar", "baz"]); # --------------------------------------------------------------------- @expected = ( [1, 2, 3, 4], [2, 3, 4], [1, 3, 4], [3, 4], [1, 2, 4], [2, 4], [1, 4], [4], [1, 2, 3], [2, 3], [1, 3], [3], [1, 2], [2], [1], [] ); $tester->__test(\@expected, [1..4]); # ---------------------------------------------------------------------- my $nsubsets = 0; my $iter = subsets([1..16]); while (my $c = $iter->next) { ++$nsubsets; } is($nsubsets, 65536, ""); Algorithm-Combinatorics-0.26/t/14_subsets_of_size_k.t000644 000765 000024 00000003616 11520552415 022601 0ustar00fxnstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Test::More qw(no_plan); use Algorithm::Combinatorics qw(subsets); use Tester; my $tester = Tester->__new(\&subsets); my (@result, @expected); # --------------------------------------------------------------------- eval { subsets() }; ok($@, ''); eval { subsets(1) }; ok($@, ''); # --------------------------------------------------------------------- @expected = ([]); $tester->__test(\@expected, [], 0); @expected = ([]); $tester->__test(\@expected, [1, 2], 0); # --------------------------------------------------------------------- @expected = (["foo"]); $tester->__test(\@expected, ["foo"], 1); # --------------------------------------------------------------------- @expected = (["foo"], ["bar"]); $tester->__test(\@expected, ["foo", "bar"], 1); # --------------------------------------------------------------------- @expected = (["foo", "bar"]); $tester->__test(\@expected, ["foo", "bar"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "bar"], ["foo", "baz"], ["bar", "baz"], ); $tester->__test(\@expected, ["foo", "bar", "baz"], 2); # --------------------------------------------------------------------- @expected = ( ["foo", "bar", "baz"], ["foo", "bar", "zoo"], ["foo", "baz", "zoo"], ["bar", "baz", "zoo"], ); $tester->__test(\@expected, ["foo", "bar", "baz", "zoo"], 3); # ---------------------------------------------------------------------- @expected = ( [1, 2, 3], [1, 2, 4], [1, 2, 5], [1, 3, 4], [1, 3, 5], [1, 4, 5], [2, 3, 4], [2, 3, 5], [2, 4, 5], [3, 4, 5], ); $tester->__test(\@expected, [1..5], 3); # ---------------------------------------------------------------------- my $nsubsets = 0; my $iter = subsets([1..20], 15); while (my $c = $iter->next) { ++$nsubsets; } is($nsubsets, 15504, ""); Algorithm-Combinatorics-0.26/t/pod-coverage.t000644 000765 000024 00000000370 11520552415 021122 0ustar00fxnstaff000000 000000 #!perl use Test::More; eval "use Test::Pod::Coverage"; plan skip_all => "Test::Pod::Coverage required for testing Pod coverage" if $@; plan tests => 1; $trustme = { trustme => [qr/_new$/] }; pod_coverage_ok( "Algorithm::Combinatorics", $trustme);Algorithm-Combinatorics-0.26/t/pod.t000644 000765 000024 00000000211 11520552415 017323 0ustar00fxnstaff000000 000000 #!perl use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing Pod" if $@; all_pod_files_ok();Algorithm-Combinatorics-0.26/t/Tester.pm000644 000765 000024 00000002015 11520552415 020164 0ustar00fxnstaff000000 000000 package Tester; use strict; use Test::More; sub __new { my ($class, $coderef, $comparator) = @_; $comparator = \&Test::More::is_deeply if not $comparator; bless { to_test => $coderef, comparator => $comparator }, $class; } # Here @rest is mean to be either (@data) or (@data, $k). sub __test { my ($self, $expected, @rest) = @_; my @result = (); my $iter = $self->{to_test}(@rest); while (my $c = $iter->next) { push @result, $c; } $self->{comparator}($expected, \@result, ""); @result = $self->{to_test}(@rest); $self->{comparator}($expected, \@result, ""); if (@rest > 1) { # as of today this means we've got a $k # test we don't assume $k is an IV in XS $rest[1] = "$rest[1]"; @result = (); $iter = $self->{to_test}(@rest); while (my $c = $iter->next) { push @result, $c; } $self->{comparator}($expected, \@result, ""); @result = $self->{to_test}(@rest); $self->{comparator}($expected, \@result, ""); } } 1; Algorithm-Combinatorics-0.26/benchmarks/combinations.pl000644 000765 000024 00000000773 11520552415 023265 0ustar00fxnstaff000000 000000 use strict; use warnings; use Algorithm::Combinatorics qw(combinations); use Math::Combinatorics; use Benchmark qw(cmpthese); our @data = 1..10; our $n = 7; sub acomb { my $iter = combinations(\@data, $n); 1 while $iter->next; } sub mcomb { my $iter = Math::Combinatorics->new(count => $n, data => \@data); 1 while $iter->next_combination; } cmpthese(-10, { acomb => \&acomb, mcomb => \&mcomb, }); # Rate mcomb acomb # mcomb 87.7/s -- -96% # acomb 2245/s 2461% -- Algorithm-Combinatorics-0.26/benchmarks/derangements.pl000644 000765 000024 00000000724 11520552415 023250 0ustar00fxnstaff000000 000000 use strict; use warnings; use Algorithm::Combinatorics qw(derangements); use Math::Combinatorics; use Benchmark qw(cmpthese); our @data = 1..7; sub ader { my $iter = derangements(\@data); 1 while $iter->next; } sub mder { my $iter = Math::Combinatorics->new(data => \@data); 1 while $iter->next_derangement; } cmpthese(-10, { ader => \&ader, mder => \&mder, }); # Rate mder ader # mder 11.9/s -- -91% # ader 138/s 1063% -- Algorithm-Combinatorics-0.26/benchmarks/permutations.pl000644 000765 000024 00000000735 11520552415 023330 0ustar00fxnstaff000000 000000 use strict; use warnings; use Algorithm::Combinatorics qw(permutations); use Math::Combinatorics; use Benchmark qw(cmpthese); our @data = 1..7; sub aperm { my $iter = permutations(\@data); 1 while $iter->next; } sub mperm { my $iter = Math::Combinatorics->new(data => \@data); 1 while $iter->next_permutation; } cmpthese(-10, { aperm => \&aperm, mperm => \&mperm, }); # Rate mperm aperm # mperm 12.2/s -- -78% # aperm 54.4/s 347% -- Algorithm-Combinatorics-0.26/benchmarks/subsets.pl000644 000765 000024 00000001335 11520552415 022263 0ustar00fxnstaff000000 000000 use strict; use Algorithm::Combinatorics qw(subsets); use List::PowerSet; use Benchmark qw(cmpthese); our @data = 1..10; sub lps_subsets { my $p = List::PowerSet::powerset_lazy(@data); 1 while $p->(); } sub ac_subsets { my $p = subsets(\@data); 1 while $p->next; } cmpthese(-15, { lps_subsets => \&lps_subsets, ac_subsets => \&ac_subsets, }); # The iterator is faster, but the subroutine that gives the entire powerset # in List::PowerSet is faster than our code in list context. We do not provide # that one because one of the premises of this module is to not recurse. # Rate lps_subsets ac_subsets #lps_subsets 120/s -- -50% #ac_subsets 241/s 101% --