Download the raw code.
#!/usr/local/bin/perl6
## ======================================================================== ##
## Hex Puzzle solver
##
## This code uses a variant of A-star search to try to find a reasonable
## and efficient set of moves to solve the puzzle. For speed purposes,
## I rely on a set of precomputed tables to make it easy to determine
## piece collisions and movement possibilities.
## ======================================================================== ##
## ------------------------------------------------------------------------ ##
## Resource Tracking Bitmaps
##
## Represent all piece positions as 38-bit bitmaps. Two pieces coexist
## if the bit-wise and between their bitmaps is 0.
##
## Bit position assignments are in left-to-right order from the original
## hexagon graph, starting with i1 in bit 37 and ending with o5 in bit 0.
## ------------------------------------------------------------------------ ##
my %piece_bmp =
(
# iiiii jjjjjj kkkkk llllll mmmmm nnnnnn ooooo
# 12345 123456 12345 123456 12345 123456 12345
i12 => 0b11000_000000_00000_000000_00000_000000_00000,
i23 => 0b01100_000000_00000_000000_00000_000000_00000,
i34 => 0b00110_000000_00000_000000_00000_000000_00000,
i45 => 0b00011_000000_00000_000000_00000_000000_00000,
i123 => 0b11100_000000_00000_000000_00000_000000_00000,
i234 => 0b01110_000000_00000_000000_00000_000000_00000,
i345 => 0b00111_000000_00000_000000_00000_000000_00000,
j12 => 0b00000_110000_00000_000000_00000_000000_00000,
j23 => 0b00000_011000_00000_000000_00000_000000_00000,
j34 => 0b00000_001100_00000_000000_00000_000000_00000,
j45 => 0b00000_000110_00000_000000_00000_000000_00000,
j56 => 0b00000_000011_00000_000000_00000_000000_00000,
j123 => 0b00000_111000_00000_000000_00000_000000_00000,
j234 => 0b00000_011100_00000_000000_00000_000000_00000,
j345 => 0b00000_001110_00000_000000_00000_000000_00000,
j456 => 0b00000_000111_00000_000000_00000_000000_00000,
k12 => 0b00000_000000_11000_000000_00000_000000_00000,
k23 => 0b00000_000000_01100_000000_00000_000000_00000,
k34 => 0b00000_000000_00110_000000_00000_000000_00000,
k45 => 0b00000_000000_00011_000000_00000_000000_00000,
k123 => 0b00000_000000_11100_000000_00000_000000_00000,
k234 => 0b00000_000000_01110_000000_00000_000000_00000,
k345 => 0b00000_000000_00111_000000_00000_000000_00000,
l12 => 0b00000_000000_00000_110000_00000_000000_00000,
l23 => 0b00000_000000_00000_011000_00000_000000_00000,
l34 => 0b00000_000000_00000_001100_00000_000000_00000,
l45 => 0b00000_000000_00000_000110_00000_000000_00000,
l56 => 0b00000_000000_00000_000011_00000_000000_00000,
l123 => 0b00000_000000_00000_111000_00000_000000_00000,
l234 => 0b00000_000000_00000_011100_00000_000000_00000,
l345 => 0b00000_000000_00000_001110_00000_000000_00000,
l456 => 0b00000_000000_00000_000111_00000_000000_00000,
m12 => 0b00000_000000_00000_000000_11000_000000_00000,
m23 => 0b00000_000000_00000_000000_01100_000000_00000,
m34 => 0b00000_000000_00000_000000_00110_000000_00000,
m45 => 0b00000_000000_00000_000000_00011_000000_00000,
m123 => 0b00000_000000_00000_000000_11100_000000_00000,
m234 => 0b00000_000000_00000_000000_01110_000000_00000,
m345 => 0b00000_000000_00000_000000_00111_000000_00000,
n12 => 0b00000_000000_00000_000000_00000_110000_00000,
n23 => 0b00000_000000_00000_000000_00000_011000_00000,
n34 => 0b00000_000000_00000_000000_00000_001100_00000,
n45 => 0b00000_000000_00000_000000_00000_000110_00000,
n56 => 0b00000_000000_00000_000000_00000_000011_00000,
n123 => 0b00000_000000_00000_000000_00000_111000_00000,
n234 => 0b00000_000000_00000_000000_00000_011100_00000,
n345 => 0b00000_000000_00000_000000_00000_001110_00000,
n456 => 0b00000_000000_00000_000000_00000_000111_00000,
o12 => 0b00000_000000_00000_000000_00000_000000_11000,
o23 => 0b00000_000000_00000_000000_00000_000000_01100,
o34 => 0b00000_000000_00000_000000_00000_000000_00110,
o45 => 0b00000_000000_00000_000000_00000_000000_00011,
o123 => 0b00000_000000_00000_000000_00000_000000_11100,
o234 => 0b00000_000000_00000_000000_00000_000000_01110,
o345 => 0b00000_000000_00000_000000_00000_000000_00111,
# edcba fedcba fedcb gfedcb gfedc hgfedc hgfed
# 11111 122222 23333 134444 24555 135666 24677
a12 => 0b00001_000001_00000_000000_00000_000000_00000,
# 1 2 3 4
b12 => 0b00010_000010_00000_000000_00000_000000_00000,
b23 => 0b00000_000010_00001_000000_00000_000000_00000,
b34 => 0b00000_000000_00001_000001_00000_000000_00000,
b123 => 0b00010_000010_00001_000000_00000_000000_00000,
b234 => 0b00000_000010_00001_000001_00000_000000_00000,
# 1 2 3 4 5 6
c12 => 0b00100_000100_00000_000000_00000_000000_00000,
c23 => 0b00000_000100_00010_000000_00000_000000_00000,
c34 => 0b00000_000000_00010_000010_00000_000000_00000,
c45 => 0b00000_000000_00000_000010_00001_000000_00000,
c56 => 0b00000_000000_00000_000000_00001_000001_00000,
c123 => 0b00100_000100_00010_000000_00000_000000_00000,
c234 => 0b00000_000100_00010_000010_00000_000000_00000,
c345 => 0b00000_000000_00010_000010_00001_000000_00000,
c456 => 0b00000_000000_00000_000010_00001_000001_00000,
# 1 2 3 4 5 6 7
d12 => 0b01000_001000_00000_000000_00000_000000_00000,
d23 => 0b00000_001000_00100_000000_00000_000000_00000,
d34 => 0b00000_000000_00100_000100_00000_000000_00000,
d45 => 0b00000_000000_00000_000100_00010_000000_00000,
d56 => 0b00000_000000_00000_000000_00010_000010_00000,
d67 => 0b00000_000000_00000_000000_00000_000010_00001,
d123 => 0b01000_001000_00100_000000_00000_000000_00000,
d234 => 0b00000_001000_00100_000100_00000_000000_00000,
d345 => 0b00000_000000_00100_000100_00010_000000_00000,
d456 => 0b00000_000000_00000_000100_00010_000010_00000,
d567 => 0b00000_000000_00000_000000_00010_000010_00001,
# 1 2 3 4 5 6 7
e12 => 0b10000_010000_00000_000000_00000_000000_00000,
e23 => 0b00000_010000_01000_000000_00000_000000_00000,
e34 => 0b00000_000000_01000_001000_00000_000000_00000,
e45 => 0b00000_000000_00000_001000_00100_000000_00000,
e56 => 0b00000_000000_00000_000000_00100_000100_00000,
e67 => 0b00000_000000_00000_000000_00000_000100_00010,
e123 => 0b10000_010000_01000_000000_00000_000000_00000,
e234 => 0b00000_010000_01000_001000_00000_000000_00000,
e345 => 0b00000_000000_01000_001000_00100_000000_00000,
e456 => 0b00000_000000_00000_001000_00100_000100_00000,
e567 => 0b00000_000000_00000_000000_00100_000100_00010,
# 1 2 3 4 5 6
f12 => 0b00000_100000_10000_000000_00000_000000_00000,
f23 => 0b00000_000000_10000_010000_00000_000000_00000,
f34 => 0b00000_000000_00000_010000_01000_000000_00000,
f45 => 0b00000_000000_00000_000000_01000_001000_00000,
f56 => 0b00000_000000_00000_000000_00000_001000_00100,
f123 => 0b00000_100000_10000_010000_00000_000000_00000,
f234 => 0b00000_000000_10000_010000_01000_000000_00000,
f345 => 0b00000_000000_00000_010000_01000_001000_00000,
f456 => 0b00000_000000_00000_000000_01000_001000_00100,
# 1 2 3 4
g12 => 0b00000_000000_00000_100000_10000_000000_00000,
g23 => 0b00000_000000_00000_000000_10000_010000_00000,
g34 => 0b00000_000000_00000_000000_00000_010000_01000,
g123 => 0b00000_000000_00000_100000_10000_010000_00000,
g234 => 0b00000_000000_00000_000000_10000_010000_01000,
# 1 2
h34 => 0b00000_000000_00000_000000_00000_100000_10000,
# pqrst pqrstu qrstu qrstuv rstuv rstuvw stuvw
# 24677 135666 24555 134444 23333 122222 11111
p12 => 0b10000_100000_00000_000000_00000_000000_00000,
# 4 3 2 1
q12 => 0b00000_000000_10000_100000_00000_000000_00000,
q23 => 0b00000_010000_10000_000000_00000_000000_00000,
q34 => 0b01000_010000_00000_000000_00000_000000_00000,
q123 => 0b00000_010000_10000_100000_00000_000000_00000,
q234 => 0b01000_010000_10000_000000_00000_000000_00000,
# 6 5 4 3 2 1
r12 => 0b00000_000000_00000_000000_10000_100000_00000,
r23 => 0b00000_000000_00000_010000_10000_000000_00000,
r34 => 0b00000_000000_01000_010000_00000_000000_00000,
r45 => 0b00000_001000_01000_000000_00000_000000_00000,
r56 => 0b00100_001000_00000_000000_00000_000000_00000,
r123 => 0b00000_000000_00000_010000_10000_100000_00000,
r234 => 0b00000_000000_01000_010000_10000_000000_00000,
r345 => 0b00000_001000_01000_010000_00000_000000_00000,
r456 => 0b00100_001000_01000_000000_00000_000000_00000,
# 7 6 5 4 3 2 1
s12 => 0b00000_000000_00000_000000_00000_010000_10000,
s23 => 0b00000_000000_00000_000000_01000_010000_00000,
s34 => 0b00000_000000_00000_001000_01000_000000_00000,
s45 => 0b00000_000000_00100_001000_00000_000000_00000,
s56 => 0b00000_000100_00100_000000_00000_000000_00000,
s67 => 0b00010_000100_00000_000000_00000_000000_00000,
s123 => 0b00000_000000_00000_000000_01000_010000_10000,
s234 => 0b00000_000000_00000_001000_01000_010000_00000,
s345 => 0b00000_000000_00100_001000_01000_000000_00000,
s456 => 0b00000_000100_00100_001000_00000_000000_00000,
s567 => 0b00010_000100_00100_000000_00000_000000_00000,
# 7 6 5 4 3 2 1
t12 => 0b00000_000000_00000_000000_00000_001000_01000,
t23 => 0b00000_000000_00000_000000_00100_001000_00000,
t34 => 0b00000_000000_00000_000100_00100_000000_00000,
t45 => 0b00000_000000_00010_000100_00000_000000_00000,
t56 => 0b00000_000010_00010_000000_00000_000000_00000,
t67 => 0b00001_000010_00000_000000_00000_000000_00000,
t123 => 0b00000_000000_00000_000000_00100_001000_01000,
t234 => 0b00000_000000_00000_000100_00100_001000_00000,
t345 => 0b00000_000000_00010_000100_00100_000000_00000,
t456 => 0b00000_000010_00010_000100_00000_000000_00000,
t567 => 0b00001_000010_00010_000000_00000_000000_00000,
# 6 5 4 3 2 1
u12 => 0b00000_000000_00000_000000_00000_000100_00100,
u23 => 0b00000_000000_00000_000000_00010_000100_00000,
u34 => 0b00000_000000_00000_000010_00010_000000_00000,
u45 => 0b00000_000000_00001_000010_00000_000000_00000,
u56 => 0b00000_000001_00001_000000_00000_000000_00000,
u123 => 0b00000_000000_00000_000000_00010_000100_00100,
u234 => 0b00000_000000_00000_000010_00010_000100_00000,
u345 => 0b00000_000000_00001_000010_00010_000000_00000,
u456 => 0b00000_000001_00001_000010_00000_000000_00000,
# 4 3 2 1
v12 => 0b00000_000000_00000_000000_00000_000010_00010,
v23 => 0b00000_000000_00000_000000_00001_000010_00000,
v34 => 0b00000_000000_00000_000001_00001_000000_00000,
v123 => 0b00000_000000_00000_000000_00001_000010_00010,
v234 => 0b00000_000000_00000_000001_00001_000010_00000,
# 2 1
w12 => 0b00000_000000_00000_000000_00000_000001_00001,
);
## ------------------------------------------------------------------------ ##
## Movement Connectivity
##
## %succ moves a piece toward the next higher index in its groove.
## %pred moves a piece toward the next lower index.
##
## A move in a particular direction is allowed if and only if
## .contains($curr) == True for that direction.
## ------------------------------------------------------------------------ ##
my %succ =
(
i12 => 'i23', i23 => 'i34', i34 => 'i45',
j12 => 'j23', j23 => 'j34', j34 => 'j45', j45 => 'j56',
k12 => 'k23', k23 => 'k34', k34 => 'k45',
l12 => 'l23', l23 => 'l34', l34 => 'l45', l45 => 'l56',
m12 => 'm23', m23 => 'm34', m34 => 'm45',
n12 => 'n23', n23 => 'n34', n34 => 'n45', n45 => 'n56',
o12 => 'o23', o23 => 'o34', o34 => 'o45',
i123 => 'i234', i234 => 'i345',
j123 => 'j234', j234 => 'j345', j345 => 'j456',
k123 => 'k234', k234 => 'k345',
l123 => 'l234', l234 => 'l345', l345 => 'l456',
m123 => 'm234', m234 => 'm345',
n123 => 'n234', n234 => 'n345', n345 => 'n456',
o123 => 'o234', o234 => 'o345',
b12 => 'b23', b23 => 'b34',
c12 => 'c23', c23 => 'c34', c34 => 'c45', c45 => 'c56',
d12 => 'd23', d23 => 'd34', d34 => 'd45', d45 => 'd56', d56 => 'd67',
e12 => 'e23', e23 => 'e34', e34 => 'e45', e45 => 'e56', e56 => 'e67',
f12 => 'f23', f23 => 'f34', f34 => 'f45', f45 => 'f56',
g12 => 'g23', g23 => 'g34',
b123 => 'b234',
c123 => 'c234', c234 => 'c345', c345 => 'c456',
d123 => 'd234', d234 => 'd345', d345 => 'd456', d456 => 'd567',
e123 => 'e234', e234 => 'e345', e345 => 'e456', e456 => 'e567',
f123 => 'f234', f234 => 'f345', f345 => 'f456',
g123 => 'g234',
q12 => 'q23', q23 => 'q34',
r12 => 'r23', r23 => 'r34', r34 => 'r45', r45 => 'r56',
s12 => 's23', s23 => 's34', s34 => 's45', s45 => 's56', r56 => 'r67',
t12 => 't23', t23 => 't34', t34 => 't45', t45 => 't56', s56 => 's67',
u12 => 'u23', u23 => 'u34', u34 => 'u45', u45 => 'u56',
v12 => 'v23', v23 => 'v34',
q123 => 'q234',
r123 => 'r234', r234 => 'r345', r345 => 'r456',
s123 => 's234', s234 => 's345', s345 => 's456', s456 => 's567',
t123 => 't234', t234 => 't345', t345 => 't456', t456 => 't567',
u123 => 'u234', u234 => 'u345', u345 => 'u456',
v123 => 'v234',
);
my %pred = %succ.invert;
## ------------------------------------------------------------------------ ##
## Helper function: Render a from/to as a move in desired output format
## ------------------------------------------------------------------------ ##
sub render_move(Str $from, Str $to)
{
return $from.substr(0, 1)
~ "[" ~ $from.substr(1) ~ " -> " ~ $to.substr(1) ~ "]";
}
## ------------------------------------------------------------------------ ##
## A-star Search
##
## Note that this implementation goes light on the abstraction. That can
## always be added later when it's time to reuse the code.
##
## The class a-star-node encapsulates a single state node from the
## state tree search. The class a-star encapsulates knowledge of visited
## states and handles iterating the actual a-star search.
## ------------------------------------------------------------------------ ##
class a-star-node
{
has Int $!cost;
has Str $!move;
has Int $!in_use;
has @!pieces;
has Bool $!bullet;
has Str $!parent;
has Int $!est_cost;
method Str() {
return @!pieces.join();
}
method is_goal() {
return @!pieces[0] eq 'l56';
}
method add_piece(Str $piece) {
# This is used only when populating start nodes from the input
say "Invalid piece name." and exit(1)
if !%piece_bmp.contains($piece);
my $new_bmp = %piece_bmp{$piece};
say "Overlapping pieces." and exit(1) if $!in_use +& $new_bmp;
$!in_use +|= $new_bmp;
if ($piece eq 'l12') {
$!bullet = True;
unshift @!pieces, $piece;
} else {
say "No solution." and exit(1) if $piece.substr(0,1) eq 'l';
push @!pieces, $piece;
}
}
method has_bullet {
# This is used only when populating start nodes from the input
return $!bullet;
}
method get_moves {
my (Int $piece, Int $cost, Str $orig, Str $curr, Int $others,
Int $p, $next, @moves);
## Try to move each piece as far backward as possible,
## then try to move each piece as far forward as possible.
##
## Cost of the move is 3 + # of segments.
##
## Insert the options into the result buffer in reverse
## order, so the first move we consider is the one that
## moves the bullet the furthest right.
for $(%pred), $(%succ) -> $next {
for @!pieces.elems-1 ... 0 -> $p {
my @p_copy = @!pieces;
$curr = $orig = @!pieces[$p];
$cost = $!cost + 1;
$others = $!in_use +^ %piece_bmp{$orig};
while ( $next.contains($curr) ) {
$curr = $next{$curr};
$cost++;
if ($others +& %piece_bmp{$curr}) == 0 {
@p_copy[$p] = $curr;
@moves.unshift(
a-star-node.new(
cost => $cost,
move => render_move($orig, $curr),
in_use => $others +| %piece_bmp{$curr},
pieces => @p_copy,
bullet => $!bullet,
parent => self.Str
)
)
} else {
last;
}
}
}
}
return @moves;
}
method get_parent { return $!parent; }
method get_move { return $!move; }
method tot_cost_to_here {
# Actual cost incurred getting to this node.
return $!cost;
}
method est_cost_to_goal {
return $!est_cost if $!est_cost > 0;
# Estimated cost to get from this node to the goal state.
#
# Our heuristic:
# -- Number of slots the bullet needs to slide, plus
# -- Number of other piece segments overlapping l1 .. l6 to
# the right of the bullet, plus
# -- 1, to cover the minimum cost of any move.
#
# Because we start calculating "overlapping piece segments"
# on the right-edge of the "bullet", we don't need to add 1
# explicitly.
my Int $bull_pos = @!pieces[0].substr(1,1).Int;
my Int $in_way = 0;
my Int $bit_num;
for (21 - $bull_pos) ... 16 -> $bit_num {
$in_way += ($!in_use +> $bit_num) +& 1;
}
return $!est_cost = ( 5 - $bull_pos ) + $in_way;
}
submethod BUILD
(
:$!cost = 0,
:$!move = '',
:$!in_use = 0,
:@!pieces = ( ),
:$!bullet = False,
:$!parent = 'START',
:$!est_cost = -1
) {
}
};
class a-star
{
has %!visited;
has @!frontier;
method !visit(a-star-node $state) {
my Str $str = $state.Str;
my Bool $was_visited = %!visited.contains($str);
%!visited{$str} = $state
if (!$was_visited ||
$state.tot_cost_to_here < %!visited{$str}.tot_cost_to_here);
return $was_visited;
}
method !best_path(a-star-node $end) {
my @moves;
my $state = $end.Str;
while (%!visited.contains($state)) {
@moves.unshift( %!visited{$state}.get_move );
$state = %!visited{$state}.get_parent;
}
shift @moves; ## remove extra move from last iter
return @moves;
}
method !pick() {
my Int $best_idx = 0;
my Int $best_cost = 99999999;
for 0 ..^ @!frontier.elems {
my $tot_est_cost = @!frontier[$_].tot_cost_to_here +
@!frontier[$_].est_cost_to_goal;
if $best_cost > $tot_est_cost {
$best_cost = $tot_est_cost;
$best_idx = $_;
}
}
my $pick = @!frontier[$best_idx];
@!frontier.splice( $best_idx, 1 );
return $pick;
}
method search {
my (a-star-node $node, a-star-node $exit);
my (@exits, $curr);
while (@!frontier.elems > 0) {
$node = self!pick;
$curr = $node.Str;
if $node.is_goal {
return self!best_path($node);
}
@exits = $node.get_moves;
for @exits -> $exit {
my $was_visited = self!visit($exit);
if !$was_visited {
push @!frontier, $exit;
}
}
}
return @( );
}
submethod BUILD(:$start) {
push @!frontier, $start;
self!visit($start);
}
};
## ======================================================================== ##
## MAIN PROGRAM
## ======================================================================== ##
sub MAIN
{
my $start = a-star-node.new;
for lines() {
$start.add_piece( $_ );
}
say "No bullet specified" and exit(1) if !$start.has_bullet;
my $a-star = a-star.new(start => $start);
my @path = $a-star.search;
if @path.elems {
say @path.join("\n");
} else {
say "No solution.";
}
}
The program does an A star search. It seems to work as intended.
The program is nicely formatted, indented with spaces, and with pleasant interspersed comments where necessary.
The program is clearly structured, with lookup tables, class definitions, and a
MAIN
routine.
The method name !pick
is a teensy bit unfortunate, considering that it means
'take a random item' in the rest of Perl 6.
This program is impressively fast.
The whole program has a quality of balance and purpose to it.
Nice use of .invert
.
One doesn't need to close one's class definitions with };
. (C programmer
interference?)
The empty BUILD
submethod in a-star-node
could have been removed, and the
defaults just put on the attributes instead.
No need to put parens around the condition of a while
loop.
The program sacrifices brevity on the altar of performance tweaks.