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