http://www.perlmonks.org?node_id=74994
Category: Mathematics
Author/Contact Info Alex Scouras
lexicon@anapraxis.net
http://code.anapraxis.net
Description: This is a module which impliments the Combinatorics functions Pick and Choose. POD for this module is located at http://code.anapraxis.net. Questions and Comments are encouraged, as I intend to release this to the Perl community via CPAN.

In addition to normal functionality, Pick and Choose have flags to calculate with repetition and/or to auto-sum across R for an assumed set of R-Combinations/R-Permutations where 0 <= R <= N.


#!/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) (N-R)! divides out a large portion of N!.
#          2) Choose(N,R) = Choose(N, N-R).
#          3) Choose(N,R,'r') = Choose(N+R-1,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 R-Combinations 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! / (n-r)!
          $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! / (n-r)!
        $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! / (n-r)!
        $c /= $_;                       # c  / r!
      }
      return $c;
      
    # INVALID FLAG
    } else {
      die "Invalid Flag: '$f'"
    }
  }
}


####################################################################
#   PICK   ( 
#            N,   # Size of Master Array
#            R,   # Length of Sub-Sequence
#            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! / (n-r)!
        $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! / (n-r)!
      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! / ((N-R)! * 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+R-1)! / ((N-1)! * 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! / (N-R)!
                                      # 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 R-Permutations of a set, that is, sub-sequences 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 R-Combinations, that is, subsets.  Order is 
irrelevant. Think, "How many hands can I make with my cards in 
5-Card 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 pseudo-flag, $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 sub-sequences) 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