ルート探索
ルート探索(1) - バリケンのRuby日記 - RubyistをHaskellで書いてみました。最近こればっかりな気もしますが。
やっぱり再帰ものは書きやすいです。バリケンさんのコードをそのまま移植できました。副作用のないバージョンも2つ書いてみましたので、参考まで。
module Main (main) where import Data.Maybe (fromJust) routeMap :: [(String, [String])] routeMap = [("A", ["B", "D"]), ("B", ["A", "C"]), ("C", ["A", "D"]), ("D", ["B", "C"])] -- 関数の中で出力する場合。 routeComb1 :: String -> String -> [(String, [String])] -> IO () routeComb1 = comb [] where comb trace start goal rtmap = mapM_ f $ fromJust $ lookup start rtmap where trace' = start : trace f node | elem node trace = return () | node == goal = print $ reverse $ node : trace' | otherwise = comb trace' node goal rtmap -- リストを返す場合。 routeComb2 :: String -> String -> [(String, [String])] -> [[String]] routeComb2 = comb [] where comb trace start goal rtmap = concatMap f $ fromJust $ lookup start rtmap where trace' = start : trace f node | elem node trace = [] | node == goal = [reverse $ node : trace'] | otherwise = comb trace' node goal rtmap -- リストを返す場合(accumulaterを使う場合)。 routeComb3 :: String -> String -> [(String, [String])] -> [[String]] routeComb3 = comb [] [] where comb acc trace start goal rtmap = concatMap f $ fromJust $ lookup start rtmap where trace' = start : trace f node | elem node trace = acc | node == goal = (reverse $ node : trace') : acc | otherwise = comb acc trace' node goal rtmap main :: IO () main = do putStrLn "routeComb1:" routeComb1 "B" "D" routeMap putStrLn "routeComb2:" mapM_ print $ routeComb2 "B" "D" routeMap putStrLn "routeComb3:" mapM_ print $ routeComb3 "B" "D" routeMap
実行例:
$ ./rt.exe routeComb1: ["B","A","D"] ["B","C","A","D"] ["B","C","D"] routeComb2: ["B","A","D"] ["B","C","A","D"] ["B","C","D"] routeComb3: ["B","A","D"] ["B","C","A","D"] ["B","C","D"]