Problem:
MathJax.Hub.Config({ tex2jax: { inlineMath: [["$","$"], ["\\(","\\)"]], processEscapes: true }});

8 Puzzle

The goal of the 8 puzzle problem is to complete pieces on $3 \times 3$ cells where one of the cells is empty space.

In this problem, the space is represented by 0 and pieces are represented by integers from 1 to 8 as shown below.

1 3 0
4 2 5
7 8 6

You can move a piece toward the empty space at one step. Your goal is to make the pieces the following configuration in the shortest move (fewest steps).

1 2 3
4 5 6
7 8 0

Write a program which reads an initial state of the puzzle and prints the fewest steps to solve the puzzle.

Input

The $3 \times 3$ integers denoting the pieces or space are given.

Output

Print the fewest steps in a line.

Constraints

There is a solution.

Sample Input

1 3 0
4 2 5
7 8 6

Sample Output

4

Solution in Haskell (judge verdict: Accepted)

{-# LANGUAGE FlexibleContexts #-}
 
module Main where
 
import Debug.Trace
import Data.List
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Word
import Data.Char
import Data.Bits
import Data.Array
-- import Data.Array.Unboxed
-- import Data.Array.IO
import Data.Maybe
-- import qualified Data.Map as M
import qualified Data.IntMap as M
-- import Control.Monad.ST
-- import Data.STRef
import Data.Ord
import Data.Functor
import Control.Applicative
import Control.Monad
import Text.Printf
 
size = 3 
sqSize = size*size
maxAdr = sqSize -1
mask = 0xF
shiftSize = 4
shiftTimes= 16
 
solver :: [[Int]] -> Int
solver lst
    | start == goal = 0
    | otherwise = iter (initialQueue, initialVisited) where
        iter (que, visited) = case Seq.viewr que of
            Seq.EmptyR -> error "No path found."
            que Seq.:> path@(board, distance, forward) -> case next path visited of
                (_, Just d)  -> distance + d +1
                (nextPaths, Nothing) -> iter (insertPaths que visited nextPaths) where
                    insertPaths q v [] = (q, v)
                    insertPaths q v (p@(x, d, f):ps) = insertPaths insertQue insertVisited ps where
                        insertQue = p Seq.<| q
                        insertVisited = M.insert x (d, f) v
        next path@(board, distance, forward) visited = iter [] Nothing nextBoards where
            iter ac af [] = (ac, af)
            iter ac af (x:xs) = case M.lookup x visited of
                Nothing -> iter ((x, distance+1, forward):ac) af xs
                Just (d', f') -> if forward == f' then iter ac af xs else (ac, Just d')
            nextBoards = [swapWith (valueAt p board) board | p <- dest!(searchZero board)]
 
        initialQueue = (goal, 0, False) Seq.<| (Seq.singleton (start, 0, True))
        initialVisited = M.insert goal (0, False) $ M.singleton start (0, True)
        goal    = toBits [1,2,3,4,5,6,7,8,0]
        start   = toBits $ concat lst
        dest    = listArray (0, maxAdr) [[1,3],[0,2,4],[1,5],[0,4,6],[1,3,5,7],[2,4,8],[3,7],[4,6,8],[5,7]]
        toBits = foldl' (\b a-> shiftL b shiftSize .|. a) 0
        valueAt i w = mask .&. shiftR w (shiftSize*i)
 
searchZero :: Int -> Int
searchZero = iter 0 where
    iter c w = case mask .&. w of 
        hb  | hb == 0 -> c
            | otherwise -> iter (c+1) (rotateR w shiftSize)
 
swapWith :: Int -> Int -> Int
swapWith v = iter sqSize where
    iter 0 w = rotateR w (shiftSize*(shiftTimes-sqSize))
    iter c w = iter (c-1) $ rotateR (case mask .&. w of
        hb  | hb == 0 -> w .|. v
            | hb == v -> w `xor` v
            | otherwise -> w) shiftSize
 
readIntLn:: IO Int
readIntLn = (fst . fromJust . B.readInt) <$> B.getLine
 
readIntList:: IO [Int]
readIntList = map (fst . fromJust . B.readInt) . B.words <$> B.getLine
 
main :: IO() 
main = do
    l <- replicateM size readIntList
    print $ solver l