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

15 Puzzle

The goal of the 15 puzzle problem is to complete pieces on $4 \times 4$ 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 15 as shown below.

1 2 3 4
6 7 8 0
5 10 11 12
9 13 14 15

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
9 10 11 12
13 14 15 0

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

Input

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

Output

Print the fewest steps in a line.

Constraints

The given puzzle is solvable in at most 45 steps.

Sample Input

1 2 3 4
6 7 8 0
5 10 11 12
9 13 14 15

Sample Output

8

Solution in Haskell (judge verdict: Memory Limit Exceeded)

{-# 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 = 4 
sqSize = size*size
maxAdr = sqSize -1
mask = 0xF
shiftSize = 4

solver :: [[Int]] -> Int
solver lst = bfs start goal where
    bfs start goal = 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 (p Seq.<| q) (M.insert x (d, f) v) ps
        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')
            boards = [swapWith (valueAt p board) board | p <- dest!(searchZro board)]
            nextBoards = [x| x <- boards]

    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,9,10,11,12,13,14,15,0]
    start   = toBits $ concat lst
    dest    = listArray (0, maxAdr) [[1,4],[0,2,5],[1,3,6],[2,7],
                                    [0,5,8],[1,4,6,9],[2,5,7,10],[3,6,11],
                                    [4,9,12],[5,8,10,13],[6,9,11,14],[7,10,15],
                                    [8,13],[9,12,14],[10,13,15],[11,14]] 
    toBits = foldl' (\b a-> shiftL b shiftSize .|. a) 0
    valueAt i w = mask .&. shiftR w (shiftSize*i)

searchZro :: Int -> Int
searchZro = iter 0 where
    iter c w = case mask .&. w of 
        hb  | hb == 0 -> c
            | otherwise -> iter (c+1) (rotateR w size)

swapWith :: Int -> Int -> Int
swapWith v = iter sqSize where
    iter 0 w = w
    iter c w = iter (c-1) $ rotateR (case mask .&. w of
        hb  | hb == 0 -> w .|. v
            | hb == v -> w `xor` v
            | otherwise -> w) size

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