loop の列挙

cf. 今日の一行 - loopの列挙

trail はすでにたどったノードのリスト p と次にたどるノードの候補 q を受け取って，全ての経路を列挙する。「次のノード」がスタートと同じならそこでそのループは終わり。違うなら再帰的にノードをたどる。
各ノードは比較さえできればいいので Eq a にした。入出力の関係で結局は文字列になってるけど。

 module Main (main) where
 
 import Data.List (intersperse)
 import System (getArgs)
 
 
 trail :: (Eq a) => [a] -> [a] -> [[a]] 
 trail p q = concat $ map trail' q
   where
     trail' q1 | head p == q1 = [ p ++ [q1] ]
               | otherwise    = trail (p ++ [q1]) $ filter (q1/=) q
 
 
 trailLoop :: (Eq a) => a -> [a] -> [[a]]
 trailLoop s = trail [s]
 
 
 enumLoops :: (Eq a) => [a] -> [[a]]
 enumLoops nodes = concat $ map (flip trailLoop nodes) nodes
 
 
 showLoop :: [String] -> String
 showLoop = concat . intersperse " -> "
 
 
 main :: IO ()
 main = do nodes <- getArgs
           mapM_ (putStrLn.showLoop) $ enumLoops nodes

実行例

 D:\>runghc enumLoops.hs 1 2 3
 1 -> 1
 1 -> 2 -> 1
 1 -> 2 -> 3 -> 1
 1 -> 3 -> 1
 1 -> 3 -> 2 -> 1
 2 -> 1 -> 2
 2 -> 1 -> 3 -> 2
 2 -> 2
 2 -> 3 -> 1 -> 2
 2 -> 3 -> 2
 3 -> 1 -> 2 -> 3
 3 -> 1 -> 3
 3 -> 2 -> 1 -> 3
 3 -> 2 -> 3
 3 -> 3

ノードが１つ増えるとループはぐっと増える。

 D:\>runghc enumLoops.hs 1 2 3 4
 1 -> 1
 1 -> 2 -> 1
 1 -> 2 -> 3 -> 1
 1 -> 2 -> 3 -> 4 -> 1
 1 -> 2 -> 4 -> 1
 1 -> 2 -> 4 -> 3 -> 1
 1 -> 3 -> 1
 1 -> 3 -> 2 -> 1
 1 -> 3 -> 2 -> 4 -> 1
 1 -> 3 -> 4 -> 1
 1 -> 3 -> 4 -> 2 -> 1
 1 -> 4 -> 1
 1 -> 4 -> 2 -> 1
 1 -> 4 -> 2 -> 3 -> 1
 1 -> 4 -> 3 -> 1
 1 -> 4 -> 3 -> 2 -> 1
 2 -> 1 -> 2
 2 -> 1 -> 3 -> 2
 2 -> 1 -> 3 -> 4 -> 2
 2 -> 1 -> 4 -> 2
 2 -> 1 -> 4 -> 3 -> 2
 2 -> 2
 2 -> 3 -> 1 -> 2
 2 -> 3 -> 1 -> 4 -> 2
 2 -> 3 -> 2
 2 -> 3 -> 4 -> 1 -> 2
 2 -> 3 -> 4 -> 2
 2 -> 4 -> 1 -> 2
 2 -> 4 -> 1 -> 3 -> 2
 2 -> 4 -> 2
 2 -> 4 -> 3 -> 1 -> 2
 2 -> 4 -> 3 -> 2
 3 -> 1 -> 2 -> 3
 3 -> 1 -> 2 -> 4 -> 3
 3 -> 1 -> 3
 3 -> 1 -> 4 -> 2 -> 3
 3 -> 1 -> 4 -> 3
 3 -> 2 -> 1 -> 3
 3 -> 2 -> 1 -> 4 -> 3
 3 -> 2 -> 3
 3 -> 2 -> 4 -> 1 -> 3
 3 -> 2 -> 4 -> 3
 3 -> 3
 3 -> 4 -> 1 -> 2 -> 3
 3 -> 4 -> 1 -> 3
 3 -> 4 -> 2 -> 1 -> 3
 3 -> 4 -> 2 -> 3
 3 -> 4 -> 3
 4 -> 1 -> 2 -> 3 -> 4
 4 -> 1 -> 2 -> 4
 4 -> 1 -> 3 -> 2 -> 4
 4 -> 1 -> 3 -> 4
 4 -> 1 -> 4
 4 -> 2 -> 1 -> 3 -> 4
 4 -> 2 -> 1 -> 4
 4 -> 2 -> 3 -> 1 -> 4
 4 -> 2 -> 3 -> 4
 4 -> 2 -> 4
 4 -> 3 -> 1 -> 2 -> 4
 4 -> 3 -> 1 -> 4
 4 -> 3 -> 2 -> 1 -> 4
 4 -> 3 -> 2 -> 4
 4 -> 3 -> 4
 4 -> 4