11-- | A data structure and functions for graphs
22
3- module Data.Graph (
4- Edge (..),
5- Graph (..),
6- SCC (..),
7-
8- vertices ,
9-
10- scc ,
11- scc' ,
12-
13- topSort ,
14- topSort'
3+ module Data.Graph
4+ ( Edge (..)
5+ , Graph (..)
6+ , SCC (..)
7+ , vertices
8+ , scc
9+ , scc'
10+ , topSort
11+ , topSort'
1512 ) where
1613
17- import Prelude ( class Ord , class Eq , class Show , (<<<), id , ($), (<), (==), (&&), not , unit , return , bind , (++), flip , map , one , (+), zero , show )
14+ import Prelude
1815
19- import Data.Maybe (Maybe (Just, Nothing), isNothing )
20- import Data.List (List (Cons, Nil), concatMap , reverse , singleton )
21- import Data.Foldable (any , for_ , elem )
22- import Data.Traversable (for )
23-
24- import Control.Monad (when )
2516import Control.Monad.Eff (runPure )
2617import Control.Monad.ST (writeSTRef , modifySTRef , readSTRef , newSTRef , runST )
2718
19+ import Data.Foldable (any , for_ , elem )
20+ import Data.List (List (..), concatMap , reverse , singleton )
2821import Data.Map as M
22+ import Data.Maybe (Maybe (..), isNothing )
23+ import Data.Traversable (for )
2924
3025-- | An directed edge between vertices labelled with keys of type `k`.
3126data Edge k = Edge k k
@@ -35,8 +30,6 @@ data Edge k = Edge k k
3530-- | Edges refer to vertices using keys of type `k`.
3631data Graph k v = Graph (List v ) (List (Edge k ))
3732
38- type Index = Int
39-
4033-- | A strongly-connected component of a graph.
4134-- |
4235-- | - `AcyclicSCC` identifies strongly-connected components consisting of a single vertex.
@@ -45,8 +38,8 @@ type Index = Int
4538data SCC v = AcyclicSCC v | CyclicSCC (List v )
4639
4740instance showSCC :: (Show v ) => Show (SCC v ) where
48- show (AcyclicSCC v) = " AcyclicSCC ( " ++ show v ++ " )"
49- show (CyclicSCC vs) = " CyclicSCC " ++ show vs
41+ show (AcyclicSCC v) = " ( AcyclicSCC " <> show v <> " )"
42+ show (CyclicSCC vs) = " ( CyclicSCC " <> show vs <> " ) "
5043
5144instance eqSCC :: (Eq v ) => Eq (SCC v ) where
5245 eq (AcyclicSCC v1) (AcyclicSCC v2) = v1 == v2
@@ -59,14 +52,14 @@ vertices (AcyclicSCC v) = singleton v
5952vertices (CyclicSCC vs) = vs
6053
6154-- | Compute the strongly connected components of a graph.
62- scc :: forall v . ( Eq v , Ord v ) => Graph v v -> List (SCC v )
55+ scc :: forall v . Ord v => Graph v v -> List (SCC v )
6356scc = scc' id id
6457
6558-- | Compute the strongly connected components of a graph.
6659-- |
6760-- | This function is a slight generalization of `scc` which allows key and value types
6861-- | to differ.
69- scc' :: forall k v . ( Eq k , Ord k ) => (v -> k ) -> (k -> v ) -> Graph k v -> List (SCC v )
62+ scc' :: forall k v . Ord k => (v -> k ) -> (k -> v ) -> Graph k v -> List (SCC v )
7063scc' makeKey makeVert (Graph vs es) = runPure (runST (do
7164 index <- newSTRef zero
7265 path <- newSTRef Nil
@@ -79,13 +72,13 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
7972
8073 indexOfKey k = do
8174 m <- readSTRef indexMap
82- return $ M .lookup k m
75+ pure $ M .lookup k m
8376
8477 lowlinkOf v = lowlinkOfKey (makeKey v)
8578
8679 lowlinkOfKey k = do
8780 m <- readSTRef lowlinkMap
88- return $ M .lookup k m
81+ pure $ M .lookup k m
8982
9083 go Nil = readSTRef components
9184 go (Cons v vs) = do
@@ -126,34 +119,34 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
126119 when (vIndex == vLowlink) $ do
127120 currentPath <- readSTRef path
128121 let newPath = popUntil makeKey v currentPath Nil
129- modifySTRef components $ flip (++ ) (singleton (makeComponent newPath.component))
122+ modifySTRef components $ flip (<> ) (singleton (makeComponent newPath.component))
130123 writeSTRef path newPath.path
131- return unit
124+ pure unit
132125
133126 makeComponent (Cons v Nil ) | not (isCycle (makeKey v)) = AcyclicSCC v
134127 makeComponent vs = CyclicSCC vs
135128
136129 isCycle k = any (\(Edge k1 k2) -> k1 == k && k2 == k) es
137130 in go vs)))
138131
139- popUntil :: forall k v . ( Eq k ) => (v -> k ) -> v -> List v -> List v -> { path :: List v , component :: List v }
132+ popUntil :: forall k v . Eq k => (v -> k ) -> v -> List v -> List v -> { path :: List v , component :: List v }
140133popUntil _ _ Nil popped = { path: Nil , component: popped }
141134popUntil makeKey v (Cons w path) popped | makeKey v == makeKey w = { path: path, component: Cons w popped }
142135popUntil makeKey v (Cons w ws) popped = popUntil makeKey v ws (Cons w popped)
143136
144- maybeMin :: Index -> Maybe Index -> Maybe Index
137+ maybeMin :: Int -> Maybe Int -> Maybe Int
145138maybeMin i Nothing = Just i
146139maybeMin i (Just j) = Just $ min i j
147140 where
148141 min x y = if x < y then x else y
149142
150143-- | Topologically sort the vertices of a graph
151- topSort :: forall v . ( Eq v , Ord v ) => Graph v v -> List v
144+ topSort :: forall v . Ord v => Graph v v -> List v
152145topSort = topSort' id id
153146
154147-- | Topologically sort the vertices of a graph
155148-- |
156149-- | This function is a slight generalization of `scc` which allows key and value types
157150-- | to differ.
158- topSort' :: forall k v . ( Eq k , Ord k ) => (v -> k ) -> (k -> v ) -> Graph k v -> List v
151+ topSort' :: forall k v . Ord k => (v -> k ) -> (k -> v ) -> Graph k v -> List v
159152topSort' makeKey makeVert = reverse <<< concatMap vertices <<< scc' makeKey makeVert
0 commit comments