1 module Digraph where
    2 
    3 {-
    4 elem :: Int -> [Int] -> Bool
    5 elem x [] = False
    6 elem x (y:ys) = (x == y) || (elem x ys)
    7 
    8 (||) :: Bool -> Bool -> Bool
    9 (||) True  x = True
   10 (||) False x = x
   11 
   12 (++) :: [Int] -> [Int] -> [Int]
   13 (++) [] ys = ys
   14 (++) (x:xs) ys = x : (xs ++ ys)
   15 
   16 map :: (a -> b) -> [a] -> [b]
   17 map f [] = []
   18 map f (x:xs) = (f x) : (map f xs)
   19 
   20 snd (x,y) = y
   21 -}
   22 
   23 type Edge  vertex = (vertex, vertex)
   24 type Cycle vertex = [vertex]
   25 
   26 stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
   27 -- stronglyConnComp :: [Edge Int] -> [Int] -> [[Int]]
   28 
   29 stronglyConnComp es vs
   30   = snd (span_tree (new_range reversed_edges)
   31                    ([],[])
   32                    ( snd (dfs (new_range es) ([],[]) vs) )
   33         )
   34  where
   35    -- reversed_edges :: [Edge Int]
   36    reversed_edges = map swap es
   37 
   38    -- swap :: Edge Int -> Edge Int
   39    swap (x,y) = (y, x)
   40 
   41    -- new_range :: [Edge Int] -> Int -> [Int]
   42    new_range    []       w = []
   43    new_range ((x,y):xys) w
   44        = if x==w
   45          then (y : (new_range xys w))
   46          else (new_range xys w)
   47 
   48    {- span_tree :: (Int -> [Int])
   49                       -> ([Int], [[Int]])
   50                       -> [Int]
   51                       -> ([Int], [[Int]]) -}
   52    span_tree r (vs,ns) []   = (vs,ns)
   53    span_tree r (vs,ns) (x:xs)
   54        | x `elem` vs = span_tree r (vs,ns) xs
   55        | True = span_tree r (vs',(x:ns'):ns) xs
   56          where
   57            (vs',ns') = dfs r (x:vs,[]) (r x)
   58 
   59 dfs :: Eq v => (v -> [v])
   60             -> ([v], [v])
   61             -> [v]
   62             -> ([v], [v])
   63 {-
   64 dfs :: (Int -> [Int])
   65             -> ([Int], [Int])
   66             -> [Int]
   67             -> ([Int], [Int])
   68 -}
   69 dfs r (vs,ns)   []   = (vs,ns)
   70 dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
   71                      | True = dfs r (vs',(x:ns')++ns) xs
   72                                    where
   73                                      (vs',ns') = dfs r (x:vs,[]) (r x)