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 =  
dy | c == 'L'  =  1
| c == 'R'  = -1
| otherwise =  
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, [])]

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