mdunnbass has asked for the wisdom of the Perl Monks concerning the following question:
Greetings esteemed Monks,
Forgive me for I have sinned, it has been...... ~13 years since my last seeking of wisdom.
I'm trying to write myself a little script to read in a file of multiple choice questions, permute their A-D answers, and write it all back out to files. SO far, everything is under control and going well except the actual permuting part of it all. I've found a handful of discussions on how to do this in perl, here and elsewhere, and I'm not so much asking how to do it. I found a lovely little recursive sub on RosettaCode that works beautifully. But I would like to know how 1 aspect of the code is functioning.
So, the sub in question is:
sub permutation {
my ($perm,@set) = @_;
print "$perm\n" || return unless (@set);
permutation($perm.$set[$_],@set[0..$_-1],@set[$_+1..$#set]) foreac
+h (0..$#set);
}
my @input = (qw/a b c d/);
permutation('',@input);
I've thrown all kinds of say statements in to track each aspect of the code as it runs, and I can't figure out how it initiates a second permutation.
The first permutation arises from essentially shifting the first element of @set and catenating it onto $permute, one element at a time. OK, great, I get that, it's pretty straightforward. But then, what gets me is the following:
After the first permutation has completed, $perm = '1234' and @set is empty. Dumper tells me that $_ has been = 0 since it was initialized. When the code reaches this line at this point:
permutation($perm.$set[$_],@set[0..$_-1],@set[$_+1..$#set]) foreach (0
+..$#set);
$perm is now equal to '124,' @set = 3, and $_ = 1.
How did that recursive call to the permutation pull 3 out of the string and put it in set? The closest thing to a coherent idea I could come up with was that maybe $set[$_]is now undefined, so catenating that to permute actually acted like catenating a -1 and popped the -1 element out of it? But if that's the case, how did that get added into @set?
Or do I have it all wrong? Am I looking in the wrong place?
Any insights would be greatly appreciated. Thanks. mdunnbass
Re: Please help me understand this permutation sub?
by choroba (Cardinal) on Dec 08, 2020 at 21:46 UTC
|
Maybe printing the @set with the recursion depth shown as indentation can enlighten you?
#!/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);
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
| [reply] [d/l] [select] |
|
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.
| [reply] |
|
> 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.
| [reply] [d/l] |
Re: Please help me understand this permutation sub?
by LanX (Saint) on Dec 08, 2020 at 21:45 UTC
|
I'm not sure I understand your problem.
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]) )
Here some code to demonstrate it:
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
update
expanded explanation
| [reply] [d/l] [select] |
|
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
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
| [reply] [d/l] [select] |
|
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
}
}
}
}
(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
| [reply] [d/l] [select] |
|
|
3:ab # for @set=(c,d); return to 2
4:abc # ...
4:abd # ...
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
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.
| [reply] [d/l] [select] |
|
Re: Please help me understand this permutation sub?
by GrandFather (Saint) on Dec 09, 2020 at 05:56 UTC
|
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);
}
}
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.
Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond
| [reply] [d/l] |
|
| [reply] |
Re: Please help me understand this permutation sub?
by BillKSmith (Monsignor) on Dec 09, 2020 at 04:30 UTC
|
Your sub is confusing. Note that the return statement is never executed. (You can replace it with die.) The code requires you to know exactly what happens when @set becomes empty. Are you sure you know the values of the special variable $#set, the range operator 0..$#set, and how foreach handles that? The code below avoids these issues, but is equivalent. At first, my logic appears more complicated, but I think you will find it easier to follow. Add the same debugging if you wish. Once you see what is going on, you should be able to see how the terse original is really the same thing.
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);
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.
| [reply] [d/l] |
|
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.
| [reply] |
Re: Please help me understand this permutation sub?
by Leudwinus (Scribe) on Dec 10, 2020 at 01:52 UTC
|
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
| [reply] |
|
|