11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE FlexibleContexts #-}
3+ {-# LANGUAGE FlexibleInstances #-}
4+ {-# LANGUAGE FunctionalDependencies #-}
35{-# LANGUAGE ScopedTypeVariables #-}
4- {-# LANGUAGE TypeFamilies #-}
5- {-# LANGUAGE TypeOperators #-}
66{-# LANGUAGE UndecidableInstances #-}
77
88-- |
@@ -107,40 +107,40 @@ import qualified Distribution.Compat.Prelude as Prelude
107107
108108-- | A graph of nodes @a@. The nodes are expected to have instance
109109-- of class 'IsNode'.
110- data Graph a = Graph
111- { graphMap :: ! (Map ( Key a ) a )
110+ data Graph keyA a = Graph
111+ { graphMap :: ! (Map keyA a )
112112 , -- Lazily cached graph representation
113113 graphForward :: G. Graph
114114 , graphAdjoint :: G. Graph
115115 , graphVertexToNode :: G. Vertex -> a
116- , graphKeyToVertex :: Key a -> Maybe G. Vertex
117- , graphBroken :: [(a , [Key a ])]
116+ , graphKeyToVertex :: keyA -> Maybe G. Vertex
117+ , graphBroken :: [(a , [keyA ])]
118118 }
119119
120120-- NB: Not a Functor! (or Traversable), because you need
121- -- to restrict Key a ~ Key b. We provide our own mapping
121+ -- to restrict keyA ~ Key b. We provide our own mapping
122122-- functions.
123123
124124-- General strategy is most operations are deferred to the
125125-- Map representation.
126126
127- instance Show a => Show (Graph a ) where
127+ instance Show a => Show (Graph keyA a ) where
128128 show = show . toList
129129
130- instance (IsNode a , Read a , Show ( Key a )) => Read (Graph a ) where
130+ instance (IsNode keyA a , Read a , Show keyA ) => Read (Graph keyA a ) where
131131 readsPrec d s = map (first fromDistinctList) (readsPrec d s)
132132
133- instance (IsNode a , Binary a , Show ( Key a )) => Binary (Graph a ) where
133+ instance (IsNode keyA a , Binary a , Show keyA ) => Binary (Graph keyA a ) where
134134 put x = put (toList x)
135135 get = fmap fromDistinctList get
136136
137- instance Structured a => Structured (Graph a ) where
137+ instance ( Structured a , Typeable keyA ) => Structured (Graph keyA a ) where
138138 structure p = Nominal (typeRep p) 0 " Graph" [structure (Proxy :: Proxy a )]
139139
140- instance (Eq ( Key a ) , Eq a ) => Eq (Graph a ) where
140+ instance (Eq keyA , Eq a ) => Eq (Graph keyA a ) where
141141 g1 == g2 = graphMap g1 == graphMap g2
142142
143- instance Foldable. Foldable Graph where
143+ instance Foldable. Foldable ( Graph keyA ) where
144144 elem x = Foldable. elem x . graphMap
145145 fold = Foldable. fold . graphMap
146146 foldl f z = Foldable. foldl f z . graphMap
@@ -156,7 +156,7 @@ instance Foldable.Foldable Graph where
156156 sum = Foldable. sum . graphMap
157157 toList = Foldable. toList . graphMap
158158
159- instance (NFData a , NFData ( Key a )) => NFData (Graph a ) where
159+ instance (NFData a , NFData keyA ) => NFData (Graph keyA a ) where
160160 rnf
161161 Graph
162162 { graphMap = m
@@ -173,13 +173,11 @@ instance (NFData a, NFData (Key a)) => NFData (Graph a) where
173173-- graph nodes. A node of type @a@ is associated with some unique key of
174174-- type @'Key' a@; given a node we can determine its key ('nodeKey')
175175-- and the keys of its neighbors ('nodeNeighbors').
176- class Ord (Key a ) => IsNode a where
177- type Key a
178- nodeKey :: a -> Key a
179- nodeNeighbors :: a -> [Key a ]
176+ class Ord keyA => IsNode keyA a | a -> keyA where
177+ nodeKey :: a -> keyA
178+ nodeNeighbors :: a -> [keyA ]
180179
181- instance (IsNode a , IsNode b , Key a ~ Key b ) => IsNode (Either a b ) where
182- type Key (Either a b ) = Key a
180+ instance (IsNode key a , IsNode key b ) => IsNode key (Either a b ) where
183181 nodeKey (Left x) = nodeKey x
184182 nodeKey (Right x) = nodeKey x
185183 nodeNeighbors (Left x) = nodeNeighbors x
@@ -196,50 +194,49 @@ nodeValue (N a _ _) = a
196194instance Functor (Node k ) where
197195 fmap f (N a k ks) = N (f a) k ks
198196
199- instance Ord k => IsNode (Node k a ) where
200- type Key (Node k a ) = k
197+ instance Ord k => IsNode k (Node k a ) where
201198 nodeKey (N _ k _) = k
202199 nodeNeighbors (N _ _ ks) = ks
203200
204201-- TODO: Maybe introduce a typeclass for items which just
205- -- keys (so, Key associated type, and nodeKey method). But
202+ -- keys (so, keyAssociated type, and nodeKey method). But
206203-- I didn't need it here, so I didn't introduce it.
207204
208205-- Query
209206
210207-- | /O(1)/. Is the graph empty?
211- null :: Graph a -> Bool
208+ null :: Graph keyA a -> Bool
212209null = Map. null . toMap
213210
214211-- | /O(1)/. The number of nodes in the graph.
215- size :: Graph a -> Int
212+ size :: Graph keyA a -> Int
216213size = Map. size . toMap
217214
218215-- | /O(log V)/. Check if the key is in the graph.
219- member :: IsNode a => Key a -> Graph a -> Bool
216+ member :: IsNode keyA a => keyA -> Graph keyA a -> Bool
220217member k g = Map. member k (toMap g)
221218
222219-- | /O(log V)/. Lookup the node at a key in the graph.
223- lookup :: IsNode a => Key a -> Graph a -> Maybe a
220+ lookup :: IsNode keyA a => keyA -> Graph keyA a -> Maybe a
224221lookup k g = Map. lookup k (toMap g)
225222
226223-- Construction
227224
228225-- | /O(1)/. The empty graph.
229- empty :: IsNode a => Graph a
226+ empty :: IsNode keyA a => Graph keyA a
230227empty = fromMap Map. empty
231228
232229-- | /O(log V)/. Insert a node into a graph.
233- insert :: IsNode a => a -> Graph a -> Graph a
230+ insert :: IsNode keyA a => a -> Graph keyA a -> Graph keyA a
234231insert ! n g = fromMap (Map. insert (nodeKey n) n (toMap g))
235232
236233-- | /O(log V)/. Delete the node at a key from the graph.
237- deleteKey :: IsNode a => Key a -> Graph a -> Graph a
234+ deleteKey :: IsNode keyA a => keyA -> Graph keyA a -> Graph keyA a
238235deleteKey k g = fromMap (Map. delete k (toMap g))
239236
240237-- | /O(log V)/. Lookup and delete. This function returns the deleted
241238-- value if it existed.
242- deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a , Graph a )
239+ deleteLookup :: IsNode keyA a => keyA -> Graph keyA a -> (Maybe a , Graph keyA a )
243240deleteLookup k g =
244241 let (r, m') = Map. updateLookupWithKey (\ _ _ -> Nothing ) k (toMap g)
245242 in (r, fromMap m')
@@ -249,19 +246,19 @@ deleteLookup k g =
249246-- | /O(V + V')/. Right-biased union, preferring entries
250247-- from the second map when conflicts occur.
251248-- @'nodeKey' x = 'nodeKey' (f x)@.
252- unionRight :: IsNode a => Graph a -> Graph a -> Graph a
249+ unionRight :: IsNode keyA a => Graph keyA a -> Graph keyA a -> Graph keyA a
253250unionRight g g' = fromMap (Map. union (toMap g') (toMap g))
254251
255252-- | /O(V + V')/. Left-biased union, preferring entries from
256253-- the first map when conflicts occur.
257- unionLeft :: IsNode a => Graph a -> Graph a -> Graph a
254+ unionLeft :: IsNode keyA a => Graph keyA a -> Graph keyA a -> Graph keyA a
258255unionLeft = flip unionRight
259256
260257-- Graph-like operations
261258
262259-- | /Ω(V + E)/. Compute the strongly connected components of a graph.
263260-- Requires amortized construction of graph.
264- stronglyConnComp :: Graph a -> [SCC a ]
261+ stronglyConnComp :: Graph keyA a -> [SCC a ]
265262stronglyConnComp g = map decode forest
266263 where
267264 forest = G. scc (graphForward g)
@@ -278,25 +275,25 @@ stronglyConnComp g = map decode forest
278275
279276-- | /Ω(V + E)/. Compute the cycles of a graph.
280277-- Requires amortized construction of graph.
281- cycles :: Graph a -> [[a ]]
278+ cycles :: Graph keyA a -> [[a ]]
282279cycles g = [vs | CyclicSCC vs <- stronglyConnComp g]
283280
284281-- | /O(1)/. Return a list of nodes paired with their broken
285282-- neighbors (i.e., neighbor keys which are not in the graph).
286283-- Requires amortized construction of graph.
287- broken :: Graph a -> [(a , [Key a ])]
284+ broken :: Graph keyA a -> [(a , [keyA ])]
288285broken g = graphBroken g
289286
290287-- | Lookup the immediate neighbors from a key in the graph.
291288-- Requires amortized construction of graph.
292- neighbors :: Graph a -> Key a -> Maybe [a ]
289+ neighbors :: Graph keyA a -> keyA -> Maybe [a ]
293290neighbors g k = do
294291 v <- graphKeyToVertex g k
295292 return (map (graphVertexToNode g) (graphForward g ! v))
296293
297294-- | Lookup the immediate reverse neighbors from a key in the graph.
298295-- Requires amortized construction of graph.
299- revNeighbors :: Graph a -> Key a -> Maybe [a ]
296+ revNeighbors :: Graph keyA a -> keyA -> Maybe [a ]
300297revNeighbors g k = do
301298 v <- graphKeyToVertex g k
302299 return (map (graphVertexToNode g) (graphAdjoint g ! v))
@@ -305,7 +302,7 @@ revNeighbors g k = do
305302-- Returns @Nothing@ if one (or more) keys are not present in
306303-- the graph.
307304-- Requires amortized construction of graph.
308- closure :: Graph a -> [Key a ] -> Maybe [a ]
305+ closure :: Graph keyA a -> [keyA ] -> Maybe [a ]
309306closure g ks = do
310307 vs <- traverse (graphKeyToVertex g) ks
311308 return (decodeVertexForest g (G. dfs (graphForward g) vs))
@@ -314,25 +311,25 @@ closure g ks = do
314311-- of keys. Returns @Nothing@ if one (or more) keys are not present in
315312-- the graph.
316313-- Requires amortized construction of graph.
317- revClosure :: Graph a -> [Key a ] -> Maybe [a ]
314+ revClosure :: Graph keyA a -> [keyA ] -> Maybe [a ]
318315revClosure g ks = do
319316 vs <- traverse (graphKeyToVertex g) ks
320317 return (decodeVertexForest g (G. dfs (graphAdjoint g) vs))
321318
322319flattenForest :: Tree. Forest a -> [a ]
323320flattenForest = concatMap Tree. flatten
324321
325- decodeVertexForest :: Graph a -> Tree. Forest G. Vertex -> [a ]
322+ decodeVertexForest :: Graph keyA a -> Tree. Forest G. Vertex -> [a ]
326323decodeVertexForest g = map (graphVertexToNode g) . flattenForest
327324
328325-- | Topologically sort the nodes of a graph.
329326-- Requires amortized construction of graph.
330- topSort :: Graph a -> [a ]
327+ topSort :: Graph keyA a -> [a ]
331328topSort g = map (graphVertexToNode g) $ G. topSort (graphForward g)
332329
333330-- | Reverse topologically sort the nodes of a graph.
334331-- Requires amortized construction of graph.
335- revTopSort :: Graph a -> [a ]
332+ revTopSort :: Graph keyA a -> [a ]
336333revTopSort g = map (graphVertexToNode g) $ G. topSort (graphAdjoint g)
337334
338335-- Conversions
@@ -343,7 +340,7 @@ revTopSort g = map (graphVertexToNode g) $ G.topSort (graphAdjoint g)
343340-- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@
344341-- instead. The values of the map are assumed to already
345342-- be in WHNF.
346- fromMap :: IsNode a => Map ( Key a ) a -> Graph a
343+ fromMap :: IsNode keyA a => Map keyA a -> Graph keyA a
347344fromMap m =
348345 Graph
349346 { graphMap = m
@@ -377,7 +374,7 @@ fromMap m =
377374 bounds = (0 , Map. size m - 1 )
378375
379376-- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.
380- fromDistinctList :: (IsNode a , Show ( Key a )) => [a ] -> Graph a
377+ fromDistinctList :: (IsNode keyA a , Show keyA ) => [a ] -> Graph keyA a
381378fromDistinctList =
382379 fromMap
383380 . Map. fromListWith (\ _ -> duplicateError)
@@ -391,26 +388,26 @@ fromDistinctList =
391388-- Map-like operations
392389
393390-- | /O(V)/. Convert a graph into a list of nodes.
394- toList :: Graph a -> [a ]
391+ toList :: Graph keyA a -> [a ]
395392toList g = Map. elems (toMap g)
396393
397394-- | /O(V)/. Convert a graph into a list of keys.
398- keys :: Graph a -> [Key a ]
395+ keys :: Graph keyA a -> [keyA ]
399396keys g = Map. keys (toMap g)
400397
401398-- | /O(V)/. Convert a graph into a set of keys.
402- keysSet :: Graph a -> Set. Set ( Key a )
399+ keysSet :: Graph keyA a -> Set. Set keyA
403400keysSet g = Map. keysSet (toMap g)
404401
405402-- | /O(1)/. Convert a graph into a map from keys to nodes.
406403-- The resulting map @m@ is guaranteed to have the property that
407404-- @'Prelude.all' (\(k,n) -> k == 'nodeKey' n) ('Data.Map.toList' m)@.
408- toMap :: Graph a -> Map ( Key a ) a
405+ toMap :: Graph keyA a -> Map keyA a
409406toMap = graphMap
410407
411408-- Graph-like operations
412409
413410-- | /O(1)/. Convert a graph into a 'Data.Graph.Graph'.
414411-- Requires amortized construction of graph.
415- toGraph :: Graph a -> (G. Graph , G. Vertex -> a , Key a -> Maybe G. Vertex )
412+ toGraph :: Graph keyA a -> (G. Graph , G. Vertex -> a , keyA -> Maybe G. Vertex )
416413toGraph g = (graphForward g, graphVertexToNode g, graphKeyToVertex g)
0 commit comments