Haskell で水差し問題を解く (自答編 2)

前回の話は、全状態のリストを求めるところまでと、中途半端だったので。全ての解を求めるプログラムを作成した。

ゴール状態に到着したら、ゴールまでの経路を文字列に変換し、全ての解とその経路を出力している。
以下が、コードの全体。

import List
import Char

basicState = (0,0)
actions = let {xmax = 4; ymax = 3}
in [(\(x, y) -> (xmax, y)),
(\(x, y) -> (x, ymax)),
(\(x, y) -> (0, y)),
(\(x, y) -> (x, 0)),
(\(x, y) -> if (x + y > xmax) then (xmax, y+x-xmax) else (x+y, 0)),
(\(x, y) -> if (x + y > ymax) then (x+y-ymax, ymax) else (0, x+y))]

main = putStr $ searchStates [] basicState

searchStates :: [(Int, Int)] -> (Int, Int) -> String
searchStates route state | stateGoal(state) = makeLine (state:route)
| True = let nexts = nub $ filter (not . (checkState route)) $ execSeek actions state
in if length nexts > 0
then concatMap (searchStates (state:route)) nexts
else ""

execSeek :: [((Int, Int) -> (Int, Int))] -> (Int, Int) -> [(Int, Int)]
execSeek (f:fs) crnt | null fs = (f crnt : [])
| True = (f crnt : []) ++ execSeek fs crnt

stateGoal :: (Int, Int) -> Bool
stateGoal (x,y) | x == 2 || y == 2 = True
| True = False

checkState :: [(Int, Int)] -> (Int, Int) -> Bool
checkState states (crnt_x, crnt_y) = any isSameState states
where
isSameState :: (Int, Int) -> Bool
isSameState (x, y) = if (x == crnt_x && y == crnt_y) then True else False

makeLine :: [(Int, Int)] -> String
makeLine states = (concatMap (\(x, y) -> "("++((chr (ord('0')+x)):", ")++((chr (ord('0')+y)):")") ) states) ++ "\n"

出力結果は次のようになる

./a.out | nl | tail
3143 (2, 3)(4, 1)(4, 1)(0, 1)(1, 0)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3144 (2, 3)(4, 1)(0, 1)(1, 0)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3145 (2, 3)(4, 1)(4, 1)(0, 1)(0, 1)(1, 0)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3146 (2, 3)(4, 1)(0, 1)(0, 1)(1, 0)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3147 (2, 3)(4, 1)(4, 1)(0, 1)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3148 (2, 3)(4, 1)(0, 1)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3149 (2, 3)(4, 1)(4, 1)(0, 1)(0, 1)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3150 (2, 3)(4, 1)(0, 1)(0, 1)(1, 0)(1, 3)(4, 0)(4, 3)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3151 (4, 2)(3, 3)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)
3152 (4, 2)(3, 3)(3, 0)(3, 0)(0, 3)(0, 0)(0, 0)