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
maxAdr = size*size -1

solver :: [[Int]] -> Int
solver lst = bfs start goalID where
    bfs start goalID = iter (initialQueue, initialVisited) where
        iter (que, visited) = case Seq.viewr que of
            Seq.EmptyR -> error "No path found."
            que Seq.:> path@(board, bId, 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, xId):xs) = case M.lookup xId visited of
                Nothing -> iter ((x, xId, distance+1, forward):ac) af xs
                Just (d', f') -> if forward == f' then iter ac af xs else (ac, Just d')
            boards = [swapAt (board !! q) board | q <- dest!p]
            nextBoards = [(x, generateID x)| x <- boards]
            p = fromJust $ elemIndex 0 board

    initialQueue = (goal, goalID, 0, False) Seq.<| (Seq.singleton (start, startID, 0, True))
    initialVisited = M.insert goalID (0, False) $ M.singleton startID (0, True)
    goal    = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,0]
    goalID  = generateID goal
    start   = concat lst
    startID = generateID start
    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]] 
    generateID board = foldl' (\b a-> shiftL b 4 .|. a) 0 board

swapAt :: Int -> [Int] -> [Int]
swapAt v = foldr (\a b -> case a of
    _   | a == 0 -> v:b
        | a == v -> 0:b
        | otherwise -> a:b
     ) [] 

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