$ 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

##</code><code>##

$ 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

##</code><code>##

#!/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;
}