オフラインリアルタイムどう書く第四回の参考問題をHaskellで書いた


オフラインリアルタイムどう書く第四回の参考問題をHaskellで書きました。

アルゴリズムは単純な深さ優先探索です。
通行止めがない5×5のグラフを予めハードコーデリングしているのがイマイチです。。。

fukashigi.hs
import Data.List

type Path = (Char,Char)
type Graph = [Path]
graph = [
        ('a','b'),('a','f'),
        ('b','c'),('b','g'),('b','a'),
        ('c','d'),('c','h'),('c','b'),
        ('d','e'),('d','i'),('d','c'),
        ('e','j'),('e','d'),
        ('f','a'),('f','g'),('f','k'),
        ('g','b'),('g','h'),('g','l'),('g','f'),
        ('h','c'),('h','i'),('h','m'),('h','g'),
        ('i','d'),('i','j'),('i','n'),('i','h'),
        ('j','e'),('j','o'),('j','i'),
        ('k','f'),('k','l'),('k','p'),
        ('l','g'),('l','m'),('l','q'),('l','k'),
        ('m','h'),('m','n'),('m','r'),('m','l'),
        ('n','i'),('n','o'),('n','s'),('n','m'),
        ('o','j'),('o','t'),('o','n'),
        ('p','k'),('p','q'),('p','u'),
        ('q','l'),('q','r'),('q','v'),('q','p'),
        ('r','m'),('r','s'),('r','w'),('r','q'),
        ('s','n'),('s','t'),('s','x'),('s','r'),
        ('t','o'),('t','y'),('t','s'),
        ('u','p'),('u','v'),
        ('v','q'),('v','w'),('v','u'),
        ('w','r'),('w','x'),('w','v'),
        ('x','s'),('x','y'),('x','w'),
        ('y','t'),('y','x')
        ] :: Graph


makeGraph :: IO Graph
makeGraph = do
    line <- getLine
    let removedPath = concatMap (\(x:y:[]) -> [(x,y),(y,x)]) $ words line
    let removedGraph = foldr delete graph removedPath
    return removedGraph


dfs p g graph px | p == g = 1
                 | p `elem` px = 0
                 | otherwise = sum [dfs np g graph (p:px) | np <- nextp p]
                 where
                    nextp p = [y | (x,y) <- graph, x == p]

main = do
    removedGraph <- makeGraph
    print $ dfs 'a' 'y' removedGraph []

他の過去問も解いています。(解けそうな問題から書いてます。。。汗)