{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Distribution.Compat.Graph (
Graph,
IsNode(..),
null,
size,
member,
lookup,
empty,
insert,
deleteKey,
deleteLookup,
unionLeft,
unionRight,
stronglyConnComp,
SCC(..),
cycles,
broken,
neighbors,
revNeighbors,
closure,
revClosure,
topSort,
revTopSort,
toMap,
fromDistinctList,
toList,
keys,
keysSet,
toGraph,
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
data Graph a
= Graph {
forall a. Graph a -> Map (Key a) a
graphMap :: !(Map (Key a) a),
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)
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
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
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)
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
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
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
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)
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)
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
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))
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))
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')
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))
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
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)
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 ]
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
neighbors :: Graph a -> Key a -> Maybe [a]
neighbors :: forall a. Graph a -> Key a -> Maybe [a]
neighbors Graph a
g Key a
k = do
Vertex
v <- Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g Key a
k
[a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((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) (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))
revNeighbors :: Graph a -> Key a -> Maybe [a]
revNeighbors :: forall a. Graph a -> Key a -> Maybe [a]
revNeighbors Graph a
g Key a
k = do
Vertex
v <- Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g Key a
k
[a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((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) (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v))
closure :: Graph a -> [Key a] -> Maybe [a]
closure :: forall a. Graph a -> [Key a] -> Maybe [a]
closure Graph a
g [Key a]
ks = do
[Vertex]
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
[a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Graph a -> [Tree Vertex] -> [a]
forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g (Graph -> [Vertex] -> [Tree Vertex]
G.dfs (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g) [Vertex]
vs))
revClosure :: Graph a -> [Key a] -> Maybe [a]
revClosure :: forall a. Graph a -> [Key a] -> Maybe [a]
revClosure Graph a
g [Key a]
ks = do
[Vertex]
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
[a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Graph a -> [Tree Vertex] -> [a]
forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g (Graph -> [Vertex] -> [Tree Vertex]
G.dfs (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g) [Vertex]
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
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)
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)
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
, 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
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)
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} {a}. (Show (Key a), IsNode a) => a -> a
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 -> a
duplicateError a
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
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)
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)
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)
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)
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
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)