(Alternative title: "My undying love for.kv
on lists")
Knuth's 'Facsicle 0a' starts with a kind of programmer's cliffhanger:
He moves on to other things without divulging what the unique solution for n = 4 might be. Reading this (on a bus carrying me between cities in Sweden), I flung open a terminal window to write a one-liner to solve the problem. Don't know if Knuth intended to have that effect on the reader, but that's what happened when I read it.
My one-liners are infamously long. Here's what I arrived at:
# Generate all possible permutations of the list @a. The list @prefix
# assists in the recursion, adding its elements before the reordered
# elements of @a.
sub all-possible-orderings(@a, @prefix=[]) {
return [@prefix] unless @a.elems;
return gather for @a.kv -> $k, $v {
my @others = @a[0..^$k, $k^..^*];
take all-possible-orderings(@others, [@prefix, $v]);
}
}
# Returns True if and only if the list @a satisfies the
# Langford property, i.e. each pair of numbers $n has
# exactly $n other numbers between them.
sub langford(@a) {
for 1..@a/2 -> $n {
for @a.kv -> $k1, $v1 {
if $v1 == $n {
for @a[$k1^..^*].kv -> $k2, $v2 {
return False if $v2 == $n != $k2;
}
}
}
}
return True;
}
.join.say for all-possible-orderings([1,1,2,2,3,3]).grep({ langford($_) }).uniq;
This code worked well for n = 3, but for n = 4 it just sat there. Kind of fitting, since the remainder of the Facsicle was about the futility of brute force, more or less. Kind of drove the point home, my PDF reader in the foreground saying things like "A single good idea can reduce the amount of computation by many orders of magnitude", while the perl6
process in a window behind it chewed up all my cycles and all my memory.
So I gave it another go.
# Generates a list of all permutations of the list @candidates
# satisfying the Langford property.
sub langford(@candidates, @slots = [0 xx 2*@candidates]) {
return [@slots] if all @slots;
my @found;
for @candidates -> $c {
for @slots[0..@slots-$c-2].kv -> $k, $v {
if !$v {
if !@slots[$k+$c+1] {
my @new-slots = @slots;
@new-slots[$k, $k+$c+1] = $c, $c;
push @found, langford( (grep { $_ != $c }, @candidates),
@new-slots );
}
last;
}
}
}
return @found;
}
.join.say for langford 1..4;
(moritz++ for the nice line return [@slots] if all @slots;
where I had previously used a grep
.)
Notice how this solution, besides being faster, is also shorter, simpler, and more fun at parties. It does the n = 4 case in a jiffy, and the n = 7 and n = 8 cases with some hesitation. It could probably easily go higher than that without blowing the stack, but time starts to become the limiting factor at this point.
Anyway, a fun afternoon experiment. It's 2009, and I'm solving combinatorics puzzles in Perl 6. Cool!
(Oh, and it's 23421314, in case you were wondering too.)
if Knuth intended to have that effect (Score:1)
Bill
# I had a sig when sigs were cool
use Sig;
left-to-right recursive generation is very fast (Score:2)
Use a function that takes a position and a set of as-yet-unplaced numbers. The position is the first slot that might be free. The function finds the first slot that really is free, and then for each unplaced number tries to place it (also trying to place its pair k+1 positions later). If there are additional unplaced numbers recurse, else you have a solution. (To eliminate the reversed pairs, only print the result if the first number is lower than the last.) You have to remove the the numbers that were
Re: (Score:1)
Use a function that takes a position and a set of as-yet-unplaced numbers. The position is the first slot that might be free. The function finds the first slot that really is free, and then for each unplaced number tries to place it (also trying to place its pair k+1 positions later). If there are additional unplaced numbers recurse, else you have a solution.
You've just described my second, non-bruteforce solution given in the post. Did you read it?
(To eliminate the reversed pairs, only print the result if the first number is lower than the last.)
Nice idea. Didn't think of that.
I implemented that on the train last night (but then didn't bring it with me today). It found the unique solutions for 3 and 4, found that there were no solutions for 5 and 6, and found a dozen or two (I didn't count them) solutions for 7 - all of these cases came back with no noticeable delay.
Then I conclude that your algorithm was not in Perl 6. :)
Re: (Score:2)
[...]
You've just described my second, non-bruteforce solution given in the post. Did you read it?
Well, I looked at it, but didn't figure out what it was doing.
[...] - all of these cases came back with no noticeable delay.
Then I conclude that your algorithm was not in Perl 6. :)
Nope Perl 5 (and that's probably why I didn't figure out what your solution was doing :-)
Re: (Score:1)
[...]
You've just described my second, non-bruteforce solution given in the post. Did you read it?
Well, I looked at it, but didn't figure out what it was doing.
[...] - all of these cases came back with no noticeable delay.
Then I conclude that your algorithm was not in Perl 6. :)
Nope Perl 5 (and that's probably why I didn't figure out what your solution was doing :-)
If you find the tuits, it would be interesting to hear what you conclude from a comparison of our two approaches.
Of course, if some particular piece of strange syntax blocks such an endeavor, I'd be very happy to explain the syntax rather than have you trawl the synopses for enlightenment.
Re: (Score:2)
[...]
You've just described my second, non-bruteforce solution given in the post. Did you read it?
Well, I looked at it, but didn't figure out what it was doing.
[...] - all of these cases came back with no noticeable delay.
Then I conclude that your algorithm was not in Perl 6. :)
Nope Perl 5 (and that's probably why I didn't figure out what your solution was doing :-)
If you find the tuits, it would be interesting to hear what you conclude from a comparison of our two approaches.
Of course, if some particular piece of strange syntax blocks such an endeavor, I'd be very happy to explain the syntax rather than have you trawl the synopses for enlightenment.
The tuits will take a couple of days. I'll post my perl5 code then too for comparison.
Re: (Score:2)
Also, I think yours is still algorithmically slower than mine. You try every number in every place. I try every number in the first place, then trying the remaining numbers in the remaining places (not all places).
So, the comparison here is not between Perl5 and Perl6, but coding with always using array ops, and sometimes using individual elements.
I have to go to 9 and 10 to get a