15 puzzle solver/Multimove
Phix
<lang Phix>-- -- demo\rosetta\Solve15puzzle.exw -- constant STM = 0 -- single-tile metrics. constant MTM = 0 -- multi-tile metrics. if STM and MTM then ?9/0 end if -- both prohibited -- 0 0 -- fastest, but non-optimal -- 1 0 -- optimal in STM -- 0 1 -- optimal in MTM (slowest by far)
--Note: The fast method uses an inadmissible heuristic - see "not STM" in iddfs(). -- It explores mtm-style using the higher stm heuristic and may therefore -- fail badly in some cases.
constant SIZE = 4
constant goal = { 1, 2, 3, 4,
5, 6, 7, 8,
9,10,11,12,
13,14,15, 0}
-- -- multi-tile-metric walking distance heuristic lookup (mmwd). -- ========================================================== -- Uses patterns of counts of tiles in/from row/col, eg the solved state -- (ie goal above) could be represented by the following: -- {{4,0,0,0}, -- {0,4,0,0}, -- {0,0,4,0}, -- {0,0,0,3}} -- ie row/col 1 contains 4 tiles from col/row 1, etc. In this case -- both are identical, but you can count row/col or col/row, and then -- add them together. There are up to 24964 possible patterns. The -- blank space is not counted. Note that a vertical move cannot change -- a vertical pattern, ditto horizontal, and basic symmetry means that -- row/col and col/row patterns will match (at least, that is, if they -- are calculated sympathetically), halving the setup cost. -- The data is just the number of moves made before this pattern was -- first encountered, in a breadth-first search, backwards from the -- goal state, until all patterns have been enumerated. -- (The same ideas/vars are now also used for stm metrics when MTM=0) -- sequence wdkey -- one such 4x4 pattern constant mmwd = new_dict() -- lookup table, data is walking distance.
--
-- We use two to-do lists: todo is the current list, and everything
-- of walkingdistance+1 ends up on tdnx. Once todo is exhausted, we
-- swap the dictionary-ids, so tdnx automatically becomes empty.
-- Key is an mmwd pattern as above, and data is {distance,space_idx}.
--
integer todo = new_dict()
integer tdnx = new_dict()
--
enum UP = 1, DOWN = -1
procedure explore(integer space_idx, walking_distance, direction) -- -- Given a space index, explore all the possible moves in direction, -- setting the distance and extending the tdnx table. -- integer tile_idx = space_idx+direction
for group=1 to SIZE do
if wdkey[tile_idx][group] then
-- ie: check row tile_idx for tiles belonging to rows 1..4
-- Swap one of those tiles with the space
wdkey[tile_idx][group] -= 1
wdkey[space_idx][group] += 1
if getd_index(wdkey,mmwd)=0 then
-- save the walking distance value
setd(wdkey,walking_distance+1,mmwd)
-- and add to the todo next list:
if getd_index(wdkey,tdnx)!=0 then ?9/0 end if
setd(wdkey,{walking_distance+1,tile_idx},tdnx)
end if
if MTM then
if tile_idx>1 and tile_idx<SIZE then
-- mtm: same direction means same distance:
explore(tile_idx, walking_distance, direction)
end if
end if
-- Revert the swap so we can look at the next candidate.
wdkey[tile_idx][group] += 1
wdkey[space_idx][group] -= 1
end if
end for
end procedure
procedure generate_mmwd() -- Perform a breadth-first search begining with the solved puzzle state -- and exploring from there until no more new patterns emerge. integer walking_distance = 0, space = 4
wdkey = {{4,0,0,0}, -- \
{0,4,0,0}, -- } 4 tiles in correct row positions
{0,0,4,0}, -- /
{0,0,0,3}} -- 3 tiles in correct row position
setd(wdkey,walking_distance,mmwd)
while 1 do
if space<4 then explore(space, walking_distance, UP) end if
if space>1 then explore(space, walking_distance, DOWN) end if
if dict_size(todo)=0 then
if dict_size(tdnx)=0 then exit end if
{todo,tdnx} = {tdnx,todo}
end if
wdkey = getd_partial_key(0,todo)
{walking_distance,space} = getd(wdkey,todo)
deld(wdkey,todo)
end while
end procedure
function walking_distance(sequence puzzle) sequence rkey = repeat(repeat(0,SIZE),SIZE),
ckey = repeat(repeat(0,SIZE),SIZE)
integer k = 1
for i=1 to SIZE do -- rows
for j=1 to SIZE do -- columns
integer tile = puzzle[k]
if tile!=0 then
integer row = floor((tile-1)/4)+1,
col = mod(tile-1,4)+1
rkey[i][row] += 1
ckey[j][col] += 1
end if
k += 1
end for
end for
if getd_index(rkey,mmwd)=0
or getd_index(ckey,mmwd)=0 then
?9/0 -- sanity check
end if
integer rwd = getd(rkey,mmwd),
cwd = getd(ckey,mmwd)
return rwd+cwd
end function
sequence puzzle string res = "" atom t0 = time(),
t1 = time()+1
atom tries = 0
constant ok = {{0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1}, -- left
{0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1}, -- up
{1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0}, -- down
{1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0}} -- right
function iddfs(integer step, lim, space, prevmv)
if time()>t1 then
printf(1,"working... (depth=%d, tries=%d, time=%3ds)\r",{lim,tries,time()-t0})
t1 = time()+1
end if
tries += 1
integer d = iff(step==lim?0:walking_distance(puzzle))
if d=0 then
return (puzzle==goal)
elsif step+d<=lim then
for mv=1 to 4 do -- l/u/d/r
if prevmv!=(5-mv) -- not l after r or vice versa, ditto u/d
and ok[mv][space] then
integer nspace = space+{-1,-4,+4,+1}[mv]
integer tile = puzzle[nspace]
if puzzle[space]!=0 then ?9/0 end if -- sanity check
puzzle[space] = tile
puzzle[nspace] = 0
if iddfs(step+iff(MTM or not STM?(prevmv!=mv):1),lim,nspace,mv) then
res &= "ludr"[mv]
return true
end if
puzzle[nspace] = tile
puzzle[space] = 0
end if
end for
end if
return false
end function
function pack(string s) integer n = length(s), n0 = n
for i=1 to 4 do
integer ch = "lrud"[i], k
while 1 do
k = match(repeat(ch,3),s)
if k=0 then exit end if
s[k+1..k+2] = "3"
n -= 2
end while
while 1 do
k = match(repeat(ch,2),s)
if k=0 then exit end if
s[k+1] = '2'
n -= 1
end while
end for
return {n,iff(MTM?sprintf("%d",n):sprintf("%d(%d)",{n,n0})),s}
end function
procedure apply_moves(string moves, integer space) integer move, ch, nspace
puzzle[space] = 0
for i=1 to length(moves) do
ch = moves[i]
if ch>'3' then
move = find(ch,"ulrd")
end if
-- (hint: "r" -> the 'r' does 1
-- "r2" -> the 'r' does 1, the '2' does 1
-- "r3" -> the 'r' does 1, the '3' does 2!)
for j=1 to 1+(ch='3') do
nspace = space+{-4,-1,+1,4}[move]
puzzle[space] = puzzle[nspace]
space = nspace
puzzle[nspace] = 0
end for
end for
end procedure
function solvable(sequence board) integer n = length(board) sequence positions = repeat(0,n)
-- prepare the mapping from each tile to its position
board[find(0,board)] = n
for i=1 to n do
positions[board[i]] = i
end for
-- check whether this is an even or odd state
integer row = floor((positions[16]-1)/4),
col = (positions[16]-1)-row*4
bool even_state = (positions[16]==16) or (mod(row,2)==mod(col,2))
-- count the even cycles
integer even_count = 0
sequence visited = repeat(false,16)
for i=1 to n do
if not visited[i] then
-- a new cycle starts at i. Count its length..
integer cycle_length = 0,
next_tile = i
while not visited[next_tile] do
cycle_length +=1
visited[next_tile] = true
next_tile = positions[next_tile]
end while
even_count += (mod(cycle_length,2)==0)
end if
end for
return even_state == (mod(even_count,2)==0)
end function
procedure main()
puzzle = {15,14, 1, 6,
9,11, 4,12,
0,10, 7, 3,
13, 8, 5, 2}
if not solvable(puzzle) then
?puzzle
printf(1,"puzzle is not solveable\n")
else
generate_mmwd()
sequence original = puzzle
integer space = find(0,puzzle)
for lim=walking_distance(puzzle) to iff(MTM?43:80) do
if iddfs(0, lim, space, '-') then exit end if
end for
{integer n, string ns, string ans} = pack(reverse(res))
printf(1,"\n\noriginal:")
?original
atom t = time()-t0
printf(1,"\n%soptimal solution of %s moves found in %s: %s\n\nresult: ",
{iff(MTM?"mtm-":iff(STM?"stm-":"non-")),ns,elapsed(t),ans})
puzzle = original
apply_moves(ans,space)
?puzzle
end if
end procedure main()</lang>
- Output:
original:{15,14,1,6,9,11,4,12,0,10,7,3,13,8,5,2}
non-optimal solution of 35(60) moves found in 2.42s: u2r2d3ru2ld2ru3ld3l2u3r2d2l2dru2ldru2rd3lulur3dl2ur2d2
stm-optimal solution of 38(52) moves found in 1 minute and 54s: r3uldlu2ldrurd3lu2lur3dld2ruldlu2rd2lulur2uldr2d2
mtm-optimal solution of 31(60) moves found in 2 hours, 38 minutes and 28s: u2r2d3ru2ld2ru3ld3l2u3r2d2l2dru3rd3l2u2r3dl3dru2r2d2