#!/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."; } }