-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Acyclic.AdjacencyMap
-- Copyright  : (c) Andrey Mokhov 2016-2021
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- 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
    -- @
    AdjacencyMap a -> AdjacencyMap a
fromAcyclic :: AM.AdjacencyMap a
    } deriving (AdjacencyMap a -> AdjacencyMap a -> Bool
(AdjacencyMap a -> AdjacencyMap a -> Bool)
-> (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> Eq (AdjacencyMap a)
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, Eq (AdjacencyMap a)
Eq (AdjacencyMap a)
-> (AdjacencyMap a -> AdjacencyMap a -> Ordering)
-> (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> (AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a)
-> (AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a)
-> Ord (AdjacencyMap a)
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
$cp1Ord :: forall a. Ord a => Eq (AdjacencyMap a)
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)
        | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
vs    = String -> ShowS
showString String
"empty"
        | [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, a)]
es    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [a] -> ShowS
forall a. Show a => [a] -> ShowS
vshow [a]
vs
        | Bool
otherwise  = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"(fromJust . toAcyclic) ("
                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> ShowS
forall a. Show a => a -> ShowS
shows AdjacencyMap a
am ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
      where
        vs :: [a]
vs             = AdjacencyMap a -> [a]
forall a. AdjacencyMap a -> [a]
vertexList AdjacencyMap a
aam
        es :: [(a, a)]
es             = AdjacencyMap a -> [(a, a)]
forall a. AdjacencyMap a -> [(a, a)]
edgeList AdjacencyMap a
aam
        vshow :: [a] -> ShowS
vshow [a
x]      = String -> ShowS
showString String
"vertex "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
        vshow [a]
xs       = String -> ShowS
showString String
"vertices " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
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 :: AdjacencyMap a
empty = AdjacencyMap a -> AdjacencyMap a
coerce AdjacencyMap a
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 :: a -> AdjacencyMap a
vertex = (a -> AdjacencyMap a) -> a -> AdjacencyMap a
coerce a -> AdjacencyMap a
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 :: [a] -> AdjacencyMap a
vertices = ([a] -> AdjacencyMap a) -> [a] -> AdjacencyMap a
coerce [a] -> AdjacencyMap a
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 :: AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (Either a b)
union (AAM AdjacencyMap a
x) (AAM AdjacencyMap b
y) = AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a. AdjacencyMap a -> AdjacencyMap a
AAM (AdjacencyMap (Either a b) -> AdjacencyMap (Either a b))
-> AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a b. (a -> b) -> a -> b
$ AdjacencyMap (Either a b)
-> AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
AM.overlay ((a -> Either a b) -> AdjacencyMap a -> AdjacencyMap (Either a b)
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap a -> Either a b
forall a b. a -> Either a b
Left AdjacencyMap a
x) ((b -> Either a b) -> AdjacencyMap b -> AdjacencyMap (Either a b)
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap b -> Either a b
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 :: AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (Either a b)
join (AAM AdjacencyMap a
a) (AAM AdjacencyMap b
b) = AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a. AdjacencyMap a -> AdjacencyMap a
AAM (AdjacencyMap (Either a b) -> AdjacencyMap (Either a b))
-> AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a b. (a -> b) -> a -> b
$ AdjacencyMap (Either a b)
-> AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
AM.connect ((a -> Either a b) -> AdjacencyMap a -> AdjacencyMap (Either a b)
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap a -> Either a b
forall a b. a -> Either a b
Left AdjacencyMap a
a) ((b -> Either a b) -> AdjacencyMap b -> AdjacencyMap (Either a b)
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap b -> Either a b
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 :: AdjacencyMap a -> AdjacencyMap a -> Bool
isSubgraphOf = (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> AdjacencyMap a -> AdjacencyMap a -> Bool
coerce AdjacencyMap a -> AdjacencyMap a -> Bool
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 :: AdjacencyMap a -> Bool
isEmpty = (AdjacencyMap a -> Bool) -> AdjacencyMap a -> Bool
coerce AdjacencyMap a -> Bool
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 :: a -> AdjacencyMap a -> Bool
hasVertex = (a -> AdjacencyMap a -> Bool) -> a -> AdjacencyMap a -> Bool
coerce a -> AdjacencyMap a -> Bool
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 :: a -> a -> AdjacencyMap a -> Bool
hasEdge = (a -> a -> AdjacencyMap a -> Bool)
-> a -> a -> AdjacencyMap a -> Bool
coerce a -> a -> AdjacencyMap a -> Bool
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 :: AdjacencyMap a -> Int
vertexCount = (AdjacencyMap a -> Int) -> AdjacencyMap a -> Int
coerce AdjacencyMap a -> Int
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 :: AdjacencyMap a -> Int
edgeCount = (AdjacencyMap a -> Int) -> AdjacencyMap a -> Int
coerce AdjacencyMap a -> Int
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 :: AdjacencyMap a -> [a]
vertexList = (AdjacencyMap a -> [a]) -> AdjacencyMap a -> [a]
coerce AdjacencyMap a -> [a]
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 :: AdjacencyMap a -> [(a, a)]
edgeList = (AdjacencyMap a -> [(a, a)]) -> AdjacencyMap a -> [(a, a)]
coerce AdjacencyMap a -> [(a, a)]
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 :: AdjacencyMap a -> [(a, [a])]
adjacencyList = (AdjacencyMap a -> [(a, [a])]) -> AdjacencyMap a -> [(a, [a])]
coerce AdjacencyMap a -> [(a, [a])]
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 :: AdjacencyMap a -> Set a
vertexSet = (AdjacencyMap a -> Set a) -> AdjacencyMap a -> Set a
coerce AdjacencyMap a -> Set a
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 :: AdjacencyMap a -> Set (a, a)
edgeSet = (AdjacencyMap a -> Set (a, a)) -> AdjacencyMap a -> Set (a, a)
coerce AdjacencyMap a -> Set (a, a)
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 :: a -> AdjacencyMap a -> Set a
preSet = (a -> AdjacencyMap a -> Set a) -> a -> AdjacencyMap a -> Set a
coerce a -> AdjacencyMap a -> Set a
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 :: a -> AdjacencyMap a -> Set a
postSet = (a -> AdjacencyMap a -> Set a) -> a -> AdjacencyMap a -> Set a
coerce a -> AdjacencyMap a -> Set a
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 :: a -> AdjacencyMap a -> AdjacencyMap a
removeVertex = (a -> AdjacencyMap a -> AdjacencyMap a)
-> a -> AdjacencyMap a -> AdjacencyMap a
coerce a -> AdjacencyMap a -> AdjacencyMap a
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 :: a -> a -> AdjacencyMap a -> AdjacencyMap a
removeEdge = (a -> a -> AdjacencyMap a -> AdjacencyMap a)
-> a -> a -> AdjacencyMap a -> AdjacencyMap a
coerce a -> a -> AdjacencyMap a -> AdjacencyMap a
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 :: AdjacencyMap a -> AdjacencyMap a
transpose = (AdjacencyMap a -> AdjacencyMap a)
-> AdjacencyMap a -> AdjacencyMap a
coerce AdjacencyMap a -> AdjacencyMap a
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 :: (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
induce = ((a -> Bool) -> AdjacencyMap a -> AdjacencyMap a)
-> (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
coerce (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
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 :: AdjacencyMap (Maybe a) -> AdjacencyMap a
induceJust = (AdjacencyMap (Maybe a) -> AdjacencyMap a)
-> AdjacencyMap (Maybe a) -> AdjacencyMap a
coerce AdjacencyMap (Maybe a) -> AdjacencyMap a
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 :: AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
box = (AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b))
-> AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
coerce AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
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 :: AdjacencyMap a -> AdjacencyMap a
transitiveClosure = (AdjacencyMap a -> AdjacencyMap a)
-> AdjacencyMap a -> AdjacencyMap a
coerce AdjacencyMap a -> AdjacencyMap a
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 :: AdjacencyMap a -> [a]
topSort AdjacencyMap a
g = case AdjacencyMap a -> Either (Cycle a) [a]
forall a. Ord a => AdjacencyMap a -> Either (Cycle a) [a]
AM.topSort (AdjacencyMap a -> AdjacencyMap a
coerce AdjacencyMap a
g) of
    Right [a]
vs -> [a]
vs
    Left Cycle a
_ -> String -> [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 :: AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
scc = (AdjacencyMap a -> AdjacencyMap (AdjacencyMap a))
-> AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
coerce AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
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 :: AdjacencyMap a -> Maybe (AdjacencyMap a)
toAcyclic AdjacencyMap a
x = if AdjacencyMap a -> Bool
forall a. Ord a => AdjacencyMap a -> Bool
AM.isAcyclic AdjacencyMap a
x then AdjacencyMap a -> Maybe (AdjacencyMap a)
forall a. a -> Maybe a
Just (AdjacencyMap a -> AdjacencyMap a
forall a. AdjacencyMap a -> AdjacencyMap a
AAM AdjacencyMap a
x) else Maybe (AdjacencyMap a)
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 :: AdjacencyMap a -> AdjacencyMap a
toAcyclicOrd = AdjacencyMap a -> AdjacencyMap a
forall a. AdjacencyMap a -> AdjacencyMap a
AAM (AdjacencyMap a -> AdjacencyMap a)
-> (AdjacencyMap a -> AdjacencyMap a)
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
forall a.
Ord a =>
(a -> a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
filterEdges a -> a -> Bool
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 :: AdjacencyMap a -> AdjacencyMap a
shrink = AdjacencyMap a -> AdjacencyMap a
forall a. AdjacencyMap a -> AdjacencyMap a
AAM (AdjacencyMap a -> AdjacencyMap a)
-> (AdjacencyMap a -> AdjacencyMap a)
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AdjacencyMap a -> a)
-> AdjacencyMap (AdjacencyMap a) -> AdjacencyMap a
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap (NonEmpty a -> a
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty a -> a)
-> (AdjacencyMap a -> NonEmpty a) -> AdjacencyMap a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> NonEmpty a
forall a. AdjacencyMap a -> NonEmpty a
NAM.vertexList1) (AdjacencyMap (AdjacencyMap a) -> AdjacencyMap a)
-> (AdjacencyMap a -> AdjacencyMap (AdjacencyMap a))
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
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 :: (a -> a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
filterEdges a -> a -> Bool
p AdjacencyMap a
m = [(a, Set a)] -> AdjacencyMap a
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets
    [ (a
a, (a -> Bool) -> Set a -> Set 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) <- Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList (AdjacencyMap a -> Map a (Set a)
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 :: AdjacencyMap a -> Bool
consistent (AAM AdjacencyMap a
m) = AdjacencyMap a -> Bool
forall a. Ord a => AdjacencyMap a -> Bool
AM.consistent AdjacencyMap a
m Bool -> Bool -> Bool
&& AdjacencyMap a -> Bool
forall a. Ord a => AdjacencyMap a -> Bool
AM.isAcyclic AdjacencyMap a
m