For testing purposes it is often useful to generate permutations on a list through an iterator (like tye's Derangements iterator. Sometimes we need random permutations, but for some applications it is necessary that there is an order in the generated permutations.

I am using the following order on permutations. If the list to be permuted consists of increasing digits, then the permutations are numbered such that the concatenated digits of each permutation would give monotonically increasing values.

Like that: 

$ perl -w permute_n.pl 3                    
0: 1,2,3
1: 1,3,2
2: 2,1,3
3: 2,3,1
4: 3,1,2
5: 3,2,1

[download]

More control compared to an iterator is given by the 'random-access' permutation 'accessor' that can generate the n-th ordered permutation directly (thus 'random access').

For example you might want to use every n-th permutation or simply step backwards through the permutations. Maybe you are interested only in permutations on prime number positions...

For such purposes the following program allows flexible access. If the list of elements is large, it can avoid a lot wasteful calculating.

For example generate the first, third, fifth, and then the fifth last, third last, and the last permutation of the list of numbers 1..18:

$ perl -w permute_n.pl 18 0 2 4 -5 -3 -1
0: 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18
2: 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,17,16,18
4: 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,18,16,17
6402373705727995: 18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,1,3,2
6402373705727997: 18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,2,3,1
6402373705727999: 18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1

[download]

On the other hand, if all permutations are needed, any iterator would probably outperform this generator.

Enjoy.

#!/usr/bin/perl
#
# demo application for 'generate the n_th permutation of a list'
#
# permute_n [set_size [permutation_numbers]]
#
# parameters:
#   set_size 
#     sets the size of the set to be used for permutation generation.
#     The set is built from numbers starting at 1.
#
#   permutation_number
#    selects the permutation to be generated.
#    Negative values select from the end.
#
# defaults are:
#     set size=4
#     (none)=generate all permutations
#
# The algorithm allows for 'random-access' generation of permutations.
# In order to generate the last permutation, it is NOT necessary
# to cycle through all preceeding permutations.
#
# (c) Heiko Eißfeldt, 2008
#
use strict;
use integer;
use warnings;
use bigint;

my @object;

my $size = shift || 4;
my @perms = @ARGV;
my $last = factorial($size);

if (defined $perms[0]) {
    for my $n (@perms) {
        if ($n < 0) {
            $n += $last;
        }
        @object = (1..$size);
        permute_n($n, \@object);
    }
} else {
    for my $which_permutation (0 .. $last - 1) {
        @object = (1..$size);
        permute_n($which_permutation, \@object);
    }
}

sub permute_n
{
    my ($which_permutation, $object_ref) = @_;
    my $size = scalar @{$object_ref};
    my $current_fac = factorial($size - 1);
    my $perm = $which_permutation;
    for my $level (reverse 2..$size) {
        my $offset = $size - $level;
        my $to_front = $perm / $current_fac;

        $perm = $perm % $current_fac;
        $current_fac = $current_fac / ($level-1);
        next if ($to_front == 0);

        # move position to front
        @{$object_ref}[$offset..$size-1]
          = ($object_ref->[$offset+$to_front],
              @{$object_ref}[$offset .. $offset+$to_front-1],
             @{$object_ref}[$offset+$to_front+1 .. $size-1],
             );
    }
    print "$which_permutation: ", join(q{,}, @{$object_ref}), "\n" or 
+die "print $!\n";

    return;
}

sub factorial
{
    my ($n) = @_;
    my $result = 1;
    for my $fac (2..$n) {
        $result *= $fac;
    }
    return $result;
}

[download]

Back to Cool Uses for Perl