{-# LANGUAGE CPP #-}
#include "containers.h"
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE DeriveGeneric #-}{-# LANGUAGE DeriveLift #-}{-# LANGUAGE StandaloneDeriving #-}{-# LANGUAGE Safe #-}{-# LANGUAGE TemplateHaskellQuotes #-}
#endif
#ifdef DEFINE_PATTERN_SYNONYMS
{-# LANGUAGE PatternSynonyms #-}{-# LANGUAGE ViewPatterns #-}
#endif
#ifdef USE_ST_MONAD
{-# LANGUAGE RankNTypes #-}
#endif
------------------------------------------------------------------------------- |-- Module : Data.Graph-- Copyright : (c) The University of Glasgow 2002-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Portability : portable---- = Finite Graphs---- The @'Graph'@ type is an adjacency list representation of a finite, directed-- graph with vertices of type @Int@.---- The @'SCC'@ type represents a-- <https://en.wikipedia.org/wiki/Strongly_connected_component strongly-connected component>-- of a graph.---- == Implementation---- The implementation is based on---- * David King and John Launchbury,-- \"/Structuring Depth-First Search Algorithms in Haskell/\",-- Proceedings of the 22nd ACM SIGPLAN-SIGACT Symposium on Principles of-- Programming Languages, 344-354, 1995,-- <https://doi.org/10.1145/199448.199530>.-------------------------------------------------------------------------------moduleData.Graph(-- * GraphsGraph ,Bounds ,Edge ,Vertex ,Table -- ** Graph Construction,graphFromEdges ,graphFromEdges' ,buildG -- ** Graph Properties,vertices ,edges ,outdegree ,indegree -- ** Graph Transformations,transposeG -- ** Graph Algorithms,dfs ,dff ,topSort ,reverseTopSort ,components ,scc ,bcc ,reachable ,path -- * Strongly Connected Components,SCC (..
#ifdef DEFINE_PATTERN_SYNONYMS
,CyclicSCC 
#endif
)-- ** Construction,stronglyConnComp ,stronglyConnCompR -- ** Conversion,flattenSCC ,flattenSCC1 ,flattenSCCs -- * Trees,moduleData.Tree )whereimportUtils.Containers.Internal.Prelude importPrelude()
#if USE_ST_MONAD
importControl.Monad.STimportData.Array.ST.Safe(newArray,readArray,writeArray)
# if USE_UNBOXED_ARRAYS
importData.Array.ST.Safe(STUArray)
# else
importData.Array.ST.Safe(STArray)
# endif
#else
importData.IntSet(IntSet)importqualifiedData.IntSetasSet
#endif
importData.Tree (Tree (Node ),Forest )-- std interfacesimportData.FoldableasF
#if MIN_VERSION_base(4,18,0)
importqualifiedData.Foldable1asF1
#endif
importControl.DeepSeq(NFData(rnf),NFData1(liftRnf))importData.MaybeimportData.Array
#if USE_UNBOXED_ARRAYS
importqualifiedData.Array.UnboxedasUAimportData.Array.Unboxed(UArray)
#else
importqualifiedData.ArrayasUA
#endif
importqualifiedData.ListasLimportData.List.NonEmpty(NonEmpty(..))importqualifiedData.List.NonEmptyasNEimportData.Functor.Classes
#if !MIN_VERSION_base(4,11,0)
importData.Semigroup(Semigroup(..))
#endif
#ifdef __GLASGOW_HASKELL__
importGHC.Generics(Generic,Generic1)importData.Data(Data)importLanguage.Haskell.TH.Syntax(Lift(..))-- See Note [ Template Haskell Dependencies ]importLanguage.Haskell.TH()
#endif
-- Make sure we don't use Integer by mistake.default()--------------------------------------------------------------------------- --- Strongly Connected Components-- ---------------------------------------------------------------------------- | Strongly connected component.dataSCC vertex =AcyclicSCC vertex -- ^ A single vertex that is not in any cycle.|NECyclicSCC {-# UNPACK#-}!(NonEmptyvertex )-- ^ A maximal set of mutually reachable vertices.---- @since 0.7deriving(SCC vertex -> SCC vertex -> Bool
(SCC vertex -> SCC vertex -> Bool)
-> (SCC vertex -> SCC vertex -> Bool) -> Eq (SCC vertex)
forall vertex. Eq vertex => SCC vertex -> SCC vertex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall vertex. Eq vertex => SCC vertex -> SCC vertex -> Bool
== :: SCC vertex -> SCC vertex -> Bool
$c/= :: forall vertex. Eq vertex => SCC vertex -> SCC vertex -> Bool
/= :: SCC vertex -> SCC vertex -> Bool
Eq-- ^ @since 0.5.9,Int -> SCC vertex -> ShowS
[SCC vertex] -> ShowS
SCC vertex -> String
(Int -> SCC vertex -> ShowS)
-> (SCC vertex -> String)
-> ([SCC vertex] -> ShowS)
-> Show (SCC vertex)
forall vertex. Show vertex => Int -> SCC vertex -> ShowS
forall vertex. Show vertex => [SCC vertex] -> ShowS
forall vertex. Show vertex => SCC vertex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall vertex. Show vertex => Int -> SCC vertex -> ShowS
showsPrec :: Int -> SCC vertex -> ShowS
$cshow :: forall vertex. Show vertex => SCC vertex -> String
show :: SCC vertex -> String
$cshowList :: forall vertex. Show vertex => [SCC vertex] -> ShowS
showList :: [SCC vertex] -> ShowS
Show-- ^ @since 0.5.9,ReadPrec [SCC vertex]
ReadPrec (SCC vertex)
Int -> ReadS (SCC vertex)
ReadS [SCC vertex]
(Int -> ReadS (SCC vertex))
-> ReadS [SCC vertex]
-> ReadPrec (SCC vertex)
-> ReadPrec [SCC vertex]
-> Read (SCC vertex)
forall vertex. Read vertex => ReadPrec [SCC vertex]
forall vertex. Read vertex => ReadPrec (SCC vertex)
forall vertex. Read vertex => Int -> ReadS (SCC vertex)
forall vertex. Read vertex => ReadS [SCC vertex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall vertex. Read vertex => Int -> ReadS (SCC vertex)
readsPrec :: Int -> ReadS (SCC vertex)
$creadList :: forall vertex. Read vertex => ReadS [SCC vertex]
readList :: ReadS [SCC vertex]
$creadPrec :: forall vertex. Read vertex => ReadPrec (SCC vertex)
readPrec :: ReadPrec (SCC vertex)
$creadListPrec :: forall vertex. Read vertex => ReadPrec [SCC vertex]
readListPrec :: ReadPrec [SCC vertex]
Read-- ^ @since 0.5.9)
#ifdef DEFINE_PATTERN_SYNONYMS
-- | Partial pattern synonym for backward compatibility with @containers < 0.7@.patternCyclicSCC ::[vertex ]->SCC vertex pattern$mCyclicSCC :: forall {r} {vertex}.
SCC vertex -> ([vertex] -> r) -> ((# #) -> r) -> r
$bCyclicSCC :: forall vertex. [vertex] -> SCC vertex
CyclicSCC xs <-NECyclicSCC (NE.toList->xs )whereCyclicSCC []=String -> SCC vertex
forall a. HasCallStack => String -> a
errorString
"CyclicSCC: an argument cannot be an empty list"CyclicSCC (vertex
x :[vertex]
xs )=NonEmpty vertex -> SCC vertex
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC (vertex
x vertex -> [vertex] -> NonEmpty vertex
forall a. a -> [a] -> NonEmpty a
:|[vertex]
xs ){-# COMPLETEAcyclicSCC ,CyclicSCC #-}
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.5.9derivinginstanceDatavertex =>Data(SCC vertex )-- | @since 0.5.9derivinginstanceGeneric1SCC -- | @since 0.5.9derivinginstanceGeneric(SCC vertex )-- There is no instance Lift (NonEmpty v) before template-haskell-2.15.
#if MIN_VERSION_template_haskell(2,15,0)
-- | @since 0.6.6derivinginstanceLiftvertex =>Lift(SCC vertex )
#else
instanceLiftvertex=>Lift(SCCvertex)wherelift(AcyclicSCCv)=[|AcyclicSCCv|]lift(NECyclicSCC(v:|vs))=[|NECyclicSCC(v:|vs)|]
#endif

#endif
-- | @since 0.5.9instanceEq1SCC whereliftEq :: forall a b. (a -> b -> Bool) -> SCC a -> SCC b -> Bool
liftEq a -> b -> Bool
eq (AcyclicSCC a
v1 )(AcyclicSCC b
v2 )=a -> b -> Bool
eq a
v1 b
v2 liftEqa -> b -> Bool
eq (NECyclicSCC NonEmpty a
vs1 )(NECyclicSCC NonEmpty b
vs2 )=(a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEqa -> b -> Bool
eq NonEmpty a
vs1 NonEmpty b
vs2 liftEqa -> b -> Bool
_SCC a
_SCC b
_=Bool
False-- | @since 0.5.9instanceShow1SCC whereliftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SCC a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_sl Int
d (AcyclicSCC a
v )=(Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWithInt -> a -> ShowS
sp String
"AcyclicSCC"Int
d a
v liftShowsPrecInt -> a -> ShowS
sp [a] -> ShowS
sl Int
d (NECyclicSCC NonEmpty a
vs )=(Int -> NonEmpty a -> ShowS)
-> String -> Int -> NonEmpty a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrecInt -> a -> ShowS
sp [a] -> ShowS
sl )String
"NECyclicSCC"Int
d NonEmpty a
vs -- | @since 0.5.9instanceRead1SCC whereliftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SCC a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl =(String -> ReadS (SCC a)) -> Int -> ReadS (SCC a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData((String -> ReadS (SCC a)) -> Int -> ReadS (SCC a))
-> (String -> ReadS (SCC a)) -> Int -> ReadS (SCC a)
forall a b. (a -> b) -> a -> b
$(Int -> ReadS a)
-> String -> (a -> SCC a) -> String -> ReadS (SCC a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWithInt -> ReadS a
rp String
"AcyclicSCC"a -> SCC a
forall vertex. vertex -> SCC vertex
AcyclicSCC (String -> ReadS (SCC a))
-> (String -> ReadS (SCC a)) -> String -> ReadS (SCC a)
forall a. Semigroup a => a -> a -> a
<>(Int -> ReadS (NonEmpty a))
-> String -> (NonEmpty a -> SCC a) -> String -> ReadS (SCC a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NonEmpty a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NonEmpty a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecInt -> ReadS a
rp ReadS [a]
rl )String
"NECyclicSCC"NonEmpty a -> SCC a
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC 
#ifdef __GLASGOW_HASKELL__
(String -> ReadS (SCC a))
-> (String -> ReadS (SCC a)) -> String -> ReadS (SCC a)
forall a. Semigroup a => a -> a -> a
<>(Int -> ReadS [a])
-> String -> ([a] -> SCC a) -> String -> ReadS (SCC a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith(ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
constReadS [a]
rl )String
"CyclicSCC"[a] -> SCC a
forall vertex. [vertex] -> SCC vertex
CyclicSCC 
#endif
-- | @since 0.5.9instanceF.FoldableSCC wherefoldr :: forall a b. (a -> b -> b) -> b -> SCC a -> b
foldr a -> b -> b
c b
n (AcyclicSCC a
v )=a -> b -> b
c a
v b
n foldra -> b -> b
c b
n (NECyclicSCC NonEmpty a
vs )=(a -> b -> b) -> b -> NonEmpty a -> b
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldra -> b -> b
c b
n NonEmpty a
vs toList :: forall a. SCC a -> [a]
toList =SCC a -> [a]
forall a. SCC a -> [a]
flattenSCC 
#if MIN_VERSION_base(4,18,0)
-- | @since 0.7instanceF1.Foldable1SCC wherefoldMap1 :: forall m a. Semigroup m => (a -> m) -> SCC a -> m
foldMap1 a -> m
f (AcyclicSCC a
v )=a -> m
f a
v foldMap1a -> m
f (NECyclicSCC NonEmpty a
vs )=(a -> m) -> NonEmpty a -> m
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
F1.foldMap1a -> m
f NonEmpty a
vs toNonEmpty :: forall a. SCC a -> NonEmpty a
toNonEmpty =SCC a -> NonEmpty a
forall a. SCC a -> NonEmpty a
flattenSCC1 -- TODO define more methods
#endif
-- | @since 0.5.9instanceTraversableSCC wheretraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SCC a -> f (SCC b)
traverse a -> f b
f (AcyclicSCC a
vertex )=b -> SCC b
forall vertex. vertex -> SCC vertex
AcyclicSCC (b -> SCC b) -> f b -> f (SCC b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>a -> f b
f a
vertex -- Avoid traverse from instance Traversable NonEmpty,-- it is redundantly lazy.traversea -> f b
f (NECyclicSCC (a
x :|[a]
xs ))=(b -> [b] -> SCC b) -> f b -> f [b] -> f (SCC b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2(\b
x' [b]
xs' ->NonEmpty b -> SCC b
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC (b
x' b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:|[b]
xs' ))(a -> f b
f a
x )((a -> f b) -> [a] -> f [b]
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]
traversea -> f b
f [a]
xs )instanceNFDataa =>NFData(SCC a )wherernf :: SCC a -> ()
rnf(AcyclicSCC a
v )=a -> ()
forall a. NFData a => a -> ()
rnfa
v rnf(NECyclicSCC NonEmpty a
vs )=NonEmpty a -> ()
forall a. NFData a => a -> ()
rnfNonEmpty a
vs -- | @since 0.8instanceNFData1SCC whereliftRnf :: forall a. (a -> ()) -> SCC a -> ()
liftRnfa -> ()
rnfx (AcyclicSCC a
v )=a -> ()
rnfx a
v liftRnfa -> ()
rnfx (NECyclicSCC NonEmpty a
vs )=(a -> ()) -> NonEmpty a -> ()
forall a. (a -> ()) -> NonEmpty a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnfa -> ()
rnfx NonEmpty a
vs -- | @since 0.5.4instanceFunctorSCC wherefmap :: forall a b. (a -> b) -> SCC a -> SCC b
fmapa -> b
f (AcyclicSCC a
v )=b -> SCC b
forall vertex. vertex -> SCC vertex
AcyclicSCC (a -> b
f a
v )-- Avoid fmap from instance Functor NonEmpty,-- it is redundantly lazy.fmapa -> b
f (NECyclicSCC (a
x :|[a]
xs ))=NonEmpty b -> SCC b
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC (a -> b
f a
x b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:|(a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
mapa -> b
f [a]
xs )-- | The vertices of a list of strongly connected components.flattenSCCs ::[SCC a ]->[a ]flattenSCCs :: forall a. [SCC a] -> [a]
flattenSCCs =(SCC a -> [a]) -> [SCC a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMapSCC a -> [a]
forall a. SCC a -> [a]
flattenSCC -- | The vertices of a strongly connected component.---- @flattenSCC = 'Data.List.NonEmpty.toList' . 'flattenSCC1'@.---- This function is retained for backward compatibility,-- 'flattenSCC1' has the more precise type.flattenSCC ::SCC vertex ->[vertex ]flattenSCC :: forall a. SCC a -> [a]
flattenSCC (AcyclicSCC vertex
v )=[vertex
v ]flattenSCC (NECyclicSCC (vertex
v :|[vertex]
vs ))=vertex
v vertex -> [vertex] -> [vertex]
forall a. a -> [a] -> [a]
:[vertex]
vs -- Note: Best to avoid NE.toList, it is too lazy.-- | The vertices of a strongly connected component.---- @since 0.8flattenSCC1 ::SCC vertex ->NonEmptyvertex flattenSCC1 :: forall a. SCC a -> NonEmpty a
flattenSCC1 (AcyclicSCC vertex
v )=vertex
v vertex -> [vertex] -> NonEmpty vertex
forall a. a -> [a] -> NonEmpty a
:|[]flattenSCC1 (NECyclicSCC NonEmpty vertex
vs )=NonEmpty vertex
vs -- | \(O((V+E) \log V)\). The strongly connected components of a directed graph,-- reverse topologically sorted.---- ==== __Examples__---- > stronglyConnComp [("a",0,[1]),("b",1,[2,3]),("c",2,[1]),("d",3,[3])]-- > == [CyclicSCC ["d"],CyclicSCC ["b","c"],AcyclicSCC "a"]stronglyConnComp ::Ordkey =>[(node ,key ,[key ])]-- ^ The graph: a list of nodes uniquely identified by keys,-- with a list of keys of nodes this node has edges to.-- The out-list may contain keys that don't correspond to-- nodes of the graph; such edges are ignored.->[SCC node ]stronglyConnComp :: forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [(node, key, [key])]
edges0 =(SCC (node, key, [key]) -> SCC node)
-> [SCC (node, key, [key])] -> [SCC node]
forall a b. (a -> b) -> [a] -> [b]
mapSCC (node, key, [key]) -> SCC node
forall {vertex} {b} {c}. SCC (vertex, b, c) -> SCC vertex
get_node ([(node, key, [key])] -> [SCC (node, key, [key])]
forall key node.
Ord key =>
[(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR [(node, key, [key])]
edges0 )whereget_node :: SCC (vertex, b, c) -> SCC vertex
get_node (AcyclicSCC (vertex
n ,b
_,c
_))=vertex -> SCC vertex
forall vertex. vertex -> SCC vertex
AcyclicSCC vertex
n get_node (NECyclicSCC ((vertex
n0 ,b
_,c
_):|[(vertex, b, c)]
triples ))=NonEmpty vertex -> SCC vertex
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC (vertex
n0 vertex -> [vertex] -> NonEmpty vertex
forall a. a -> [a] -> NonEmpty a
:|[vertex
n |(vertex
n ,b
_,c
_)<-[(vertex, b, c)]
triples ]){-# INLINABLEstronglyConnComp #-}-- | \(O((V+E) \log V)\). The strongly connected components of a directed graph,-- reverse topologically sorted. The function is the same as-- 'stronglyConnComp', except that all the information about each node retained.-- This interface is used when you expect to apply 'SCC' to-- (some of) the result of 'SCC', so you don't want to lose the-- dependency information.---- ==== __Examples__---- > stronglyConnCompR [("a",0,[1]),("b",1,[2,3]),("c",2,[1]),("d",3,[3])]-- > == [CyclicSCC [("d",3,[3])],CyclicSCC [("b",1,[2,3]),("c",2,[1])],AcyclicSCC ("a",0,[1])]stronglyConnCompR ::Ordkey =>[(node ,key ,[key ])]-- ^ The graph: a list of nodes uniquely identified by keys,-- with a list of keys of nodes this node has edges to.-- The out-list may contain keys that don't correspond to-- nodes of the graph; such edges are ignored.->[SCC (node ,key ,[key ])]-- ^ Reverse topologically sortedstronglyConnCompR :: forall key node.
Ord key =>
[(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR []=[]-- added to avoid creating empty array in graphFromEdges -- SOFstronglyConnCompR [(node, key, [key])]
edges0 =(Tree Int -> SCC (node, key, [key]))
-> [Tree Int] -> [SCC (node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
mapTree Int -> SCC (node, key, [key])
decode [Tree Int]
forest where(Graph
graph ,Int -> (node, key, [key])
vertex_fn ,key -> Maybe Int
_)=[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges [(node, key, [key])]
edges0 forest :: [Tree Int]
forest =Graph -> [Tree Int]
scc Graph
graph decode :: Tree Int -> SCC (node, key, [key])
decode (Node Int
v [])|Int -> Bool
mentions_itself Int
v =NonEmpty (node, key, [key]) -> SCC (node, key, [key])
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC (Int -> (node, key, [key])
vertex_fn Int
v (node, key, [key])
-> [(node, key, [key])] -> NonEmpty (node, key, [key])
forall a. a -> [a] -> NonEmpty a
:|[])|Bool
otherwise=(node, key, [key]) -> SCC (node, key, [key])
forall vertex. vertex -> SCC vertex
AcyclicSCC (Int -> (node, key, [key])
vertex_fn Int
v )decode (Node Int
v [Tree Int]
ts )=NonEmpty (node, key, [key]) -> SCC (node, key, [key])
forall vertex. NonEmpty vertex -> SCC vertex
NECyclicSCC (Int -> (node, key, [key])
vertex_fn Int
v (node, key, [key])
-> [(node, key, [key])] -> NonEmpty (node, key, [key])
forall a. a -> [a] -> NonEmpty a
:|(Tree Int -> [(node, key, [key])] -> [(node, key, [key])])
-> [(node, key, [key])] -> [Tree Int] -> [(node, key, [key])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldrTree Int -> [(node, key, [key])] -> [(node, key, [key])]
dec [][Tree Int]
ts )dec :: Tree Int -> [(node, key, [key])] -> [(node, key, [key])]
dec (Node Int
v [Tree Int]
ts )[(node, key, [key])]
vs =Int -> (node, key, [key])
vertex_fn Int
v (node, key, [key]) -> [(node, key, [key])] -> [(node, key, [key])]
forall a. a -> [a] -> [a]
:(Tree Int -> [(node, key, [key])] -> [(node, key, [key])])
-> [(node, key, [key])] -> [Tree Int] -> [(node, key, [key])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldrTree Int -> [(node, key, [key])] -> [(node, key, [key])]
dec [(node, key, [key])]
vs [Tree Int]
ts mentions_itself :: Int -> Bool
mentions_itself Int
v =Int
v Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`(Graph
graph Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
!Int
v ){-# INLINABLEstronglyConnCompR #-}--------------------------------------------------------------------------- --- Graphs-- ---------------------------------------------------------------------------- | Abstract representation of vertices.typeVertex =Int-- | Table indexed by a contiguous set of vertices.---- /Note: This is included for backwards compatibility./typeTable a =ArrayVertex a -- | Adjacency list representation of a graph, mapping each vertex to its-- list of successors.typeGraph =ArrayVertex [Vertex ]-- | The bounds of an @Array@.typeBounds =(Vertex ,Vertex )-- | An edge from the first vertex to the second.typeEdge =(Vertex ,Vertex )
#if !USE_UNBOXED_ARRAYS
typeUArrayia=Arrayia
#endif
-- | \(O(V)\). Returns the list of vertices in the graph.---- ==== __Examples__---- > vertices (buildG (0,-1) []) == []---- > vertices (buildG (0,2) [(0,1),(1,2)]) == [0,1,2]vertices ::Graph ->[Vertex ]vertices :: Graph -> [Int]
vertices =Graph -> [Int]
forall i e. Ix i => Array i e -> [i]
indices-- See Note [Inline for fusion]{-# INLINEvertices #-}-- | \(O(V+E)\). Returns the list of edges in the graph.---- ==== __Examples__---- > edges (buildG (0,-1) []) == []---- > edges (buildG (0,2) [(0,1),(1,2)]) == [(0,1),(1,2)]edges ::Graph ->[Edge ]edges :: Graph -> [Edge]
edges Graph
g =[(Int
v ,Int
w )|Int
v <-Graph -> [Int]
vertices Graph
g ,Int
w <-Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
!Int
v ]-- See Note [Inline for fusion]{-# INLINEedges #-}-- | \(O(V+E)\). Build a graph from a list of edges.---- Warning: This function will cause a runtime exception if a vertex in the edge-- list is not within the given @Bounds@.---- ==== __Examples__---- > buildG (0,-1) [] == array (0,-1) []-- > buildG (0,2) [(0,1), (1,2)] == array (0,1) [(0,[1]),(1,[2])]-- > buildG (0,2) [(0,1), (0,2), (1,2)] == array (0,2) [(0,[2,1]),(1,[2]),(2,[])]buildG ::Bounds ->[Edge ]->Graph buildG :: Edge -> [Edge] -> Graph
buildG =([Int] -> Int -> [Int]) -> [Int] -> Edge -> [Edge] -> Graph
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray((Int -> [Int] -> [Int]) -> [Int] -> Int -> [Int]
forall a b c. (a -> b -> c) -> b -> a -> c
flip(:))[]-- See Note [Inline for fusion]{-# INLINEbuildG #-}-- | \(O(V+E)\). The graph obtained by reversing all edges.---- ==== __Examples__---- > transposeG (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,[]),(1,[0]),(2,[1])]transposeG ::Graph ->Graph transposeG :: Graph -> Graph
transposeG Graph
g =Edge -> [Edge] -> Graph
buildG (Graph -> Edge
forall i e. Array i e -> (i, i)
boundsGraph
g )(Graph -> [Edge]
reverseE Graph
g )reverseE ::Graph ->[Edge ]reverseE :: Graph -> [Edge]
reverseE Graph
g =[(Int
w ,Int
v )|(Int
v ,Int
w )<-Graph -> [Edge]
edges Graph
g ]-- See Note [Inline for fusion]{-# INLINEreverseE #-}-- | \(O(V+E)\). A table of the count of edges from each node.---- ==== __Examples__---- > outdegree (buildG (0,-1) []) == array (0,-1) []---- > outdegree (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,1),(1,1),(2,0)]outdegree ::Graph ->ArrayVertex Int-- This is bizarrely lazy. We build an array filled with thunks, instead-- of actually calculating anything. This is the historical behavior, and I-- suppose someone *could* be relying on it, but it might be worth finding-- out. Note that we *can't* be so lazy with indegree.outdegree :: Graph -> Array Int Int
outdegree =([Int] -> Int) -> Graph -> Array Int Int
forall a b. (a -> b) -> Array Int a -> Array Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap[Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length-- | \(O(V+E)\). A table of the count of edges into each node.---- ==== __Examples__---- > indegree (buildG (0,-1) []) == array (0,-1) []---- > indegree (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,0),(1,1),(2,1)]indegree ::Graph ->ArrayVertex Intindegree :: Graph -> Array Int Int
indegree Graph
g =(Int -> Int -> Int) -> Int -> Edge -> [Edge] -> Array Int Int
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArrayInt -> Int -> Int
forall a. Num a => a -> a -> a
(+)Int
0(Graph -> Edge
forall i e. Array i e -> (i, i)
boundsGraph
g )[(Int
v ,Int
1)|(Int
_,[Int]
outs )<-Graph -> [(Int, [Int])]
forall i e. Ix i => Array i e -> [(i, e)]
assocsGraph
g ,Int
v <-[Int]
outs ]-- | \(O((V+E) \log V)\). Identical to 'graphFromEdges', except that the return-- value does not include the function which maps keys to vertices. This-- version of 'graphFromEdges' is for backwards compatibility.graphFromEdges' ::Ordkey =>[(node ,key ,[key ])]->(Graph ,Vertex ->(node ,key ,[key ]))graphFromEdges' :: forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
graphFromEdges' [(node, key, [key])]
x =(Graph
a ,Int -> (node, key, [key])
b )where(Graph
a ,Int -> (node, key, [key])
b ,key -> Maybe Int
_)=[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges [(node, key, [key])]
x {-# INLINABLEgraphFromEdges' #-}-- | \(O((V+E) \log V)\). Build a graph from a list of nodes uniquely identified-- by keys, with a list of keys of nodes this node should have edges to.---- This function takes an adjacency list representing a graph with vertices of-- type @key@ labeled by values of type @node@ and produces a @Graph@-based-- representation of that list. The @Graph@ result represents the /shape/ of the-- graph, and the functions describe a) how to retrieve the label and adjacent-- vertices of a given vertex, and b) how to retrieve a vertex given a key.---- @(graph, nodeFromVertex, vertexFromKey) = graphFromEdges edgeList@---- * @graph :: Graph@ is the raw, array based adjacency list for the graph.-- * @nodeFromVertex :: Vertex -> (node, key, [key])@ returns the node-- associated with the given 0-based @Int@ vertex; see /warning/ below. This-- runs in \(O(1)\) time.-- * @vertexFromKey :: key -> Maybe Vertex@ returns the @Int@ vertex for the-- key if it exists in the graph, @Nothing@ otherwise. This runs in-- \(O(\log V)\) time.---- To safely use this API you must either extract the list of vertices directly-- from the graph or first call @vertexFromKey k@ to check if a vertex-- corresponds to the key @k@. Once it is known that a vertex exists you can use-- @nodeFromVertex@ to access the labelled node and adjacent vertices. See below-- for examples.---- Note: The out-list may contain keys that don't correspond to nodes of the-- graph; they are ignored.---- Warning: The @nodeFromVertex@ function will cause a runtime exception if the-- given @Vertex@ does not exist.---- ==== __Examples__---- An empty graph.---- > (graph, nodeFromVertex, vertexFromKey) = graphFromEdges []-- > graph = array (0,-1) []---- A graph where the out-list references unspecified nodes (@\'c\'@), these are-- ignored.---- > (graph, _, _) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c'])]-- > array (0,1) [(0,[1]),(1,[])]------ A graph with 3 vertices: ("a") -> ("b") -> ("c")---- > (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c']), ("c", 'c', [])]-- > graph == array (0,2) [(0,[1]),(1,[2]),(2,[])]-- > nodeFromVertex 0 == ("a",'a',"b")-- > vertexFromKey 'a' == Just 0---- Get the label for a given key.---- > let getNodePart (n, _, _) = n-- > (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c']), ("c", 'c', [])]-- > getNodePart . nodeFromVertex <$> vertexFromKey 'a' == Just "A"--graphFromEdges ::Ordkey =>[(node ,key ,[key ])]->(Graph ,Vertex ->(node ,key ,[key ]),key ->MaybeVertex )graphFromEdges :: forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges [(node, key, [key])]
edges0 =(Graph
graph ,\Int
v ->Array Int (node, key, [key])
vertex_map Array Int (node, key, [key]) -> Int -> (node, key, [key])
forall i e. Ix i => Array i e -> i -> e
!Int
v ,key -> Maybe Int
key_vertex )wheremax_v :: Int
max_v =[(node, key, [key])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[(node, key, [key])]
edges0 Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1bounds0 :: Edge
bounds0 =(Int
0,Int
max_v )::(Vertex ,Vertex )sorted_edges :: [(node, key, [key])]
sorted_edges =((node, key, [key]) -> (node, key, [key]) -> Ordering)
-> [(node, key, [key])] -> [(node, key, [key])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy(node, key, [key]) -> (node, key, [key]) -> Ordering
forall {a} {a} {c} {a} {c}.
Ord a =>
(a, a, c) -> (a, a, c) -> Ordering
lt [(node, key, [key])]
edges0 edges1 :: [(Int, (node, key, [key]))]
edges1 =(Int -> (node, key, [key]) -> (Int, (node, key, [key])))
-> [Int] -> [(node, key, [key])] -> [(Int, (node, key, [key]))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(,)[Int
0..][(node, key, [key])]
sorted_edges graph :: Graph
graph =Edge -> [(Int, [Int])] -> Graph
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
arrayEdge
bounds0 [(,)Int
v ((key -> Maybe Int) -> [key] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybekey -> Maybe Int
key_vertex [key]
ks )|(,)Int
v (node
_,key
_,[key]
ks )<-[(Int, (node, key, [key]))]
edges1 ]key_map :: Array Int key
key_map =Edge -> [(Int, key)] -> Array Int key
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
arrayEdge
bounds0 [(,)Int
v key
k |(,)Int
v (node
_,key
k ,[key]
_)<-[(Int, (node, key, [key]))]
edges1 ]vertex_map :: Array Int (node, key, [key])
vertex_map =Edge -> [(Int, (node, key, [key]))] -> Array Int (node, key, [key])
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
arrayEdge
bounds0 [(Int, (node, key, [key]))]
edges1 (a
_,a
k1 ,c
_)lt :: (a, a, c) -> (a, a, c) -> Ordering
`lt` (a
_,a
k2 ,c
_)=a
k1 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`a
k2 -- key_vertex :: key -> Maybe Vertex-- returns Nothing for non-interesting verticeskey_vertex :: key -> Maybe Int
key_vertex key
k =Int -> Int -> Maybe Int
findVertex Int
0Int
max_v wherefindVertex :: Int -> Int -> Maybe Int
findVertex Int
a Int
b |Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
b =Maybe Int
forall a. Maybe a
NothingfindVertex Int
a Int
b =casekey -> key -> Ordering
forall a. Ord a => a -> a -> Ordering
comparekey
k (Array Int key
key_map Array Int key -> Int -> key
forall i e. Ix i => Array i e -> i -> e
!Int
mid )ofOrdering
LT->Int -> Int -> Maybe Int
findVertex Int
a (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Ordering
EQ->Int -> Maybe Int
forall a. a -> Maybe a
JustInt
mid Ordering
GT->Int -> Int -> Maybe Int
findVertex (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int
b wheremid :: Int
mid =Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a )Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
2{-# INLINABLEgraphFromEdges #-}--------------------------------------------------------------------------- --- Depth first search-- ---------------------------------------------------------------------------- | \(O(V+E)\). A spanning forest of the graph, obtained from a depth-first-- search of the graph starting from each vertex in an unspecified order.dff ::Graph ->[Tree Vertex ]dff :: Graph -> [Tree Int]
dff Graph
g =Graph -> [Int] -> [Tree Int]
dfs Graph
g (Graph -> [Int]
vertices Graph
g )-- | \(O(V+E)\). A spanning forest of the part of the graph reachable from the-- listed vertices, obtained from a depth-first search of the graph starting at-- each of the listed vertices in order.-- This function deviates from King and Launchbury's implementation by-- bundling together the functions generate, prune, and chop for efficiency-- reasons.dfs ::Graph ->[Vertex ]->[Tree Vertex ]dfs :: Graph -> [Int] -> [Tree Int]
dfs !Graph
g [Int]
vs0 =Edge
-> (forall {s}.
 (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s [Tree Int])
-> [Tree Int]
forall a.
Edge
-> (forall s. (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s a)
-> a
run (Graph -> Edge
forall i e. Array i e -> (i, i)
boundsGraph
g )((forall {s}.
 (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s [Tree Int])
 -> [Tree Int])
-> (forall {s}.
 (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s [Tree Int])
-> [Tree Int]
forall a b. (a -> b) -> a -> b
$\Int -> ST s Bool
contains Int -> ST s ()
include ->letgo :: [Int] -> ST s [Tree Int]
go []=[Tree Int] -> ST s [Tree Int]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[]go (Int
v :[Int]
vs )=doBool
visited <-Int -> ST s Bool
contains Int
v ifBool
visited then[Int] -> ST s [Tree Int]
go [Int]
vs elsedoInt -> ST s ()
include Int
v [Tree Int]
as <-[Int] -> ST s [Tree Int]
go (Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
!Int
v )[Tree Int]
bs <-[Int] -> ST s [Tree Int]
go [Int]
vs [Tree Int] -> ST s [Tree Int]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure([Tree Int] -> ST s [Tree Int]) -> [Tree Int] -> ST s [Tree Int]
forall a b. (a -> b) -> a -> b
$Int -> [Tree Int] -> Tree Int
forall a. a -> [Tree a] -> Tree a
Node Int
v [Tree Int]
as Tree Int -> [Tree Int] -> [Tree Int]
forall a. a -> [a] -> [a]
:[Tree Int]
bs in[Int] -> ST s [Tree Int]
go [Int]
vs0 
#if USE_ST_MONAD
-- Use the ST monad if available, for constant-time primitives.newArrayBool ::Bounds 
#if USE_UNBOXED_ARRAYS
->STs (STUArrays Vertex Bool)
#else
->STs(STArraysVertexBool)
#endif
newArrayBool :: forall s. Edge -> ST s (STUArray s Int Bool)
newArrayBool Edge
bnds =Edge -> Bool -> ST s (STUArray s Int Bool)
forall i. Ix i => (i, i) -> Bool -> ST s (STUArray s i Bool)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArrayEdge
bnds Bool
Falserun ::Bounds ->(foralls .(Vertex ->STs Bool)->(Vertex ->STs ())->STs a )->a run :: forall a.
Edge
-> (forall s. (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s a)
-> a
run Edge
bnds forall s. (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s a
f =(forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$doSTUArray s Int Bool
m <-Edge -> ST s (STUArray s Int Bool)
forall s. Edge -> ST s (STUArray s Int Bool)
newArrayBool Edge
bnds (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s a
forall s. (Int -> ST s Bool) -> (Int -> ST s ()) -> ST s a
f (STUArray s Int Bool -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArraySTUArray s Int Bool
m )(\Int
v ->STUArray s Int Bool -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArraySTUArray s Int Bool
m Int
v Bool
True){-# INLINErun #-}
#else /* !USE_ST_MONAD */
-- Portable implementation using IntSet.newtypeSetMa=SetM{runSetM::IntSet->(a,IntSet)}instanceMonadSetMwhereSetMv>>=f=SetM$\s->casevsof(x,s')->runSetM(fx)s'instanceFunctorSetMwheref`fmap`SetMv=SetM$\s->casevsof(x,s')->(fx,s'){-# INLINEfmap#-}instanceApplicativeSetMwherepurex=SetM$\s->(x,s){-# INLINEpure#-}SetMf<*>SetMv=SetM$\s->casefsof(k,s')->casevs'of(x,s'')->(kx,s''){-# INLINE(<*>)#-}run::Bounds->((Vertex->SetMBool)->(Vertex->SetM())->SetMa)->arun_f=fst(runSetM(fcontainsinclude)Set.empty)wherecontainsv=SetM$\m->(Set.membervm,m)includev=SetM$\m->((),Set.insertvm)
#endif /* !USE_ST_MONAD */
--------------------------------------------------------------------------- --- Algorithms-- ---------------------------------------------------------------------------------------------------------------------------------------- Algorithm 1: depth first search numbering------------------------------------------------------------preorder' ::Tree a ->[a ]->[a ]preorder' :: forall a. Tree a -> [a] -> [a]
preorder' (Node a
a [Tree a]
ts )=(a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Tree a] -> [a] -> [a]
forall a. [Tree a] -> [a] -> [a]
preorderF' [Tree a]
ts preorderF' ::[Tree a ]->[a ]->[a ]preorderF' :: forall a. [Tree a] -> [a] -> [a]
preorderF' [Tree a]
ts =(([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)[a] -> [a]
forall a. a -> a
id([[a] -> [a]] -> [a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$(Tree a -> [a] -> [a]) -> [Tree a] -> [[a] -> [a]]
forall a b. (a -> b) -> [a] -> [b]
mapTree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
preorder' [Tree a]
ts preorderF ::[Tree a ]->[a ]preorderF :: forall a. [Tree a] -> [a]
preorderF [Tree a]
ts =[Tree a] -> [a] -> [a]
forall a. [Tree a] -> [a] -> [a]
preorderF' [Tree a]
ts []tabulate ::Bounds ->[Vertex ]->UArrayVertex Inttabulate :: Edge -> [Int] -> UArray Int Int
tabulate Edge
bnds [Int]
vs =Edge -> [Edge] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
UA.arrayEdge
bnds ((Int -> Int -> Edge) -> [Int] -> [Int] -> [Edge]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith((Int -> Int -> Edge) -> Int -> Int -> Edge
forall a b c. (a -> b -> c) -> b -> a -> c
flip(,))[Int
1..][Int]
vs )-- Why zipWith (flip (,)) instead of just using zip with the-- arguments in the other order? We want the [1..] to fuse-- away, and these days that only happens when it's the first-- list argument.preArr ::Bounds ->[Tree Vertex ]->UArrayVertex IntpreArr :: Edge -> [Tree Int] -> UArray Int Int
preArr Edge
bnds =Edge -> [Int] -> UArray Int Int
tabulate Edge
bnds ([Int] -> UArray Int Int)
-> ([Tree Int] -> [Int]) -> [Tree Int] -> UArray Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Tree Int] -> [Int]
forall a. [Tree a] -> [a]
preorderF -------------------------------------------------------------- Algorithm 2: topological sorting------------------------------------------------------------postorder ::Tree a ->[a ]->[a ]postorder :: forall a. Tree a -> [a] -> [a]
postorder (Node a
a [Tree a]
ts )=[Tree a] -> [a] -> [a]
forall a. [Tree a] -> [a] -> [a]
postorderF [Tree a]
ts ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)postorderF ::[Tree a ]->[a ]->[a ]postorderF :: forall a. [Tree a] -> [a] -> [a]
postorderF [Tree a]
ts =(([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)[a] -> [a]
forall a. a -> a
id([[a] -> [a]] -> [a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$(Tree a -> [a] -> [a]) -> [Tree a] -> [[a] -> [a]]
forall a b. (a -> b) -> [a] -> [b]
mapTree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
postorder [Tree a]
ts postOrd ::Graph ->[Vertex ]postOrd :: Graph -> [Int]
postOrd Graph
g =[Tree Int] -> [Int] -> [Int]
forall a. [Tree a] -> [a] -> [a]
postorderF (Graph -> [Tree Int]
dff Graph
g )[]-- | \(O(V+E)\). A topological sort of the graph.-- The order is partially specified by the condition that a vertex /i/-- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa.---- Note: A topological sort exists only when there are no cycles in the graph.-- If the graph has cycles, the output of this function will not be a-- topological sort. In such a case consider using 'scc'.topSort ::Graph ->[Vertex ]topSort :: Graph -> [Int]
topSort =[Int] -> [Int]
forall a. [a] -> [a]
reverse([Int] -> [Int]) -> (Graph -> [Int]) -> Graph -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Graph -> [Int]
postOrd -- | \(O(V+E)\). Reverse ordering of `topSort`.---- See note in 'topSort'.---- @since 0.6.4reverseTopSort ::Graph ->[Vertex ]reverseTopSort :: Graph -> [Int]
reverseTopSort =Graph -> [Int]
postOrd -------------------------------------------------------------- Algorithm 3: connected components-------------------------------------------------------------- | \(O(V+E)\). The connected components of a graph.-- Two vertices are connected if there is a path between them, traversing-- edges in either direction.components ::Graph ->[Tree Vertex ]components :: Graph -> [Tree Int]
components =Graph -> [Tree Int]
dff (Graph -> [Tree Int]) -> (Graph -> Graph) -> Graph -> [Tree Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Graph -> Graph
undirected undirected ::Graph ->Graph undirected :: Graph -> Graph
undirected Graph
g =Edge -> [Edge] -> Graph
buildG (Graph -> Edge
forall i e. Array i e -> (i, i)
boundsGraph
g )(Graph -> [Edge]
edges Graph
g [Edge] -> [Edge] -> [Edge]
forall a. [a] -> [a] -> [a]
++Graph -> [Edge]
reverseE Graph
g )-- Algorithm 4: strongly connected components-- | \(O(V+E)\). The strongly connected components of a graph, in reverse-- topological order.---- ==== __Examples__---- > scc (buildG (0,3) [(3,1),(1,2),(2,0),(0,1)])-- > == [Node {rootLabel = 0, subForest = [Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []}]}]}-- > ,Node {rootLabel = 3, subForest = []}]scc ::Graph ->[Tree Vertex ]scc :: Graph -> [Tree Int]
scc Graph
g =Graph -> [Int] -> [Tree Int]
dfs Graph
g ([Int] -> [Int]
forall a. [a] -> [a]
reverse(Graph -> [Int]
postOrd (Graph -> Graph
transposeG Graph
g )))-------------------------------------------------------------- Algorithm 5: Classifying edges------------------------------------------------------------{-
XXX unused code
tree :: Bounds -> Forest Vertex -> Graph
tree bnds ts = buildG bnds (concat (map flat ts))
 where flat (Node v ts') = [ (v, w) | Node w _us <- ts' ]
 ++ concat (map flat ts')
back :: Graph -> Table Int -> Graph
back g post = mapT select g
 where select v ws = [ w | w <- ws, post!v < post!w ]
cross :: Graph -> Table Int -> Table Int -> Graph
cross g pre post = mapT select g
 where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ]
forward :: Graph -> Graph -> Table Int -> Graph
forward g tree' pre = mapT select g
 where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree' ! v
mapT :: (Vertex -> a -> b) -> Array Vertex a -> Array Vertex b
mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]
-}-------------------------------------------------------------- Algorithm 6: Finding reachable vertices-------------------------------------------------------------- | \(O(V+E)\). Returns the list of vertices reachable from a given vertex.---- ==== __Examples__---- > reachable (buildG (0,0) []) 0 == [0]---- > reachable (buildG (0,2) [(0,1), (1,2)]) 0 == [0,1,2]reachable ::Graph ->Vertex ->[Vertex ]reachable :: Graph -> Int -> [Int]
reachable Graph
g Int
v =[Tree Int] -> [Int]
forall a. [Tree a] -> [a]
preorderF (Graph -> [Int] -> [Tree Int]
dfs Graph
g [Int
v ])-- | \(O(V+E)\). Returns @True@ if the second vertex reachable from the first.---- ==== __Examples__---- > path (buildG (0,0) []) 0 0 == True---- > path (buildG (0,2) [(0,1), (1,2)]) 0 2 == True---- > path (buildG (0,2) [(0,1), (1,2)]) 2 0 == Falsepath ::Graph ->Vertex ->Vertex ->Boolpath :: Graph -> Int -> Int -> Bool
path Graph
g Int
v Int
w =Int
w Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`(Graph -> Int -> [Int]
reachable Graph
g Int
v )-------------------------------------------------------------- Algorithm 7: Biconnected components-------------------------------------------------------------- | \(O(V+E)\). The biconnected components of a graph.-- An undirected graph is biconnected if the deletion of any vertex-- leaves it connected.---- The input graph is expected to be undirected, i.e. for every edge in the-- graph the reverse edge is also in the graph. If the graph is not undirected-- the output is arbitrary.bcc ::Graph ->[Tree [Vertex ]]bcc :: Graph -> [Tree [Int]]
bcc Graph
g =(Tree Int -> [Tree [Int]]) -> [Tree Int] -> [Tree [Int]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMapTree Int -> [Tree [Int]]
bicomps [Tree Int]
forest where-- The algorithm here is the same as given by King and Launchbury, which is-- an adaptation of Hopcroft and Tarjan's. The implementation, however, has-- been modified from King and Launchbury to make it efficient.forest :: [Tree Int]
forest =Graph -> [Tree Int]
dff Graph
g -- dnum!v is the index of vertex v in the dfs preorder of verticesdnum :: UArray Int Int
dnum =Edge -> [Tree Int] -> UArray Int Int
preArr (Graph -> Edge
forall i e. Array i e -> (i, i)
boundsGraph
g )[Tree Int]
forest -- Wraps up the component of every child of the rootbicomps ::Tree Vertex ->[Tree [Vertex ]]bicomps :: Tree Int -> [Tree [Int]]
bicomps (Node Int
v [Tree Int]
tws )=[[Int] -> [Tree [Int]] -> Tree [Int]
forall a. a -> [Tree a] -> Tree a
Node (Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int] -> [Int]
curw [])([Tree [Int]] -> [Tree [Int]]
donew [])|(Int
_,[Int] -> [Int]
curw ,[Tree [Int]] -> [Tree [Int]]
donew )<-(Tree Int -> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]]))
-> [Tree Int]
-> [(Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])]
forall a b. (a -> b) -> [a] -> [b]
mapTree Int -> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
collect [Tree Int]
tws ]-- Returns a triple of-- * lowpoint of v-- * difference list of vertices in v's component-- * difference list of trees of components, whose root components are-- adjacent to v's componentcollect ::Tree Vertex ->(Int,[Vertex ]->[Vertex ],[Tree [Vertex ]]->[Tree [Vertex ]])collect :: Tree Int -> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
collect (Node Int
v [Tree Int]
tws )=(Int
lowv ,(Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> [Int]
curv ,[Tree [Int]] -> [Tree [Int]]
donev )wheredv :: Int
dv =UArray Int Int
dnum UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
UA.!Int
v accf :: (Int, [Int] -> c, [Tree [Int]] -> c)
-> Tree Int -> (Int, [Int] -> c, [Tree [Int]] -> c)
accf (Int
lowv' ,[Int] -> c
curv' ,[Tree [Int]] -> c
donev' )Tree Int
tw |Int
loww Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
dv -- w's component extends through v=(Int
lowv'' ,[Int] -> c
curv' ([Int] -> c) -> ([Int] -> [Int]) -> [Int] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> [Int]
curw ,[Tree [Int]] -> c
donev' ([Tree [Int]] -> c)
-> ([Tree [Int]] -> [Tree [Int]]) -> [Tree [Int]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Tree [Int]] -> [Tree [Int]]
donew )|Bool
otherwise-- w's component ends with v as an articulation point=(Int
lowv'' ,[Int] -> c
curv' ,[Tree [Int]] -> c
donev' ([Tree [Int]] -> c)
-> ([Tree [Int]] -> [Tree [Int]]) -> [Tree [Int]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Int] -> [Tree [Int]] -> Tree [Int]
forall a. a -> [Tree a] -> Tree a
Node (Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int] -> [Int]
curw [])([Tree [Int]] -> [Tree [Int]]
donew [])Tree [Int] -> [Tree [Int]] -> [Tree [Int]]
forall a. a -> [a] -> [a]
:))where(Int
loww ,[Int] -> [Int]
curw ,[Tree [Int]] -> [Tree [Int]]
donew )=Tree Int -> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
collect Tree Int
tw !lowv'' :: Int
lowv'' =Int -> Int -> Int
forall a. Ord a => a -> a -> a
minInt
lowv' Int
loww !lowv0 :: Int
lowv0 =(Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'Int -> Int -> Int
forall a. Ord a => a -> a -> a
minInt
dv [UArray Int Int
dnum UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
UA.!Int
w |Int
w <-Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
!Int
v ]!(Int
lowv ,[Int] -> [Int]
curv ,[Tree [Int]] -> [Tree [Int]]
donev )=((Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
 -> Tree Int -> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]]))
-> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
-> [Tree Int]
-> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'(Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
-> Tree Int -> (Int, [Int] -> [Int], [Tree [Int]] -> [Tree [Int]])
forall {c} {c}.
(Int, [Int] -> c, [Tree [Int]] -> c)
-> Tree Int -> (Int, [Int] -> c, [Tree [Int]] -> c)
accf (Int
lowv0 ,[Int] -> [Int]
forall a. a -> a
id,[Tree [Int]] -> [Tree [Int]]
forall a. a -> a
id)[Tree Int]
tws ---------------------------------------------------------------------------------- Note [Inline for fusion]-- ~~~~~~~~~~~~~~~~~~~~~~~~---- We inline simple functions that produce or consume lists so that list fusion-- can fire. transposeG is a function where this is particularly useful; it has-- two intermediate lists in its definition which get fused away.