#!/usr/local/bin/perl w
package Math::Combinatorics;
use strict;
use Exporter;
@Math::Combinatorics::ISA = qw(Exporter);
@Math::Combinatorics::EXPORT = "";
@Math::Combinatorics::EXPORT_OK = qw(
Pick Choose
Permutation Combination
);
%Math::Combinatorics::EXPORT_TAGS = (
"common" => [qw(Pick Choose )],
"formal" => [qw(Permutation Combination)],
);
$Math::Combinatorics::VERSION = 0.91; # v1.00 Release Candidate.
####################################################################
# CHOOSE (
# N, # Size of Master Array
# R, # Size of Subset
# F # Repetition Flag
# )
####################################################################
# Of note, 1) (NR)! divides out a large portion of N!.
# 2) Choose(N,R) = Choose(N, NR).
# 3) Choose(N,R,'r') = Choose(N+R1,R).
#
# These facts are taken advantage of in the formula to increase
# speed and improve accuracy.
#
# In the special case of R = 1, the sum of RCombinations for all
# R = 0..N is returned. This happens to be simply 2^n.
####################################################################
sub Choose {
my $n = shift; die "N ($n) must be a positive integer" if $n < 1;
my $r = shift;
my $f = shift  '';
# SUMMATION ACROSS R 
if ($r eq '*') {
# NO REPETITION
if (!$f) {
return 1 << $n
# REPETITION
} elsif ($f eq 'r') {
my $sum = 0;
for my $r (0..$n) {
my $c = 1;
for (1..$r) {
$c *= $n + $_  1; # n! / (nr)!
$c /= $_; # c / r!
}
$sum += $c;
}
return $sum;
# INVALID FLAG
} else {
die "Invalid Flag: '$f'"
}
# SPECIFIED R 
} else {
# NO REPETITION
if (!$f) {
die "R must be 0 < R < N ($n) if there is no repetition"
if ($r < 0  $r > $n);
my $c = 1;
if ($r > $n/2) { $r = $n  $r } # Take advantage of 2)
for (1..$r) {
$c *= $n; # n! / (nr)!
$c /= $_; # c / r!
}
return $c;
# REPETITION
} elsif ($f eq 'r') {
die "R ($r) must be 0 < R if there is repetition" if ($r < 0);
$n += $r  1;
my $c = 1;
if ($r > $n/2) { $r = $n  $r } # Take advantage of 2)
for (1..$r) {
$c *= $n; # n! / (nr)!
$c /= $_; # c / r!
}
return $c;
# INVALID FLAG
} else {
die "Invalid Flag: '$f'"
}
}
}
####################################################################
# PICK (
# N, # Size of Master Array
# R, # Length of SubSequence
# F # Repetition Flag
# )
####################################################################
sub Pick {
my $n = shift; die "N ($n) must be a positive integer" if $n < 1;
my $r = shift;
my $f = shift  '';
# SUMMATION ACROSS R 
if ($r eq '*') {
# NO REPETITION
if (!$f) {
my $sum = 0;
for my $r (0..$n) {
my $p = 1;
$p *= $_ for ($n$r+1..$n); # n! / (nr)!
$sum += $p;
}
return $sum;
# REPETITION
} elsif ($f eq 'r') {
my $sum = 0;
for my $r (0..$n) {
$sum += $n ** $r;
}
return $sum;
# INVALID FLAG
} else {
die "Invalid Flag: '$f'"
}
# SPECIFIED R 
} else {
# NO REPETITION
if (!$f) {
my $p = 1;
$p *= $_ for ($n$r+1..$n); # n! / (nr)!
return $p;
# REPETITION
} elsif ($f eq 'r') {
return $n ** $r;
# INVALID FLAG
} else {
die "Invalid Flag: '$f'"
}
}
}
*Combination = *Choose;
*Permutation = *Pick;
1;
=pod
=head1 NAME
Math::Combinatorics  Pick and Choose combinatorics functions
=head1 SYNOPSIS
use Math::Combinatorics;
use strict;
my @master = ( 1, 2, 3, 4, 5 ); # The master array
my $n = @master; # Size of the master
my $r = rand * $n # Size of the subset
$Combinations = Choose($n, $r) # Specific R, No Repetition.
# C = N! / ((NR)! * R!)
# O($r)
$Combinations = Choose($n, 1) # Sum of R's, No Repetition
# C = 2^N
# O(1)
$Combinations = Choose($n, $r, 'r') # Specific R, Repetition
# C = (N+R1)! / ((N1)! * R!)
# O($r)
$Combinations = Choose($n, 1, 'r') # Sum of R's, Repetition.
# C = Sum of Chooses over R
# O($r~2/2 + $r/2)
$Combinations = Combination($n, $r) # &Combination == &Choose
$Permutations = Pick($n, $r) # Specific R, No Repetition.
# P = N! / (NR)!
# O($r^2/2 + $r/2)
$Permutations = Pick($n, 1) # Sum of R's, No Repetition
# P = Sum of Picks over R.
# O(1)
$Permutations = Pick($n, $r, 'r') # Specific R, Repetition
# P = N^R
# O(1)
$Permutations = Pick($n, 1, 'r') # Sum of R's, Repetition.
# P = Sum of Pics over R.
# O($r)
$Permutations = Permutation($n, $r) # &Permutation == &Pick
=head1 DESCRIPTION
This module only includes two functions, Pick and Choose.
Pick returns RPermutations of a set, that is, subsequences of a
set. Think, "How many words can I make with my tiles in Scrabble?"
Lots, you rearrange the letters and get new words. For formality,
&Pick has been aliased to &Permutation. You may use them
interchangably.
Choose returns RCombinations, that is, subsets. Order is
irrelevant. Think, "How many hands can I make with my cards in
5Card Stud Poker?". One, your hand is the same no matter what
order you put the cards in. For formality, Choose has been
aliased to &Combination. You may use them interchangably.
Each function has 2 flags, leading to 4 execution modes each, for a
total of 8 different 'functions' that the module can currently
perform.
Normally a function executes without allowing repetitions, but by
setting $f to 'r' repetitions will be permitted. $f is optional,
and will default to False ( no repetition ).
The other is more of a pseudoflag, $r. Normally $r should be
0 <= $r <= $n. However, as a special case, if $r is set to '*', the
summation of all combinations (or permutations) for all $r = 1..$n
will be performed, returning the total count of subsets
(or subsequences) of a Master array.
=head1 BUGS & WARNINGS
This seems a rather tiny file to release as module, and
could probably do with some expansion. If you have anything
you would like to see in this module or, of course, find an
error, let me know. If you have code you think belongs here,
let me know and I'll toss it in and put you in the credits.
This module doesn't export anything by default. You should pick
your two combinatorics functions by hand by calling use with
the 'formal' or 'common' tags.
use Math::Combinatorics qw(:common); # &Pick & &Choose
use Math::Combinatorics qw(:formal); # &Permutation & &Combiantion
=head1 VERSION
25 April 2001  Version 0.91 (1.0 Release Candidate B)
=over4
=item * Provided aliases of Combination for Choose and
Permutation for Pick.
=item * Reduced lines to 70 characters from 71.
=back
22 April 2001  Version 0.91 (1.0 Release Candidate A)
=over4
=item * Original Public Beta
=back
=head1 CREDITS
Copyright (c) 2001  Alexander (Lexicon) Scouras  Anapraxis.Net
All rights reserved.
For current release information see CPAN or
F<http://code.anapraxis.net>.
Bug reports or comments may be sent to F<lexicon@anapraxis.net>
This program is free software.
It may be distributed and/or modified under either the
Perl Artistic License or the GNU General Public License.
=cut
