Perl Cd Bookshelf [Electronic resources] نسخه متنی

4.20. Program: permute

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 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.

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 Recipe 10.3. This technique is so useful that there''s a
standard module that will handle the value caching for you. If you
just had a regular factorial function that didn''t have its own
caching, you could add caching to the existing function this way:

use Memoize;
memoize("factorial");

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 0^th element, then the second element
from the remaining list, then the 0^th
element, then the first, then the 0^th."

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.1. See Also

unshift and splice in
perlfunc(1) or Chapter 29 of
Programming Perl; the sections discussing
closures in perlsub(1) and
perlref(1) and Chapter 8 of
Programming Perl; Recipe 2.6; Recipe 10.3