    {-# OPTIONS_GHC -Wunused-imports #-}

    -- | Directed graphs (can of course simulate undirected graphs).
    --
    --   Represented as adjacency maps in direction from source to target.
    --
    --   Each source node maps to an adjacency map of outgoing edges,
    --   which is a map from target nodes to edges.
    --
    --   Listed time complexities are for the worst case (and possibly
    --   amortised), with /n/ standing for the number of nodes in the
    --   graph and /e/ standing for the number of edges. Comparisons,
    --   predicates etc. are assumed to take constant time (unless
    --   otherwise stated).

    module Agda.Utils.Graph.AdjacencyMap.Unidirectional
      ( -- * Graphs and edges
        Graph(..)
      , invariant
      , Edge(..)
        -- * Queries
      , lookup
      , edges
      , neighbours, neighboursMap
      , edgesFrom
      , edgesTo
      , diagonal
      , nodes, sourceNodes, targetNodes, isolatedNodes
      , Nodes(..), computeNodes
      , discrete
      , acyclic
        -- * Construction
      , fromNodes, fromNodeSet
      , fromEdges, fromEdgesWith
      , empty
      , singleton
      , insert, insertWith
      , insertEdge, insertEdgeWith
      , union, unionWith
      , unions, unionsWith
        -- * Transformation
      , mapWithEdge
      , transposeEdge, transpose
      , clean
      , removeNode, removeNodes
      , removeEdge
      , filterNodes
      , filterEdges
      , filterNodesKeepingEdges
      , renameNodes, renameNodesMonotonic
      , WithUniqueInt(..), addUniqueInts
      , unzip
      , composeWith
        -- * Strongly connected components
      , sccs'
      , sccs
      , DAG(..)
      , dagInvariant
      , oppositeDAG
      , reachable
      , sccDAG'
      , sccDAG
        -- * Reachability
      , reachableFrom, reachableFromSet
      , walkSatisfying
      , longestPaths
        -- * Transitive closure
      , gaussJordanFloydWarshallMcNaughtonYamada
      , gaussJordanFloydWarshallMcNaughtonYamadaReference
      , transitiveClosure
      , transitiveReduction
      , complete, completeIter
      )
      where

    import Prelude hiding ( lookup, null, unzip )

    import qualified Data.Array.IArray as Array
    import Data.Sequence (Seq)
    import qualified Data.Sequence as Seq
    import qualified Data.Graph as Graph
    import Data.IntMap.Strict (IntMap)
    import qualified Data.IntMap.Strict as IntMap
    import qualified Data.IntSet as IntSet
    import qualified Data.List as List
    import qualified Data.Map.Strict as Map
    import Data.Map.Strict (Map)
    import Data.Foldable (toList)

    import Data.Maybe (maybeToList, fromMaybe)
    import qualified Data.Set as Set
    import Data.Set (Set)
    import qualified Data.Tree as Tree

    import Agda.Utils.Function
    import Agda.Utils.List1 (List1)
    import qualified Agda.Utils.List1 as List1
    import Agda.Utils.Null (Null(null))
    import qualified Agda.Utils.Null as Null
    import Agda.Syntax.Common.Pretty
    import Agda.Utils.SemiRing
    import Agda.Utils.Tuple

    import Agda.Utils.Impossible
    import Agda.Utils.Functor

    ------------------------------------------------------------------------
    -- Graphs and edges

    -- | @Graph n e@ is a type of directed graphs with nodes in @n@ and
    --   edges in @e@.
    --
    --   At most one edge is allowed between any two nodes. Multigraphs
    --   can be simulated by letting the edge type @e@ be a collection
    --   type.
    --
    --   The graphs are represented as adjacency maps (adjacency lists,
    --   but using finite maps instead of arrays and lists). This makes it
    --   possible to compute a node's outgoing edges in logarithmic time
    --   (/O(log n)/). However, computing the incoming edges may be more
    --   expensive.
    --
    --   Note that neither the number of nodes nor the number of edges may
    --   exceed @'maxBound' :: 'Int'@.

    newtype Graph n e = Graph
      { forall n e. Graph n e -> Map n (Map n e)
    graph :: Map n (Map n e) -- ^ Forward edges.
      }
      deriving Graph n e -> Graph n e -> Bool
    (Graph n e -> Graph n e -> Bool)
    -> (Graph n e -> Graph n e -> Bool) -> Eq (Graph n e)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall n e. (Eq n, Eq e) => Graph n e -> Graph n e -> Bool
    $c== :: forall n e. (Eq n, Eq e) => Graph n e -> Graph n e -> Bool
    == :: Graph n e -> Graph n e -> Bool
    $c/= :: forall n e. (Eq n, Eq e) => Graph n e -> Graph n e -> Bool
    /= :: Graph n e -> Graph n e -> Bool
    Eq

    -- The Functor instance for strict maps is the one for lazy maps, so a
    -- custom Functor instance using strict map functions is used here.

    instance Functor (Graph n) where
      fmap :: forall a b. (a -> b) -> Graph n a -> Graph n b
    fmap a -> b
    f = Map n (Map n b) -> Graph n b
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n b) -> Graph n b)
    -> (Graph n a -> Map n (Map n b)) -> Graph n a -> Graph n b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map n a -> Map n b) -> Map n (Map n a) -> Map n (Map n b)
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map ((a -> b) -> Map n a -> Map n b
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map a -> b
    f) (Map n (Map n a) -> Map n (Map n b))
    -> (Graph n a -> Map n (Map n a)) -> Graph n a -> Map n (Map n b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n a -> Map n (Map n a)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | Internal invariant.

    invariant :: Ord n => Graph n e -> Bool
    invariant :: forall n e. Ord n => Graph n e -> Bool
    invariant Graph n e
    g =
      -- Every target node must be present in the graph as a source node,
      -- possibly without outgoing edges.
      Set n -> Set n -> Bool
    forall a. Ord a => Set a -> Set a -> Bool
    Set.isSubsetOf (Graph n e -> Set n
    forall n e. Ord n => Graph n e -> Set n
    targetNodes Graph n e
    g) (Graph n e -> Set n
    forall n e. Graph n e -> Set n
    nodes Graph n e
    g)

    instance (Ord n, Pretty n, Pretty e) => Pretty (Graph n e) where
      pretty :: Graph n e -> Doc
    pretty Graph n e
    g = [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ((n -> [Doc]) -> [n] -> [Doc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap n -> [Doc]
    pretty' (Set n -> [n]
    forall a. Set a -> [a]
    Set.toAscList (Graph n e -> Set n
    forall n e. Graph n e -> Set n
    nodes Graph n e
    g)))
        where
        pretty' :: n -> [Doc]
    pretty' n
    n = case Graph n e -> [n] -> [Edge n e]
    forall n e. Ord n => Graph n e -> [n] -> [Edge n e]
    edgesFrom Graph n e
    g [n
    n] of
          [] -> [n -> Doc
    forall a. Pretty a => a -> Doc
    pretty n
    n]
          [Edge n e]
    es -> (Edge n e -> Doc) -> [Edge n e] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Edge n e -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Edge n e]
    es

    instance (Ord n, Show n, Show e) => Show (Graph n e) where
      showsPrec :: Int -> Graph n e -> ShowS
    showsPrec Int
    _ Graph n e
    g =
        String -> ShowS
    showString String
    "union (fromEdges " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        [Edge n e] -> ShowS
    forall a. Show a => a -> ShowS
    shows (Graph n e -> [Edge n e]
    forall n e. Graph n e -> [Edge n e]
    edges Graph n e
    g) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        String -> ShowS
    showString String
    ") (fromNodes " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        [n] -> ShowS
    forall a. Show a => a -> ShowS
    shows (Set n -> [n]
    forall a. Set a -> [a]
    Set.toList (Graph n e -> Set n
    forall n e. Ord n => Graph n e -> Set n
    isolatedNodes Graph n e
    g)) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        String -> ShowS
    showString String
    ")"

    -- | Edges.

    data Edge n e = Edge
      { forall n e. Edge n e -> n
    source :: n  -- ^ Outgoing node.
      , forall n e. Edge n e -> n
    target :: n  -- ^ Incoming node.
      , forall n e. Edge n e -> e
    label  :: e  -- ^ Edge label (weight).
      } deriving (Edge n e -> Edge n e -> Bool
    (Edge n e -> Edge n e -> Bool)
    -> (Edge n e -> Edge n e -> Bool) -> Eq (Edge n e)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall n e. (Eq n, Eq e) => Edge n e -> Edge n e -> Bool
    $c== :: forall n e. (Eq n, Eq e) => Edge n e -> Edge n e -> Bool
    == :: Edge n e -> Edge n e -> Bool
    $c/= :: forall n e. (Eq n, Eq e) => Edge n e -> Edge n e -> Bool
    /= :: Edge n e -> Edge n e -> Bool
    Eq, Eq (Edge n e)
    Eq (Edge n e) =>
    (Edge n e -> Edge n e -> Ordering)
    -> (Edge n e -> Edge n e -> Bool)
    -> (Edge n e -> Edge n e -> Bool)
    -> (Edge n e -> Edge n e -> Bool)
    -> (Edge n e -> Edge n e -> Bool)
    -> (Edge n e -> Edge n e -> Edge n e)
    -> (Edge n e -> Edge n e -> Edge n e)
    -> Ord (Edge n e)
    Edge n e -> Edge n e -> Bool
    Edge n e -> Edge n e -> Ordering
    Edge n e -> Edge n e -> Edge n e
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall n e. (Ord n, Ord e) => Eq (Edge n e)
    forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Bool
    forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Ordering
    forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Edge n e
    $ccompare :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Ordering
    compare :: Edge n e -> Edge n e -> Ordering
    $c< :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Bool
    < :: Edge n e -> Edge n e -> Bool
    $c<= :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Bool
    <= :: Edge n e -> Edge n e -> Bool
    $c> :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Bool
    > :: Edge n e -> Edge n e -> Bool
    $c>= :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Bool
    >= :: Edge n e -> Edge n e -> Bool
    $cmax :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Edge n e
    max :: Edge n e -> Edge n e -> Edge n e
    $cmin :: forall n e. (Ord n, Ord e) => Edge n e -> Edge n e -> Edge n e
    min :: Edge n e -> Edge n e -> Edge n e
    Ord, (forall a b. (a -> b) -> Edge n a -> Edge n b)
    -> (forall a b. a -> Edge n b -> Edge n a) -> Functor (Edge n)
    forall a b. a -> Edge n b -> Edge n a
    forall a b. (a -> b) -> Edge n a -> Edge n b
    forall n a b. a -> Edge n b -> Edge n a
    forall n a b. (a -> b) -> Edge n a -> Edge n b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall n a b. (a -> b) -> Edge n a -> Edge n b
    fmap :: forall a b. (a -> b) -> Edge n a -> Edge n b
    $c<$ :: forall n a b. a -> Edge n b -> Edge n a
    <$ :: forall a b. a -> Edge n b -> Edge n a
    Functor, Int -> Edge n e -> ShowS
    [Edge n e] -> ShowS
    Edge n e -> String
    (Int -> Edge n e -> ShowS)
    -> (Edge n e -> String) -> ([Edge n e] -> ShowS) -> Show (Edge n e)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall n e. (Show n, Show e) => Int -> Edge n e -> ShowS
    forall n e. (Show n, Show e) => [Edge n e] -> ShowS
    forall n e. (Show n, Show e) => Edge n e -> String
    $cshowsPrec :: forall n e. (Show n, Show e) => Int -> Edge n e -> ShowS
    showsPrec :: Int -> Edge n e -> ShowS
    $cshow :: forall n e. (Show n, Show e) => Edge n e -> String
    show :: Edge n e -> String
    $cshowList :: forall n e. (Show n, Show e) => [Edge n e] -> ShowS
    showList :: [Edge n e] -> ShowS
    Show)

    instance (Pretty n, Pretty e) => Pretty (Edge n e) where
      pretty :: Edge n e -> Doc
    pretty (Edge n
    s n
    t e
    e) =
        n -> Doc
    forall a. Pretty a => a -> Doc
    pretty n
    s Doc -> Doc -> Doc
    forall a. Doc a -> Doc a -> Doc a
    <+> (Doc
    "--(" Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> e -> Doc
    forall a. Pretty a => a -> Doc
    pretty e
    e Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc
    ")-->") Doc -> Doc -> Doc
    forall a. Doc a -> Doc a -> Doc a
    <+> n -> Doc
    forall a. Pretty a => a -> Doc
    pretty n
    t

    ------------------------------------------------------------------------
    -- Queries

    -- | If there is an edge from @s@ to @t@, then @lookup s t g@ is
    -- @'Just' e@, where @e@ is the edge's label. /O(log n)/.

    lookup :: Ord n => n -> n -> Graph n e -> Maybe e
    lookup :: forall n e. Ord n => n -> n -> Graph n e -> Maybe e
    lookup n
    s n
    t (Graph Map n (Map n e)
    g) = n -> Map n e -> Maybe e
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    t (Map n e -> Maybe e) -> Maybe (Map n e) -> Maybe e
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< n -> Map n (Map n e) -> Maybe (Map n e)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    s Map n (Map n e)
    g

    -- | The graph's edges. /O(n + e)/.

    edges :: Graph n e -> [Edge n e]
    edges :: forall n e. Graph n e -> [Edge n e]
    edges (Graph Map n (Map n e)
    g) =
      [ n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    s n
    t e
    e
      | (n
    s, Map n e
    tes) <- Map n (Map n e) -> [(n, Map n e)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n (Map n e)
    g
      , (n
    t, e
    e)   <- Map n e -> [(n, e)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n e
    tes
      ]

    -- | @neighbours u g@ consists of all nodes @v@ for which there is an
    -- edge from @u@ to @v@ in @g@, along with the corresponding edge
    -- labels. /O(log n + |@neighbours u g@|)/.

    neighbours :: Ord n => n -> Graph n e -> [(n, e)]
    neighbours :: forall n e. Ord n => n -> Graph n e -> [(n, e)]
    neighbours n
    s = Map n e -> [(n, e)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map n e -> [(n, e)])
    -> (Graph n e -> Map n e) -> Graph n e -> [(n, e)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> Graph n e -> Map n e
    forall n e. Ord n => n -> Graph n e -> Map n e
    neighboursMap n
    s

    -- | @neighboursMap u g@ consists of all nodes @v@ for which there is
    -- an edge from @u@ to @v@ in @g@, along with the corresponding edge
    -- labels. /O(log n)/.

    neighboursMap :: Ord n => n -> Graph n e -> Map n e
    neighboursMap :: forall n e. Ord n => n -> Graph n e -> Map n e
    neighboursMap n
    s (Graph Map n (Map n e)
    g) = Map n e -> Maybe (Map n e) -> Map n e
    forall a. a -> Maybe a -> a
    fromMaybe Map n e
    forall k a. Map k a
    Map.empty (Maybe (Map n e) -> Map n e) -> Maybe (Map n e) -> Map n e
    forall a b. (a -> b) -> a -> b
    $ n -> Map n (Map n e) -> Maybe (Map n e)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    s Map n (Map n e)
    g

    -- | @edgesFrom g ns@ is a list containing all edges originating in
    -- the given nodes (i.e., all outgoing edges for the given nodes). If
    -- @ns@ does not contain duplicates, then the resulting list does not
    -- contain duplicates. /O(|@ns@| log |@n@| + |@edgesFrom g ns@|)/.

    edgesFrom :: Ord n => Graph n e -> [n] -> [Edge n e]
    edgesFrom :: forall n e. Ord n => Graph n e -> [n] -> [Edge n e]
    edgesFrom (Graph Map n (Map n e)
    g) [n]
    ss =
      [ n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    s n
    t e
    e
      | n
    s <- [n]
    ss
      , Map n e
    m <- Maybe (Map n e) -> [Map n e]
    forall a. Maybe a -> [a]
    maybeToList (Maybe (Map n e) -> [Map n e]) -> Maybe (Map n e) -> [Map n e]
    forall a b. (a -> b) -> a -> b
    $ n -> Map n (Map n e) -> Maybe (Map n e)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    s Map n (Map n e)
    g
      , (n
    t, e
    e) <- Map n e -> [(n, e)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n e
    m
      ]

    -- | @edgesTo g ns@ is a list containing all edges ending in the given
    -- nodes (i.e., all incoming edges for the given nodes). If @ns@ does
    -- not contain duplicates, then the resulting list does not contain
    -- duplicates. /O(|@ns@| n log n)/.

    edgesTo :: Ord n => Graph n e -> [n] -> [Edge n e]
    edgesTo :: forall n e. Ord n => Graph n e -> [n] -> [Edge n e]
    edgesTo (Graph Map n (Map n e)
    g) [n]
    ts =
      [ n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    s n
    t e
    e
      | (n
    s, Map n e
    m) <- Map n (Map n e) -> [(n, Map n e)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n (Map n e)
    g
      , n
    t <- [n]
    ts
      , e
    e <- Maybe e -> [e]
    forall a. Maybe a -> [a]
    maybeToList (Maybe e -> [e]) -> Maybe e -> [e]
    forall a b. (a -> b) -> a -> b
    $ n -> Map n e -> Maybe e
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    t Map n e
    m
      ]

    -- | All self-loops. /O(n log n)/.

    diagonal :: Ord n => Graph n e -> [Edge n e]
    diagonal :: forall n e. Ord n => Graph n e -> [Edge n e]
    diagonal (Graph Map n (Map n e)
    g) =
      [ n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    s n
    s e
    e
      | (n
    s, Map n e
    m) <- Map n (Map n e) -> [(n, Map n e)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n (Map n e)
    g
      , e
    e      <- Maybe e -> [e]
    forall a. Maybe a -> [a]
    maybeToList (Maybe e -> [e]) -> Maybe e -> [e]
    forall a b. (a -> b) -> a -> b
    $ n -> Map n e -> Maybe e
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    s Map n e
    m
      ]

    -- | All nodes. /O(n)/.

    nodes :: Graph n e -> Set n
    nodes :: forall n e. Graph n e -> Set n
    nodes = Map n (Map n e) -> Set n
    forall k a. Map k a -> Set k
    Map.keysSet (Map n (Map n e) -> Set n)
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Set n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | Nodes with outgoing edges. /O(n)/.

    sourceNodes :: Graph n e -> Set n
    sourceNodes :: forall n e. Graph n e -> Set n
    sourceNodes = Map n (Map n e) -> Set n
    forall k a. Map k a -> Set k
    Map.keysSet (Map n (Map n e) -> Set n)
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Set n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map n e -> Bool) -> Map n (Map n e) -> Map n (Map n e)
    forall a k. (a -> Bool) -> Map k a -> Map k a
    Map.filter (Bool -> Bool
    not (Bool -> Bool) -> (Map n e -> Bool) -> Map n e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map n e -> Bool
    forall k a. Map k a -> Bool
    Map.null) (Map n (Map n e) -> Map n (Map n e))
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Map n (Map n e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | Nodes with incoming edges. /O(n + e log n)/.

    targetNodes :: Ord n => Graph n e -> Set n
    targetNodes :: forall n e. Ord n => Graph n e -> Set n
    targetNodes = [n] -> Set n
    forall a. Ord a => [a] -> Set a
    Set.fromList ([n] -> Set n) -> (Graph n e -> [n]) -> Graph n e -> Set n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Edge n e -> n) -> [Edge n e] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map Edge n e -> n
    forall n e. Edge n e -> n
    target ([Edge n e] -> [n])
    -> (Graph n e -> [Edge n e]) -> Graph n e -> [n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> [Edge n e]
    forall n e. Graph n e -> [Edge n e]
    edges

    -- | Various kinds of nodes.

    data Nodes n = Nodes
      { forall n. Nodes n -> Set n
    srcNodes :: Set n
        -- ^ Nodes with outgoing edges.
      , forall n. Nodes n -> Set n
    tgtNodes :: Set n
        -- ^ Nodes with incoming edges.
      , forall n. Nodes n -> Set n
    allNodes :: Set n
        -- ^ All nodes, with or without edges.
      }

    -- | Constructs a 'Nodes' structure. /O(n + e log n)/.

    computeNodes :: Ord n => Graph n e -> Nodes n
    computeNodes :: forall n e. Ord n => Graph n e -> Nodes n
    computeNodes Graph n e
    g =
      Nodes { srcNodes :: Set n
    srcNodes = (n -> Bool) -> Set n -> Set n
    forall a. (a -> Bool) -> Set a -> Set a
    Set.filter (Bool -> Bool
    not (Bool -> Bool) -> (n -> Bool) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(n, e)] -> Bool
    forall a. Null a => a -> Bool
    null ([(n, e)] -> Bool) -> (n -> [(n, e)]) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> Graph n e -> [(n, e)]) -> Graph n e -> n -> [(n, e)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip n -> Graph n e -> [(n, e)]
    forall n e. Ord n => n -> Graph n e -> [(n, e)]
    neighbours Graph n e
    g) Set n
    ns
            , tgtNodes :: Set n
    tgtNodes = Graph n e -> Set n
    forall n e. Ord n => Graph n e -> Set n
    targetNodes Graph n e
    g
            , allNodes :: Set n
    allNodes = Set n
    ns
            }
      where
      ns :: Set n
    ns = Graph n e -> Set n
    forall n e. Graph n e -> Set n
    nodes Graph n e
    g

    -- | Nodes without incoming or outgoing edges. /O(n + e log n)/.

    isolatedNodes :: Ord n => Graph n e -> Set n
    isolatedNodes :: forall n e. Ord n => Graph n e -> Set n
    isolatedNodes Graph n e
    g =
      Set n -> Set n -> Set n
    forall a. Ord a => Set a -> Set a -> Set a
    Set.difference (Nodes n -> Set n
    forall n. Nodes n -> Set n
    allNodes Nodes n
    ns) (Set n -> Set n -> Set n
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (Nodes n -> Set n
    forall n. Nodes n -> Set n
    srcNodes Nodes n
    ns) (Nodes n -> Set n
    forall n. Nodes n -> Set n
    tgtNodes Nodes n
    ns))
      where
      ns :: Nodes n
    ns = Graph n e -> Nodes n
    forall n e. Ord n => Graph n e -> Nodes n
    computeNodes Graph n e
    g

    -- | Checks whether the graph is discrete (containing no edges other
    -- than 'null' edges). /O(n + e)/.

    discrete :: Null e => Graph n e -> Bool
    discrete :: forall e n. Null e => Graph n e -> Bool
    discrete = (Map n e -> Bool) -> Map n (Map n e) -> Bool
    forall {a} {k}. (a -> Bool) -> Map k a -> Bool
    all' ((e -> Bool) -> Map n e -> Bool
    forall {a} {k}. (a -> Bool) -> Map k a -> Bool
    all' e -> Bool
    forall a. Null a => a -> Bool
    null) (Map n (Map n e) -> Bool)
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph
      where all' :: (a -> Bool) -> Map k a -> Bool
    all' a -> Bool
    p = (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    List.all a -> Bool
    p ([a] -> Bool) -> (Map k a -> [a]) -> Map k a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map k a -> [a]
    forall k a. Map k a -> [a]
    Map.elems

    -- | Returns @True@ iff the graph is acyclic.

    acyclic :: Ord n => Graph n e -> Bool
    acyclic :: forall n e. Ord n => Graph n e -> Bool
    acyclic = (SCC n -> Bool) -> [SCC n] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all SCC n -> Bool
    forall {vertex}. SCC vertex -> Bool
    isAcyclic ([SCC n] -> Bool) -> (Graph n e -> [SCC n]) -> Graph n e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> [SCC n]
    forall n e. Ord n => Graph n e -> [SCC n]
    sccs'
      where
      isAcyclic :: SCC vertex -> Bool
    isAcyclic Graph.AcyclicSCC{} = Bool
    True
      isAcyclic Graph.CyclicSCC{}  = Bool
    False

    ------------------------------------------------------------------------
    -- Construction

    -- | Constructs a completely disconnected graph containing the given
    --   nodes. /O(n log n)/.

    fromNodes :: Ord n => [n] -> Graph n e
    fromNodes :: forall n e. Ord n => [n] -> Graph n e
    fromNodes [n]
    ns = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e) -> Graph n e) -> Map n (Map n e) -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ [(n, Map n e)] -> Map n (Map n e)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(n, Map n e)] -> Map n (Map n e))
    -> [(n, Map n e)] -> Map n (Map n e)
    forall a b. (a -> b) -> a -> b
    $ (n -> (n, Map n e)) -> [n] -> [(n, Map n e)]
    forall a b. (a -> b) -> [a] -> [b]
    map (, Map n e
    forall k a. Map k a
    Map.empty) [n]
    ns

    -- | Constructs a completely disconnected graph containing the given
    --   nodes. /O(n)/.

    fromNodeSet :: Ord n => Set n -> Graph n e
    fromNodeSet :: forall n e. Ord n => Set n -> Graph n e
    fromNodeSet Set n
    ns = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e) -> Graph n e) -> Map n (Map n e) -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ (n -> Map n e) -> Set n -> Map n (Map n e)
    forall k a. (k -> a) -> Set k -> Map k a
    Map.fromSet (\n
    _ -> Map n e
    forall k a. Map k a
    Map.empty) Set n
    ns

    -- | @fromEdges es@ is a graph containing the edges in @es@, with the
    -- caveat that later edges overwrite earlier edges. /O(|@es@| log n)/.

    fromEdges :: Ord n => [Edge n e] -> Graph n e
    fromEdges :: forall n e. Ord n => [Edge n e] -> Graph n e
    fromEdges = (e -> e -> e) -> [Edge n e] -> Graph n e
    forall n e. Ord n => (e -> e -> e) -> [Edge n e] -> Graph n e
    fromEdgesWith ((e -> e -> e) -> [Edge n e] -> Graph n e)
    -> (e -> e -> e) -> [Edge n e] -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ \ e
    new e
    old -> e
    new

    -- | @fromEdgesWith f es@ is a graph containing the edges in @es@.
    -- Later edges are combined with earlier edges using the supplied
    -- function. /O(|@es@| log n)/.

    fromEdgesWith :: Ord n => (e -> e -> e) -> [Edge n e] -> Graph n e
    fromEdgesWith :: forall n e. Ord n => (e -> e -> e) -> [Edge n e] -> Graph n e
    fromEdgesWith e -> e -> e
    f = (Graph n e -> Edge n e -> Graph n e)
    -> Graph n e -> [Edge n e] -> Graph n e
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' ((Edge n e -> Graph n e -> Graph n e)
    -> Graph n e -> Edge n e -> Graph n e
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    insertEdgeWith e -> e -> e
    f)) Graph n e
    forall n e. Graph n e
    empty

    -- | Empty graph (no nodes, no edges). /O(1)/.

    empty :: Graph n e
    empty :: forall n e. Graph n e
    empty = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph Map n (Map n e)
    forall k a. Map k a
    Map.empty

    -- | A graph with two nodes and a single connecting edge. /O(1)/.

    singleton :: Ord n => n -> n -> e -> Graph n e
    singleton :: forall n e. Ord n => n -> n -> e -> Graph n e
    singleton n
    s n
    t e
    e = n -> n -> e -> Graph n e -> Graph n e
    forall n e. Ord n => n -> n -> e -> Graph n e -> Graph n e
    insert n
    s n
    t e
    e Graph n e
    forall n e. Graph n e
    empty

    -- | Inserts an edge into the graph. /O(log n)/.

    insert :: Ord n => n -> n -> e -> Graph n e -> Graph n e
    insert :: forall n e. Ord n => n -> n -> e -> Graph n e -> Graph n e
    insert = (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    insertWith ((e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e)
    -> (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ \ e
    new e
    old -> e
    new

    -- | Inserts an edge into the graph. /O(log n)/.

    insertEdge :: Ord n => Edge n e -> Graph n e -> Graph n e
    insertEdge :: forall n e. Ord n => Edge n e -> Graph n e -> Graph n e
    insertEdge (Edge n
    s n
    t e
    e) = n -> n -> e -> Graph n e -> Graph n e
    forall n e. Ord n => n -> n -> e -> Graph n e -> Graph n e
    insert n
    s n
    t e
    e

    -- | @insertWith f s t new@ inserts an edge from @s@ to @t@ into the
    -- graph. If there is already an edge from @s@ to @t@ with label @old@,
    -- then this edge gets replaced by an edge with label @f new old@, and
    -- otherwise the edge's label is @new@. /O(log n)/.

    insertWith ::
      Ord n => (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    insertWith :: forall n e.
    Ord n =>
    (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    insertWith e -> e -> e
    f n
    s n
    t e
    e (Graph Map n (Map n e)
    g) =
      Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph ((Maybe (Map n e) -> Maybe (Map n e))
    -> n -> Map n (Map n e) -> Map n (Map n e)
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter (Map n e -> Maybe (Map n e)
    forall a. a -> Maybe a
    Just (Map n e -> Maybe (Map n e))
    -> (Maybe (Map n e) -> Map n e)
    -> Maybe (Map n e)
    -> Maybe (Map n e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Map n e) -> Map n e
    forall {k} {a}. Maybe (Map k a) -> Map k a
    insNode) n
    t (Map n (Map n e) -> Map n (Map n e))
    -> Map n (Map n e) -> Map n (Map n e)
    forall a b. (a -> b) -> a -> b
    $ (Maybe (Map n e) -> Maybe (Map n e))
    -> n -> Map n (Map n e) -> Map n (Map n e)
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter (Map n e -> Maybe (Map n e)
    forall a. a -> Maybe a
    Just (Map n e -> Maybe (Map n e))
    -> (Maybe (Map n e) -> Map n e)
    -> Maybe (Map n e)
    -> Maybe (Map n e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Map n e) -> Map n e
    insEdge) n
    s Map n (Map n e)
    g)
      where
      insEdge :: Maybe (Map n e) -> Map n e
    insEdge Maybe (Map n e)
    Nothing  = n -> e -> Map n e
    forall k a. k -> a -> Map k a
    Map.singleton n
    t e
    e
      insEdge (Just Map n e
    m) = (e -> e -> e) -> n -> e -> Map n e -> Map n e
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith e -> e -> e
    f n
    t e
    e Map n e
    m

      insNode :: Maybe (Map k a) -> Map k a
    insNode Maybe (Map k a)
    Nothing  = Map k a
    forall k a. Map k a
    Map.empty
      insNode (Just Map k a
    m) = Map k a
    m

    -- | A variant of 'insertWith'. /O(log n)/.

    insertEdgeWith ::
      Ord n => (e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    insertEdgeWith :: forall n e.
    Ord n =>
    (e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    insertEdgeWith e -> e -> e
    f (Edge n
    s n
    t e
    e) = (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> n -> n -> e -> Graph n e -> Graph n e
    insertWith e -> e -> e
    f n
    s n
    t e
    e

    -- | Left-biased union.
    --
    -- Time complexity: See 'unionWith'.

    union :: Ord n => Graph n e -> Graph n e -> Graph n e
    union :: forall n e. Ord n => Graph n e -> Graph n e -> Graph n e
    union = (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    unionWith ((e -> e -> e) -> Graph n e -> Graph n e -> Graph n e)
    -> (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ \ e
    left e
    right -> e
    left

    -- | Union. The function is used to combine edge labels for edges that
    -- occur in both graphs (labels from the first graph are given as the
    -- first argument to the function).
    --
    -- Time complexity: /O(n₁ log (n₂/n₁ + 1) + e₁ log e₂)/, where /n₁/ is
    -- the number of nodes in the graph with the smallest number of nodes
    -- and /n₂/ is the number of nodes in the other graph, and /e₁/ is the
    -- number of edges in the graph with the smallest number of edges and
    -- /e₂/ is the number of edges in the other graph.
    --
    -- Less complicated time complexity: /O((n + e) log n/ (where /n/ and
    -- /e/ refer to the resulting graph).

    unionWith ::
      Ord n => (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    unionWith :: forall n e.
    Ord n =>
    (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    unionWith e -> e -> e
    f (Graph Map n (Map n e)
    g) (Graph Map n (Map n e)
    g') =
      Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e) -> Graph n e) -> Map n (Map n e) -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ (Map n e -> Map n e -> Map n e)
    -> Map n (Map n e) -> Map n (Map n e) -> Map n (Map n e)
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith ((e -> e -> e) -> Map n e -> Map n e -> Map n e
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith e -> e -> e
    f) Map n (Map n e)
    g Map n (Map n e)
    g'

    -- | Union. /O((n + e) log n/ (where /n/ and /e/ refer to the
    -- resulting graph).

    unions :: Ord n => [Graph n e] -> Graph n e
    unions :: forall n e. Ord n => [Graph n e] -> Graph n e
    unions = (e -> e -> e) -> [Graph n e] -> Graph n e
    forall n e. Ord n => (e -> e -> e) -> [Graph n e] -> Graph n e
    unionsWith ((e -> e -> e) -> [Graph n e] -> Graph n e)
    -> (e -> e -> e) -> [Graph n e] -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ \ e
    left e
    right -> e
    left

    -- | Union. The function is used to combine edge labels for edges that
    -- occur in several graphs. /O((n + e) log n/ (where /n/ and /e/ refer
    -- to the resulting graph).

    unionsWith :: Ord n => (e -> e -> e) -> [Graph n e] -> Graph n e
    unionsWith :: forall n e. Ord n => (e -> e -> e) -> [Graph n e] -> Graph n e
    unionsWith e -> e -> e
    f = (Graph n e -> Graph n e -> Graph n e)
    -> Graph n e -> [Graph n e] -> Graph n e
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' ((e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    unionWith e -> e -> e
    f) Graph n e
    forall n e. Graph n e
    empty

    ------------------------------------------------------------------------
    -- Transformation

    -- | A variant of 'fmap' that provides extra information to the
    -- function argument. /O(n + e)/.

    mapWithEdge :: (Edge n e -> e') -> Graph n e -> Graph n e'
    mapWithEdge :: forall n e e'. (Edge n e -> e') -> Graph n e -> Graph n e'
    mapWithEdge Edge n e -> e'
    f (Graph Map n (Map n e)
    g) = Map n (Map n e') -> Graph n e'
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e') -> Graph n e') -> Map n (Map n e') -> Graph n e'
    forall a b. (a -> b) -> a -> b
    $ ((n -> Map n e -> Map n e') -> Map n (Map n e) -> Map n (Map n e'))
    -> Map n (Map n e)
    -> (n -> Map n e -> Map n e')
    -> Map n (Map n e')
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (n -> Map n e -> Map n e') -> Map n (Map n e) -> Map n (Map n e')
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey Map n (Map n e)
    g ((n -> Map n e -> Map n e') -> Map n (Map n e'))
    -> (n -> Map n e -> Map n e') -> Map n (Map n e')
    forall a b. (a -> b) -> a -> b
    $ \ n
    s Map n e
    m ->
      ((n -> e -> e') -> Map n e -> Map n e')
    -> Map n e -> (n -> e -> e') -> Map n e'
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (n -> e -> e') -> Map n e -> Map n e'
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey Map n e
    m ((n -> e -> e') -> Map n e') -> (n -> e -> e') -> Map n e'
    forall a b. (a -> b) -> a -> b
    $ \ n
    t e
    e -> Edge n e -> e'
    f (n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    s n
    t e
    e)

    -- | Reverses an edge. /O(1)/.

    transposeEdge :: Edge n e -> Edge n e
    transposeEdge :: forall n e. Edge n e -> Edge n e
    transposeEdge (Edge n
    s n
    t e
    e) = n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    t n
    s e
    e

    -- | The opposite graph (with all edges reversed). /O((n + e) log n)/.

    transpose :: Ord n => Graph n e -> Graph n e
    transpose :: forall n e. Ord n => Graph n e -> Graph n e
    transpose Graph n e
    g =
      [Edge n e] -> Graph n e
    forall n e. Ord n => [Edge n e] -> Graph n e
    fromEdges ((Edge n e -> Edge n e) -> [Edge n e] -> [Edge n e]
    forall a b. (a -> b) -> [a] -> [b]
    map Edge n e -> Edge n e
    forall n e. Edge n e -> Edge n e
    transposeEdge (Graph n e -> [Edge n e]
    forall n e. Graph n e -> [Edge n e]
    edges Graph n e
    g))
        Graph n e -> Graph n e -> Graph n e
    forall n e. Ord n => Graph n e -> Graph n e -> Graph n e
    `union`
      Set n -> Graph n e
    forall n e. Ord n => Set n -> Graph n e
    fromNodeSet (Graph n e -> Set n
    forall n e. Ord n => Graph n e -> Set n
    isolatedNodes Graph n e
    g)

    -- | Removes 'null' edges. /O(n + e)/.

    clean :: Null e => Graph n e -> Graph n e
    clean :: forall e n. Null e => Graph n e -> Graph n e
    clean = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e) -> Graph n e)
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Graph n e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map n e -> Map n e) -> Map n (Map n e) -> Map n (Map n e)
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map ((e -> Bool) -> Map n e -> Map n e
    forall a k. (a -> Bool) -> Map k a -> Map k a
    Map.filter (Bool -> Bool
    not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> Bool
    forall a. Null a => a -> Bool
    null)) (Map n (Map n e) -> Map n (Map n e))
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Map n (Map n e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | The graph @filterNodes p g@ contains exactly those nodes from @g@
    -- that satisfy the predicate @p@. Edges to or from nodes that are
    -- removed are also removed. /O(n + e)/.

    filterNodes :: Ord n => (n -> Bool) -> Graph n e -> Graph n e
    filterNodes :: forall n e. Ord n => (n -> Bool) -> Graph n e -> Graph n e
    filterNodes n -> Bool
    p (Graph Map n (Map n e)
    g) = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph ((n -> Map n e -> Maybe (Map n e))
    -> Map n (Map n e) -> Map n (Map n e)
    forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
    Map.mapMaybeWithKey n -> Map n e -> Maybe (Map n e)
    remSrc Map n (Map n e)
    g)
      where
      remSrc :: n -> Map n e -> Maybe (Map n e)
    remSrc n
    s Map n e
    m
        | n -> Bool
    p n
    s       = Map n e -> Maybe (Map n e)
    forall a. a -> Maybe a
    Just ((n -> e -> Bool) -> Map n e -> Map n e
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey (\n
    t e
    _ -> n -> Bool
    p n
    t) Map n e
    m)
        | Bool
    otherwise = Maybe (Map n e)
    forall a. Maybe a
    Nothing

    -- | @removeNodes ns g@ removes the nodes in @ns@ (and all
    -- corresponding edges) from @g@. /O((n + e) log |@ns@|)/.

    removeNodes :: Ord n => Set n -> Graph n e -> Graph n e
    removeNodes :: forall n e. Ord n => Set n -> Graph n e -> Graph n e
    removeNodes Set n
    ns = (n -> Bool) -> Graph n e -> Graph n e
    forall n e. Ord n => (n -> Bool) -> Graph n e -> Graph n e
    filterNodes (\n
    n -> Bool -> Bool
    not (n -> Set n -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member n
    n Set n
    ns))

    -- | @removeNode n g@ removes the node @n@ (and all corresponding
    -- edges) from @g@. /O(n + e)/.

    removeNode :: Ord n => n -> Graph n e -> Graph n e
    removeNode :: forall n e. Ord n => n -> Graph n e -> Graph n e
    removeNode = Set n -> Graph n e -> Graph n e
    forall n e. Ord n => Set n -> Graph n e -> Graph n e
    removeNodes (Set n -> Graph n e -> Graph n e)
    -> (n -> Set n) -> n -> Graph n e -> Graph n e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> Set n
    forall a. a -> Set a
    Set.singleton

    -- | @removeEdge s t g@ removes the edge going from @s@ to @t@, if any.
    --   /O(log n)/.

    removeEdge :: Ord n => n -> n -> Graph n e -> Graph n e
    removeEdge :: forall n e. Ord n => n -> n -> Graph n e -> Graph n e
    removeEdge n
    s n
    t (Graph Map n (Map n e)
    g) = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e) -> Graph n e) -> Map n (Map n e) -> Graph n e
    forall a b. (a -> b) -> a -> b
    $ (Map n e -> Map n e) -> n -> Map n (Map n e) -> Map n (Map n e)
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust (n -> Map n e -> Map n e
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete n
    t) n
    s Map n (Map n e)
    g

    -- | Keep only the edges that satisfy the predicate. /O(n + e)/.

    filterEdges :: (Edge n e -> Bool) -> Graph n e -> Graph n e
    filterEdges :: forall n e. (Edge n e -> Bool) -> Graph n e -> Graph n e
    filterEdges Edge n e -> Bool
    f =
      Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n e) -> Graph n e)
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Graph n e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (n -> Map n e -> Map n e) -> Map n (Map n e) -> Map n (Map n e)
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey (\n
    s ->
        (n -> e -> Bool) -> Map n e -> Map n e
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey (\n
    t e
    l ->
          Edge n e -> Bool
    f (Edge { source :: n
    source = n
    s, target :: n
    target = n
    t, label :: e
    label = e
    l }))) (Map n (Map n e) -> Map n (Map n e))
    -> (Graph n e -> Map n (Map n e)) -> Graph n e -> Map n (Map n e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | Removes the nodes that do not satisfy the predicate from the
    -- graph, but keeps the edges: if there is a path in the original
    -- graph between two nodes that are retained, then there is a path
    -- between these two nodes also in the resulting graph.
    --
    -- Precondition: The graph must be acyclic.
    --
    -- Worst-case time complexity: /O(e n log n)/ (this has not been
    -- verified carefully).

    filterNodesKeepingEdges ::
      forall n e. (Ord n, SemiRing e) =>
      (n -> Bool) -> Graph n e -> Graph n e
    filterNodesKeepingEdges :: forall n e.
    (Ord n, SemiRing e) =>
    (n -> Bool) -> Graph n e -> Graph n e
    filterNodesKeepingEdges n -> Bool
    p Graph n e
    g =
      (Edge n e -> Graph n e -> Graph n e)
    -> Graph n e -> [Edge n e] -> Graph n e
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    insertEdgeWith e -> e -> e
    forall a. SemiRing a => a -> a -> a
    oplus) ((n -> Bool) -> Graph n e -> Graph n e
    forall n e. Ord n => (n -> Bool) -> Graph n e -> Graph n e
    filterNodes n -> Bool
    p Graph n e
    g)
        (([Edge n e], Map n (Map n e)) -> [Edge n e]
    forall a b. (a, b) -> a
    fst ([Edge n e], Map n (Map n e))
    edgesToAddAndRemove)
      where
      -- The new edges that should be added, and a map from nodes that
      -- should be removed to edges that should potentially be added
      -- (after being combined with paths into the nodes that should be
      -- removed).
      edgesToAddAndRemove :: ([Edge n e], Map n (Map n e))
      edgesToAddAndRemove :: ([Edge n e], Map n (Map n e))
    edgesToAddAndRemove =
        (([Edge n e], Map n (Map n e))
     -> SCC n -> ([Edge n e], Map n (Map n e)))
    -> ([Edge n e], Map n (Map n e))
    -> [SCC n]
    -> ([Edge n e], Map n (Map n e))
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' ([Edge n e], Map n (Map n e))
    -> SCC n -> ([Edge n e], Map n (Map n e))
    edgesToAddAndRemoveForSCC ([], Map n (Map n e)
    forall k a. Map k a
    Map.empty) (Graph n e -> [SCC n]
    forall n e. Ord n => Graph n e -> [SCC n]
    sccs' Graph n e
    g)

      edgesToAddAndRemoveForSCC :: ([Edge n e], Map n (Map n e))
    -> SCC n -> ([Edge n e], Map n (Map n e))
    edgesToAddAndRemoveForSCC ([Edge n e]
    add, !Map n (Map n e)
    remove) (Graph.AcyclicSCC n
    n)
        | n -> Bool
    p n
    n =
          ( (do (n', e) <- n -> Graph n e -> [(n, e)]
    forall n e. Ord n => n -> Graph n e -> [(n, e)]
    neighbours n
    n Graph n e
    g
                case Map.lookup n' remove of
                  Maybe (Map n e)
    Nothing -> []
                  Just Map n e
    es ->
                    [(n, e)] -> ((n, e) -> Edge n e) -> [Edge n e]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    for (Map n e -> [(n, e)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map n e
    es) (((n, e) -> Edge n e) -> [Edge n e])
    -> ((n, e) -> Edge n e) -> [Edge n e]
    forall a b. (a -> b) -> a -> b
    $ \(n
    n', e
    e') -> Edge
                      { source :: n
    source = n
    n
                      , target :: n
    target = n
    n'
                      , label :: e
    label  = e
    e e -> e -> e
    forall a. SemiRing a => a -> a -> a
    `otimes` e
    e'
                      })
              [Edge n e] -> [Edge n e] -> [Edge n e]
    forall a. [a] -> [a] -> [a]
    ++
            [Edge n e]
    add
          , Map n (Map n e)
    remove
          )
        | Bool
    otherwise =
          ( [Edge n e]
    add
          , n -> Map n e -> Map n (Map n e) -> Map n (Map n e)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert
              n
    n
              ((e -> e -> e) -> [Map n e] -> Map n e
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    (a -> a -> a) -> f (Map k a) -> Map k a
    Map.unionsWith e -> e -> e
    forall a. SemiRing a => a -> a -> a
    oplus ([Map n e] -> Map n e) -> [Map n e] -> Map n e
    forall a b. (a -> b) -> a -> b
    $
               [(n, e)] -> ((n, e) -> Map n e) -> [Map n e]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    for (n -> Graph n e -> [(n, e)]
    forall n e. Ord n => n -> Graph n e -> [(n, e)]
    neighbours n
    n Graph n e
    g) (((n, e) -> Map n e) -> [Map n e])
    -> ((n, e) -> Map n e) -> [Map n e]
    forall a b. (a -> b) -> a -> b
    $ \(n
    n', e
    e) ->
                 case n -> Map n (Map n e) -> Maybe (Map n e)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    n' Map n (Map n e)
    remove of
                   Maybe (Map n e)
    Nothing -> n -> e -> Map n e
    forall k a. k -> a -> Map k a
    Map.singleton n
    n' e
    e
                   Just Map n e
    es -> (e -> e) -> Map n e -> Map n e
    forall a b. (a -> b) -> Map n a -> Map n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (e
    e e -> e -> e
    forall a. SemiRing a => a -> a -> a
    `otimes`) Map n e
    es)
              Map n (Map n e)
    remove
          )
      edgesToAddAndRemoveForSCC ([Edge n e], Map n (Map n e))
    _ (Graph.CyclicSCC{}) = ([Edge n e], Map n (Map n e))
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Renames the nodes.
    --
    -- Precondition: The renaming function must be injective.
    --
    -- Time complexity: /O((n + e) log n)/.

    renameNodes :: Ord n2 => (n1 -> n2) -> Graph n1 e -> Graph n2 e
    renameNodes :: forall n2 n1 e. Ord n2 => (n1 -> n2) -> Graph n1 e -> Graph n2 e
    renameNodes n1 -> n2
    ren =
      Map n2 (Map n2 e) -> Graph n2 e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n2 (Map n2 e) -> Graph n2 e)
    -> (Graph n1 e -> Map n2 (Map n2 e)) -> Graph n1 e -> Graph n2 e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Map n1 e -> Map n2 e) -> Map n2 (Map n1 e) -> Map n2 (Map n2 e)
    forall a b. (a -> b) -> Map n2 a -> Map n2 b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((n1 -> n2) -> Map n1 e -> Map n2 e
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeys n1 -> n2
    ren) (Map n2 (Map n1 e) -> Map n2 (Map n2 e))
    -> (Graph n1 e -> Map n2 (Map n1 e))
    -> Graph n1 e
    -> Map n2 (Map n2 e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (n1 -> n2) -> Map n1 (Map n1 e) -> Map n2 (Map n1 e)
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeys n1 -> n2
    ren (Map n1 (Map n1 e) -> Map n2 (Map n1 e))
    -> (Graph n1 e -> Map n1 (Map n1 e))
    -> Graph n1 e
    -> Map n2 (Map n1 e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Graph n1 e -> Map n1 (Map n1 e)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | Renames the nodes.
    --
    -- Precondition: The renaming function @ren@ must be strictly
    -- increasing (if @x '<' y@ then @ren x '<' ren y@).
    --
    -- Time complexity: /O(n + e)/.

    renameNodesMonotonic ::
      (Ord n1, Ord n2) => (n1 -> n2) -> Graph n1 e -> Graph n2 e
    renameNodesMonotonic :: forall n1 n2 e.
    (Ord n1, Ord n2) =>
    (n1 -> n2) -> Graph n1 e -> Graph n2 e
    renameNodesMonotonic n1 -> n2
    ren =
      Map n2 (Map n2 e) -> Graph n2 e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n2 (Map n2 e) -> Graph n2 e)
    -> (Graph n1 e -> Map n2 (Map n2 e)) -> Graph n1 e -> Graph n2 e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Map n1 e -> Map n2 e) -> Map n2 (Map n1 e) -> Map n2 (Map n2 e)
    forall a b. (a -> b) -> Map n2 a -> Map n2 b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((n1 -> n2) -> Map n1 e -> Map n2 e
    forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeysMonotonic n1 -> n2
    ren) (Map n2 (Map n1 e) -> Map n2 (Map n2 e))
    -> (Graph n1 e -> Map n2 (Map n1 e))
    -> Graph n1 e
    -> Map n2 (Map n2 e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (n1 -> n2) -> Map n1 (Map n1 e) -> Map n2 (Map n1 e)
    forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeysMonotonic n1 -> n2
    ren (Map n1 (Map n1 e) -> Map n2 (Map n1 e))
    -> (Graph n1 e -> Map n1 (Map n1 e))
    -> Graph n1 e
    -> Map n2 (Map n1 e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Graph n1 e -> Map n1 (Map n1 e)
    forall n e. Graph n e -> Map n (Map n e)
    graph

    -- | @WithUniqueInt n@ consists of pairs of (unique) 'Int's and values
    -- of type @n@.
    --
    -- Values of this type are compared by comparing the 'Int's.

    data WithUniqueInt n = WithUniqueInt
      { forall n. WithUniqueInt n -> Int
    uniqueInt  :: !Int
      , forall n. WithUniqueInt n -> n
    otherValue :: !n
      }
      deriving (Int -> WithUniqueInt n -> ShowS
    [WithUniqueInt n] -> ShowS
    WithUniqueInt n -> String
    (Int -> WithUniqueInt n -> ShowS)
    -> (WithUniqueInt n -> String)
    -> ([WithUniqueInt n] -> ShowS)
    -> Show (WithUniqueInt n)
    forall n. Show n => Int -> WithUniqueInt n -> ShowS
    forall n. Show n => [WithUniqueInt n] -> ShowS
    forall n. Show n => WithUniqueInt n -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall n. Show n => Int -> WithUniqueInt n -> ShowS
    showsPrec :: Int -> WithUniqueInt n -> ShowS
    $cshow :: forall n. Show n => WithUniqueInt n -> String
    show :: WithUniqueInt n -> String
    $cshowList :: forall n. Show n => [WithUniqueInt n] -> ShowS
    showList :: [WithUniqueInt n] -> ShowS
    Show, (forall a b. (a -> b) -> WithUniqueInt a -> WithUniqueInt b)
    -> (forall a b. a -> WithUniqueInt b -> WithUniqueInt a)
    -> Functor WithUniqueInt
    forall a b. a -> WithUniqueInt b -> WithUniqueInt a
    forall a b. (a -> b) -> WithUniqueInt a -> WithUniqueInt b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> WithUniqueInt a -> WithUniqueInt b
    fmap :: forall a b. (a -> b) -> WithUniqueInt a -> WithUniqueInt b
    $c<$ :: forall a b. a -> WithUniqueInt b -> WithUniqueInt a
    <$ :: forall a b. a -> WithUniqueInt b -> WithUniqueInt a
    Functor)

    instance Eq (WithUniqueInt n) where
      WithUniqueInt Int
    i1 n
    _ == :: WithUniqueInt n -> WithUniqueInt n -> Bool
    == WithUniqueInt Int
    i2 n
    _ = Int
    i1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    i2

    instance Ord (WithUniqueInt n) where
      compare :: WithUniqueInt n -> WithUniqueInt n -> Ordering
    compare (WithUniqueInt Int
    i1 n
    _) (WithUniqueInt Int
    i2 n
    _) = Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    i1 Int
    i2

    instance Pretty n => Pretty (WithUniqueInt n) where
      pretty :: WithUniqueInt n -> Doc
    pretty (WithUniqueInt Int
    i n
    n) =
        Doc -> Doc
    parens ((Int -> Doc
    forall a. Pretty a => a -> Doc
    pretty Int
    i Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc
    comma) Doc -> Doc -> Doc
    forall a. Doc a -> Doc a -> Doc a
    <+> n -> Doc
    forall a. Pretty a => a -> Doc
    pretty n
    n)

    -- | Combines each node label with a unique 'Int'.
    --
    -- Precondition: The number of nodes in the graph must not be larger
    -- than @'maxBound' :: 'Int'@.
    --
    -- Time complexity: /O(n + e log n)/.

    addUniqueInts ::
      forall n e. Ord n => Graph n e -> Graph (WithUniqueInt n) e
    addUniqueInts :: forall n e. Ord n => Graph n e -> Graph (WithUniqueInt n) e
    addUniqueInts Graph n e
    g =
      Map (WithUniqueInt n) (Map (WithUniqueInt n) e)
    -> Graph (WithUniqueInt n) e
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map (WithUniqueInt n) (Map (WithUniqueInt n) e)
     -> Graph (WithUniqueInt n) e)
    -> Map (WithUniqueInt n) (Map (WithUniqueInt n) e)
    -> Graph (WithUniqueInt n) e
    forall a b. (a -> b) -> a -> b
    $
      [(WithUniqueInt n, Map (WithUniqueInt n) e)]
    -> Map (WithUniqueInt n) (Map (WithUniqueInt n) e)
    forall k a. [(k, a)] -> Map k a
    Map.fromDistinctAscList ([(WithUniqueInt n, Map (WithUniqueInt n) e)]
     -> Map (WithUniqueInt n) (Map (WithUniqueInt n) e))
    -> [(WithUniqueInt n, Map (WithUniqueInt n) e)]
    -> Map (WithUniqueInt n) (Map (WithUniqueInt n) e)
    forall a b. (a -> b) -> a -> b
    $
      ((Int, (n, Map n e)) -> (WithUniqueInt n, Map (WithUniqueInt n) e))
    -> [(Int, (n, Map n e))]
    -> [(WithUniqueInt n, Map (WithUniqueInt n) e)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Int
    i, (n
    n, Map n e
    m)) ->
            (Int -> n -> WithUniqueInt n
    forall n. Int -> n -> WithUniqueInt n
    WithUniqueInt Int
    i n
    n, (n -> WithUniqueInt n) -> Map n e -> Map (WithUniqueInt n) e
    forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeysMonotonic n -> WithUniqueInt n
    ren Map n e
    m)) ([(Int, (n, Map n e))]
     -> [(WithUniqueInt n, Map (WithUniqueInt n) e)])
    -> [(Int, (n, Map n e))]
    -> [(WithUniqueInt n, Map (WithUniqueInt n) e)]
    forall a b. (a -> b) -> a -> b
    $
      [Int] -> [(n, Map n e)] -> [(Int, (n, Map n e))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([(n, Map n e)] -> [(Int, (n, Map n e))])
    -> [(n, Map n e)] -> [(Int, (n, Map n e))]
    forall a b. (a -> b) -> a -> b
    $
      Map n (Map n e) -> [(n, Map n e)]
    forall k a. Map k a -> [(k, a)]
    Map.toAscList (Map n (Map n e) -> [(n, Map n e)])
    -> Map n (Map n e) -> [(n, Map n e)]
    forall a b. (a -> b) -> a -> b
    $
      Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph Graph n e
    g
      where
      renaming :: Map n Int
      renaming :: Map n Int
    renaming = (Int, Map n Int) -> Map n Int
    forall a b. (a, b) -> b
    snd ((Int, Map n Int) -> Map n Int) -> (Int, Map n Int) -> Map n Int
    forall a b. (a -> b) -> a -> b
    $ (Int -> Map n e -> (Int, Int))
    -> Int -> Map n (Map n e) -> (Int, Map n Int)
    forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
    Map.mapAccum (\Int
    i Map n e
    _ -> (Int -> Int
    forall a. Enum a => a -> a
    succ Int
    i, Int
    i)) Int
    0 (Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph Graph n e
    g)

      ren :: n -> WithUniqueInt n
      ren :: n -> WithUniqueInt n
    ren n
    n = case n -> Map n Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    n Map n Int
    renaming of
        Just Int
    i  -> Int -> n -> WithUniqueInt n
    forall n. Int -> n -> WithUniqueInt n
    WithUniqueInt Int
    i n
    n
        Maybe Int
    Nothing -> WithUniqueInt n
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Unzips the graph. /O(n + e)/.

    -- This is a naive implementation that uses fmap.

    unzip :: Graph n (e, e') -> (Graph n e, Graph n e')
    unzip :: forall n e e'. Graph n (e, e') -> (Graph n e, Graph n e')
    unzip Graph n (e, e')
    g = ((e, e') -> e
    forall a b. (a, b) -> a
    fst ((e, e') -> e) -> Graph n (e, e') -> Graph n e
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Graph n (e, e')
    g, (e, e') -> e'
    forall a b. (a, b) -> b
    snd ((e, e') -> e') -> Graph n (e, e') -> Graph n e'
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Graph n (e, e')
    g)

    -- | @composeWith times plus g g'@ finds all edges
    --   @s --c_i--> t_i --d_i--> u@ and constructs the
    --   result graph from @edge(s,u) = sum_i (c_i times d_i)@.
    --
    --   Complexity:  For each edge @s --> t@ in @g@ we look up
    --   all edges starting with @t@ in @g'@.
    --
    --   Precondition: The two graphs must have exactly the same nodes.

    composeWith ::
      Ord n =>
      (c -> d -> e) -> (e -> e -> e) ->
      Graph n c -> Graph n d -> Graph n e
    composeWith :: forall n c d e.
    Ord n =>
    (c -> d -> e)
    -> (e -> e -> e) -> Graph n c -> Graph n d -> Graph n e
    composeWith c -> d -> e
    times e -> e -> e
    plus (Graph Map n (Map n c)
    g) (Graph Map n (Map n d)
    g') = Map n (Map n e) -> Graph n e
    forall n e. Map n (Map n e) -> Graph n e
    Graph ((Map n c -> Map n e) -> Map n (Map n c) -> Map n (Map n e)
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map Map n c -> Map n e
    comp Map n (Map n c)
    g)
      where
      comp :: Map n c -> Map n e
    comp Map n c
    m = (e -> e -> e) -> [(n, e)] -> Map n e
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith e -> e -> e
    plus
        [ (n
    u, c
    c c -> d -> e
    `times` d
    d)
        | (n
    t, c
    c) <- Map n c -> [(n, c)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n c
    m
        , Map n d
    m'     <- Maybe (Map n d) -> [Map n d]
    forall a. Maybe a -> [a]
    maybeToList (n -> Map n (Map n d) -> Maybe (Map n d)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    t Map n (Map n d)
    g')
        , (n
    u, d
    d) <- Map n d -> [(n, d)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map n d
    m'
        ]

    ------------------------------------------------------------------------
    -- Strongly connected components

    -- | The graph's strongly connected components, in reverse topological
    -- order.
    --
    -- The time complexity is likely /O(n + e log n)/ (but this depends on
    -- the, at the time of writing undocumented, time complexity of
    -- 'Graph.stronglyConnComp').

    sccs' :: Ord n => Graph n e -> [Graph.SCC n]
    sccs' :: forall n e. Ord n => Graph n e -> [SCC n]
    sccs' Graph n e
    g =
      [(n, n, [n])] -> [SCC n]
    forall key node. Ord key => [(node, key, [key])] -> [SCC node]
    Graph.stronglyConnComp
        [ (n
    n, n
    n, Map n e -> [n]
    forall k a. Map k a -> [k]
    Map.keys Map n e
    es)
        | (n
    n, Map n e
    es) <- Map n (Map n e) -> [(n, Map n e)]
    forall k a. Map k a -> [(k, a)]
    Map.toAscList (Graph n e -> Map n (Map n e)
    forall n e. Graph n e -> Map n (Map n e)
    graph Graph n e
    g)
        ]
        -- Graph.stronglyConnComp sorts this list, and the sorting
        -- algorithm that is used is adaptive, so it may make sense to
        -- generate a sorted list. (These comments apply to one specific
        -- version of the code in Graph, compiled in a specific way.)

    -- | The graph's strongly connected components, in reverse topological
    -- order.
    --
    -- The time complexity is likely /O(n + e log n)/ (but this depends on
    -- the, at the time of writing undocumented, time complexity of
    -- 'Graph.stronglyConnComp').

    sccs :: Ord n => Graph n e -> [List1 n]
    sccs :: forall n e. Ord n => Graph n e -> [List1 n]
    sccs = (SCC n -> List1 n) -> [SCC n] -> [List1 n]
    forall a b. (a -> b) -> [a] -> [b]
    map SCC n -> List1 n
    forall n. SCC n -> List1 n
    flattenSCC ([SCC n] -> [List1 n])
    -> (Graph n e -> [SCC n]) -> Graph n e -> [List1 n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> [SCC n]
    forall n e. Ord n => Graph n e -> [SCC n]
    sccs'

    -- | 'Data.Graph.flattenSCC' with a more precise type.

    flattenSCC :: Graph.SCC n -> List1 n
    flattenSCC :: forall n. SCC n -> List1 n
    flattenSCC = [n] -> List1 n
    [Item (List1 n)] -> List1 n
    forall l. IsList l => [Item l] -> l
    List1.fromList ([n] -> List1 n) -> (SCC n -> [n]) -> SCC n -> List1 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC
    -- Andreas, 2024-01-31
    -- Really, upstream should give flattenSCC a more precise type:
    -- See https://github.com/haskell/containers/issues/985
    -- The following more direct definition only works with containers >= 0.7,
    -- but the time is not yet ripe for this:
    --   \case
    --     Graph.AcyclicSCC n   -> List1.singleton n
    --     Graph.NECyclicSCC ns -> ns

    -- | SCC DAGs.
    --
    -- The maps map SCC indices to and from SCCs/nodes.

    data DAG n = DAG
      { forall n. DAG n -> Graph
    dagGraph        :: Graph.Graph
      , forall n. DAG n -> IntMap (SCC n)
    dagComponentMap :: IntMap (Graph.SCC n)
      , forall n. DAG n -> Map n Int
    dagNodeMap      :: Map n Int
      }

    -- | 'DAG' invariant.

    dagInvariant :: Ord n => DAG n -> Bool
    dagInvariant :: forall n. Ord n => DAG n -> Bool
    dagInvariant DAG n
    g =
      [n] -> Set n
    forall a. Ord a => [a] -> Set a
    Set.fromList ((SCC n -> [n]) -> [SCC n] -> [n]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC
                              (IntMap (SCC n) -> [SCC n]
    forall a. IntMap a -> [a]
    IntMap.elems (DAG n -> IntMap (SCC n)
    forall n. DAG n -> IntMap (SCC n)
    dagComponentMap DAG n
    g)))
        Set n -> Set n -> Bool
    forall a. Eq a => a -> a -> Bool
    ==
      Map n Int -> Set n
    forall k a. Map k a -> Set k
    Map.keysSet (DAG n -> Map n Int
    forall n. DAG n -> Map n Int
    dagNodeMap DAG n
    g)
        Bool -> Bool -> Bool
    &&
      [Int] -> IntSet
    IntSet.fromList (Map n Int -> [Int]
    forall k a. Map k a -> [a]
    Map.elems (DAG n -> Map n Int
    forall n. DAG n -> Map n Int
    dagNodeMap DAG n
    g))
        IntSet -> IntSet -> Bool
    forall a. Eq a => a -> a -> Bool
    ==
      IntMap (SCC n) -> IntSet
    forall a. IntMap a -> IntSet
    IntMap.keysSet (DAG n -> IntMap (SCC n)
    forall n. DAG n -> IntMap (SCC n)
    dagComponentMap DAG n
    g)
        Bool -> Bool -> Bool
    &&
      [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ n
    n n -> [n] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC
                       (DAG n -> IntMap (SCC n)
    forall n. DAG n -> IntMap (SCC n)
    dagComponentMap DAG n
    g IntMap (SCC n) -> Int -> SCC n
    forall a. IntMap a -> Int -> a
    IntMap.! (DAG n -> Map n Int
    forall n. DAG n -> Map n Int
    dagNodeMap DAG n
    g Map n Int -> n -> Int
    forall k a. Ord k => Map k a -> k -> a
    Map.! n
    n))
          | n
    n <- Map n Int -> [n]
    forall k a. Map k a -> [k]
    Map.keys (DAG n -> Map n Int
    forall n. DAG n -> Map n Int
    dagNodeMap DAG n
    g)
          ]
        Bool -> Bool -> Bool
    &&
      [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ DAG n -> Map n Int
    forall n. DAG n -> Map n Int
    dagNodeMap DAG n
    g Map n Int -> n -> Int
    forall k a. Ord k => Map k a -> k -> a
    Map.! n
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    i
          | Int
    i <- Graph -> [Int]
    Graph.vertices (DAG n -> Graph
    forall n. DAG n -> Graph
    dagGraph DAG n
    g)
          , n
    n <- SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC (DAG n -> IntMap (SCC n)
    forall n. DAG n -> IntMap (SCC n)
    dagComponentMap DAG n
    g IntMap (SCC n) -> Int -> SCC n
    forall a. IntMap a -> Int -> a
    IntMap.! Int
    i)
          ]
        Bool -> Bool -> Bool
    &&
      [Int] -> IntSet
    IntSet.fromList (Graph -> [Int]
    Graph.vertices (DAG n -> Graph
    forall n. DAG n -> Graph
    dagGraph DAG n
    g))
        IntSet -> IntSet -> Bool
    forall a. Eq a => a -> a -> Bool
    ==
      IntMap (SCC n) -> IntSet
    forall a. IntMap a -> IntSet
    IntMap.keysSet (DAG n -> IntMap (SCC n)
    forall n. DAG n -> IntMap (SCC n)
    dagComponentMap DAG n
    g)
        Bool -> Bool -> Bool
    &&
      (Tree Int -> Bool) -> [Tree Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Tree Int -> Bool
    isAcyclic (Graph -> [Tree Int]
    Graph.scc (DAG n -> Graph
    forall n. DAG n -> Graph
    dagGraph DAG n
    g))
      where
      isAcyclic :: Tree Int -> Bool
    isAcyclic (Tree.Node Int
    r []) = Int
    r Int -> [Int] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (DAG n -> Graph
    forall n. DAG n -> Graph
    dagGraph DAG n
    g Graph -> Int -> [Int]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    Array.! Int
    r)
      isAcyclic Tree Int
    _                = Bool
    False

    -- | The opposite DAG.

    oppositeDAG :: DAG n -> DAG n
    oppositeDAG :: forall n. DAG n -> DAG n
    oppositeDAG DAG n
    g = DAG n
    g { dagGraph = Graph.transposeG (dagGraph g) }

    -- | The nodes reachable from the given SCC.

    reachable :: Ord n => DAG n -> Graph.SCC n -> [n]
    reachable :: forall n. Ord n => DAG n -> SCC n -> [n]
    reachable DAG n
    g SCC n
    scc = case SCC n
    scc of
      Graph.AcyclicSCC n
    n      -> n -> [n] -> [n]
    forall a. Eq a => a -> [a] -> [a]
    List.delete n
    n (n -> [n]
    reachable' n
    n)
      Graph.CyclicSCC (n
    n : [n]
    _) -> n -> [n]
    reachable' n
    n
      Graph.CyclicSCC []      -> [n]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      where
      lookup' :: IntMap a -> Int -> a
    lookup' IntMap a
    g Int
    k = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Int -> IntMap a -> Maybe a
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    k IntMap a
    g)

      lookup'' :: Map k a -> k -> a
    lookup'' Map k a
    g k
    k = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (k -> Map k a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup k
    k Map k a
    g)

      reachable' :: n -> [n]
    reachable' n
    n =
        (Int -> [n]) -> [Int] -> [n]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC (SCC n -> [n]) -> (Int -> SCC n) -> Int -> [n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IntMap (SCC n) -> Int -> SCC n
    forall a. IntMap a -> Int -> a
    lookup' (DAG n -> IntMap (SCC n)
    forall n. DAG n -> IntMap (SCC n)
    dagComponentMap DAG n
    g)) ([Int] -> [n]) -> [Int] -> [n]
    forall a b. (a -> b) -> a -> b
    $
        Graph -> Int -> [Int]
    Graph.reachable (DAG n -> Graph
    forall n. DAG n -> Graph
    dagGraph DAG n
    g) (Map n Int -> n -> Int
    forall k a. Ord k => Map k a -> k -> a
    lookup'' (DAG n -> Map n Int
    forall n. DAG n -> Map n Int
    dagNodeMap DAG n
    g) n
    n)

    -- | Constructs a DAG containing the graph's strongly connected
    -- components.

    sccDAG' ::
      forall n e. Ord n
      => Graph n e
      -> [Graph.SCC n]
         -- ^ The graph's strongly connected components.
      -> DAG n
    sccDAG' :: forall n e. Ord n => Graph n e -> [SCC n] -> DAG n
    sccDAG' Graph n e
    g [SCC n]
    sccs = Graph -> IntMap (SCC n) -> Map n Int -> DAG n
    forall n. Graph -> IntMap (SCC n) -> Map n Int -> DAG n
    DAG Graph
    theDAG IntMap (SCC n)
    componentMap Map n Int
    secondNodeMap
      where
      components :: [(Int, Graph.SCC n)]
      components :: [(Int, SCC n)]
    components = [Int] -> [SCC n] -> [(Int, SCC n)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [SCC n]
    sccs

      firstNodeMap :: Map n Int
      firstNodeMap :: Map n Int
    firstNodeMap = [(n, Int)] -> Map n Int
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
        [ (n
    n, Int
    i)
        | (Int
    i, SCC n
    c) <- [(Int, SCC n)]
    components
        , n
    n      <- SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC SCC n
    c
        ]

      targets :: Int -> [n] -> [Int]
      targets :: Int -> [n] -> [Int]
    targets Int
    i [n]
    ns =
        IntSet -> [Int]
    IntSet.toList (IntSet -> [Int]) -> IntSet -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> IntSet
    IntSet.fromList
          [ Int
    j
          | Edge n e
    e <- Graph n e -> [n] -> [Edge n e]
    forall n e. Ord n => Graph n e -> [n] -> [Edge n e]
    edgesFrom Graph n e
    g [n]
    ns
          , let j :: Int
    j = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (n -> Map n Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Edge n e -> n
    forall n e. Edge n e -> n
    target Edge n e
    e) Map n Int
    firstNodeMap)
          , Int
    j Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    i
          ]

      (Graph
    theDAG, Int -> (Int, Int, [Int])
    _, Int -> Maybe Int
    toVertex) =
        [(Int, Int, [Int])]
    -> (Graph, Int -> (Int, Int, [Int]), Int -> Maybe Int)
    forall key node.
    Ord key =>
    [(node, key, [key])]
    -> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
    Graph.graphFromEdges
          [ (Int
    i, Int
    i, Int -> [n] -> [Int]
    targets Int
    i (SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC SCC n
    c))
          | (Int
    i, SCC n
    c) <- [(Int, SCC n)]
    components
          ]

      convertInt :: Int -> Graph.Vertex
      convertInt :: Int -> Int
    convertInt Int
    i = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Int -> Maybe Int
    toVertex Int
    i)

      componentMap :: IntMap (Graph.SCC n)
      componentMap :: IntMap (SCC n)
    componentMap = [(Int, SCC n)] -> IntMap (SCC n)
    forall a. [(Int, a)] -> IntMap a
    IntMap.fromList (((Int, SCC n) -> (Int, SCC n)) -> [(Int, SCC n)] -> [(Int, SCC n)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Int -> Int) -> (Int, SCC n) -> (Int, SCC n)
    forall a c b. (a -> c) -> (a, b) -> (c, b)
    mapFst Int -> Int
    convertInt) [(Int, SCC n)]
    components)

      secondNodeMap :: Map n Int
      secondNodeMap :: Map n Int
    secondNodeMap = (Int -> Int) -> Map n Int -> Map n Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map Int -> Int
    convertInt Map n Int
    firstNodeMap

    -- | Constructs a DAG containing the graph's strongly connected
    -- components.

    sccDAG :: Ord n => Graph n e -> DAG n
    sccDAG :: forall n e. Ord n => Graph n e -> DAG n
    sccDAG Graph n e
    g = Graph n e -> [SCC n] -> DAG n
    forall n e. Ord n => Graph n e -> [SCC n] -> DAG n
    sccDAG' Graph n e
    g (Graph n e -> [SCC n]
    forall n e. Ord n => Graph n e -> [SCC n]
    sccs' Graph n e
    g)

    ------------------------------------------------------------------------
    -- Reachability

    -- | @reachableFrom g n@ is a map containing all nodes reachable from
    -- @n@ in @g@. For each node a simple path to the node is given, along
    -- with its length (the number of edges). The paths are as short as
    -- possible (in terms of the number of edges).
    --
    -- Precondition: @n@ must be a node in @g@. The number of nodes in the
    -- graph must not be larger than @'maxBound' :: 'Int'@.
    --
    -- Amortised time complexity (assuming that comparisons take constant
    -- time): /O(e log n)/, if the lists are not inspected. Inspection of
    -- a prefix of a list is linear in the length of the prefix.

    reachableFrom :: Ord n => Graph n e -> n -> Map n (Int, [Edge n e])
    reachableFrom :: forall n e. Ord n => Graph n e -> n -> Map n (Int, [Edge n e])
    reachableFrom Graph n e
    g n
    n = Graph n e -> Set n -> Map n (Int, [Edge n e])
    forall n e. Ord n => Graph n e -> Set n -> Map n (Int, [Edge n e])
    reachableFromInternal Graph n e
    g (n -> Set n
    forall a. a -> Set a
    Set.singleton n
    n)

    -- | @reachableFromSet g ns@ is a set containing all nodes reachable
    -- from @ns@ in @g@.
    --
    -- Precondition: Every node in @ns@ must be a node in @g@. The number
    -- of nodes in the graph must not be larger than @'maxBound' ::
    -- 'Int'@.
    --
    -- Amortised time complexity (assuming that comparisons take constant
    -- time): /O((|@ns@| + e) log n)/.

    reachableFromSet :: Ord n => Graph n e -> Set n -> Set n
    reachableFromSet :: forall n e. Ord n => Graph n e -> Set n -> Set n
    reachableFromSet Graph n e
    g Set n
    ns = Map n (Int, [Edge n e]) -> Set n
    forall k a. Map k a -> Set k
    Map.keysSet (Graph n e -> Set n -> Map n (Int, [Edge n e])
    forall n e. Ord n => Graph n e -> Set n -> Map n (Int, [Edge n e])
    reachableFromInternal Graph n e
    g Set n
    ns)

    -- | Used to implement 'reachableFrom' and 'reachableFromSet'.

    reachableFromInternal ::
      Ord n => Graph n e -> Set n -> Map n (Int, [Edge n e])
    reachableFromInternal :: forall n e. Ord n => Graph n e -> Set n -> Map n (Int, [Edge n e])
    reachableFromInternal Graph n e
    g Set n
    ns =
      Seq (n, Seq (Edge n e))
    -> Map n (Int, [Edge n e]) -> Map n (Int, [Edge n e])
    bfs ([(n, Seq (Edge n e))] -> Seq (n, Seq (Edge n e))
    forall a. [a] -> Seq a
    Seq.fromList ((n -> (n, Seq (Edge n e))) -> [n] -> [(n, Seq (Edge n e))]
    forall a b. (a -> b) -> [a] -> [b]
    map (, Seq (Edge n e)
    forall a. Seq a
    Seq.empty) (Set n -> [n]
    forall a. Set a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Set n
    ns))) Map n (Int, [Edge n e])
    forall k a. Map k a
    Map.empty
      where
      bfs :: Seq (n, Seq (Edge n e))
    -> Map n (Int, [Edge n e]) -> Map n (Int, [Edge n e])
    bfs !Seq (n, Seq (Edge n e))
    q !Map n (Int, [Edge n e])
    map = case Seq (n, Seq (Edge n e)) -> ViewL (n, Seq (Edge n e))
    forall a. Seq a -> ViewL a
    Seq.viewl Seq (n, Seq (Edge n e))
    q of
        ViewL (n, Seq (Edge n e))
    Seq.EmptyL -> Map n (Int, [Edge n e])
    map
        (n
    u, Seq (Edge n e)
    p) Seq.:< Seq (n, Seq (Edge n e))
    q ->
          if n
    u n -> Map n (Int, [Edge n e]) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `Map.member` Map n (Int, [Edge n e])
    map
          then Seq (n, Seq (Edge n e))
    -> Map n (Int, [Edge n e]) -> Map n (Int, [Edge n e])
    bfs Seq (n, Seq (Edge n e))
    q Map n (Int, [Edge n e])
    map
          else Seq (n, Seq (Edge n e))
    -> Map n (Int, [Edge n e]) -> Map n (Int, [Edge n e])
    bfs (((n, Seq (Edge n e))
     -> Seq (n, Seq (Edge n e)) -> Seq (n, Seq (Edge n e)))
    -> Seq (n, Seq (Edge n e))
    -> [(n, Seq (Edge n e))]
    -> Seq (n, Seq (Edge n e))
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((Seq (n, Seq (Edge n e))
     -> (n, Seq (Edge n e)) -> Seq (n, Seq (Edge n e)))
    -> (n, Seq (Edge n e))
    -> Seq (n, Seq (Edge n e))
    -> Seq (n, Seq (Edge n e))
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Seq (n, Seq (Edge n e))
    -> (n, Seq (Edge n e)) -> Seq (n, Seq (Edge n e))
    forall a. Seq a -> a -> Seq a
    (Seq.|>)) Seq (n, Seq (Edge n e))
    q
                          [ (n
    v, Seq (Edge n e)
    p Seq (Edge n e) -> Edge n e -> Seq (Edge n e)
    forall a. Seq a -> a -> Seq a
    Seq.|> n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    u n
    v e
    e)
                          | (n
    v, e
    e) <- n -> Graph n e -> [(n, e)]
    forall n e. Ord n => n -> Graph n e -> [(n, e)]
    neighbours n
    u Graph n e
    g
                          ])
                   (let n :: Int
    n = Seq (Edge n e) -> Int
    forall a. Seq a -> Int
    Seq.length Seq (Edge n e)
    p in
                    Int
    n Int -> Map n (Int, [Edge n e]) -> Map n (Int, [Edge n e])
    forall a b. a -> b -> b
    `seq` n
    -> (Int, [Edge n e])
    -> Map n (Int, [Edge n e])
    -> Map n (Int, [Edge n e])
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert n
    u (Int
    n, Seq (Edge n e) -> [Edge n e]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Seq (Edge n e)
    p) Map n (Int, [Edge n e])
    map)

    -- | @walkSatisfying every some g from to@ determines if there is a
    -- walk from @from@ to @to@ in @g@, in which every edge satisfies the
    -- predicate @every@, and some edge satisfies the predicate @some@. If
    -- there are several such walks, then a shortest one (in terms of the
    -- number of edges) is returned.
    --
    -- Precondition: @from@ and @to@ must be nodes in @g@. The number of
    -- nodes in the graph must not be larger than @'maxBound' :: 'Int'@.
    --
    -- Amortised time complexity (assuming that comparisons and the
    -- predicates take constant time to compute): /O(n + e log n)/.

    walkSatisfying ::
      Ord n =>
      (Edge n e -> Bool) -> (Edge n e -> Bool) ->
      Graph n e -> n -> n -> Maybe [Edge n e]
    walkSatisfying :: forall n e.
    Ord n =>
    (Edge n e -> Bool)
    -> (Edge n e -> Bool) -> Graph n e -> n -> n -> Maybe [Edge n e]
    walkSatisfying Edge n e -> Bool
    every Edge n e -> Bool
    some Graph n e
    g n
    from n
    to =
      case
        [ (Int
    l1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    l2, [Edge n e]
    p1 [Edge n e] -> [Edge n e] -> [Edge n e]
    forall a. [a] -> [a] -> [a]
    ++ [Edge n e
    e] [Edge n e] -> [Edge n e] -> [Edge n e]
    forall a. [a] -> [a] -> [a]
    ++ (Edge n e -> Edge n e) -> [Edge n e] -> [Edge n e]
    forall a b. (a -> b) -> [a] -> [b]
    map Edge n e -> Edge n e
    forall n e. Edge n e -> Edge n e
    transposeEdge ([Edge n e] -> [Edge n e]
    forall a. [a] -> [a]
    reverse [Edge n e]
    p2))
        | Edge n e
    e <- [Edge n e]
    everyEdges
        , Edge n e -> Bool
    some Edge n e
    e
        , (Int
    l1, [Edge n e]
    p1) <- Maybe (Int, [Edge n e]) -> [(Int, [Edge n e])]
    forall a. Maybe a -> [a]
    maybeToList (n -> Map n (Int, [Edge n e]) -> Maybe (Int, [Edge n e])
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Edge n e -> n
    forall n e. Edge n e -> n
    source Edge n e
    e) Map n (Int, [Edge n e])
    fromReaches)
        , (Int
    l2, [Edge n e]
    p2) <- Maybe (Int, [Edge n e]) -> [(Int, [Edge n e])]
    forall a. Maybe a -> [a]
    maybeToList (n -> Map n (Int, [Edge n e]) -> Maybe (Int, [Edge n e])
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Edge n e -> n
    forall n e. Edge n e -> n
    target Edge n e
    e) Map n (Int, [Edge n e])
    reachesTo)
        ] of
        []  -> Maybe [Edge n e]
    forall a. Maybe a
    Nothing
        [(Int, [Edge n e])]
    ess -> [Edge n e] -> Maybe [Edge n e]
    forall a. a -> Maybe a
    Just ([Edge n e] -> Maybe [Edge n e]) -> [Edge n e] -> Maybe [Edge n e]
    forall a b. (a -> b) -> a -> b
    $ (Int, [Edge n e]) -> [Edge n e]
    forall a b. (a, b) -> b
    snd ((Int, [Edge n e]) -> [Edge n e])
    -> (Int, [Edge n e]) -> [Edge n e]
    forall a b. (a -> b) -> a -> b
    $ ((Int, [Edge n e]) -> (Int, [Edge n e]) -> Ordering)
    -> [(Int, [Edge n e])] -> (Int, [Edge n e])
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    List.minimumBy (Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Int -> Int -> Ordering)
    -> ((Int, [Edge n e]) -> Int)
    -> (Int, [Edge n e])
    -> (Int, [Edge n e])
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Int, [Edge n e]) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, [Edge n e])]
    ess
      where
      everyEdges :: [Edge n e]
    everyEdges = [ Edge n e
    e | Edge n e
    e <- Graph n e -> [Edge n e]
    forall n e. Graph n e -> [Edge n e]
    edges Graph n e
    g, Edge n e -> Bool
    every Edge n e
    e ]

      fromReaches :: Map n (Int, [Edge n e])
    fromReaches = Graph n e -> n -> Map n (Int, [Edge n e])
    forall n e. Ord n => Graph n e -> n -> Map n (Int, [Edge n e])
    reachableFrom ([Edge n e] -> Graph n e
    forall n e. Ord n => [Edge n e] -> Graph n e
    fromEdges [Edge n e]
    everyEdges) n
    from

      reachesTo :: Map n (Int, [Edge n e])
    reachesTo =
        Graph n e -> n -> Map n (Int, [Edge n e])
    forall n e. Ord n => Graph n e -> n -> Map n (Int, [Edge n e])
    reachableFrom ([Edge n e] -> Graph n e
    forall n e. Ord n => [Edge n e] -> Graph n e
    fromEdges ((Edge n e -> Edge n e) -> [Edge n e] -> [Edge n e]
    forall a b. (a -> b) -> [a] -> [b]
    map Edge n e -> Edge n e
    forall n e. Edge n e -> Edge n e
    transposeEdge [Edge n e]
    everyEdges)) n
    to

    -- | Constructs a graph @g'@ with the same nodes as the original graph
    -- @g@. In @g'@ there is an edge from @n1@ to @n2@ if and only if
    -- there is a (possibly empty) simple path from @n1@ to @n2@ in @g@.
    -- In that case the edge is labelled with all of the longest (in terms
    -- of numbers of edges) simple paths from @n1@ to @n2@ in @g@, as well
    -- as the lengths of these paths.
    --
    -- Precondition: The graph must be acyclic. The number of nodes in the
    -- graph must not be larger than @'maxBound' :: 'Int'@.
    --
    -- Worst-case time complexity (if the paths are not inspected):
    -- /O(e n log n)/ (this has not been verified carefully).
    --
    -- The algorithm is based on one found on Wikipedia.

    longestPaths ::
      forall n e. Ord n => Graph n e -> Graph n (Int, [[Edge n e]])
    longestPaths :: forall n e. Ord n => Graph n e -> Graph n (Int, [[Edge n e]])
    longestPaths Graph n e
    g =
      Map n (Map n (Int, [[Edge n e]])) -> Graph n (Int, [[Edge n e]])
    forall n e. Map n (Map n e) -> Graph n e
    Graph (Map n (Map n (Int, [[Edge n e]])) -> Graph n (Int, [[Edge n e]]))
    -> Map n (Map n (Int, [[Edge n e]])) -> Graph n (Int, [[Edge n e]])
    forall a b. (a -> b) -> a -> b
    $
      (Map n (Int, Seq [Edge n e]) -> Map n (Int, [[Edge n e]]))
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> Map n (Map n (Int, [[Edge n e]]))
    forall a b. (a -> b) -> Map n a -> Map n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((Int, Seq [Edge n e]) -> (Int, [[Edge n e]]))
    -> Map n (Int, Seq [Edge n e]) -> Map n (Int, [[Edge n e]])
    forall a b. (a -> b) -> Map n a -> Map n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Seq [Edge n e] -> [[Edge n e]])
    -> (Int, Seq [Edge n e]) -> (Int, [[Edge n e]])
    forall b d a. (b -> d) -> (a, b) -> (a, d)
    mapSnd Seq [Edge n e] -> [[Edge n e]]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList)) (Map n (Map n (Int, Seq [Edge n e]))
     -> Map n (Map n (Int, [[Edge n e]])))
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> Map n (Map n (Int, [[Edge n e]]))
    forall a b. (a -> b) -> a -> b
    $
      (Map n (Map n (Int, Seq [Edge n e]))
     -> SCC n -> Map n (Map n (Int, Seq [Edge n e])))
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> [SCC n]
    -> Map n (Map n (Int, Seq [Edge n e]))
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' ((SCC n
     -> Map n (Map n (Int, Seq [Edge n e]))
     -> Map n (Map n (Int, Seq [Edge n e])))
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> SCC n
    -> Map n (Map n (Int, Seq [Edge n e]))
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip SCC n
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> Map n (Map n (Int, Seq [Edge n e]))
    addLongestFrom) Map n (Map n (Int, Seq [Edge n e]))
    forall k a. Map k a
    Map.empty ([SCC n] -> Map n (Map n (Int, Seq [Edge n e])))
    -> [SCC n] -> Map n (Map n (Int, Seq [Edge n e]))
    forall a b. (a -> b) -> a -> b
    $
      Graph n e -> [SCC n]
    forall n e. Ord n => Graph n e -> [SCC n]
    sccs' Graph n e
    g
      where
      addLongestFrom ::
        Graph.SCC n ->
        Map n (Map n (Int, Seq [Edge n e])) ->
        Map n (Map n (Int, Seq [Edge n e]))
      addLongestFrom :: SCC n
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> Map n (Map n (Int, Seq [Edge n e]))
    addLongestFrom Graph.CyclicSCC{}    !Map n (Map n (Int, Seq [Edge n e]))
    _  = Map n (Map n (Int, Seq [Edge n e]))
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      addLongestFrom (Graph.AcyclicSCC n
    n) Map n (Map n (Int, Seq [Edge n e]))
    pss =
        n
    -> Map n (Int, Seq [Edge n e])
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> Map n (Map n (Int, Seq [Edge n e]))
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert n
    n
          (n
    -> (Int, Seq [Edge n e])
    -> Map n (Int, Seq [Edge n e])
    -> Map n (Int, Seq [Edge n e])
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert n
    n (Int
    0, [Edge n e] -> Seq [Edge n e]
    forall a. a -> Seq a
    Seq.singleton []) (Map n (Int, Seq [Edge n e]) -> Map n (Int, Seq [Edge n e]))
    -> Map n (Int, Seq [Edge n e]) -> Map n (Int, Seq [Edge n e])
    forall a b. (a -> b) -> a -> b
    $
           ((Int, Seq [Edge n e])
     -> (Int, Seq [Edge n e]) -> (Int, Seq [Edge n e]))
    -> [Map n (Int, Seq [Edge n e])] -> Map n (Int, Seq [Edge n e])
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    (a -> a -> a) -> f (Map k a) -> Map k a
    Map.unionsWith (Int, Seq [Edge n e])
    -> (Int, Seq [Edge n e]) -> (Int, Seq [Edge n e])
    forall {a} {a}. Ord a => (a, Seq a) -> (a, Seq a) -> (a, Seq a)
    longest [Map n (Int, Seq [Edge n e])]
    candidates)
          Map n (Map n (Int, Seq [Edge n e]))
    pss
        where
        longest :: (a, Seq a) -> (a, Seq a) -> (a, Seq a)
    longest p1 :: (a, Seq a)
    p1@(a
    n1, Seq a
    ps1) p2 :: (a, Seq a)
    p2@(a
    n2, Seq a
    ps2) = case a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    n1 a
    n2 of
          Ordering
    GT -> (a, Seq a)
    p1
          Ordering
    LT -> (a, Seq a)
    p2
          Ordering
    EQ -> (a
    n1, Seq a
    ps1 Seq a -> Seq a -> Seq a
    forall a. Seq a -> Seq a -> Seq a
    Seq.>< Seq a
    ps2)

        candidates :: [Map n (Int, Seq [Edge n e])]
        candidates :: [Map n (Int, Seq [Edge n e])]
    candidates =
          [(n, e)]
    -> ((n, e) -> Map n (Int, Seq [Edge n e]))
    -> [Map n (Int, Seq [Edge n e])]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    for (n -> Graph n e -> [(n, e)]
    forall n e. Ord n => n -> Graph n e -> [(n, e)]
    neighbours n
    n Graph n e
    g) (((n, e) -> Map n (Int, Seq [Edge n e]))
     -> [Map n (Int, Seq [Edge n e])])
    -> ((n, e) -> Map n (Int, Seq [Edge n e]))
    -> [Map n (Int, Seq [Edge n e])]
    forall a b. (a -> b) -> a -> b
    $ \(n
    n', e
    e) ->
          let edge :: Edge n e
    edge = Edge
                { source :: n
    source = n
    n
                , target :: n
    target = n
    n'
                , label :: e
    label  = e
    e
                }
          in case n
    -> Map n (Map n (Int, Seq [Edge n e]))
    -> Maybe (Map n (Int, Seq [Edge n e]))
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    n' Map n (Map n (Int, Seq [Edge n e]))
    pss of
            Maybe (Map n (Int, Seq [Edge n e]))
    Nothing -> Map n (Int, Seq [Edge n e])
    forall k a. Map k a
    Map.empty
            Just Map n (Int, Seq [Edge n e])
    ps -> ((Int, Seq [Edge n e]) -> (Int, Seq [Edge n e]))
    -> Map n (Int, Seq [Edge n e]) -> Map n (Int, Seq [Edge n e])
    forall a b. (a -> b) -> Map n a -> Map n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Int
    forall a. Enum a => a -> a
    succ (Int -> Int)
    -> (Seq [Edge n e] -> Seq [Edge n e])
    -> (Int, Seq [Edge n e])
    -> (Int, Seq [Edge n e])
    forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
    -*- ([Edge n e] -> [Edge n e]) -> Seq [Edge n e] -> Seq [Edge n e]
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Edge n e
    edge Edge n e -> [Edge n e] -> [Edge n e]
    forall a. a -> [a] -> [a]
    :)) Map n (Int, Seq [Edge n e])
    ps

    ------------------------------------------------------------------------
    -- Transitive closure

    -- | Transitive closure ported from "Agda.Termination.CallGraph".
    --
    --   Relatively efficient, see Issue 1560.

    complete :: (Eq e, Null e, SemiRing e, Ord n) => Graph n e -> Graph n e
    complete :: forall e n.
    (Eq e, Null e, SemiRing e, Ord n) =>
    Graph n e -> Graph n e
    complete Graph n e
    g = (Graph n e -> (Bool, Graph n e)) -> Graph n e -> Graph n e
    forall a. (a -> (Bool, a)) -> a -> a
    repeatWhile ((Graph n e -> Bool) -> (Graph n e, Graph n e) -> (Bool, Graph n e)
    forall a c b. (a -> c) -> (a, b) -> (c, b)
    mapFst (Bool -> Bool
    not (Bool -> Bool) -> (Graph n e -> Bool) -> Graph n e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Bool
    forall e n. Null e => Graph n e -> Bool
    discrete) ((Graph n e, Graph n e) -> (Bool, Graph n e))
    -> (Graph n e -> (Graph n e, Graph n e))
    -> Graph n e
    -> (Bool, Graph n e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Graph n e -> (Graph n e, Graph n e)
    forall {n} {e'}.
    (Ord n, SemiRing e', Null e', Eq e') =>
    Graph n e' -> Graph n e' -> (Graph n e', Graph n e')
    combineNewOld' Graph n e
    g) Graph n e
    g
      where
        combineNewOld' :: Graph n e' -> Graph n e' -> (Graph n e', Graph n e')
    combineNewOld' Graph n e'
    new Graph n e'
    old = Graph n (e', e') -> (Graph n e', Graph n e')
    forall n e e'. Graph n (e, e') -> (Graph n e, Graph n e')
    unzip (Graph n (e', e') -> (Graph n e', Graph n e'))
    -> Graph n (e', e') -> (Graph n e', Graph n e')
    forall a b. (a -> b) -> a -> b
    $ ((e', e') -> (e', e') -> (e', e'))
    -> Graph n (e', e') -> Graph n (e', e') -> Graph n (e', e')
    forall n e.
    Ord n =>
    (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    unionWith (e', e') -> (e', e') -> (e', e')
    forall {b} {b} {a}.
    (SemiRing b, Eq b, Null b) =>
    (b, b) -> (a, b) -> (b, b)
    comb Graph n (e', e')
    new' Graph n (e', e')
    old'
          where
          -- The following procedure allows us to check if anything new happened:
          -- Pair the composed graphs with an empty graph.
          -- The empty graph will remain empty.  We only need it due to the typing
          -- of Map.unionWith.
          new' :: Graph n (e', e')
    new' = (,e'
    forall a. Null a => a
    Null.empty) (e' -> (e', e')) -> Graph n e' -> Graph n (e', e')
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (e' -> e' -> e')
    -> (e' -> e' -> e') -> Graph n e' -> Graph n e' -> Graph n e'
    forall n c d e.
    Ord n =>
    (c -> d -> e)
    -> (e -> e -> e) -> Graph n c -> Graph n d -> Graph n e
    composeWith e' -> e' -> e'
    forall a. SemiRing a => a -> a -> a
    otimes e' -> e' -> e'
    forall a. SemiRing a => a -> a -> a
    oplus Graph n e'
    new Graph n e'
    old
          -- Pair an empty graph with the old graph.
          old' :: Graph n (e', e')
    old' = (e'
    forall a. Null a => a
    Null.empty,) (e' -> (e', e')) -> Graph n e' -> Graph n (e', e')
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Graph n e'
    old
          -- Combine the pairs.
          -- Update 'old' with 'new'.  This will be the new 'old'. No new 'new' if no change.
          comb :: (b, b) -> (a, b) -> (b, b)
    comb (b
    new, b
    _) (a
    _, b
    old) = (if b
    x b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    old then b
    forall a. Null a => a
    Null.empty else b
    x, b
    x)
            where x :: b
    x = b
    old b -> b -> b
    forall a. SemiRing a => a -> a -> a
    `oplus` b
    new

    -- | Version of 'complete' that produces a list of intermediate results
    --   paired to the left with a difference that lead to the new intermediat result.
    --
    --   The last element in the list is the transitive closure, paired with the empty graph.
    --
    --   @complete g = snd $ last $ completeIter g@

    completeIter :: (Eq e, Null e, SemiRing e, Ord n) => Graph n e -> [(Graph n e, Graph n e)]
    completeIter :: forall e n.
    (Eq e, Null e, SemiRing e, Ord n) =>
    Graph n e -> [(Graph n e, Graph n e)]
    completeIter Graph n e
    g = (Graph n e -> Bool)
    -> (Graph n e -> (Graph n e, Graph n e))
    -> Graph n e
    -> [(Graph n e, Graph n e)]
    forall b a. (b -> Bool) -> (a -> (b, a)) -> a -> [(b, a)]
    iterWhile (Bool -> Bool
    not (Bool -> Bool) -> (Graph n e -> Bool) -> Graph n e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> Bool
    forall e n. Null e => Graph n e -> Bool
    discrete) (Graph n e -> Graph n e -> (Graph n e, Graph n e)
    forall {n} {e'}.
    (Ord n, SemiRing e', Null e', Eq e') =>
    Graph n e' -> Graph n e' -> (Graph n e', Graph n e')
    combineNewOld' Graph n e
    g) Graph n e
    g
      where
        combineNewOld' :: Graph n e' -> Graph n e' -> (Graph n e', Graph n e')
    combineNewOld' Graph n e'
    new Graph n e'
    old = Graph n (e', e') -> (Graph n e', Graph n e')
    forall n e e'. Graph n (e, e') -> (Graph n e, Graph n e')
    unzip (Graph n (e', e') -> (Graph n e', Graph n e'))
    -> Graph n (e', e') -> (Graph n e', Graph n e')
    forall a b. (a -> b) -> a -> b
    $ ((e', e') -> (e', e') -> (e', e'))
    -> Graph n (e', e') -> Graph n (e', e') -> Graph n (e', e')
    forall n e.
    Ord n =>
    (e -> e -> e) -> Graph n e -> Graph n e -> Graph n e
    unionWith (e', e') -> (e', e') -> (e', e')
    forall {b} {b} {a}.
    (SemiRing b, Eq b, Null b) =>
    (b, b) -> (a, b) -> (b, b)
    comb Graph n (e', e')
    new' Graph n (e', e')
    old'
          where
          -- The following procedure allows us to check if anything new happened:
          -- Pair the composed graphs with an empty graph.
          -- The empty graph will remain empty.  We only need it due to the typing
          -- of Map.unionWith.
          new' :: Graph n (e', e')
    new' = (,e'
    forall a. Null a => a
    Null.empty) (e' -> (e', e')) -> Graph n e' -> Graph n (e', e')
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (e' -> e' -> e')
    -> (e' -> e' -> e') -> Graph n e' -> Graph n e' -> Graph n e'
    forall n c d e.
    Ord n =>
    (c -> d -> e)
    -> (e -> e -> e) -> Graph n c -> Graph n d -> Graph n e
    composeWith e' -> e' -> e'
    forall a. SemiRing a => a -> a -> a
    otimes e' -> e' -> e'
    forall a. SemiRing a => a -> a -> a
    oplus Graph n e'
    new Graph n e'
    old
          -- Pair an empty graph with the old graph.
          old' :: Graph n (e', e')
    old' = (e'
    forall a. Null a => a
    Null.empty,) (e' -> (e', e')) -> Graph n e' -> Graph n (e', e')
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Graph n e'
    old
          -- Combine the pairs.
          -- Update 'old' with 'new'.  This will be the new 'old'. No new 'new' if no change.
          comb :: (b, b) -> (a, b) -> (b, b)
    comb (b
    new, b
    _) (a
    _, b
    old) = (if b
    x b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    old then b
    forall a. Null a => a
    Null.empty else b
    x, b
    x)
            where x :: b
    x = b
    old b -> b -> b
    forall a. SemiRing a => a -> a -> a
    `oplus` b
    new

    -- | Computes the transitive closure of the graph.
    --
    -- Uses the Gauss-Jordan-Floyd-Warshall-McNaughton-Yamada algorithm
    -- (as described by Russell O'Connor in \"A Very General Method of
    -- Computing Shortest Paths\"
    -- <http://r6.ca/blog/20110808T035622Z.html>), implemented using
    -- matrices.
    --
    -- The resulting graph does not contain any zero edges.
    --
    -- This algorithm should be seen as a reference implementation. In
    -- practice 'gaussJordanFloydWarshallMcNaughtonYamada' is likely to be
    -- more efficient.

    gaussJordanFloydWarshallMcNaughtonYamadaReference ::
      forall n e. (Ord n, Eq e, StarSemiRing e) =>
      Graph n e -> Graph n e
    gaussJordanFloydWarshallMcNaughtonYamadaReference :: forall n e. (Ord n, Eq e, StarSemiRing e) => Graph n e -> Graph n e
    gaussJordanFloydWarshallMcNaughtonYamadaReference Graph n e
    g =
      Array (Int, Int) e -> Graph n e
    toGraph ((Int -> Array (Int, Int) e -> Array (Int, Int) e)
    -> Array (Int, Int) e -> [Int] -> Array (Int, Int) e
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Int -> Array (Int, Int) e -> Array (Int, Int) e
    step Array (Int, Int) e
    initialMatrix [Int]
    nodeIndices)
      where
      indicesAndNodes :: [(Int, n)]
    indicesAndNodes = [Int] -> [n] -> [(Int, n)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] ([n] -> [(Int, n)]) -> [n] -> [(Int, n)]
    forall a b. (a -> b) -> a -> b
    $ Set n -> [n]
    forall a. Set a -> [a]
    Set.toList (Set n -> [n]) -> Set n -> [n]
    forall a b. (a -> b) -> a -> b
    $ Graph n e -> Set n
    forall n e. Graph n e -> Set n
    nodes Graph n e
    g
      nodeMap :: Map n Int
    nodeMap         = [(n, Int)] -> Map n Int
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(n, Int)] -> Map n Int) -> [(n, Int)] -> Map n Int
    forall a b. (a -> b) -> a -> b
    $ ((Int, n) -> (n, Int)) -> [(Int, n)] -> [(n, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, n) -> (n, Int)
    forall a b. (a, b) -> (b, a)
    swap [(Int, n)]
    indicesAndNodes
      indexMap :: Map Int n
    indexMap        = [(Int, n)] -> Map Int n
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList            [(Int, n)]
    indicesAndNodes

      noNodes :: Int
    noNodes      = Map n Int -> Int
    forall k a. Map k a -> Int
    Map.size Map n Int
    nodeMap
      nodeIndices :: [Int]
    nodeIndices  = [Int
    1 .. Int
    noNodes]
      matrixBounds :: ((Int, Int), (Int, Int))
    matrixBounds = ((Int
    1, Int
    1), (Int
    noNodes, Int
    noNodes))

      initialMatrix :: Array.Array (Int, Int) e
      initialMatrix :: Array (Int, Int) e
    initialMatrix =
        (e -> e -> e)
    -> e
    -> ((Int, Int), (Int, Int))
    -> [((Int, Int), e)]
    -> Array (Int, Int) e
    forall (a :: * -> * -> *) e i e'.
    (IArray a e, Ix i) =>
    (e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
    Array.accumArray
          e -> e -> e
    forall a. SemiRing a => a -> a -> a
    oplus e
    forall a. SemiRing a => a
    ozero
          ((Int, Int), (Int, Int))
    matrixBounds
          [ ((Map n Int
    nodeMap Map n Int -> n -> Int
    forall k a. Ord k => Map k a -> k -> a
    Map.! Edge n e -> n
    forall n e. Edge n e -> n
    source Edge n e
    e, Map n Int
    nodeMap Map n Int -> n -> Int
    forall k a. Ord k => Map k a -> k -> a
    Map.! Edge n e -> n
    forall n e. Edge n e -> n
    target Edge n e
    e), Edge n e -> e
    forall n e. Edge n e -> e
    label Edge n e
    e)
          | Edge n e
    e <- Graph n e -> [Edge n e]
    forall n e. Graph n e -> [Edge n e]
    edges Graph n e
    g
          ]

      rightStrictPair :: a -> b -> (a, b)
    rightStrictPair a
    i !b
    e = (a
    i , b
    e)

      step :: Int -> Array (Int, Int) e -> Array (Int, Int) e
    step Int
    k !Array (Int, Int) e
    m =
        ((Int, Int), (Int, Int)) -> [((Int, Int), e)] -> Array (Int, Int) e
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [(i, e)] -> a i e
    Array.array
          ((Int, Int), (Int, Int))
    matrixBounds
          [ (Int, Int) -> e -> ((Int, Int), e)
    forall {a} {b}. a -> b -> (a, b)
    rightStrictPair
              (Int
    i, Int
    j)
              (e -> e -> e
    forall a. SemiRing a => a -> a -> a
    oplus (Array (Int, Int) e
    m Array (Int, Int) e -> (Int, Int) -> e
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    Array.! (Int
    i, Int
    j))
                     (e -> e -> e
    forall a. SemiRing a => a -> a -> a
    otimes (Array (Int, Int) e
    m Array (Int, Int) e -> (Int, Int) -> e
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    Array.! (Int
    i, Int
    k))
                             (e -> e -> e
    forall a. SemiRing a => a -> a -> a
    otimes (e -> e
    forall a. StarSemiRing a => a -> a
    ostar (Array (Int, Int) e
    m Array (Int, Int) e -> (Int, Int) -> e
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    Array.! (Int
    k, Int
    k)))
                                     (Array (Int, Int) e
    m Array (Int, Int) e -> (Int, Int) -> e
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    Array.! (Int
    k, Int
    j)))))
          | Int
    i <- [Int]
    nodeIndices, Int
    j <- [Int]
    nodeIndices
          ]

      toGraph :: Array (Int, Int) e -> Graph n e
    toGraph Array (Int, Int) e
    m =
        [Edge n e] -> Graph n e
    forall n e. Ord n => [Edge n e] -> Graph n e
    fromEdges [ n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge (Map Int n
    indexMap Map Int n -> Int -> n
    forall k a. Ord k => Map k a -> k -> a
    Map.! Int
    i) (Map Int n
    indexMap Map Int n -> Int -> n
    forall k a. Ord k => Map k a -> k -> a
    Map.! Int
    j) e
    e
                  | ((Int
    i, Int
    j), e
    e) <- Array (Int, Int) e -> [((Int, Int), e)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    Array.assocs Array (Int, Int) e
    m
                  , e
    e e -> e -> Bool
    forall a. Eq a => a -> a -> Bool
    /= e
    forall a. SemiRing a => a
    ozero
                  ]
          Graph n e -> Graph n e -> Graph n e
    forall n e. Ord n => Graph n e -> Graph n e -> Graph n e
    `union`
        Set n -> Graph n e
    forall n e. Ord n => Set n -> Graph n e
    fromNodeSet (Graph n e -> Set n
    forall n e. Graph n e -> Set n
    nodes Graph n e
    g)

    -- | Computes the transitive closure of the graph.
    --
    -- Uses the Gauss-Jordan-Floyd-Warshall-McNaughton-Yamada algorithm
    -- (as described by Russell O'Connor in \"A Very General Method of
    -- Computing Shortest Paths\"
    -- <http://r6.ca/blog/20110808T035622Z.html>), implemented using
    -- 'Graph', and with some shortcuts:
    --
    -- * Zero edge differences are not added to the graph, thus avoiding
    --   some zero edges.
    --
    -- * Strongly connected components are used to avoid computing some
    --   zero edges.
    --
    -- The graph's strongly connected components (in reverse topological
    -- order) are returned along with the transitive closure.

    gaussJordanFloydWarshallMcNaughtonYamada ::
      forall n e. (Ord n, Eq e, StarSemiRing e) =>
      Graph n e -> (Graph n e, [Graph.SCC n])
    gaussJordanFloydWarshallMcNaughtonYamada :: forall n e.
    (Ord n, Eq e, StarSemiRing e) =>
    Graph n e -> (Graph n e, [SCC n])
    gaussJordanFloydWarshallMcNaughtonYamada Graph n e
    g =
      ([SCC n] -> Graph n e -> Graph n e
    loop [SCC n]
    components Graph n e
    g, [SCC n]
    components)
      where
      components :: [SCC n]
    components = Graph n e -> [SCC n]
    forall n e. Ord n => Graph n e -> [SCC n]
    sccs' Graph n e
    g
      forwardDAG :: DAG n
    forwardDAG = Graph n e -> [SCC n] -> DAG n
    forall n e. Ord n => Graph n e -> [SCC n] -> DAG n
    sccDAG' Graph n e
    g [SCC n]
    components
      reverseDAG :: DAG n
    reverseDAG = DAG n -> DAG n
    forall n. DAG n -> DAG n
    oppositeDAG DAG n
    forwardDAG

      loop :: [Graph.SCC n] -> Graph n e -> Graph n e
      loop :: [SCC n] -> Graph n e -> Graph n e
    loop []           !Graph n e
    g = Graph n e
    g
      loop (SCC n
    scc : [SCC n]
    sccs)  Graph n e
    g =
        [SCC n] -> Graph n e -> Graph n e
    loop [SCC n]
    sccs ((n -> Graph n e -> Graph n e) -> Graph n e -> [n] -> Graph n e
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr n -> Graph n e -> Graph n e
    step Graph n e
    g (SCC n -> [n]
    forall vertex. SCC vertex -> [vertex]
    Graph.flattenSCC SCC n
    scc))
        where
        -- All nodes that are reachable from the SCC.
        canBeReached :: [n]
    canBeReached = DAG n -> SCC n -> [n]
    forall n. Ord n => DAG n -> SCC n -> [n]
    reachable DAG n
    forwardDAG SCC n
    scc
        -- All nodes that can reach the SCC.
        canReach :: [n]
    canReach     = DAG n -> SCC n -> [n]
    forall n. Ord n => DAG n -> SCC n -> [n]
    reachable DAG n
    reverseDAG SCC n
    scc

        step :: n -> Graph n e -> Graph n e
        step :: n -> Graph n e -> Graph n e
    step n
    k !Graph n e
    g =
          (Edge n e -> Graph n e -> Graph n e)
    -> Graph n e -> [Edge n e] -> Graph n e
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    forall n e.
    Ord n =>
    (e -> e -> e) -> Edge n e -> Graph n e -> Graph n e
    insertEdgeWith e -> e -> e
    forall a. SemiRing a => a -> a -> a
    oplus) Graph n e
    g
            [ n -> n -> e -> Edge n e
    forall n e. n -> n -> e -> Edge n e
    Edge n
    i n
    j e
    e
            | n
    i <- [n]
    canReach
            , n
    j <- [n]
    canBeReached
            , let e :: e
    e = e -> e -> e
    forall a. SemiRing a => a -> a -> a
    otimes (n -> n -> e
    lookup' n
    i n
    k) (e -> e
    starTimes (n -> n -> e
    lookup' n
    k n
    j))
            , e
    e e -> e -> Bool
    forall a. Eq a => a -> a -> Bool
    /= e
    forall a. SemiRing a => a
    ozero
            ]
          where
          starTimes :: e -> e
    starTimes = e -> e -> e
    forall a. SemiRing a => a -> a -> a
    otimes (e -> e
    forall a. StarSemiRing a => a -> a
    ostar (n -> n -> e
    lookup' n
    k n
    k))

          lookup' :: n -> n -> e
    lookup' n
    s n
    t = e -> Maybe e -> e
    forall a. a -> Maybe a -> a
    fromMaybe e
    forall a. SemiRing a => a
    ozero (n -> n -> Graph n e -> Maybe e
    forall n e. Ord n => n -> n -> Graph n e -> Maybe e
    lookup n
    s n
    t Graph n e
    g)

    -- | The transitive closure. Using 'gaussJordanFloydWarshallMcNaughtonYamada'.
    --   NOTE: DO NOT USE () AS EDGE LABEL SINCE THIS MEANS EVERY EDGE IS CONSIDERED A ZERO EDGE AND NO
    --         NEW EDGES WILL BE ADDED! Use 'Maybe ()' instead.
    transitiveClosure :: (Ord n, Eq e, StarSemiRing e) => Graph n e -> Graph n e
    transitiveClosure :: forall n e. (Ord n, Eq e, StarSemiRing e) => Graph n e -> Graph n e
    transitiveClosure = (Graph n e, [SCC n]) -> Graph n e
    forall a b. (a, b) -> a
    fst ((Graph n e, [SCC n]) -> Graph n e)
    -> (Graph n e -> (Graph n e, [SCC n])) -> Graph n e -> Graph n e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph n e -> (Graph n e, [SCC n])
    forall n e.
    (Ord n, Eq e, StarSemiRing e) =>
    Graph n e -> (Graph n e, [SCC n])
    gaussJordanFloydWarshallMcNaughtonYamada

    -- | The transitive reduction of the graph: a graph with the same
    -- reachability relation as the graph, but with as few edges as
    -- possible.
    --
    -- Precondition: The graph must be acyclic. The number of nodes in the
    -- graph must not be larger than @'maxBound' :: 'Int'@.
    --
    -- Worst-case time complexity: /O(e n log n)/ (this has not been
    -- verified carefully).
    --
    -- The algorithm is based on one found on Wikipedia.

    transitiveReduction :: Ord n => Graph n e -> Graph n ()
    transitiveReduction :: forall n e. Ord n => Graph n e -> Graph n ()
    transitiveReduction Graph n e
    g =
      ((Int, [[Edge n e]]) -> ())
    -> Graph n (Int, [[Edge n e]]) -> Graph n ()
    forall a b. (a -> b) -> Graph n a -> Graph n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> (Int, [[Edge n e]]) -> ()
    forall a b. a -> b -> a
    const ()) (Graph n (Int, [[Edge n e]]) -> Graph n ())
    -> Graph n (Int, [[Edge n e]]) -> Graph n ()
    forall a b. (a -> b) -> a -> b
    $
      (Edge n (Int, [[Edge n e]]) -> Bool)
    -> Graph n (Int, [[Edge n e]]) -> Graph n (Int, [[Edge n e]])
    forall n e. (Edge n e -> Bool) -> Graph n e -> Graph n e
    filterEdges ((Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1) (Int -> Bool)
    -> (Edge n (Int, [[Edge n e]]) -> Int)
    -> Edge n (Int, [[Edge n e]])
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, [[Edge n e]]) -> Int
    forall a b. (a, b) -> a
    fst ((Int, [[Edge n e]]) -> Int)
    -> (Edge n (Int, [[Edge n e]]) -> (Int, [[Edge n e]]))
    -> Edge n (Int, [[Edge n e]])
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Edge n (Int, [[Edge n e]]) -> (Int, [[Edge n e]])
    forall n e. Edge n e -> e
    label) (Graph n (Int, [[Edge n e]]) -> Graph n (Int, [[Edge n e]]))
    -> Graph n (Int, [[Edge n e]]) -> Graph n (Int, [[Edge n e]])
    forall a b. (a -> b) -> a -> b
    $
      Graph n e -> Graph n (Int, [[Edge n e]])
    forall n e. Ord n => Graph n e -> Graph n (Int, [[Edge n e]])
    longestPaths Graph n e
    g