Posted at

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

More than 5 years have passed since last update.

オフラインリアルタイムどう書く第四回の参考問題を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 []


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