#!/usr/bin/perl
use strict;
use warnings;

sub permutation {
    my ($perm, $depth, @set) = @_;
    print "\t" x $depth, "@set\n";
    print "$perm\n" unless @set;
    permutation($perm . $set[$_],
                $depth + 1,
                @set[ 0      .. $_ - 1],
                @set[ $_ + 1 .. $#set]
    ) for 0 .. $#set;
}

my @input = (qw/a b c d/);
permutation("", 1, @input);
[download]

Thanks choroba,

Your print statements are very much in line with what LanX posted as well. Both of them make the recursion very much more obvious to me. But my problem is in 'backing up' the recursion, for lack of a better way to put it. In my reply to LanX above, I laid out the exact spot that is tripping me up. There's something about going from the first completed permutation, resulting in $perm = abcd, to the next line of output, where the $perm is now abd, missing the c.

> There's something about going from the first completed permutation, resulting in $perm = abcd, to the next line of output, where the $perm is now abd, missing the c.

In short: Level4 calls Level5 only one time, always! This means 4 returns to Level3 immediately after 5 returns.

And Level3 calls Level4 for the second time, but now with $perm="ab"."d" .

I hope it's clearer now, have a look at the extensive explanations in my other replies, especially the nested loop analogy.

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

This

permutation($perm.$set[$_],@set[0..$_-1],@set[$_+1..$#set]) foreach (0..$#set);

• adds element at pos $_ to the new $perm ( i.e. $perm = $perm.$set[$_] )
• the new @set is composed by the slices of the remaining elements except position $_. The sliced arrays are flattened to elements and all swallowed by the new @set. (i.e. @set = (@set[0..$_-1],@set[$_+1..$#set]) )

C:/Perl_524/bin\perl.exe -w d:/tmp/pm/permute.pl 
 1:
  2:a
   3:ab
    4:abc
     5:abcd
abcd
    4:abd
     5:abdc
abdc
   3:ac
    4:acb
     5:acbd
acbd
    4:acd
     5:acdb
acdb
   3:ad
    4:adb
     5:adbc
adbc
    4:adc
     5:adcb
adcb
  2:b
   3:ba
    4:bac
     5:bacd
bacd
    4:bad
     5:badc
badc
   3:bc
    4:bca
     5:bcad
bcad
    4:bcd
     5:bcda
bcda
   3:bd
    4:bda
     5:bdac
bdac
    4:bdc
     5:bdca
bdca
  2:c
   3:ca
    4:cab
     5:cabd
cabd
    4:cad
     5:cadb
cadb
   3:cb
    4:cba
     5:cbad
cbad
    4:cbd
     5:cbda
cbda
   3:cd
    4:cda
     5:cdab
cdab
    4:cdb
     5:cdba
cdba
  2:d
   3:da
    4:dab
     5:dabc
dabc
    4:dac
     5:dacb
dacb
   3:db
    4:dba
     5:dbac
dbac
    4:dbc
     5:dbca
dbca
   3:dc
    4:dca
     5:dcab
dcab
    4:dcb
     5:dcba
dcba

Compilation finished at Tue Dec  8 22:44:20
[download]

update

expanded explanation

Thanks LanX,

Your added print statements are very similar to what I had been using myself, but far more visually helpful.

My problem stems from this point in the output:

 1:
  2:a
   3:ab
    4:abc
     5:abcd
abcd
    4:abd
     5:abdc
[download]

I understand the 1:-5: lines, and the bare abcd. I get how they were generated and where they came from. But I am not following the logic of how it then goes from $perm = abcd and @set=[] to $perm = abd and @set=[c], or how $level went from 5 back to 4.

Any way you would be able to clarify that?

Thanks!

Matt

Hi

here new code to highlight whats happening.

Please note the recursion here is effectively used to implement 4 nested loops, see second part of the code

#https://perlmonks.org/?node_id=11124854

use strict;
use warnings;
use Data::Dump qw/pp dd/;
use 5.10.0;


sub permutation {
    my ($perm,@set) = @_;

    my $level  = 5 - @set;
    my $marker = " "x$level . "$level: " ;
    say "$marker ENTER perm='$perm' set=(@set)";

    unless (@set) {
        say "$marker RESULT: $perm";
    } else {
        permutation( $perm.$set[$_],
                     @set[0..$_-1], @set[$_+1..$#set]
                   ) for (0..$#set);
    }

    say "$marker RETURN";
    return;
}

my @input = (qw/a b c d/);

permutation('',@input);


my @set = @input;
my $perm = "";

for (0..3) {                            # level 1
    my @set =@set;
    my $perm = $perm . splice @set,$_,1;
    for (0..2) {                        # level 2
        my @set =@set;
        my $perm = $perm . splice @set,$_,1;
        for (0..1) {                    # level 3
            my @set =@set;
            my $perm = $perm . splice @set,$_,1;
            for (0..0) {                # level 4
                my @set =@set;
                my $perm = $perm . splice @set,$_,1;

                say $perm;              # level 5
            }
        }
    }
}
[download]

(shortened) output

-*- mode: compilation; default-directory: "d:/tmp/pm/" -*-
Compilation started at Wed Dec  9 13:22:51

C:/Perl_524/bin\perl.exe -w d:/tmp/pm/permute.pl 
 1:  ENTER perm='' set=(a b c d)
  2:  ENTER perm='a' set=(b c d)
   3:  ENTER perm='ab' set=(c d)
    4:  ENTER perm='abc' set=(d)
     5:  ENTER perm='abcd' set=()
     5:  RESULT: abcd
     5:  RETURN
    4:  RETURN
    4:  ENTER perm='abd' set=(c)
     5:  ENTER perm='abdc' set=()
     5:  RESULT: abdc
     5:  RETURN
    4:  RETURN
   3:  RETURN
   3:  ENTER perm='ac' set=(b d)
    4:  ENTER perm='acb' set=(d)
     5:  ENTER perm='acbd' set=()
     5:  RESULT: acbd
     5:  RETURN
    4:  RETURN
    4:  ENTER perm='acd' set=(b)
     5:  ENTER perm='acdb' set=()
     5:  RESULT: acdb
     5:  RETURN
    4:  RETURN
   3:  RETURN
### shortened ...

### Nested Loops
abcd
abdc
acbd
acdb
adbc
adcb
bacd
badc
bcad
bcda
bdac
bdca
cabd
cadb
cbad
cbda
cdab
cdba
dabc
dacb
dbac
dbca
dcab
dcba

Compilation finished at Wed Dec  9 13:22:51
[download]

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

The variables at each call frame level are independent and reestablished after returning from a sub call.

The for loop at level 3 calls the recursion at level 4 each time twice before returning to level 2

   3:ab    # for @set=(c,d); return to 2 

    4:abc  # ...

    4:abd  # ...
[download]

Level 4 calls level 5 once and returns to 3

 
    4:abc    # for @set=(d); return to 3

     5:abcd  # print result; return to 4


# ... later


    4:abd    # for @set=(c); return to 3

     5:abdc  # print result; return to 4
[download]

update

> But I am not following the logic of how it then goes from $perm = abcd and @set=[] to $perm = abd and @set=c, or how $level went from 5 back to 4.

• ...
• 5 printed "abcd" and returned to 4;
• 4's loop over (d) was exhausted and returned to 3;
• 3 looping over (c,d) stepped to the second element and called 4, i.e. perm("abd", "c")
• 4 loops over (c) and calls 5;
• 5 printed "abdc" and returned to 4;
• ...

HTH :)

update

Bill's remark is spot on, the explicit "return" is fake, the real return happens implicitly after the loop.

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

I find it helps to unpack this sort of code and figure out names for intermediate variables. It also helps to add a little white space.

use strict;
use warnings;

my @input = (qw/a b c d/);

permutation('', @input);

sub permutation {
    my ($perm, @set) = @_;
    
    if (!@set) {
        print "$perm\n";
        return;
    }
        
    for my $partition (0 .. $#set) {
        my $firstEnd = $partition - 1;
        my $lastStart = $partition + 1;
        my @newSet = @set[0 .. $firstEnd];
        
        push @newSet, @set[$lastStart .. $#set];
        permutation($perm . $set[$partition], @newSet);
    }
}
[download]

This is a recursive algorithm (the function calls itself). With recursion there are two important parts - the recursion process and the stop recursing condition. The stop recursing condition is that the @set parameter is empty. In the stop condition processing $perm is printed (the result of the current recursive branch) and the function returns.

For the recursive processing the loop takes each element from @set and concatenates it on to the passed in $perm then passes the new string and @set with the current element removed down to the next recursion level. Because each recursion level removes one element from @set and tacks it onto $perm eventually all elements are removed from @set and tacked onto $perm and each of the ordering of the passed in @set are generated.

Hi GrandFather,

Thanks for the explanation. I was clear on what the catenation of $perm was doing and the splicing of @set, but my brain got lost in the nested recursions. But thanks for trying to clear it up for me.

use strict;
use warnings;

sub permutation {
    my ($perm,@set) = @_;
    unless(@set) {
      print "$perm\n" || die("Print error:$!");
    }
    else {
      permutation($perm.$set[$_], (@set[0..$_-1],@set[$_+1..$#set]) )
            foreach (0..$#set);
    }
    return;
}

my @input = (qw/a b c d/);
permutation('',@input);
[download]

UPDATE: I now believe that you original code had a serious error and it was only by pure luck that it worked at all. The '||' operator before the 'return' should be an 'and' operator. With this change, function appears to work exactly the same. The difference is that now, the 'return' is executed immediately after every print. The behavior of 'foreach' in this special case is no longer an issue. Note that the lower priority operator 'and' instead of '&&' is needed to make the string bind to the print rather than the '&&'. The reverse logic is needed because print returns a true value on success. I have never seen a failure.

Hi Bill,

Thanks for the clarification in your code. I was clear on $#set and 0..$#set, but I got lost in the nested recursions. They went one level deeper than my brain was keeping track of. LanX did a great job of clearing up my confusion, above.

It looks like those more knowledgeable than me have already set you on the right path but I too, struggle with recursion and coming up with permutations. I finally put together a small script in Perl to help with this and wrote about it here if you're interested.

Gratias tibi ago
Leudwinus