{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- | -- Module : Distribution.Compat.Graph -- Copyright : (c) Edward Z. Yang 2016 -- License : BSD3 -- -- Maintainer : cabal-dev@haskell.org -- Stability : experimental -- Portability : portable -- -- A data type representing directed graphs, backed by "Data.Graph". -- It is strict in the node type. -- -- This is an alternative interface to "Data.Graph". In this interface, -- nodes (identified by the 'IsNode' type class) are associated with a -- key and record the keys of their neighbors. This interface is more -- convenient than 'Data.Graph.Graph', which requires vertices to be -- explicitly handled by integer indexes. -- -- The current implementation has somewhat peculiar performance -- characteristics. The asymptotics of all map-like operations mirror -- their counterparts in "Data.Map". However, to perform a graph -- operation, we first must build the "Data.Graph" representation, an -- operation that takes /O(V + E log V)/. However, this operation can -- be amortized across all queries on that particular graph. -- -- Some nodes may be broken, i.e., refer to neighbors which are not -- stored in the graph. In our graph algorithms, we transparently -- ignore such edges; however, you can easily query for the broken -- vertices of a graph using 'broken' (and should, e.g., to ensure that -- a closure of a graph is well-formed.) It's possible to take a closed -- subset of a broken graph and get a well-formed graph. module Distribution.Compat.Graph ( -- * Graph type Graph , IsNode (..) -- * Query , null , size , member , lookup -- * Construction , empty , insert , deleteKey , deleteLookup -- * Combine , unionLeft , unionRight -- * Graph algorithms , stronglyConnComp , SCC (..) , cycles , broken , neighbors , revNeighbors , closure , revClosure , topSort , revTopSort -- * Conversions -- ** Maps , toMap -- ** Lists , fromDistinctList , toList , keys -- ** Sets , keysSet -- ** Graphs , toGraph -- * Node type , Node (..) , nodeValue ) where import Distribution.Compat.Prelude hiding (empty, lookup, null, toList) import Prelude () import Data.Array ((!)) import Data.Graph (SCC (..)) import Distribution.Utils.Structured (Structure (..), Structured (..)) import qualified Data.Array as Array import qualified Data.Foldable as Foldable import qualified Data.Graph as G import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Tree as Tree import qualified Distribution.Compat.Prelude as Prelude -- | A graph of nodes @a@. The nodes are expected to have instance -- of class 'IsNode'. data Graph a = Graph { forall a. Graph a -> Map (Key a) a graphMap :: !(Map (Key a) a) , -- Lazily cached graph representation forall a. Graph a -> Graph graphForward :: G.Graph , forall a. Graph a -> Graph graphAdjoint :: G.Graph , forall a. Graph a -> Vertex -> a graphVertexToNode :: G.Vertex -> a , forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex :: Key a -> Maybe G.Vertex , forall a. Graph a -> [(a, [Key a])] graphBroken :: [(a, [Key a])] } deriving (Typeable) -- NB: Not a Functor! (or Traversable), because you need -- to restrict Key a ~ Key b. We provide our own mapping -- functions. -- General strategy is most operations are deferred to the -- Map representation. instance Show a => Show (Graph a) where show :: Graph a -> String show = [a] -> String forall a. Show a => a -> String show ([a] -> String) -> (Graph a -> [a]) -> Graph a -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> [a] forall a. Graph a -> [a] toList instance (IsNode a, Read a, Show (Key a)) => Read (Graph a) where readsPrec :: Vertex -> ReadS (Graph a) readsPrec Vertex d String s = (([a], String) -> (Graph a, String)) -> [([a], String)] -> [(Graph a, String)] forall a b. (a -> b) -> [a] -> [b] map (\([a] a, String r) -> ([a] -> Graph a forall a. (IsNode a, Show (Key a)) => [a] -> Graph a fromDistinctList [a] a, String r)) (Vertex -> ReadS [a] forall a. Read a => Vertex -> ReadS a readsPrec Vertex d String s) instance (IsNode a, Binary a, Show (Key a)) => Binary (Graph a) where put :: Graph a -> Put put Graph a x = [a] -> Put forall t. Binary t => t -> Put put (Graph a -> [a] forall a. Graph a -> [a] toList Graph a x) get :: Get (Graph a) get = ([a] -> Graph a) -> Get [a] -> Get (Graph a) forall a b. (a -> b) -> Get a -> Get b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [a] -> Graph a forall a. (IsNode a, Show (Key a)) => [a] -> Graph a fromDistinctList Get [a] forall t. Binary t => Get t get instance Structured a => Structured (Graph a) where structure :: Proxy (Graph a) -> Structure structure Proxy (Graph a) p = TypeRep -> TypeVersion -> String -> [Structure] -> Structure Nominal (Proxy (Graph a) -> TypeRep forall {k} (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep typeRep Proxy (Graph a) p) TypeVersion 0 String "Graph" [Proxy a -> Structure forall a. Structured a => Proxy a -> Structure structure (Proxy a forall {k} (t :: k). Proxy t Proxy :: Proxy a)] instance (Eq (Key a), Eq a) => Eq (Graph a) where Graph a g1 == :: Graph a -> Graph a -> Bool == Graph a g2 = Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap Graph a g1 Map (Key a) a -> Map (Key a) a -> Bool forall a. Eq a => a -> a -> Bool == Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap Graph a g2 instance Foldable.Foldable Graph where fold :: forall m. Monoid m => Graph m -> m fold = Map (Key m) m -> m forall m. Monoid m => Map (Key m) m -> m forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m Foldable.fold (Map (Key m) m -> m) -> (Graph m -> Map (Key m) m) -> Graph m -> m forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph m -> Map (Key m) m forall a. Graph a -> Map (Key a) a graphMap foldr :: forall a b. (a -> b -> b) -> b -> Graph a -> b foldr a -> b -> b f b z = (a -> b -> b) -> b -> Map (Key a) a -> b forall a b. (a -> b -> b) -> b -> Map (Key a) a -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b Foldable.foldr a -> b -> b f b z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap foldl :: forall b a. (b -> a -> b) -> b -> Graph a -> b foldl b -> a -> b f b z = (b -> a -> b) -> b -> Map (Key a) a -> b forall b a. (b -> a -> b) -> b -> Map (Key a) a -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b Foldable.foldl b -> a -> b f b z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap foldMap :: forall m a. Monoid m => (a -> m) -> Graph a -> m foldMap a -> m f = (a -> m) -> Map (Key a) a -> m forall m a. Monoid m => (a -> m) -> Map (Key a) a -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m Foldable.foldMap a -> m f (Map (Key a) a -> m) -> (Graph a -> Map (Key a) a) -> Graph a -> m forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap foldl' :: forall b a. (b -> a -> b) -> b -> Graph a -> b foldl' b -> a -> b f b z = (b -> a -> b) -> b -> Map (Key a) a -> b forall b a. (b -> a -> b) -> b -> Map (Key a) a -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b Foldable.foldl' b -> a -> b f b z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap foldr' :: forall a b. (a -> b -> b) -> b -> Graph a -> b foldr' a -> b -> b f b z = (a -> b -> b) -> b -> Map (Key a) a -> b forall a b. (a -> b -> b) -> b -> Map (Key a) a -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b Foldable.foldr' a -> b -> b f b z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap #ifdef MIN_VERSION_base #if MIN_VERSION_base(4,8,0) length :: forall a. Graph a -> Vertex length = Map (Key a) a -> Vertex forall a. Map (Key a) a -> Vertex forall (t :: * -> *) a. Foldable t => t a -> Vertex Foldable.length (Map (Key a) a -> Vertex) -> (Graph a -> Map (Key a) a) -> Graph a -> Vertex forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap null :: forall a. Graph a -> Bool null = Map (Key a) a -> Bool forall a. Map (Key a) a -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Foldable.null (Map (Key a) a -> Bool) -> (Graph a -> Map (Key a) a) -> Graph a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap toList :: forall a. Graph a -> [a] toList = Map (Key a) a -> [a] forall a. Map (Key a) a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] Foldable.toList (Map (Key a) a -> [a]) -> (Graph a -> Map (Key a) a) -> Graph a -> [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap elem :: forall a. Eq a => a -> Graph a -> Bool elem a x = a -> Map (Key a) a -> Bool forall a. Eq a => a -> Map (Key a) a -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool Foldable.elem a x (Map (Key a) a -> Bool) -> (Graph a -> Map (Key a) a) -> Graph a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap maximum :: forall a. Ord a => Graph a -> a maximum = Map (Key a) a -> a forall a. Ord a => Map (Key a) a -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a Foldable.maximum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap minimum :: forall a. Ord a => Graph a -> a minimum = Map (Key a) a -> a forall a. Ord a => Map (Key a) a -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a Foldable.minimum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap sum :: forall a. Num a => Graph a -> a sum = Map (Key a) a -> a forall a. Num a => Map (Key a) a -> a forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a Foldable.sum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap product :: forall a. Num a => Graph a -> a product = Map (Key a) a -> a forall a. Num a => Map (Key a) a -> a forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a Foldable.product (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap #endif #endif instance (NFData a, NFData (Key a)) => NFData (Graph a) where rnf :: Graph a -> () rnf Graph { graphMap :: forall a. Graph a -> Map (Key a) a graphMap = Map (Key a) a m , graphForward :: forall a. Graph a -> Graph graphForward = Graph gf , graphAdjoint :: forall a. Graph a -> Graph graphAdjoint = Graph ga , graphVertexToNode :: forall a. Graph a -> Vertex -> a graphVertexToNode = Vertex -> a vtn , graphKeyToVertex :: forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex = Key a -> Maybe Vertex ktv , graphBroken :: forall a. Graph a -> [(a, [Key a])] graphBroken = [(a, [Key a])] b } = Graph gf Graph -> () -> () forall a b. a -> b -> b `seq` Graph ga Graph -> () -> () forall a b. a -> b -> b `seq` Vertex -> a vtn (Vertex -> a) -> () -> () forall a b. a -> b -> b `seq` Key a -> Maybe Vertex ktv (Key a -> Maybe Vertex) -> () -> () forall a b. a -> b -> b `seq` [(a, [Key a])] b [(a, [Key a])] -> () -> () forall a b. a -> b -> b `seq` Map (Key a) a -> () forall a. NFData a => a -> () rnf Map (Key a) a m -- TODO: Data instance? -- | The 'IsNode' class is used for datatypes which represent directed -- graph nodes. A node of type @a@ is associated with some unique key of -- type @'Key' a@; given a node we can determine its key ('nodeKey') -- and the keys of its neighbors ('nodeNeighbors'). class Ord (Key a) => IsNode a where type Key a nodeKey :: a -> Key a nodeNeighbors :: a -> [Key a] instance (IsNode a, IsNode b, Key a ~ Key b) => IsNode (Either a b) where type Key (Either a b) = Key a nodeKey :: Either a b -> Key (Either a b) nodeKey (Left a x) = a -> Key a forall a. IsNode a => a -> Key a nodeKey a x nodeKey (Right b x) = b -> Key b forall a. IsNode a => a -> Key a nodeKey b x nodeNeighbors :: Either a b -> [Key (Either a b)] nodeNeighbors (Left a x) = a -> [Key a] forall a. IsNode a => a -> [Key a] nodeNeighbors a x nodeNeighbors (Right b x) = b -> [Key b] forall a. IsNode a => a -> [Key a] nodeNeighbors b x -- | A simple, trivial data type which admits an 'IsNode' instance. data Node k a = N a k [k] deriving (Vertex -> Node k a -> ShowS [Node k a] -> ShowS Node k a -> String (Vertex -> Node k a -> ShowS) -> (Node k a -> String) -> ([Node k a] -> ShowS) -> Show (Node k a) forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS forall k a. (Show a, Show k) => [Node k a] -> ShowS forall k a. (Show a, Show k) => Node k a -> String $cshowsPrec :: forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS showsPrec :: Vertex -> Node k a -> ShowS $cshow :: forall k a. (Show a, Show k) => Node k a -> String show :: Node k a -> String $cshowList :: forall k a. (Show a, Show k) => [Node k a] -> ShowS showList :: [Node k a] -> ShowS Show, Node k a -> Node k a -> Bool (Node k a -> Node k a -> Bool) -> (Node k a -> Node k a -> Bool) -> Eq (Node k a) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool $c== :: forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool == :: Node k a -> Node k a -> Bool $c/= :: forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool /= :: Node k a -> Node k a -> Bool Eq) -- | Get the value from a 'Node'. nodeValue :: Node k a -> a nodeValue :: forall k a. Node k a -> a nodeValue (N a a k _ [k] _) = a a instance Functor (Node k) where fmap :: forall a b. (a -> b) -> Node k a -> Node k b fmap a -> b f (N a a k k [k] ks) = b -> k -> [k] -> Node k b forall k a. a -> k -> [k] -> Node k a N (a -> b f a a) k k [k] ks instance Ord k => IsNode (Node k a) where type Key (Node k a) = k nodeKey :: Node k a -> Key (Node k a) nodeKey (N a _ k k [k] _) = k Key (Node k a) k nodeNeighbors :: Node k a -> [Key (Node k a)] nodeNeighbors (N a _ k _ [k] ks) = [k] [Key (Node k a)] ks -- TODO: Maybe introduce a typeclass for items which just -- keys (so, Key associated type, and nodeKey method). But -- I didn't need it here, so I didn't introduce it. -- Query -- | /O(1)/. Is the graph empty? null :: Graph a -> Bool null :: forall a. Graph a -> Bool null = Map (Key a) a -> Bool forall k a. Map k a -> Bool Map.null (Map (Key a) a -> Bool) -> (Graph a -> Map (Key a) a) -> Graph a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap -- | /O(1)/. The number of nodes in the graph. size :: Graph a -> Int size :: forall a. Graph a -> Vertex size = Map (Key a) a -> Vertex forall k a. Map k a -> Vertex Map.size (Map (Key a) a -> Vertex) -> (Graph a -> Map (Key a) a) -> Graph a -> Vertex forall b c a. (b -> c) -> (a -> b) -> a -> c . Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap -- | /O(log V)/. Check if the key is in the graph. member :: IsNode a => Key a -> Graph a -> Bool member :: forall a. IsNode a => Key a -> Graph a -> Bool member Key a k Graph a g = Key a -> Map (Key a) a -> Bool forall k a. Ord k => k -> Map k a -> Bool Map.member Key a k (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g) -- | /O(log V)/. Lookup the node at a key in the graph. lookup :: IsNode a => Key a -> Graph a -> Maybe a lookup :: forall a. IsNode a => Key a -> Graph a -> Maybe a lookup Key a k Graph a g = Key a -> Map (Key a) a -> Maybe a forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Key a k (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g) -- Construction -- | /O(1)/. The empty graph. empty :: IsNode a => Graph a empty :: forall a. IsNode a => Graph a empty = Map (Key a) a -> Graph a forall a. IsNode a => Map (Key a) a -> Graph a fromMap Map (Key a) a forall k a. Map k a Map.empty -- | /O(log V)/. Insert a node into a graph. insert :: IsNode a => a -> Graph a -> Graph a insert :: forall a. IsNode a => a -> Graph a -> Graph a insert !a n Graph a g = Map (Key a) a -> Graph a forall a. IsNode a => Map (Key a) a -> Graph a fromMap (Key a -> a -> Map (Key a) a -> Map (Key a) a forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert (a -> Key a forall a. IsNode a => a -> Key a nodeKey a n) a n (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g)) -- | /O(log V)/. Delete the node at a key from the graph. deleteKey :: IsNode a => Key a -> Graph a -> Graph a deleteKey :: forall a. IsNode a => Key a -> Graph a -> Graph a deleteKey Key a k Graph a g = Map (Key a) a -> Graph a forall a. IsNode a => Map (Key a) a -> Graph a fromMap (Key a -> Map (Key a) a -> Map (Key a) a forall k a. Ord k => k -> Map k a -> Map k a Map.delete Key a k (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g)) -- | /O(log V)/. Lookup and delete. This function returns the deleted -- value if it existed. deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a) deleteLookup :: forall a. IsNode a => Key a -> Graph a -> (Maybe a, Graph a) deleteLookup Key a k Graph a g = let (Maybe a r, Map (Key a) a m') = (Key a -> a -> Maybe a) -> Key a -> Map (Key a) a -> (Maybe a, Map (Key a) a) forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a) Map.updateLookupWithKey (\Key a _ a _ -> Maybe a forall a. Maybe a Nothing) Key a k (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g) in (Maybe a r, Map (Key a) a -> Graph a forall a. IsNode a => Map (Key a) a -> Graph a fromMap Map (Key a) a m') -- Combining -- | /O(V + V')/. Right-biased union, preferring entries -- from the second map when conflicts occur. -- @'nodeKey' x = 'nodeKey' (f x)@. unionRight :: IsNode a => Graph a -> Graph a -> Graph a unionRight :: forall a. IsNode a => Graph a -> Graph a -> Graph a unionRight Graph a g Graph a g' = Map (Key a) a -> Graph a forall a. IsNode a => Map (Key a) a -> Graph a fromMap (Map (Key a) a -> Map (Key a) a -> Map (Key a) a forall k a. Ord k => Map k a -> Map k a -> Map k a Map.union (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g') (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g)) -- | /O(V + V')/. Left-biased union, preferring entries from -- the first map when conflicts occur. unionLeft :: IsNode a => Graph a -> Graph a -> Graph a unionLeft :: forall a. IsNode a => Graph a -> Graph a -> Graph a unionLeft = (Graph a -> Graph a -> Graph a) -> Graph a -> Graph a -> Graph a forall a b c. (a -> b -> c) -> b -> a -> c flip Graph a -> Graph a -> Graph a forall a. IsNode a => Graph a -> Graph a -> Graph a unionRight -- Graph-like operations -- | /Ω(V + E)/. Compute the strongly connected components of a graph. -- Requires amortized construction of graph. stronglyConnComp :: Graph a -> [SCC a] stronglyConnComp :: forall a. Graph a -> [SCC a] stronglyConnComp Graph a g = (Tree Vertex -> SCC a) -> [Tree Vertex] -> [SCC a] forall a b. (a -> b) -> [a] -> [b] map Tree Vertex -> SCC a decode [Tree Vertex] forest where forest :: [Tree Vertex] forest = Graph -> [Tree Vertex] G.scc (Graph a -> Graph forall a. Graph a -> Graph graphForward Graph a g) decode :: Tree Vertex -> SCC a decode (Tree.Node Vertex v []) | Vertex -> Bool mentions_itself Vertex v = [a] -> SCC a forall vertex. [vertex] -> SCC vertex CyclicSCC [Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g Vertex v] | Bool otherwise = a -> SCC a forall vertex. vertex -> SCC vertex AcyclicSCC (Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g Vertex v) decode Tree Vertex other = [a] -> SCC a forall vertex. [vertex] -> SCC vertex CyclicSCC (Tree Vertex -> [a] -> [a] dec Tree Vertex other []) where dec :: Tree Vertex -> [a] -> [a] dec (Tree.Node Vertex v [Tree Vertex] ts) [a] vs = Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g Vertex v a -> [a] -> [a] forall a. a -> [a] -> [a] : (Tree Vertex -> [a] -> [a]) -> [a] -> [Tree Vertex] -> [a] forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr Tree Vertex -> [a] -> [a] dec [a] vs [Tree Vertex] ts mentions_itself :: Vertex -> Bool mentions_itself Vertex v = Vertex v Vertex -> [Vertex] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` (Graph a -> Graph forall a. Graph a -> Graph graphForward Graph a g Graph -> Vertex -> [Vertex] forall i e. Ix i => Array i e -> i -> e ! Vertex v) -- Implementation copied from 'stronglyConnCompR' in 'Data.Graph'. -- | /Ω(V + E)/. Compute the cycles of a graph. -- Requires amortized construction of graph. cycles :: Graph a -> [[a]] cycles :: forall a. Graph a -> [[a]] cycles Graph a g = [[a] vs | CyclicSCC [a] vs <- Graph a -> [SCC a] forall a. Graph a -> [SCC a] stronglyConnComp Graph a g] -- | /O(1)/. Return a list of nodes paired with their broken -- neighbors (i.e., neighbor keys which are not in the graph). -- Requires amortized construction of graph. broken :: Graph a -> [(a, [Key a])] broken :: forall a. Graph a -> [(a, [Key a])] broken Graph a g = Graph a -> [(a, [Key a])] forall a. Graph a -> [(a, [Key a])] graphBroken Graph a g -- | Lookup the immediate neighbors from a key in the graph. -- Requires amortized construction of graph. neighbors :: Graph a -> Key a -> Maybe [a] neighbors :: forall a. Graph a -> Key a -> Maybe [a] neighbors Graph a g Key a k = do v <- Graph a -> Key a -> Maybe Vertex forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex Graph a g Key a k return (map (graphVertexToNode g) (graphForward g ! v)) -- | Lookup the immediate reverse neighbors from a key in the graph. -- Requires amortized construction of graph. revNeighbors :: Graph a -> Key a -> Maybe [a] revNeighbors :: forall a. Graph a -> Key a -> Maybe [a] revNeighbors Graph a g Key a k = do v <- Graph a -> Key a -> Maybe Vertex forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex Graph a g Key a k return (map (graphVertexToNode g) (graphAdjoint g ! v)) -- | Compute the subgraph which is the closure of some set of keys. -- Returns @Nothing@ if one (or more) keys are not present in -- the graph. -- Requires amortized construction of graph. closure :: Graph a -> [Key a] -> Maybe [a] closure :: forall a. Graph a -> [Key a] -> Maybe [a] closure Graph a g [Key a] ks = do vs <- (Key a -> Maybe Vertex) -> [Key a] -> Maybe [Vertex] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> [a] -> f [b] traverse (Graph a -> Key a -> Maybe Vertex forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex Graph a g) [Key a] ks return (decodeVertexForest g (G.dfs (graphForward g) vs)) -- | Compute the reverse closure of a graph from some set -- of keys. Returns @Nothing@ if one (or more) keys are not present in -- the graph. -- Requires amortized construction of graph. revClosure :: Graph a -> [Key a] -> Maybe [a] revClosure :: forall a. Graph a -> [Key a] -> Maybe [a] revClosure Graph a g [Key a] ks = do vs <- (Key a -> Maybe Vertex) -> [Key a] -> Maybe [Vertex] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> [a] -> f [b] traverse (Graph a -> Key a -> Maybe Vertex forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex Graph a g) [Key a] ks return (decodeVertexForest g (G.dfs (graphAdjoint g) vs)) flattenForest :: Tree.Forest a -> [a] flattenForest :: forall a. Forest a -> [a] flattenForest = (Tree a -> [a]) -> [Tree a] -> [a] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Tree a -> [a] forall a. Tree a -> [a] Tree.flatten decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a] decodeVertexForest :: forall a. Graph a -> [Tree Vertex] -> [a] decodeVertexForest Graph a g = (Vertex -> a) -> [Vertex] -> [a] forall a b. (a -> b) -> [a] -> [b] map (Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g) ([Vertex] -> [a]) -> ([Tree Vertex] -> [Vertex]) -> [Tree Vertex] -> [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Tree Vertex] -> [Vertex] forall a. Forest a -> [a] flattenForest -- | Topologically sort the nodes of a graph. -- Requires amortized construction of graph. topSort :: Graph a -> [a] topSort :: forall a. Graph a -> [a] topSort Graph a g = (Vertex -> a) -> [Vertex] -> [a] forall a b. (a -> b) -> [a] -> [b] map (Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g) ([Vertex] -> [a]) -> [Vertex] -> [a] forall a b. (a -> b) -> a -> b $ Graph -> [Vertex] G.topSort (Graph a -> Graph forall a. Graph a -> Graph graphForward Graph a g) -- | Reverse topologically sort the nodes of a graph. -- Requires amortized construction of graph. revTopSort :: Graph a -> [a] revTopSort :: forall a. Graph a -> [a] revTopSort Graph a g = (Vertex -> a) -> [Vertex] -> [a] forall a b. (a -> b) -> [a] -> [b] map (Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g) ([Vertex] -> [a]) -> [Vertex] -> [a] forall a b. (a -> b) -> a -> b $ Graph -> [Vertex] G.topSort (Graph a -> Graph forall a. Graph a -> Graph graphAdjoint Graph a g) -- Conversions -- | /O(1)/. Convert a map from keys to nodes into a graph. -- The map must satisfy the invariant that -- @'fromMap' m == 'fromList' ('Data.Map.elems' m)@; -- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@ -- instead. The values of the map are assumed to already -- be in WHNF. fromMap :: IsNode a => Map (Key a) a -> Graph a fromMap :: forall a. IsNode a => Map (Key a) a -> Graph a fromMap Map (Key a) a m = Graph { graphMap :: Map (Key a) a graphMap = Map (Key a) a m , -- These are lazily computed! graphForward :: Graph graphForward = Graph g , graphAdjoint :: Graph graphAdjoint = Graph -> Graph G.transposeG Graph g , graphVertexToNode :: Vertex -> a graphVertexToNode = Vertex -> a vertex_to_node , graphKeyToVertex :: Key a -> Maybe Vertex graphKeyToVertex = Key a -> Maybe Vertex key_to_vertex , graphBroken :: [(a, [Key a])] graphBroken = [(a, [Key a])] broke } where try_key_to_vertex :: Key a -> Either (Key a) Vertex try_key_to_vertex Key a k = Either (Key a) Vertex -> (Vertex -> Either (Key a) Vertex) -> Maybe Vertex -> Either (Key a) Vertex forall b a. b -> (a -> b) -> Maybe a -> b maybe (Key a -> Either (Key a) Vertex forall a b. a -> Either a b Left Key a k) Vertex -> Either (Key a) Vertex forall a b. b -> Either a b Right (Key a -> Maybe Vertex key_to_vertex Key a k) ([[Key a]] brokenEdges, [[Vertex]] edges) = [([Key a], [Vertex])] -> ([[Key a]], [[Vertex]]) forall a b. [(a, b)] -> ([a], [b]) unzip ([([Key a], [Vertex])] -> ([[Key a]], [[Vertex]])) -> [([Key a], [Vertex])] -> ([[Key a]], [[Vertex]]) forall a b. (a -> b) -> a -> b $ [ [Either (Key a) Vertex] -> ([Key a], [Vertex]) forall a b. [Either a b] -> ([a], [b]) partitionEithers ((Key a -> Either (Key a) Vertex) -> [Key a] -> [Either (Key a) Vertex] forall a b. (a -> b) -> [a] -> [b] map Key a -> Either (Key a) Vertex try_key_to_vertex (a -> [Key a] forall a. IsNode a => a -> [Key a] nodeNeighbors a n)) | a n <- [a] ns ] broke :: [(a, [Key a])] broke = ((a, [Key a]) -> Bool) -> [(a, [Key a])] -> [(a, [Key a])] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> ((a, [Key a]) -> Bool) -> (a, [Key a]) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . [Key a] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null ([Key a] -> Bool) -> ((a, [Key a]) -> [Key a]) -> (a, [Key a]) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (a, [Key a]) -> [Key a] forall a b. (a, b) -> b snd) ([a] -> [[Key a]] -> [(a, [Key a])] forall a b. [a] -> [b] -> [(a, b)] zip [a] ns [[Key a]] brokenEdges) g :: Graph g = (Vertex, Vertex) -> [[Vertex]] -> Graph forall i e. Ix i => (i, i) -> [e] -> Array i e Array.listArray (Vertex, Vertex) bounds [[Vertex]] edges ns :: [a] ns = Map (Key a) a -> [a] forall k a. Map k a -> [a] Map.elems Map (Key a) a m -- sorted ascending vertices :: [(Key a, Vertex)] vertices = [Key a] -> [Vertex] -> [(Key a, Vertex)] forall a b. [a] -> [b] -> [(a, b)] zip ((a -> Key a) -> [a] -> [Key a] forall a b. (a -> b) -> [a] -> [b] map a -> Key a forall a. IsNode a => a -> Key a nodeKey [a] ns) [Vertex 0 ..] vertex_map :: Map (Key a) Vertex vertex_map = [(Key a, Vertex)] -> Map (Key a) Vertex forall k a. Eq k => [(k, a)] -> Map k a Map.fromAscList [(Key a, Vertex)] vertices key_to_vertex :: Key a -> Maybe Vertex key_to_vertex Key a k = Key a -> Map (Key a) Vertex -> Maybe Vertex forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Key a k Map (Key a) Vertex vertex_map vertex_to_node :: Vertex -> a vertex_to_node Vertex vertex = Array Vertex a nodeTable Array Vertex a -> Vertex -> a forall i e. Ix i => Array i e -> i -> e ! Vertex vertex nodeTable :: Array Vertex a nodeTable = (Vertex, Vertex) -> [a] -> Array Vertex a forall i e. Ix i => (i, i) -> [e] -> Array i e Array.listArray (Vertex, Vertex) bounds [a] ns bounds :: (Vertex, Vertex) bounds = (Vertex 0, Map (Key a) a -> Vertex forall k a. Map k a -> Vertex Map.size Map (Key a) a m Vertex -> Vertex -> Vertex forall a. Num a => a -> a -> a - Vertex 1) -- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph. fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a fromDistinctList :: forall a. (IsNode a, Show (Key a)) => [a] -> Graph a fromDistinctList = Map (Key a) a -> Graph a forall a. IsNode a => Map (Key a) a -> Graph a fromMap (Map (Key a) a -> Graph a) -> ([a] -> Map (Key a) a) -> [a] -> Graph a forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> a -> a) -> [(Key a, a)] -> Map (Key a) a forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a Map.fromListWith (\a _ -> a -> a forall {a} {b}. (Show (Key a), IsNode a) => a -> b duplicateError) ([(Key a, a)] -> Map (Key a) a) -> ([a] -> [(Key a, a)]) -> [a] -> Map (Key a) a forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (Key a, a)) -> [a] -> [(Key a, a)] forall a b. (a -> b) -> [a] -> [b] map (\a n -> a n a -> (Key a, a) -> (Key a, a) forall a b. a -> b -> b `seq` (a -> Key a forall a. IsNode a => a -> Key a nodeKey a n, a n)) where duplicateError :: a -> b duplicateError a n = String -> b forall a. HasCallStack => String -> a error (String -> b) -> String -> b forall a b. (a -> b) -> a -> b $ String "Graph.fromDistinctList: duplicate key: " String -> ShowS forall a. [a] -> [a] -> [a] ++ Key a -> String forall a. Show a => a -> String show (a -> Key a forall a. IsNode a => a -> Key a nodeKey a n) -- Map-like operations -- | /O(V)/. Convert a graph into a list of nodes. toList :: Graph a -> [a] toList :: forall a. Graph a -> [a] toList Graph a g = Map (Key a) a -> [a] forall k a. Map k a -> [a] Map.elems (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g) -- | /O(V)/. Convert a graph into a list of keys. keys :: Graph a -> [Key a] keys :: forall a. Graph a -> [Key a] keys Graph a g = Map (Key a) a -> [Key a] forall k a. Map k a -> [k] Map.keys (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g) -- | /O(V)/. Convert a graph into a set of keys. keysSet :: Graph a -> Set.Set (Key a) keysSet :: forall a. Graph a -> Set (Key a) keysSet Graph a g = Map (Key a) a -> Set (Key a) forall k a. Map k a -> Set k Map.keysSet (Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a toMap Graph a g) -- | /O(1)/. Convert a graph into a map from keys to nodes. -- The resulting map @m@ is guaranteed to have the property that -- @'Prelude.all' (\(k,n) -> k == 'nodeKey' n) ('Data.Map.toList' m)@. toMap :: Graph a -> Map (Key a) a toMap :: forall a. Graph a -> Map (Key a) a toMap = Graph a -> Map (Key a) a forall a. Graph a -> Map (Key a) a graphMap -- Graph-like operations -- | /O(1)/. Convert a graph into a 'Data.Graph.Graph'. -- Requires amortized construction of graph. toGraph :: Graph a -> (G.Graph, G.Vertex -> a, Key a -> Maybe G.Vertex) toGraph :: forall a. Graph a -> (Graph, Vertex -> a, Key a -> Maybe Vertex) toGraph Graph a g = (Graph a -> Graph forall a. Graph a -> Graph graphForward Graph a g, Graph a -> Vertex -> a forall a. Graph a -> Vertex -> a graphVertexToNode Graph a g, Graph a -> Key a -> Maybe Vertex forall a. Graph a -> Key a -> Maybe Vertex graphKeyToVertex Graph a g)