permute.pl

#!/usr/bin/perl -w
use strict;

=head2 permute($arrayref)

Gives all permutations of a given set of elements. Stolen straight out of B. Heap's HeapPermute algorithm.

    $ fxpr 'permute [0..1]'
    [ 0 1 ]
    [ 1 0 ]
    $ fxpr 'permute [0..2]'
    [ 0 1 2 ]
    [ 1 0 2 ]
    [ 2 0 1 ]
    [ 0 2 1 ]
    [ 1 2 0 ]
    [ 2 1 0 ]

=cut

sub permute {
	my ($alphabet, $n, $current_set, $sets) = @_;

	$sets = [] unless defined $sets;
	$current_set = [ @{$alphabet} ] unless defined $current_set;
	$n = @{$alphabet} unless defined $n;

	if ($n == 1) {
		push @{$sets}, [ @{$current_set} ];
	} else {
		foreach my $i (0 .. ($n-1)) {
			&permute($alphabet, $n-1, $current_set, $sets);
			if ($n % 2) {
				# n is odd
				($current_set->[0], $current_set->[$n-1]) =
				($current_set->[$n-1], $current_set->[0]);
			} else {
				# n is even
				($current_set->[$i], $current_set->[$n-1]) =
				($current_set->[$n-1], $current_set->[$i]);
			}
		}
	}

	@{$sets}
}