#!/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]