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