不正な状態遷移を見つけるアルゴリズム

http://d.hatena.ne.jp/a-san/20090623#p1
ガーベージコレクションでよく使われる、Mark&Sweep法がこの問題に使えるのに気づきました。
攻略法がわかれば、あとは実装して終わり。
マークをつける代わりに、たどったところは集合として扱いました。

言語は久しぶりにHaskellを使ってみました。

{-
    状態遷移で、到達しない状態を求める。
    ガーベージコレクションの Mark & Sweep法と同じアルゴリズムを使っている。
-}
import Data.Set as Set hiding (filter, map)

-- 状態遷移
-- 0 は開始状態。
-- A,B,Cは普通の状態遷移。
-- D,Hは遷移しない状態。
-- E,F,Gは孤立した状態遷移。
-- Iも孤立した状態。
transientList = [
    ('0','A'),
    ('A','B'),
    ('B','C'),
    ('C','B'),
    ('C','A'),
    ('D','B'),
    ('D','H'),
    ('H','D'),
    ('E','F'),
    ('F','G'),
    ('G','F'),
    ('G','E'),
    ('I','I')]


-- cur状態から次に遷移可能な状態をすべて列挙する。
-- 例えば、cur='C'ならば、['A','B']を返す。
nextState:: Eq a => [(a,a)] -> a -> [a]
nextState tranlist cur =
    snd $ unzip $ filter (\x -> fst x == cur) tranlist


-- cur状態から始めて、遷移可能な状態を返す。
visit:: Ord a => [(a,a)] -> a -> Set a -> Set a
visit translist cur visited =
    -- すでにその状態になったことがあるか？
    if member cur visited
        then visited
        -- 次の状態をすべて廻る。
        else unions $ map (\n -> visit translist n v) nexts
            where
                v = insert cur visited
                nexts = nextState translist cur

-- 状態遷移リストから、すべての状態を取得する。"0ABCDEFGHI"が返る。
allState:: Ord a => [(a,a)] -> Set a -> Set a
allState [] result = result
allState ((a,b):xs) result = 
    insert a $ insert b (allState xs result)

-- start状態から始めて、遷移しない状態を返す。
badState tranlist start =
    difference (allState tranlist empty) (visit tranlist start empty)

-- 問題を解く
main = badState transientList '0'