Program: permute (Perl Cookbook, 2nd Edition)

4.20. Program: permute

% echo man bites dog | permute
dog bites man
bites dog man
dog man bites
man dog bites
bites man dog
man bites dog

The number of permutations of a set is the factorial of the size of the set. This number grows extremely fast, so you don't want to run it on many permutations:

Set Size            Permutations
1                   1
2                   2
3                   6
4                   24
5                   120
6                   720
7                   5040
8                   40320
9                   362880
10                  3628800
11                  39916800
12                  479001600
13                  6227020800
14                  87178291200
15                  1307674368000

Doing something for each alternative takes a correspondingly large amount of time. In fact, factorial algorithms exceed the number of particles in the universe with very small inputs. The factorial of 500 is greater than ten raised to the thousandth power!

use Math::BigInt;
sub factorial {
    my $n = shift;
    my $s = 1;
    $s *= $n-- while $n > 0;
    return $s;
}
print factorial(Math::BigInt->new("500"));
+1220136... (1035 digits total)

The two solutions that follow differ in the order of the permutations they return.

The solution in Example 4-3 uses a classic list permutation algorithm used by Lisp hackers. It's relatively straightforward but makes unnecessary copies. It's also hardwired to do nothing but print out its permutations.

Example 4-3. tsc-permute

  #!/usr/bin/perl -n
  # tsc_permute: permute each word of input
  permute([split], [  ]);
  sub permute {
      my @items = @{ $_[0] };
      my @perms = @{ $_[1] };
      unless (@items) {
          print "@perms\n";
      } else {
          my (@newitems,@newperms,$i);
          foreach $i (0 .. $#items) {
              @newitems = @items;
              @newperms = @perms;
              unshift(@newperms, splice(@newitems, $i, 1));
              permute( \@newitems, \@newperms);
          }
      }
  }

The solution in Example 4-4, provided by Mark-Jason Dominus, is faster (by around 25%) and more elegant. Rather than precalculate all permutations, his code generates the n^th particular permutation. It is elegant in two ways. First, it avoids recursion except to calculate the factorial, which the permutation algorithm proper does not use. Second, it generates a permutation of integers rather than permute the actual data set.

use Memoize;
memoize("factorial");

Example 4-4. mjd-permute

  #!/usr/bin/perl -w
  # mjd_permute: permute each word of input
  use strict;
  sub factorial($);  # forward reference to declare prototype
  
  while (<>) {
      my @data = split;
      my $num_permutations = factorial(scalar @data);
      for (my $i=0; $i < $num_permutations; $i++) {
          my @permutation = @data[n2perm($i, $#data)];
          print "@permutation\n";
      }
  }
  
  # Utility function: factorial with memoizing
  BEGIN {
    my @fact = (1);
    sub factorial($) {
        my $n = shift;
        return $fact[$n] if defined $fact[$n];
        $fact[$n] = $n * factorial($n - 1);
    }
  }
  
  # n2pat($N, $len) : produce the $N-th pattern of length $len
  sub n2pat {
      my $i   = 1;
      my $N   = shift;
      my $len = shift;
      my @pat;
      while ($i <= $len + 1) {   # Should really be just while ($N) { ...
          push @pat, $N % $i;
          $N = int($N/$i);
          $i++;
      }
      return @pat;
  }
  
  # pat2perm(@pat) : turn pattern returned by n2pat( ) into
  # permutation of integers.  XXX: splice is already O(N)
  sub pat2perm {
      my @pat    = @_;
      my @source = (0 .. $#pat);
      my @perm;
      push @perm, splice(@source, (pop @pat), 1) while @pat;
      return @perm;
  }
  
  # n2perm($N, $len) : generate the Nth permutation of $len objects
  sub n2perm {
      pat2perm(n2pat(@_));
  }

4.20. Program: permute

Example 4-3. tsc-permute

Example 4-4. mjd-permute

4.20.1. See Also