Problem 244

244 Sliders
Problem 244 - Project Euler
15 puzzle が2色に塗り分けられたときの話．
最短手順ではなく，全ての最短手順を求めなくてはいけないのだが…
状態数は高々 16*2^16 = 1,048,576 なので，全探索できるレベル．
なので，適当にコードをつくった．
はじめは，Lは空白を左に動かす操作だと思っていた．正しくは，空白の右隣のピースを左に動かす操作である．
これで，一瞬ハマリかけた．

import Data.Char (ord)
import Data.Array.Unboxed (UArray ,listArray, range, (//), (!))
import Data.Maybe (mapMaybe)
import Data.Map (toList, fromListWith)

type Board = ((Int, Int), UArray (Int, Int) Bool)
type State = (Board, [Integer])

start, goal :: Board
start = ((1,1), listArray ((1,1), (4,4)).cycle $ [False, False, True, True])
goal  = ((1,1), listArray ((1,1), (4,4)).cycle $ [False, True, False, True,
                                                  True, False, True, False])

move :: State -> Char -> Maybe State
move ( ((x,y), b), css ) c
    | not.elem (x + dx, y + dy).range $ ((1,1),(4,4))  = Nothing
    | otherwise = Just ( ((x + dx,y + dy), b //[ ((x,y), a), ((x + dx,y + dy), False) ] ), map (updateCS c) css )
    where a = b ! (x + dx, y + dy)
          dx | c == 'U'  =  1
             | c == 'D'  = -1
             | otherwise =  0
          dy | c == 'L'  =  1
             | c == 'R'  = -1
             | otherwise =  0

updateCS :: Char -> Integer -> Integer
updateCS c cs = mod (cs*243 + toInteger (ord c)) 100000007

step :: [State] -> [State]
step ss  = toList.fromListWith (++).concatMap next $ ss
    where next s = mapMaybe (move s) $ "LRUD"

main :: IO ()
main = print.sum.snd.head.filter ((==goal).fst).(!!32).iterate step $ [(start, [0])]

ものすごい，そのままの幅優先探索である．