Despite a rather long absence from such matters, we haven't forgotten that
we're still in the midst of reviewing Perl 6 Coding Contest
2011 code
submissions. The t4 task was of the puzzle kind. See the post about counting
t4 configurations
for some overview of the static parts of the problem.
In this post, it's time to get dynamic and look at how to solve actual hex
puzzles. The rest of the problem went like this:
A valid playing move on this board consists of sliding a piece along
its groove, either forwards or backwards. There are a few things which
are *not* allowed:
* Two pieces may never overlap and occupy the same location. (Note that
the above three representations of the board actually denote the same
board; the three sets of grooves intersect each other.)
* A piece may not "push" another piece as it slides; it is simply locked
in by that other piece.
* A piece may not "jump" over another piece as it slides; it is restricted
in its movement by the current positions of the other pieces.
* A piece may not rotate, move sideways, or otherwise leave its groove.
It's perfectly valid for a groove to contain more than one piece (as
long as they don't overlap).
For this problem, we will restrict ourselves to initial board configurations
with a piece at l1 and l2 (written as "l12"). We call this piece the "bullet".
The goal is to slide the bullet to l56, through a valid sequence of moves.
Thus, other pieces may have to be moved in order to get the bullet to l56.
.. .. .. .. ..
.. .. .. .. .. ..
.. .. .. .. ..
start --> l1 l2 .. .. l5 l6 <-- goal
.. .. .. .. ..
.. .. .. .. .. ..
.. .. .. .. ..
Some initial configurations won't have a solution at all. (For example, the
bullet will never get through if there are other pieces in its groove.)
Write a program that accepts an initial board configuration on standard input.
The format looks as follows:
d67
i12
l12
u345
v34
The program should reject any initial board configuration that has illegal
piece specifications, contains overlapping pieces, or lacks the bullet at
l12.
If there is possible solution, the program should output
No solution.
Otherwise it should output one solution as a sequence of valid moves on
this format:
u[345 -> 456]
d[67 -> 23]
u[456 -> 123]
v[34 -> 23]
l[12 -> 56]
A solution doesn't have to be minimal in the number of moves, but it may
count in your favor if it is. Even more so if it's minimal in the total
distance the pieces were moved. Arriving at a solution quickly is an
even more important success metric than minimal solutions.
I strongly encourage you to try a few problems; they're often quite exquisite.
Each puzzle instance requires you to move the bullet from one side of the board
to the other, but in order to do so, you must move aside other pieces, and in
order to do that, you must move yet other pieces. Everyone who has ever tried
their hand at Sokoban knows that this
quickly grows non-trivial. (The problem of solving Sokoban puzzles has been
proven to be NP-hard. I know of no such result for this hex puzzle, but let's
just say it wouldn't surprise me.)
The necessity of moving pieces aside forms an implicit dependency tree. If that
were all, these puzzles would be merely mechanical and boring. But what often
happens is that the dependencies are not cleanly separated, and you have the
additional problem of not tripping over your own pieces. Here's an example:
We trivially notice that in order to get the bullet (the l piece) across, we
need to move aside the e piece and the c piece. But in the starting
configuration, both of these pieces are blocked by other pieces. So we must move
them first. And so on.
Reasoning about this kind of board takes place in a backwards manner. We figure
out which pieces we have to move out of the way to be able to move the pieces we
are really interested in. We follow the dependencies backwards until we bottom
out.
In this particular problem, it's a bit worse than that: the two subproblems of
"move aside the e piece" and "move aside the c piece" interact. Why?
Because the c piece is blocked by the k piece, which is blocked by the e
piece. So we can't just solve the subproblems in any order we like, we have to
find a way to solve them that works. The whole thing has a feel of people
attempting to execute a ballet number in a crowded elevator. It's exquisite.
It's frustrating.
So, people solve this problem by reasoning backwards. This is the only working
approach I've seen, and I've talked to quite a few people about this problem.
How should a machine solve it?
Well, there's always the brute force approach. Try all possible moves from the
starting configuration, and all moves from the configurations that result, and
so on until you either (a) run out of new configurations to try, or (b) solve
the problem. If you do this in a breadth-first way, i.e. you examine the new
configurations in a first-in-first-out manner, you're also guaranteed to find
a shortest possible solution first. (Shortest in terms of moves required.)
This is fine. It's slow, but it's fine. What some of our contestants ended up
doing was to improve on this by using A*
search to guide the search.
A perfect fit, it seems, for this kind of problem. The extra complexity from
upgrading from BFS to A* is paid back in spades by the problems being solved
faster. A success story.
The other possible approach, which none of the submitted entries attempted,
is to do the reasoning about blocking dependencies much in the way humans do.
Though such a solution is certainly possible, I have a creeping suspicion that
it would be far more complex than the A* approach. It's unclear how many
special cases it would need to contain in order to work out all the
dependencies. One gets a bit of extra respect at the pattern-matching and
hypothetical-future algorithms in one's own brain when trying to code up the
same things as a program.
Be that as it may. Have a look at people's
solutions. Admire people's ingenuity
on this one. Even though virtually everyone solves the problem in the same way,
there's no end to how differently they factor their solutions.
By the end of March, I received an email saying this:
$ time perl t4.pl
total: 4783154184978
real 0m0.185s
user 0m0.176s
sys 0m0.004s
(requires a perl with 64bit integers)
There was a t4.pl file attached.
You may recognize the total that the program prints out is the total number of t4 configurations, the same number that it took my C program two weeks to calculate on a decent box. So somehow, Salvador Fandino, perl.org blogger and occasional reader of my blog, managed to find way to arrive at the answer 6 million times as fast.
Well, that's interesting. To say the least.
Maybe I should be super-embarrassed. Maybe my cheeks should cycle through previously un-attained shades of crimson as I ponder the fact that my program was 6 million times as slow as someone else's. Ouch! But, I dunno. I don't really see it that way. I got to write about something I care about. Salvador++ cared enough to improve on my methods. The world is a better place. Blogging is cool — I learn stuff. Prestige doesn't much enter into it — the next time I'll have a better tool in my toolbox.
So, let's investigate this new tool, and how it's better.
First off, to get a factor-6e6 speedup, you don't apply some simple optimization somewhere; you use a different method. Salvador's code doesn't try to enumerate all the configurations, it just gets at the number. Which makes a lot of sense in retrospect, since we're not using the individual configurations for anything. My program arrives at each individual configuration, but then just throws it away immediately. Wasteful.
Salvador's blog post is as brief as his email. But let's copy the code over here and talk about it a bit:
#!/usr/bin/perl
use strict;
use warnings;
my $tab = <<EOT;
-----xxx
------xx
x-----xx
x------x
xx-----x
xx------
xxx-----
EOT
my $vertical = index $tab, "\n";
my $diagonal = $vertical + 1;
my $acu = { $tab => 1 };
for my $ix (0 .. length($tab) - 1) {
my %next;
while (my ($k, $c) = each %$acu) {
my $s = substr($k, 0, 1, '');
$next{$k} += $c;
if ($s eq '-') {
my $k1 = $k;
if ($k1 =~ s/^-/x/) { # horizontal xx
$next{$k1} += $c;
if ($k1 =~ s/^x-/xx/) { # horizontal xxx
$next{$k1} += $c;
}
}
$k1 = $k;
if ($k1 =~ s/^(.{$vertical})-/${1}x/os) { # vertical xx
$next{$k1} += $c;
if ($k1 =~ s/^(.{$vertical}x.{$vertical})-/${1}x/os) { # vertical xxx
$next{$k1} += $c;
}
}
$k1 = $k;
if ($k1 =~ s/^(.{$diagonal})-/${1}x/os) { # diagonal xx
$next{$k1} += $c;
if ($k1 =~ s/^(.{$diagonal}x.{$diagonal})-/${1}x/os) { # diagonal xxx
$next{$k1} += $c;
}
}
}
}
$acu = \%next;
}
my ($k, $c) = each %$acu;
print "total: $c\n";
The code is wonderfully idiomatic and to-the-point. Here are a few highlights, as I see them:
The board is a string. It's one-dimensional, but it plays a 2D array on TV. Some cute regexes then do matches on it according to this 2D representation.
We've "compressed" the hexagonal aspect of the board into a rectangular view. You know brick walls? On every other level the bricks are "between" those on the levels above/below. It's like they have half-valued x coordinates. This board representation removes the halves and just puts the bricks right on top of each other. It's bad for building walls, but useful for memory layout. It does mean that one of the diagonals on the hex layout becomes a vertical in the rectangular layout.
The script "munches" through the board, eating it one character at a time. In a very real way, this program solves the problem by eating it.
At each point it finds an empty location, it tries to put all kinds of 2-pieces and 3-pieces at that location. It diverges into all alternatives, keeping track for each alternative what locations it's used up.
The alternatives will then converge naturally as the same half-munched board shows up in various alternative paths. The script just needs to keep track of multiplicity of each alternative.
By the time we've muched the whole board down to an empty string, everything will have converged, so the multiplicity of the empty board will magically equal all possible ways to munch up the original one.
The program does far too much destructive updating for my tastes. I realize when I look at it that I no longer "think" in terms of these destructive updates. But it does it so successfully and idiomatically, that I find it difficult to list it as a disadvantage. Maybe it's a Perl 5 thing. Constructs like s/// are terribly convenient, and their default is to mutate things. (Even though Perl 5.14 adds /r for non-destructive substitution).
I was curious how this script would look (and perform) in Perl 6, so I wrote a straight port of it, trying to stick to the original as closely as possible:
my $tab = join "\n", <
-----xxx
------xx
x-----xx
x------x
xx-----x
xx------
xxx-----
>;
my $vertical = index $tab, "\n";
my $diagonal = $vertical + 1;
my %acu = $tab => 1;
my $vertical_xx = eval("/^ (. ** $vertical) '-'/");
my $vertical_xxx = eval("/^ (. ** $vertical 'x' . ** $vertical) '-'/");
my $diagonal_xx = eval("/^ (. ** $diagonal) '-'/");
my $diagonal_xxx = eval("/^ (. ** $diagonal 'x' . ** $diagonal) '-'/");
for ^$tab.chars {
my %next;
for %acu.kv -> $k, $c {
my $s = $k.substr(0, 1);
my $k0 = $k.substr(1);
%next{$k0} += $c;
next unless $s eq '-';
my $k1 = $k0;
if $k1.=subst(/^ '-'/, 'x') ne $k0 { # horizontal xx
%next{$k1} += $c;
my $k2 = $k1;
if $k2.=subst(/^ 'x-'/, 'xx') ne $k1 { # horizontal xxx
%next{$k2} += $c;
}
}
$k1 = $k0;
if $k1.=subst($vertical_xx,
-> $/ { $0 ~ 'x' }) ne $k0 { # vertical xx
%next{$k1} += $c;
my $k2 = $k1;
if $k2.=subst($vertical_xxx,
-> $/ { $0 ~ 'x' }) ne $k1 { # vertical xxx
%next{$k2} += $c;
}
}
$k1 = $k0;
if $k1.=subst($diagonal_xx,
-> $/ { $0 ~ 'x' }) ne $k0 { # diagonal xx
%next{$k1} += $c;
my $k2 = $k1;
if $k2.=subst($diagonal_xxx,
-> $/ { $0 ~ 'x' }) ne $k1 { # diagonal xxx
%next{$k2} += $c;
}
}
}
%acu := %next;
}
say "total: %acu.values()";
Ugh! This script is longer than the Perl 5 version, and it looks messier, too. A few factors contribute to that. First, you can't just do s/// in Rakudo in an if statement. (You can in Niecza, though.) Second, there are problems with <atom> ** $repeats, and I got to submit twotickets about that, and then do a workaround with the evals you see above. (Aah. Feels like the old days.)
Furthermore, jnthn++ could put this program into the profiler, and get twooptimizations out of it. It went from 40s on my machine, to 37s.
But in the end, I felt that my straight-port version suffers from not playing off Perl 6's strengths. So I wrote a version that leans more towards immutability and closures.
my $tab = join "\n", <
-----xxx
------xx
x-----xx
x------x
xx-----x
xx------
xxx-----
>;
my $vertical = index $tab, "\n";
my $diagonal = $vertical + 1;
my %acu = $tab => 1;
sub make_substituter($rx) {
return sub ($tab) {
my $newtab = $tab;
return $newtab
if $newtab.=subst($rx, -> $/ { $0 ~ 'x' }) ne $tab;
};
}
sub make_2x_substituter($rx) {
return sub ($tab) {
my $newtab = $tab;
return $newtab
if $newtab.=subst($rx, -> $/ { [~] $0, 'x', $1, 'x' }) ne $tab;
};
}
my @pieces =
make_substituter(rx/^ ('') '-'/),
make_substituter(eval("/^ ({'.' x $vertical}) '-'/")),
make_substituter(eval("/^ ({'.' x $diagonal}) '-'/")),
make_2x_substituter(rx/^ ('') '-' ('') '-'/),
make_2x_substituter(eval("/^ ({'.' x $vertical}) '-' ({'.' x $vertical}) '-'/")),
make_2x_substituter(eval("/^ ({'.' x $diagonal}) '-' ({'.' x $diagonal}) '-'/"));
for ^$tab.chars {
my %next;
for %acu.kv -> $k, $c {
my $s = $k.substr(0, 1);
my $k0 = $k.substr(1);
%next{$k0} += $c;
next unless $s eq '-';
for @pieces -> &piece {
if &piece($k0) -> $newtab {
%next{$newtab} += $c;
}
}
}
%acu := %next;
}
say "total: %acu.values()";
Hmm. The loop is shorter now, but at the cost of some abstractions in other places. It's an improvement on my first version, but I don't really feel I got close to the succinctness of Salvador's Perl 5 version here either. (And this version runs slower, predictably. Something like 52s on my machine.)
I'm pretty sure it's possible to make even more idiomatic versions. This is a large enough problem to make things interesting. I encourage others to try.
A month of blog silence. Ouch. Looking back, the three reasons I can see for my
absence from blogging are work, work, and work.
So I saw
moritz,
jnthn, and
pmichaud
blog about the weekend, and I must've been too shell-shocked to think to do the
same. sjn++ woke me up from my reverie by asking me outright.
So, here goes.
Oslo. We had a hackathon there.
This is the second time. The first time was in 2009, and was quite possible the
best hackathon ever, in the history of Perl 6 hackathons. (Or, let's say,
certainly among the top 5.)
I haven't fully processed this one, but it's not too early to say this: this
one beat the last one.
My weekend, in brief:
jnthn and I arrived Oslo on the Thursday, and watched Damian Conway giving
and awesome presentation in a bar. No-one combines geek jokes, almost-accurate
physics, and Perl programming like Damian.
On the Saturday, I spent about an hour introducing a group of newcomers to
Perl 6, language and culture. Fun!
sergot++ (Filip Sergot) and I built a presentation framework. It's called
Sambal, and it turns a DSL into a
PDF. I'm happy and proud over how long we
managed to get with only two days of work.
sergot++ and I also spit out a
Text::Markdown module. It's in early
stages yet, but it already services Sambal in its slide generation. It's an
easy addition to have its objects model serialize to HTML, too.
I asked whether BEGIN should trigger immediately inside a quasi, or
whether it should trigger only after macro application. People around the
hackathon table suggested that we should have a QBEGIN that did the latter.
I felt it was a singularly bad idea, so I asked TimToady. He suggested the
same. I exploded.
Then I decided not to listen to anyone, and just implement it in the way that
turned out to be natural and convenient. pmichaud joked that he should have
adopted that approach long ago with respect to implementing Perl 6.
(But seriously. If you want to execute a BEGIN block at macro-parse time,
put it outside of the quasi. If you want to execute it at macro-apply time,
put it inside of it. We don't need a Q*bert
BEGIN.)
We discussed what s/// should evaluate to. No real consensus. :-(
On the Sunday, we tried a coding dojo (hosted by infosophy++),
implementing a roman numerals Int -> Str converter in Perl 6. It led to
interesting discussions, and many of us had useful insights in collaborative
coding and small-step iterative development.
jnthn++ and pmichaud++ evolved a plan for the new QAST redesign, which will
enable the next
step
in the macros grant. jnthn++ invited me to write some tests on this for great
success. It looks doable; I'll dig into this during the next week. As I do
this, I can also write tests for my new QAST::Unquasi node type.
If Oslo.pm ever hosts a third hackathon, my expectations will found be in
geostationary orbit. No chance in the world I'd miss it.
