-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Acyclic.AdjacencyMap
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : [email protected]
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for
-- the motivation behind the library, the underlying theory, and implementation
-- details.
--
-- This module defines the 'AdjacencyMap' data type and for acyclic graphs, as
-- well as associated operations and algorithms. To avoid name clashes with
-- "Algebra.Graph.AdjacencyMap", this module can be imported qualified:
--
-- @
-- import qualified Algebra.Graph.Acyclic.AdjacencyMap as Acyclic
-- @
-----------------------------------------------------------------------------
module Algebra.Graph.Acyclic.AdjacencyMap (
    -- * Data structure
    AdjacencyMap, fromAcyclic,

    -- * Basic graph construction primitives
    empty, vertex, vertices, union, join,

    -- * Relations on graphs
    isSubgraphOf,

    -- * Graph properties
    isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,
    adjacencyList, vertexSet, edgeSet, preSet, postSet,

    -- * Graph transformation
    removeVertex, removeEdge, transpose, induce, induceJust,

    -- * Graph composition
    box,

    -- * Relational operations
    transitiveClosure,

    -- * Algorithms
    topSort, scc,

    -- * Conversion to acyclic graphs
    toAcyclic, toAcyclicOrd, shrink,

    -- * Miscellaneous
    consistent
    ) where

import Data.Set (Set)
import Data.Coerce (coerce)

import qualified Algebra.Graph.AdjacencyMap           as AM
import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM
import qualified Algebra.Graph.NonEmpty.AdjacencyMap  as NAM
import qualified Data.List.NonEmpty                   as NonEmpty
import qualified Data.Map                             as Map
import qualified Data.Set                             as Set

{-| The 'AdjacencyMap' data type represents an acyclic graph by a map of
vertices to their adjacency sets. Although the internal representation allows
for cycles, the methods provided by this module cannot be used to construct a
graph with cycles.

The 'Show' instance is defined using basic graph construction primitives where
possible, falling back to 'toAcyclic' and "Algebra.Graph.AdjacencyMap"
otherwise:

@
show empty                == "empty"
show (shrink 1)           == "vertex 1"
show (shrink $ 1 + 2)     == "vertices [1,2]"
show (shrink $ 1 * 2)     == "(fromJust . toAcyclic) (edge 1 2)"
show (shrink $ 1 * 2 * 3) == "(fromJust . toAcyclic) (edges [(1,2),(1,3),(2,3)])"
show (shrink $ 1 * 2 + 3) == "(fromJust . toAcyclic) (overlay (vertex 3) (edge 1 2))"
@

The total order on graphs is defined using /size-lexicographic/ comparison:

* Compare the number of vertices. In case of a tie, continue.
* Compare the sets of vertices. In case of a tie, continue.
* Compare the number of edges. In case of a tie, continue.
* Compare the sets of edges.

Note that the resulting order refines the 'isSubgraphOf' relation:

@'isSubgraphOf' x y ==> x <= y@
-}

-- TODO: Improve the Show instance.
newtype AdjacencyMap a = AAM {
    -- | Extract the underlying acyclic "Algebra.Graph.AdjacencyMap".
    -- Complexity: /O(1)/ time and memory.
    --
    -- @
    -- fromAcyclic 'empty'                == 'AM.empty'
    -- fromAcyclic . 'vertex'             == 'AM.vertex'
    -- fromAcyclic (shrink $ 1 * 3 + 2) == 1 * 3 + 2
    -- 'AM.vertexCount' . fromAcyclic        == 'vertexCount'
    -- 'AM.edgeCount'   . fromAcyclic        == 'edgeCount'
    -- 'AM.isAcyclic'   . fromAcyclic        == 'const' True
    -- @
    forall a. AdjacencyMap a -> AdjacencyMap a
fromAcyclic :: AM.AdjacencyMap a
    } deriving (AdjacencyMap a -> AdjacencyMap a -> Bool
forall a. Eq a => AdjacencyMap a -> AdjacencyMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c/= :: forall a. Eq a => AdjacencyMap a -> AdjacencyMap a -> Bool
== :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c== :: forall a. Eq a => AdjacencyMap a -> AdjacencyMap a -> Bool
Eq, AdjacencyMap a -> AdjacencyMap a -> Bool
AdjacencyMap a -> AdjacencyMap a -> Ordering
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
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 {a}. Ord a => Eq (AdjacencyMap a)
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Ordering
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
min :: AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
$cmin :: forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
max :: AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
$cmax :: forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
>= :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c>= :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
> :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c> :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
<= :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c<= :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
< :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c< :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
compare :: AdjacencyMap a -> AdjacencyMap a -> Ordering
$ccompare :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Ordering
Ord)

instance (Ord a, Show a) => Show (AdjacencyMap a) where
    showsPrec :: Int -> AdjacencyMap a -> ShowS
showsPrec Int
p aam :: AdjacencyMap a
aam@(AAM AdjacencyMap a
am)
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
vs    = String -> ShowS
showString String
"empty"
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, a)]
es    = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> ShowS
vshow [a]
vs
        | Bool
otherwise  = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"(fromJust . toAcyclic) ("
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows AdjacencyMap a
am forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
      where
        vs :: [a]
vs             = forall a. AdjacencyMap a -> [a]
vertexList AdjacencyMap a
aam
        es :: [(a, a)]
es             = forall a. AdjacencyMap a -> [(a, a)]
edgeList AdjacencyMap a
aam
        vshow :: [a] -> ShowS
vshow [a
x]      = String -> ShowS
showString String
"vertex "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
        vshow [a]
xs       = String -> ShowS
showString String
"vertices " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
xs

-- | Construct the /empty graph/.
--
-- @
-- 'isEmpty'     empty == True
-- 'hasVertex' x empty == False
-- 'vertexCount' empty == 0
-- 'edgeCount'   empty == 0
-- @
empty :: AdjacencyMap a
empty :: forall a. AdjacencyMap a
empty = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a
AM.empty

-- | Construct the graph comprising /a single isolated vertex/.
--
-- @
-- 'isEmpty'     (vertex x) == False
-- 'hasVertex' x (vertex y) == (x == y)
-- 'vertexCount' (vertex x) == 1
-- 'edgeCount'   (vertex x) == 0
-- @
vertex :: a -> AdjacencyMap a
vertex :: forall a. a -> AdjacencyMap a
vertex = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. a -> AdjacencyMap a
AM.vertex

-- | Construct the graph comprising a given list of isolated vertices.
-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length
-- of the given list.
--
-- @
-- vertices []            == 'empty'
-- vertices [x]           == 'vertex' x
-- 'hasVertex' x . vertices == 'elem' x
-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'
-- 'vertexSet'   . vertices == Set.'Set.fromList'
-- @
vertices :: Ord a => [a] -> AdjacencyMap a
vertices :: forall a. Ord a => [a] -> AdjacencyMap a
vertices = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => [a] -> AdjacencyMap a
AM.vertices

-- | Construct the disjoint /union/ of two graphs.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- 'vertexSet' (union x y) == Set.'Set.unions' [ Set.'Set.map' 'Left'  ('vertexSet' x)
--                                     , Set.'Set.map' 'Right' ('vertexSet' y) ]
--
-- 'edgeSet'   (union x y) == Set.'Set.unions' [ Set.'Set.map' ('Data.Bifunctor.bimap' 'Left'  'Left' ) ('edgeSet' x)
--                                     , Set.'Set.map' ('Data.Bifunctor.bimap' 'Right' 'Right') ('edgeSet' y) ]
-- @
union :: (Ord a, Ord b) => AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (Either a b)
union :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (Either a b)
union (AAM AdjacencyMap a
x) (AAM AdjacencyMap b
y) = forall a. AdjacencyMap a -> AdjacencyMap a
AAM forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
AM.overlay (forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap forall a b. a -> Either a b
Left AdjacencyMap a
x) (forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap forall a b. b -> Either a b
Right AdjacencyMap b
y)

-- | Construct the /join/ of two graphs.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- 'vertexSet' (join x y) == Set.'Set.unions' [ Set.'Set.map' 'Left'  ('vertexSet' x)
--                                    , Set.'Set.map' 'Right' ('vertexSet' y) ]
--
-- 'edgeSet'   (join x y) == Set.'Set.unions' [ Set.'Set.map' ('Data.Bifunctor.bimap' 'Left'  'Left' ) ('edgeSet' x)
--                                    , Set.'Set.map' ('Data.Bifunctor.bimap' 'Right' 'Right') ('edgeSet' y)
--                                    , Set.'Set.map' ('Data.Bifunctor.bimap' 'Left'  'Right') (Set.'Set.cartesianProduct' ('vertexSet' x) ('vertexSet' y)) ]
-- @
join :: (Ord a, Ord b) => AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (Either a b)
join :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (Either a b)
join (AAM AdjacencyMap a
a) (AAM AdjacencyMap b
b) = forall a. AdjacencyMap a -> AdjacencyMap a
AAM forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
AM.connect (forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap forall a b. a -> Either a b
Left AdjacencyMap a
a) (forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap forall a b. b -> Either a b
Right AdjacencyMap b
b)

-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the
-- first graph is a /subgraph/ of the second.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- isSubgraphOf 'empty'        x                     ==  True
-- isSubgraphOf ('vertex' x)   'empty'                 ==  False
-- isSubgraphOf ('induce' p x) x                     ==  True
-- isSubgraphOf x            ('transitiveClosure' x) ==  True
-- isSubgraphOf x y                                ==> x <= y
-- @
isSubgraphOf :: Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
isSubgraphOf :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
isSubgraphOf = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
AM.isSubgraphOf

-- | Check if a graph is empty.
-- Complexity: /O(1)/ time.
--
-- @
-- isEmpty 'empty'                             == True
-- isEmpty ('vertex' x)                        == False
-- isEmpty ('removeVertex' x $ 'vertex' x)       == True
-- isEmpty ('removeEdge' 1 2 $ shrink $ 1 * 2) == False
-- @
isEmpty :: AdjacencyMap a -> Bool
isEmpty :: forall a. AdjacencyMap a -> Bool
isEmpty = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> Bool
AM.isEmpty

-- | Check if a graph contains a given vertex.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasVertex x 'empty'            == False
-- hasVertex x ('vertex' y)       == (x == y)
-- hasVertex x . 'removeVertex' x == 'const' False
-- @
hasVertex :: Ord a => a -> AdjacencyMap a -> Bool
hasVertex :: forall a. Ord a => a -> AdjacencyMap a -> Bool
hasVertex = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => a -> AdjacencyMap a -> Bool
AM.hasVertex

-- | Check if a graph contains a given edge.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasEdge x y 'empty'            == False
-- hasEdge x y ('vertex' z)       == False
-- hasEdge 1 2 (shrink $ 1 * 2) == True
-- hasEdge x y . 'removeEdge' x y == 'const' False
-- hasEdge x y                  == 'elem' (x,y) . 'edgeList'
-- @
hasEdge :: Ord a => a -> a -> AdjacencyMap a -> Bool
hasEdge :: forall a. Ord a => a -> a -> AdjacencyMap a -> Bool
hasEdge = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => a -> a -> AdjacencyMap a -> Bool
AM.hasEdge

-- | The number of vertices in a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- vertexCount 'empty'             ==  0
-- vertexCount ('vertex' x)        ==  1
-- vertexCount                   ==  'length' . 'vertexList'
-- vertexCount x \< vertexCount y ==> x \< y
-- @
vertexCount :: AdjacencyMap a -> Int
vertexCount :: forall a. AdjacencyMap a -> Int
vertexCount = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> Int
AM.vertexCount

-- | The number of edges in a graph.
-- Complexity: /O(n)/ time.
--
-- @
-- edgeCount 'empty'            == 0
-- edgeCount ('vertex' x)       == 0
-- edgeCount (shrink $ 1 * 2) == 1
-- edgeCount                  == 'length' . 'edgeList'
-- @
edgeCount :: AdjacencyMap a -> Int
edgeCount :: forall a. AdjacencyMap a -> Int
edgeCount = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> Int
AM.edgeCount

-- | The sorted list of vertices of a given graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexList 'empty'      == []
-- vertexList ('vertex' x) == [x]
-- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'
-- @
vertexList :: AdjacencyMap a -> [a]
vertexList :: forall a. AdjacencyMap a -> [a]
vertexList = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> [a]
AM.vertexList

-- | The sorted list of edges of a graph.
-- Complexity: /O(n + m)/ time and /O(m)/ memory.
--
-- @
-- edgeList 'empty'            == []
-- edgeList ('vertex' x)       == []
-- edgeList (shrink $ 2 * 1) == [(2,1)]
-- edgeList . 'transpose'      == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . edgeList
-- @
edgeList :: AdjacencyMap a -> [(a, a)]
edgeList :: forall a. AdjacencyMap a -> [(a, a)]
edgeList = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> [(a, a)]
AM.edgeList

-- | The sorted /adjacency list/ of a graph.
-- Complexity: /O(n + m)/ time and memory.
--
-- @
-- adjacencyList 'empty'            == []
-- adjacencyList ('vertex' x)       == [(x, [])]
-- adjacencyList (shrink $ 1 * 2) == [(1, [2]), (2, [])]
-- @
adjacencyList :: AdjacencyMap a -> [(a, [a])]
adjacencyList :: forall a. AdjacencyMap a -> [(a, [a])]
adjacencyList = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> [(a, [a])]
AM.adjacencyList

-- | The set of vertices of a given graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexSet 'empty'      == Set.'Set.empty'
-- vertexSet . 'vertex'   == Set.'Set.singleton'
-- vertexSet . 'vertices' == Set.'Set.fromList'
-- @
vertexSet :: AdjacencyMap a -> Set a
vertexSet :: forall a. AdjacencyMap a -> Set a
vertexSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. AdjacencyMap a -> Set a
AM.vertexSet

-- | The set of edges of a given graph.
-- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory.
--
-- @
-- edgeSet 'empty'            == Set.'Set.empty'
-- edgeSet ('vertex' x)       == Set.'Set.empty'
-- edgeSet (shrink $ 1 * 2) == Set.'Set.singleton' (1,2)
-- @
edgeSet :: Eq a => AdjacencyMap a -> Set (a, a)
edgeSet :: forall a. Eq a => AdjacencyMap a -> Set (a, a)
edgeSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Eq a => AdjacencyMap a -> Set (a, a)
AM.edgeSet

-- | The /preset/ of an element @x@ is the set of its /direct predecessors/.
-- Complexity: /O(n * log(n))/ time and /O(n)/ memory.
--
-- @
-- preSet x 'empty'            == Set.'Set.empty'
-- preSet x ('vertex' x)       == Set.'Set.empty'
-- preSet 1 (shrink $ 1 * 2) == Set.'Set.empty'
-- preSet 2 (shrink $ 1 * 2) == Set.'Set.fromList' [1]
-- Set.'Set.member' x . preSet x   == 'const' False
-- @
preSet :: Ord a => a -> AdjacencyMap a -> Set a
preSet :: forall a. Ord a => a -> AdjacencyMap a -> Set a
preSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => a -> AdjacencyMap a -> Set a
AM.preSet

-- | The /postset/ of a vertex is the set of its /direct successors/.
-- Complexity: /O(log(n))/ time and /O(1)/ memory.
--
-- @
-- postSet x 'empty'            == Set.'Set.empty'
-- postSet x ('vertex' x)       == Set.'Set.empty'
-- postSet 1 (shrink $ 1 * 2) == Set.'Set.fromList' [2]
-- postSet 2 (shrink $ 1 * 2) == Set.'Set.empty'
-- Set.'Set.member' x . postSet x   == 'const' False
-- @
postSet :: Ord a => a -> AdjacencyMap a -> Set a
postSet :: forall a. Ord a => a -> AdjacencyMap a -> Set a
postSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => a -> AdjacencyMap a -> Set a
AM.postSet

-- | Remove a vertex from a given acyclic graph.
-- Complexity: /O(n*log(n))/ time.
--
-- @
-- removeVertex x ('vertex' x)       == 'empty'
-- removeVertex 1 ('vertex' 2)       == 'vertex' 2
-- removeVertex 1 (shrink $ 1 * 2) == 'vertex' 2
-- removeVertex x . removeVertex x == removeVertex x
-- @
removeVertex :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a
removeVertex :: forall a. Ord a => a -> AdjacencyMap a -> AdjacencyMap a
removeVertex = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => a -> AdjacencyMap a -> AdjacencyMap a
AM.removeVertex

-- | Remove an edge from a given acyclic graph.
-- Complexity: /O(log(n))/ time.
--
-- @
-- removeEdge 1 2 (shrink $ 1 * 2)     == 'vertices' [1,2]
-- removeEdge x y . removeEdge x y     == removeEdge x y
-- removeEdge x y . 'removeVertex' x     == 'removeVertex' x
-- removeEdge 1 2 (shrink $ 1 * 2 * 3) == shrink ((1 + 2) * 3)
-- @
removeEdge :: Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a
removeEdge :: forall a. Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a
removeEdge = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a
AM.removeEdge

-- | Transpose a given acyclic graph.
-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.
--
-- @
-- transpose 'empty'       == 'empty'
-- transpose ('vertex' x)  == 'vertex' x
-- transpose . transpose == id
-- 'edgeList' . transpose  == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . 'edgeList'
-- @
transpose :: Ord a => AdjacencyMap a -> AdjacencyMap a
transpose :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transpose = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
AM.transpose

-- | Construct the /induced subgraph/ of a given graph by removing the
-- vertices that do not satisfy a given predicate.
-- Complexity: /O(n + m)/ time, assuming that the predicate takes constant time.
--
-- @
-- induce ('const' True ) x      == x
-- induce ('const' False) x      == 'empty'
-- induce (/= x)               == 'removeVertex' x
-- induce p . induce q         == induce (\x -> p x && q x)
-- 'isSubgraphOf' (induce p x) x == True
-- @
induce :: (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
induce :: forall a. (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
induce = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
AM.induce

-- | Construct the /induced subgraph/ of a given graph by removing the vertices
-- that are 'Nothing'.
-- Complexity: /O(n + m)/ time.
--
-- @
-- induceJust ('vertex' 'Nothing') == 'empty'
-- induceJust . 'vertex' . 'Just'  == 'vertex'
-- @
induceJust :: Ord a => AdjacencyMap (Maybe a) -> AdjacencyMap a
induceJust :: forall a. Ord a => AdjacencyMap (Maybe a) -> AdjacencyMap a
induceJust = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => AdjacencyMap (Maybe a) -> AdjacencyMap a
AM.induceJust

-- | Compute the /Cartesian product/ of graphs.
-- Complexity: /O((n + m) * log(n))/ time and O(n + m) memory.
--
-- @
-- 'edgeList' (box ('shrink' $ 1 * 2) ('shrink' $ 10 * 20)) == [ ((1,10), (1,20))
--                                                       , ((1,10), (2,10))
--                                                       , ((1,20), (2,20))
--                                                       , ((2,10), (2,20)) ]
-- @
--
-- Up to isomorphism between the resulting vertex types, this operation is
-- /commutative/ and /associative/, has singleton graphs as /identities/ and
-- 'empty' as the /annihilating zero/. Below @~~@ stands for equality up to
-- an isomorphism, e.g. @(x,@ @()) ~~ x@.
--
-- @
-- box x y               ~~ box y x
-- box x (box y z)       ~~ box (box x y) z
-- box x ('vertex' ())     ~~ x
-- box x 'empty'           ~~ 'empty'
-- 'transpose'   (box x y) == box ('transpose' x) ('transpose' y)
-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y
-- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y
-- @
box :: (Ord a, Ord b) => AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
box :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
box = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
AM.box

-- | Compute the /transitive closure/ of a graph.
-- Complexity: /O(n * m * log(n)^2)/ time.
--
-- @
-- transitiveClosure 'empty'                    == 'empty'
-- transitiveClosure ('vertex' x)               == 'vertex' x
-- transitiveClosure (shrink $ 1 * 2 + 2 * 3) == shrink (1 * 2 + 1 * 3 + 2 * 3)
-- transitiveClosure . transitiveClosure      == transitiveClosure
-- @
transitiveClosure :: Ord a => AdjacencyMap a -> AdjacencyMap a
transitiveClosure :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transitiveClosure = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
AM.transitiveClosure

-- | Compute a /topological sort/ of an acyclic graph.
--
-- @
-- topSort 'empty'                          == []
-- topSort ('vertex' x)                     == [x]
-- topSort (shrink $ 1 * (2 + 4) + 3 * 4) == [1, 2, 3, 4]
-- topSort ('join' x y)                     == 'fmap' 'Left' (topSort x) ++ 'fmap' 'Right' (topSort y)
-- 'Right' . topSort                        == 'AM.topSort' . 'fromAcyclic'
-- @
topSort :: Ord a => AdjacencyMap a -> [a]
topSort :: forall a. Ord a => AdjacencyMap a -> [a]
topSort AdjacencyMap a
g = case forall a. Ord a => AdjacencyMap a -> Either (Cycle a) [a]
AM.topSort (coerce :: forall a b. Coercible a b => a -> b
coerce AdjacencyMap a
g) of
    Right [a]
vs -> [a]
vs
    Left Cycle a
_ -> forall a. HasCallStack => String -> a
error String
"Internal error: the acyclicity invariant is violated in topSort"

-- | Compute the acyclic /condensation/ of a graph, where each vertex
-- corresponds to a /strongly-connected component/ of the original graph. Note
-- that component graphs are non-empty, and are therefore of type
-- "Algebra.Graph.NonEmpty.AdjacencyMap".
--
-- @
--            scc 'AM.empty'               == 'empty'
--            scc ('AM.vertex' x)          == 'vertex' (NonEmpty.'NonEmpty.vertex' x)
--            scc ('AM.edge' 1 1)          == 'vertex' (NonEmpty.'NonEmpty.edge' 1 1)
-- 'edgeList' $ scc ('AM.edge' 1 2)          == [ (NonEmpty.'NonEmpty.vertex' 1       , NonEmpty.'NonEmpty.vertex' 2       ) ]
-- 'edgeList' $ scc (3 * 1 * 4 * 1 * 5) == [ (NonEmpty.'NonEmpty.vertex' 3       , NonEmpty.'NonEmpty.vertex' 5       )
--                                       , (NonEmpty.'NonEmpty.vertex' 3       , NonEmpty.'NonEmpty.clique1' [1,4,1])
--                                       , (NonEmpty.'NonEmpty.clique1' [1,4,1], NonEmpty.'NonEmpty.vertex' 5       ) ]
-- @
scc :: (Ord a) => AM.AdjacencyMap a -> AdjacencyMap (NAM.AdjacencyMap a)
scc :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
scc = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
AM.scc

-- | Construct an acyclic graph from a given adjacency map, or return 'Nothing'
-- if the input contains cycles.
--
-- @
-- toAcyclic ('AM.path'    [1,2,3]) == 'Just' (shrink $ 1 * 2 + 2 * 3)
-- toAcyclic ('AM.clique'  [3,2,1]) == 'Just' ('transpose' (shrink $ 1 * 2 * 3))
-- toAcyclic ('AM.circuit' [1,2,3]) == 'Nothing'
-- toAcyclic . 'fromAcyclic'     == 'Just'
-- @
toAcyclic :: Ord a => AM.AdjacencyMap a -> Maybe (AdjacencyMap a)
toAcyclic :: forall a. Ord a => AdjacencyMap a -> Maybe (AdjacencyMap a)
toAcyclic AdjacencyMap a
x = if forall a. Ord a => AdjacencyMap a -> Bool
AM.isAcyclic AdjacencyMap a
x then forall a. a -> Maybe a
Just (forall a. AdjacencyMap a -> AdjacencyMap a
AAM AdjacencyMap a
x) else forall a. Maybe a
Nothing

-- | Construct an acyclic graph from a given adjacency map, keeping only edges
-- @(x,y)@ where @x < y@ according to the supplied 'Ord' @a@ instance.
--
-- @
-- toAcyclicOrd 'empty'       == 'empty'
-- toAcyclicOrd . 'vertex'    == 'vertex'
-- toAcyclicOrd (1 + 2)     == shrink (1 + 2)
-- toAcyclicOrd (1 * 2)     == shrink (1 * 2)
-- toAcyclicOrd (2 * 1)     == shrink (1 + 2)
-- toAcyclicOrd (1 * 2 * 1) == shrink (1 * 2)
-- toAcyclicOrd (1 * 2 * 3) == shrink (1 * 2 * 3)
-- @
toAcyclicOrd :: Ord a => AM.AdjacencyMap a -> AdjacencyMap a
toAcyclicOrd :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
toAcyclicOrd = forall a. AdjacencyMap a -> AdjacencyMap a
AAM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Ord a =>
(a -> a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
filterEdges forall a. Ord a => a -> a -> Bool
(<)

-- TODO: Add time complexity
-- TODO: Change Arbitrary instance of Acyclic and Labelled Acyclic graph
-- | Construct an acyclic graph from a given adjacency map using 'scc'.
-- If the graph is acyclic, it is returned as is. If the graph is cyclic, then a
-- representative for every strongly connected component in its condensation
-- graph is chosen and these representatives are used to build an acyclic graph.
--
-- @
-- shrink . 'AM.vertex'      == 'vertex'
-- shrink . 'AM.vertices'    == 'vertices'
-- shrink . 'fromAcyclic' == 'id'
-- @
shrink :: Ord a => AM.AdjacencyMap a -> AdjacencyMap a
shrink :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
shrink = forall a. AdjacencyMap a -> AdjacencyMap a
AAM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap (forall a. NonEmpty a -> a
NonEmpty.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AdjacencyMap a -> NonEmpty a
NAM.vertexList1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
AM.scc

-- TODO: Provide a faster equivalent in "Algebra.Graph.AdjacencyMap".
-- Keep only the edges that satisfy a given predicate.
filterEdges :: Ord a => (a -> a -> Bool) -> AM.AdjacencyMap a -> AM.AdjacencyMap a
filterEdges :: forall a.
Ord a =>
(a -> a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
filterEdges a -> a -> Bool
p AdjacencyMap a
m = forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets
    [ (a
a, forall a. (a -> Bool) -> Set a -> Set a
Set.filter (a -> a -> Bool
p a
a) Set a
bs) | (a
a, Set a
bs) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall a. AdjacencyMap a -> Map a (Set a)
AM.adjacencyMap AdjacencyMap a
m) ]

-- | Check if the internal representation of an acyclic graph is consistent,
-- i.e. that all edges refer to existing vertices and the graph is acyclic. It
-- should be impossible to create an inconsistent 'AdjacencyMap'.
--
-- @
-- consistent 'empty'                 == True
-- consistent ('vertex' x)            == True
-- consistent ('vertices' xs)         == True
-- consistent ('union' x y)           == True
-- consistent ('join' x y)            == True
-- consistent ('transpose' x)         == True
-- consistent ('box' x y)             == True
-- consistent ('transitiveClosure' x) == True
-- consistent ('scc' x)               == True
-- 'fmap' consistent ('toAcyclic' x)    /= False
-- consistent ('toAcyclicOrd' x)      == True
-- @
consistent :: Ord a => AdjacencyMap a -> Bool
consistent :: forall a. Ord a => AdjacencyMap a -> Bool
consistent (AAM AdjacencyMap a
m) = forall a. Ord a => AdjacencyMap a -> Bool
AM.consistent AdjacencyMap a
m Bool -> Bool -> Bool
&& forall a. Ord a => AdjacencyMap a -> Bool
AM.isAcyclic AdjacencyMap a
m