recursively generating permutations

spurperl has asked for the wisdom of the Perl Monks concerning the following question:

Fellow monks,

Following my attempts to write elegant "Lispy" code in Perl I came upon the interesting algorithm of recursive generation of permutations. I.e. for (1 2 3) the permutations are (1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1).

Like many problems, though at first seemingly difficult, recursion is a powerful technique for extremely elegant solutions.

All permutations of N elements can be expressed in terms of all permutations of N - 1 elements. Having a set of N elements, we take one of them and append it to all the permutations of the remaining N - 1 elements. Repeating it for every element of N gives us all permutations of N elements. Unsurprisingly, it fits well into the known formula of the amount of permutations of N elements: the factorial of N, N!.

This is expressed very succinctly and elegantly by the following Lisp code (8 lines without comments / documentation):


(defun permutations (bag)
  "Return a list of all the permutations of the input."
  ;; If the input is nil, there is only one permutation:
  ;; nil itself
  (if (null bag) 
      '(())
      ;; Otherwise, take an element, e, out of the bag.
      ;; Generate all permutations of the remaining elements,
      ;; And add e to the front of each of these.
      ;; Do this for all possible e to generate all permutations.
      (mapcan #'(lambda (e)
                  (mapcar #'(lambda (p) (cons e p))
                          (permutations
                            (remove e bag :count 1))))
              bag)))
[download]

Lisp's command of lists shines in this example, and replicating the code in Perl as succinctly (without sacrificing readability) is quite challenging. What I paste below is a straightforward implementation, without delving too much into succinctness.

First, lets define a couple of helper functions:

sub is_empty_list
{
    return @{$_[0]} == 0;
}


# remove ($what, $list, $howmany)
#
# Removes $what from the list $list up to $howmany times.
# If $howmany is not provided, removes all occurrences of $what.
#
sub remove
{
    my $what = $_[0];
    my $list = $_[1];
    my $howmany = defined $_[2] ? $_[2] : -1;
    my @ret = ();
    
    foreach my $elem (@{$list})
    {
        push @ret, $elem unless ($elem == $what and $howmany-- > 0);
    }

    return \@ret;
}
[download]

remove would look good if it were not for the argument collection. Named arguments with support for optional arguments that have default values would be of great help. Happily, it will be provided in Perl6, and this function will look much better.

Now, to the permutations function itself:

sub permutations 
{
    my $bag = $_[0];
    
    if (is_empty_list($bag))
    {
        return [[]];
    }
    
    my $perms = [];

    foreach my $elem (@$bag)
    {
        foreach my $perm (@{permutations(remove($elem, $bag, 1))})
        {
            unshift(@{$perm}, $elem);
            push(@{$perms}, $perm);
        }
    }
    
    return $perms;
}
[download]

This could have been made much nicer if Perl had a sane way to write nested maps... Also, it seems to me that unshift and push would be much better understood as prepend and append.

Any ideas/suggestion to make this code more elegant ?

Comment on recursively generating permutations Select or Download Code

Replies are listed 'Best First'.
Re: recursively generating permutations by Roy Johnson (Monsignor) on Aug 19, 2005 at 11:29 UTC
Did you run across How do I permute N elements of a list? What is difficult about nesting map? The only trick is to assign $_ to some other variable within the (outer) body block before calling the inner map. Caution: Contents may have been coded under pressure.	[reply]
Re^2: recursively generating permutations by spurperl (Priest) on Aug 19, 2005 at 11:36 UTC
Nesting maps isn't difficult, but the idiom for using the $_ of the outer map in the inner map is ugly. A lambda-like idiom with a named $_ would be nicer. Disclaimer: as can be seen from my previous posts, this is not a criticism of Perl (which is my favorite programming language), but rather ruminations on how to make the code more natural. After writing a lot of code, we all start getting a "feel" for "elegant" code. This is what I'm trying to explore with various programming problems.	[reply]
Re: recursively generating permutations by tlm (Prior) on Aug 19, 2005 at 11:35 UTC
I don't know how much of an improvement this is; at least it doesn't use helper functions, for what that's worth: `sub perms { my $arr = shift; if ( !@$arr ) { return ( [] ); } else { return map { my @a = @$arr; my $e = splice @a, $_, 1; map [ $e, @$_ ], perms( \@a ) } ( 0..$#$arr ); } }` [download] Update: I changed the original to use nested maps (my original attempt to do this had a pesky bug, so I posted the working for + push version). I see that Roy Johnson had the same idea. the lowliest monk	[reply] [d/l]
Re^2: recursively generating permutations by Roy Johnson (Monsignor) on Aug 19, 2005 at 11:42 UTC
Mapifying the else block (untested): `else { return map { my @a = @$arr; my $e = splice @a, $_, 1; map [ $e, @$_ ], perms( \@a ); } 0..$#$arr; }` [download] Caution: Contents may have been coded under pressure.	[reply] [d/l]
Re: recursively generating permutations by rnahi (Curate) on Aug 19, 2005 at 11:20 UTC
You should look at Algorithm::Loops, and, through Super Search, to the following PM links: Permutations and combinations Permuting with duplicates and no memory Non- recursive permutation of arrays.	[reply]
Re^2: recursively generating permutations by spurperl (Priest) on Aug 19, 2005 at 11:33 UTC
Hi rnahi, Thanks for the many links, but it's not exactly it. The first link you give (Permutations and combinations) talks about a different kind of permutations. The second presents a non-recursive algorithm for lexicographic order permutations. The third's title says it all.	[reply]
Re: recursively generating permutations by Roger (Parson) on Aug 19, 2005 at 12:28 UTC
If you like to write LISPish code, why don't you checkout LISP? It supports lambda, mapcar, etc. It allows you to almost do a direct translation of your LISP code to Perl.	[reply]
Re: recursively generating permutations by tlm (Prior) on Aug 20, 2005 at 01:23 UTC
Here's another "recursive" solution. :-) `sub perms { die "Bad args\n" unless @_; my $p = @_; my $i = 2; $p /= $i++ until $p % $i; return @_ if $i > @{ $_[ 0 ] }; push @_, [ @{ $_[ -1 ] } ]; @{ $_[ -1 ] }[ 0..$i-1 ] = reverse @{ $_[ -1 ] }[ 0..$i-1 ]; goto &perms; }` [download] the lowliest monk	[reply] [d/l]
Re: recursively generating permutations by BrowserUk (Patriarch) on Aug 20, 2005 at 05:05 UTC
Beauty is in the eye of the beholder, but I prefer this arrangement of the same algorithm: `#! perl -slw use strict; sub permutations { return !@_ ? [] : map{ my( $elem, $n ) = ( $_, 1 ); map{ [ $elem, @$_ ] } permutations( grep{ !/$elem/ or !$n-- } @_ ); } @_; } print @$_ for permutations @ARGV;` [download] Or better, this one: `sub permutations { return !@_ ? [] : map{ my $next = $_; map{ [ $_[ $next ], @$_ ] } permutations( @_[ 0 .. $_-1, $_+1 .. $#_ ] ); } 0 .. $#_; } print @$_ for permutations @ARGV;` [download] Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal? "Science is about questioning the status quo. Questioning authority". The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.	[reply] [d/l] [select]
Re: recursively generating permutations by Anonymous Monk on May 12, 2008 at 04:27 UTC
ali	[reply]