Have you ever wanted to generate all possible permutations of an array or to execute some code for every possible permutation? For example:

% 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 grows big 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.

He also uses a time-saving technique called
*memoizing*
. The idea is that a function that
always returns a particular answer when called with a particular
argument memorizes that answer. That way, the next time it’s
called with the same argument, no further calculations are required.
The `factorial`

function uses a private array
`@fact`

to remember previously calculated factorial
values as described in Section 10.3.

You call `n2perm`

with two arguments: the
permutation number to generate (from `0`

to
`factorial(N)`

, where N is the size of your array)
and the subscript of the array’s last element. The
`n2perm`

function calculates directions for the
permutation in the `n2pat`

subroutine. Then it
converts those directions into a permutation of integers in the
`pat2perm`

subroutine. The directions are a list
like `(0`

`2`

`0`

`1`

`0)`

, which means:
“Splice out the 0th element, then the second element from the
remaining list, then the 0th element, then the first, then the
0th.”

Example 4-4. mjd-permute

#!/usr/bin/perl -w # mjd_permute: permute each word of input use strict; 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 byinto # 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(@_)); }`n2pat()`

`unshift`

and `splice`

in
*perlfunc*(1) or Chapter 3 of
*Programming Perl*;
the sections discussing closures
in *perlsub*(1) and *perlref*(1) and Chapter 2 of *Programming Perl*; Section 2.7; Section 10.3

Start Free Trial

No credit card required