1
1
-- | A data structure and functions for graphs
2
2
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'
15
12
) where
16
13
17
- import Prelude ( class Ord , class Eq , class Show , (<<<), id , ($), (<), (==), (&&), not , unit , return , bind , (++), flip , map , one , (+), zero , show )
14
+ import Prelude
18
15
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 )
25
16
import Control.Monad.Eff (runPure )
26
17
import Control.Monad.ST (writeSTRef , modifySTRef , readSTRef , newSTRef , runST )
27
18
19
+ import Data.Foldable (any , for_ , elem )
20
+ import Data.List (List (..), concatMap , reverse , singleton )
28
21
import Data.Map as M
22
+ import Data.Maybe (Maybe (..), isNothing )
23
+ import Data.Traversable (for )
29
24
30
25
-- | An directed edge between vertices labelled with keys of type `k`.
31
26
data Edge k = Edge k k
@@ -35,8 +30,6 @@ data Edge k = Edge k k
35
30
-- | Edges refer to vertices using keys of type `k`.
36
31
data Graph k v = Graph (List v ) (List (Edge k ))
37
32
38
- type Index = Int
39
-
40
33
-- | A strongly-connected component of a graph.
41
34
-- |
42
35
-- | - `AcyclicSCC` identifies strongly-connected components consisting of a single vertex.
@@ -45,8 +38,8 @@ type Index = Int
45
38
data SCC v = AcyclicSCC v | CyclicSCC (List v )
46
39
47
40
instance 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 <> " ) "
50
43
51
44
instance eqSCC :: (Eq v ) => Eq (SCC v ) where
52
45
eq (AcyclicSCC v1) (AcyclicSCC v2) = v1 == v2
@@ -59,14 +52,14 @@ vertices (AcyclicSCC v) = singleton v
59
52
vertices (CyclicSCC vs) = vs
60
53
61
54
-- | 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 )
63
56
scc = scc' id id
64
57
65
58
-- | Compute the strongly connected components of a graph.
66
59
-- |
67
60
-- | This function is a slight generalization of `scc` which allows key and value types
68
61
-- | 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 )
70
63
scc' makeKey makeVert (Graph vs es) = runPure (runST (do
71
64
index <- newSTRef zero
72
65
path <- newSTRef Nil
@@ -79,13 +72,13 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
79
72
80
73
indexOfKey k = do
81
74
m <- readSTRef indexMap
82
- return $ M .lookup k m
75
+ pure $ M .lookup k m
83
76
84
77
lowlinkOf v = lowlinkOfKey (makeKey v)
85
78
86
79
lowlinkOfKey k = do
87
80
m <- readSTRef lowlinkMap
88
- return $ M .lookup k m
81
+ pure $ M .lookup k m
89
82
90
83
go Nil = readSTRef components
91
84
go (Cons v vs) = do
@@ -126,34 +119,34 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
126
119
when (vIndex == vLowlink) $ do
127
120
currentPath <- readSTRef path
128
121
let newPath = popUntil makeKey v currentPath Nil
129
- modifySTRef components $ flip (++ ) (singleton (makeComponent newPath.component))
122
+ modifySTRef components $ flip (<> ) (singleton (makeComponent newPath.component))
130
123
writeSTRef path newPath.path
131
- return unit
124
+ pure unit
132
125
133
126
makeComponent (Cons v Nil ) | not (isCycle (makeKey v)) = AcyclicSCC v
134
127
makeComponent vs = CyclicSCC vs
135
128
136
129
isCycle k = any (\(Edge k1 k2) -> k1 == k && k2 == k) es
137
130
in go vs)))
138
131
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 }
140
133
popUntil _ _ Nil popped = { path: Nil , component: popped }
141
134
popUntil makeKey v (Cons w path) popped | makeKey v == makeKey w = { path: path, component: Cons w popped }
142
135
popUntil makeKey v (Cons w ws) popped = popUntil makeKey v ws (Cons w popped)
143
136
144
- maybeMin :: Index -> Maybe Index -> Maybe Index
137
+ maybeMin :: Int -> Maybe Int -> Maybe Int
145
138
maybeMin i Nothing = Just i
146
139
maybeMin i (Just j) = Just $ min i j
147
140
where
148
141
min x y = if x < y then x else y
149
142
150
143
-- | 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
152
145
topSort = topSort' id id
153
146
154
147
-- | Topologically sort the vertices of a graph
155
148
-- |
156
149
-- | This function is a slight generalization of `scc` which allows key and value types
157
150
-- | 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
159
152
topSort' makeKey makeVert = reverse <<< concatMap vertices <<< scc' makeKey makeVert
0 commit comments