@@ -4,19 +4,18 @@ module Data.Graph (
4
4
Edge (..),
5
5
Graph (..),
6
6
SCC (..),
7
-
7
+
8
8
vertices ,
9
9
10
10
scc ,
11
11
scc' ,
12
-
12
+
13
13
topSort ,
14
14
topSort'
15
15
) where
16
16
17
17
import Prelude
18
18
19
- import Data.Int
20
19
import Data.Maybe
21
20
import Data.List
22
21
import Data.Foldable
@@ -37,7 +36,7 @@ data Edge k = Edge k k
37
36
-- | Edges refer to vertices using keys of type `k`.
38
37
data Graph k v = Graph (List v ) (List (Edge k ))
39
38
40
- type Index = Int
39
+ type Index = Int
41
40
42
41
-- | A strongly-connected component of a graph.
43
42
-- |
@@ -47,7 +46,7 @@ type Index = Int
47
46
data SCC v = AcyclicSCC v | CyclicSCC (List v )
48
47
49
48
instance showSCC :: (Show v ) => Show (SCC v ) where
50
- show (AcyclicSCC v) = " AcyclicSCC (" ++ show v ++ " )"
49
+ show (AcyclicSCC v) = " AcyclicSCC (" ++ show v ++ " )"
51
50
show (CyclicSCC vs) = " CyclicSCC " ++ show vs
52
51
53
52
instance eqSCC :: (Eq v ) => Eq (SCC v ) where
@@ -65,26 +64,26 @@ scc :: forall v. (Eq v, Ord v) => Graph v v -> List (SCC v)
65
64
scc = scc' id id
66
65
67
66
-- | Compute the strongly connected components of a graph.
68
- -- |
67
+ -- |
69
68
-- | This function is a slight generalization of `scc` which allows key and value types
70
69
-- | to differ.
71
70
scc' :: forall k v . (Eq k , Ord k ) => (v -> k ) -> (k -> v ) -> Graph k v -> List (SCC v )
72
71
scc' makeKey makeVert (Graph vs es) = runPure (runST (do
73
- index <- newSTRef zero
72
+ index <- newSTRef zero
74
73
path <- newSTRef Nil
75
74
indexMap <- newSTRef M .empty
76
75
lowlinkMap <- newSTRef M .empty
77
76
components <- newSTRef Nil
78
77
79
- (let
78
+ (let
80
79
indexOf v = indexOfKey (makeKey v)
81
-
80
+
82
81
indexOfKey k = do
83
82
m <- readSTRef indexMap
84
83
return $ M .lookup k m
85
-
84
+
86
85
lowlinkOf v = lowlinkOfKey (makeKey v)
87
-
86
+
88
87
lowlinkOfKey k = do
89
88
m <- readSTRef lowlinkMap
90
89
return $ M .lookup k m
@@ -97,7 +96,7 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
97
96
98
97
strongConnect k = do
99
98
let v = makeVert k
100
-
99
+
101
100
i <- readSTRef index
102
101
103
102
modifySTRef indexMap $ M .insert k i
@@ -123,23 +122,23 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
123
122
modifySTRef lowlinkMap $ M .alter (maybeMin index) k
124
123
125
124
vIndex <- indexOfKey k
126
- vLowlink <- lowlinkOfKey k
125
+ vLowlink <- lowlinkOfKey k
127
126
128
127
when (vIndex == vLowlink) $ do
129
128
currentPath <- readSTRef path
130
129
let newPath = popUntil makeKey v currentPath Nil
131
130
modifySTRef components $ flip (++) (singleton (makeComponent newPath.component))
132
131
writeSTRef path newPath.path
133
132
return unit
134
-
133
+
135
134
makeComponent (Cons v Nil ) | not (isCycle (makeKey v)) = AcyclicSCC v
136
135
makeComponent vs = CyclicSCC vs
137
-
136
+
138
137
isCycle k = any (\(Edge k1 k2) -> k1 == k && k2 == k) es
139
138
in go vs)))
140
139
141
140
popUntil :: forall k v . (Eq k ) => (v -> k ) -> v -> List v -> List v -> { path :: List v , component :: List v }
142
- popUntil _ _ Nil popped = { path: Nil , component: popped }
141
+ popUntil _ _ Nil popped = { path: Nil , component: popped }
143
142
popUntil makeKey v (Cons w path) popped | makeKey v == makeKey w = { path: path, component: Cons w popped }
144
143
popUntil makeKey v (Cons w ws) popped = popUntil makeKey v ws (Cons w popped)
145
144
@@ -154,7 +153,7 @@ topSort :: forall v. (Eq v, Ord v) => Graph v v -> List v
154
153
topSort = topSort' id id
155
154
156
155
-- | Topologically sort the vertices of a graph
157
- -- |
156
+ -- |
158
157
-- | This function is a slight generalization of `scc` which allows key and value types
159
158
-- | to differ.
160
159
topSort' :: forall k v . (Eq k , Ord k ) => (v -> k ) -> (k -> v ) -> Graph k v -> List v
0 commit comments