-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.AdjacencyIntMap
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- 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 'AdjacencyIntMap' data type and associated functions.
-- See "Algebra.Graph.AdjacencyIntMap.Algorithm" for implementations of basic
-- graph algorithms. 'AdjacencyIntMap' is an instance of the 'C.Graph' type
-- class, which can be used for polymorphic graph construction and manipulation.
-- See "Algebra.Graph.AdjacencyMap" for graphs with non-@Int@ vertices.
-----------------------------------------------------------------------------
module Algebra.Graph.AdjacencyIntMap (
    -- * Data structure
    AdjacencyIntMap, adjacencyIntMap, fromAdjacencyMap,

    -- * Basic graph construction primitives
    empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,

    -- * Relations on graphs
    isSubgraphOf,

    -- * Graph properties
    isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,
    adjacencyList, vertexIntSet, edgeSet, preIntSet, postIntSet,

    -- * Standard families of graphs
    path, circuit, clique, biclique, star, stars, fromAdjacencyIntSets, tree,
    forest,

    -- * Graph transformation
    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap,
    induce,

    -- * Relational operations
    compose, closure, reflexiveClosure, symmetricClosure, transitiveClosure,

    -- * Miscellaneous
    consistent
    ) where

import Control.DeepSeq
import Data.IntMap.Strict (IntMap)
import Data.IntSet (IntSet)
import Data.List ((\\))
import Data.Monoid (Sum (..))
import Data.Set (Set)
import Data.Tree
import GHC.Generics

import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet        as IntSet
import qualified Data.Map.Strict    as Map
import qualified Data.Set           as Set

import qualified Algebra.Graph.AdjacencyMap as AM

{-| The 'AdjacencyIntMap' data type represents a graph by a map of vertices to
their adjacency sets. We define a 'Num' instance as a convenient notation for
working with graphs:

@
0           == 'vertex' 0
1 + 2       == 'overlay' ('vertex' 1) ('vertex' 2)
1 * 2       == 'connect' ('vertex' 1) ('vertex' 2)
1 + 2 * 3   == 'overlay' ('vertex' 1) ('connect' ('vertex' 2) ('vertex' 3))
1 * (2 + 3) == 'connect' ('vertex' 1) ('overlay' ('vertex' 2) ('vertex' 3))
@

__Note:__ the 'Num' instance does not satisfy several "customary laws" of 'Num',
which dictate that 'fromInteger' @0@ and 'fromInteger' @1@ should act as
additive and multiplicative identities, and 'negate' as additive inverse.
Nevertheless, overloading 'fromInteger', '+' and '*' is very convenient when
working with algebraic graphs; we hope that in future Haskell's Prelude will
provide a more fine-grained class hierarchy for algebraic structures, which we
would be able to utilise without violating any laws.

The 'Show' instance is defined using basic graph construction primitives:

@show (empty     :: AdjacencyIntMap Int) == "empty"
show (1         :: AdjacencyIntMap Int) == "vertex 1"
show (1 + 2     :: AdjacencyIntMap Int) == "vertices [1,2]"
show (1 * 2     :: AdjacencyIntMap Int) == "edge 1 2"
show (1 * 2 * 3 :: AdjacencyIntMap Int) == "edges [(1,2),(1,3),(2,3)]"
show (1 * 2 + 3 :: AdjacencyIntMap Int) == "overlay (vertex 3) (edge 1 2)"@

The 'Eq' instance satisfies all axioms of algebraic graphs:

    * 'overlay' is commutative and associative:

        >       x + y == y + x
        > x + (y + z) == (x + y) + z

    * 'connect' is associative and has 'empty' as the identity:

        >   x * empty == x
        >   empty * x == x
        > x * (y * z) == (x * y) * z

    * 'connect' distributes over 'overlay':

        > x * (y + z) == x * y + x * z
        > (x + y) * z == x * z + y * z

    * 'connect' can be decomposed:

        > x * y * z == x * y + x * z + y * z

The following useful theorems can be proved from the above set of axioms.

    * 'overlay' has 'empty' as the identity and is idempotent:

        >   x + empty == x
        >   empty + x == x
        >       x + x == x

    * Absorption and saturation of 'connect':

        > x * y + x + y == x * y
        >     x * x * x == x * x

When specifying the time and memory complexity of graph algorithms, /n/ and /m/
will denote the number of vertices and edges in the graph, respectively.

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.

Here are a few examples:

@'vertex' 1 < 'vertex' 2
'vertex' 3 < 'edge' 1 2
'vertex' 1 < 'edge' 1 1
'edge' 1 1 < 'edge' 1 2
'edge' 1 2 < 'edge' 1 1 + 'edge' 2 2
'edge' 1 2 < 'edge' 1 3@

Note that the resulting order refines the 'isSubgraphOf' relation and is
compatible with 'overlay' and 'connect' operations:

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

@'empty' <= x
x     <= x + y
x + y <= x * y@
-}
newtype AdjacencyIntMap = AM {
    -- | The /adjacency map/ of a graph: each vertex is associated with a set of
    -- its direct successors. Complexity: /O(1)/ time and memory.
    --
    -- @
    -- adjacencyIntMap 'empty'      == IntMap.'IntMap.empty'
    -- adjacencyIntMap ('vertex' x) == IntMap.'IntMap.singleton' x IntSet.'IntSet.empty'
    -- adjacencyIntMap ('edge' 1 1) == IntMap.'IntMap.singleton' 1 (IntSet.'IntSet.singleton' 1)
    -- adjacencyIntMap ('edge' 1 2) == IntMap.'IntMap.fromList' [(1,IntSet.'IntSet.singleton' 2), (2,IntSet.'IntSet.empty')]
    -- @
    AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap :: IntMap IntSet } deriving (AdjacencyIntMap -> AdjacencyIntMap -> Bool
(AdjacencyIntMap -> AdjacencyIntMap -> Bool)
-> (AdjacencyIntMap -> AdjacencyIntMap -> Bool)
-> Eq AdjacencyIntMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdjacencyIntMap -> AdjacencyIntMap -> Bool
$c/= :: AdjacencyIntMap -> AdjacencyIntMap -> Bool
== :: AdjacencyIntMap -> AdjacencyIntMap -> Bool
$c== :: AdjacencyIntMap -> AdjacencyIntMap -> Bool
Eq, (forall x. AdjacencyIntMap -> Rep AdjacencyIntMap x)
-> (forall x. Rep AdjacencyIntMap x -> AdjacencyIntMap)
-> Generic AdjacencyIntMap
forall x. Rep AdjacencyIntMap x -> AdjacencyIntMap
forall x. AdjacencyIntMap -> Rep AdjacencyIntMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AdjacencyIntMap x -> AdjacencyIntMap
$cfrom :: forall x. AdjacencyIntMap -> Rep AdjacencyIntMap x
Generic)

instance Show AdjacencyIntMap where
    showsPrec :: Int -> AdjacencyIntMap -> ShowS
showsPrec Int
p am :: AdjacencyIntMap
am@(AM IntMap IntSet
m)
        | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
vs    = String -> ShowS
showString String
"empty"
        | [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
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
$ [Int] -> ShowS
forall a. Show a => [a] -> ShowS
vshow [Int]
vs
        | [Int]
vs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
used = 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
$ [(Int, Int)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow [(Int, Int)]
es
        | 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
"overlay (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => [a] -> ShowS
vshow ([Int]
vs [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
used) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           String -> ShowS
showString String
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow [(Int, Int)]
es ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
      where
        vs :: [Int]
vs             = AdjacencyIntMap -> [Int]
vertexList AdjacencyIntMap
am
        es :: [(Int, Int)]
es             = AdjacencyIntMap -> [(Int, Int)]
edgeList AdjacencyIntMap
am
        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
        eshow :: [(a, a)] -> ShowS
eshow [(a
x, a
y)] = String -> ShowS
showString String
"edge "     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 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         String -> ShowS
showString String
" "         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
y
        eshow [(a, a)]
xs       = String -> ShowS
showString String
"edges "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
xs
        used :: [Int]
used           = IntSet -> [Int]
IntSet.toAscList (IntMap IntSet -> IntSet
referredToVertexSet IntMap IntSet
m)

instance Ord AdjacencyIntMap where
    compare :: AdjacencyIntMap -> AdjacencyIntMap -> Ordering
compare AdjacencyIntMap
x AdjacencyIntMap
y = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
        [ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyIntMap -> Int
vertexCount  AdjacencyIntMap
x) (AdjacencyIntMap -> Int
vertexCount  AdjacencyIntMap
y)
        , IntSet -> IntSet -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyIntMap -> IntSet
vertexIntSet AdjacencyIntMap
x) (AdjacencyIntMap -> IntSet
vertexIntSet AdjacencyIntMap
y)
        , Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyIntMap -> Int
edgeCount    AdjacencyIntMap
x) (AdjacencyIntMap -> Int
edgeCount    AdjacencyIntMap
y)
        , Set (Int, Int) -> Set (Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyIntMap -> Set (Int, Int)
edgeSet      AdjacencyIntMap
x) (AdjacencyIntMap -> Set (Int, Int)
edgeSet      AdjacencyIntMap
y) ]

-- | __Note:__ this does not satisfy the usual ring laws; see 'AdjacencyIntMap'
-- for more details.
instance Num AdjacencyIntMap where
    fromInteger :: Integer -> AdjacencyIntMap
fromInteger = Int -> AdjacencyIntMap
vertex (Int -> AdjacencyIntMap)
-> (Integer -> Int) -> Integer -> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger
    + :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
(+)         = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
overlay
    * :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
(*)         = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
connect
    signum :: AdjacencyIntMap -> AdjacencyIntMap
signum      = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
forall a b. a -> b -> a
const AdjacencyIntMap
empty
    abs :: AdjacencyIntMap -> AdjacencyIntMap
abs         = AdjacencyIntMap -> AdjacencyIntMap
forall a. a -> a
id
    negate :: AdjacencyIntMap -> AdjacencyIntMap
negate      = AdjacencyIntMap -> AdjacencyIntMap
forall a. a -> a
id

instance NFData AdjacencyIntMap where
    rnf :: AdjacencyIntMap -> ()
rnf (AM IntMap IntSet
a) = IntMap IntSet -> ()
forall a. NFData a => a -> ()
rnf IntMap IntSet
a

-- | Defined via 'overlay'.
instance Semigroup AdjacencyIntMap where
    <> :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
(<>) = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
overlay

-- | Defined via 'overlay' and 'empty'.
instance Monoid AdjacencyIntMap where
    mempty :: AdjacencyIntMap
mempty = AdjacencyIntMap
empty

-- | Construct an 'AdjacencyIntMap' from an 'AM.AdjacencyMap' with vertices of
-- type 'Int'.
-- Complexity: /O(n + m)/ time and memory.
--
-- @
-- fromAdjacencyMap == 'stars' . AdjacencyMap.'AM.adjacencyList'
-- @
fromAdjacencyMap :: AM.AdjacencyMap Int -> AdjacencyIntMap
fromAdjacencyMap :: AdjacencyMap Int -> AdjacencyIntMap
fromAdjacencyMap = IntMap IntSet -> AdjacencyIntMap
AM
                 (IntMap IntSet -> AdjacencyIntMap)
-> (AdjacencyMap Int -> IntMap IntSet)
-> AdjacencyMap Int
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, IntSet)] -> IntMap IntSet
forall a. [(Int, a)] -> IntMap a
IntMap.fromAscList
                 ([(Int, IntSet)] -> IntMap IntSet)
-> (AdjacencyMap Int -> [(Int, IntSet)])
-> AdjacencyMap Int
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Set Int) -> (Int, IntSet))
-> [(Int, Set Int)] -> [(Int, IntSet)]
forall a b. (a -> b) -> [a] -> [b]
map ((Set Int -> IntSet) -> (Int, Set Int) -> (Int, IntSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Set Int -> IntSet) -> (Int, Set Int) -> (Int, IntSet))
-> (Set Int -> IntSet) -> (Int, Set Int) -> (Int, IntSet)
forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
IntSet.fromAscList ([Int] -> IntSet) -> (Set Int -> [Int]) -> Set Int -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Int -> [Int]
forall a. Set a -> [a]
Set.toAscList)
                 ([(Int, Set Int)] -> [(Int, IntSet)])
-> (AdjacencyMap Int -> [(Int, Set Int)])
-> AdjacencyMap Int
-> [(Int, IntSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int (Set Int) -> [(Int, Set Int)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
                 (Map Int (Set Int) -> [(Int, Set Int)])
-> (AdjacencyMap Int -> Map Int (Set Int))
-> AdjacencyMap Int
-> [(Int, Set Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap Int -> Map Int (Set Int)
forall a. AdjacencyMap a -> Map a (Set a)
AM.adjacencyMap

-- | Construct the /empty graph/.
--
-- @
-- 'isEmpty'     empty == True
-- 'hasVertex' x empty == False
-- 'vertexCount' empty == 0
-- 'edgeCount'   empty == 0
-- @
empty :: AdjacencyIntMap
empty :: AdjacencyIntMap
empty = IntMap IntSet -> AdjacencyIntMap
AM IntMap IntSet
forall a. IntMap a
IntMap.empty
{-# NOINLINE [1] 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 :: Int -> AdjacencyIntMap
vertex :: Int -> AdjacencyIntMap
vertex Int
x = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ Int -> IntSet -> IntMap IntSet
forall a. Int -> a -> IntMap a
IntMap.singleton Int
x IntSet
IntSet.empty
{-# NOINLINE [1] vertex #-}

-- | Construct the graph comprising /a single edge/.
--
-- @
-- edge x y               == 'connect' ('vertex' x) ('vertex' y)
-- 'hasEdge' x y (edge x y) == True
-- 'edgeCount'   (edge x y) == 1
-- 'vertexCount' (edge 1 1) == 1
-- 'vertexCount' (edge 1 2) == 2
-- @
edge :: Int -> Int -> AdjacencyIntMap
edge :: Int -> Int -> AdjacencyIntMap
edge Int
x Int
y | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y    = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ Int -> IntSet -> IntMap IntSet
forall a. Int -> a -> IntMap a
IntMap.singleton Int
x (Int -> IntSet
IntSet.singleton Int
y)
         | Bool
otherwise = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ [(Int, IntSet)] -> IntMap IntSet
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int
x, Int -> IntSet
IntSet.singleton Int
y), (Int
y, IntSet
IntSet.empty)]

-- | /Overlay/ two graphs. This is a commutative, associative and idempotent
-- operation with the identity 'empty'.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'vertexCount' (overlay x y) >= 'vertexCount' x
-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y
-- 'edgeCount'   (overlay x y) >= 'edgeCount' x
-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y
-- 'vertexCount' (overlay 1 2) == 2
-- 'edgeCount'   (overlay 1 2) == 0
-- @
overlay :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
overlay :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
overlay (AM IntMap IntSet
x) (AM IntMap IntSet
y) = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ (IntSet -> IntSet -> IntSet)
-> IntMap IntSet -> IntMap IntSet -> IntMap IntSet
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith IntSet -> IntSet -> IntSet
IntSet.union IntMap IntSet
x IntMap IntSet
y
{-# NOINLINE [1] overlay #-}

-- | /Connect/ two graphs. This is an associative operation with the identity
-- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the
-- number of edges in the resulting graph is quadratic with respect to the
-- number of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.
--
-- @
-- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'vertexCount' (connect x y) >= 'vertexCount' x
-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y
-- 'edgeCount'   (connect x y) >= 'edgeCount' x
-- 'edgeCount'   (connect x y) >= 'edgeCount' y
-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y
-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y
-- 'vertexCount' (connect 1 2) == 2
-- 'edgeCount'   (connect 1 2) == 1
-- @
connect :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
connect :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
connect (AM IntMap IntSet
x) (AM IntMap IntSet
y) = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ (IntSet -> IntSet -> IntSet) -> [IntMap IntSet] -> IntMap IntSet
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith IntSet -> IntSet -> IntSet
IntSet.union
    [ IntMap IntSet
x, IntMap IntSet
y, (Int -> IntSet) -> IntSet -> IntMap IntSet
forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (IntSet -> Int -> IntSet
forall a b. a -> b -> a
const (IntSet -> Int -> IntSet) -> IntSet -> Int -> IntSet
forall a b. (a -> b) -> a -> b
$ IntMap IntSet -> IntSet
forall a. IntMap a -> IntSet
IntMap.keysSet IntMap IntSet
y) (IntMap IntSet -> IntSet
forall a. IntMap a -> IntSet
IntMap.keysSet IntMap IntSet
x) ]
{-# NOINLINE [1] connect #-}

-- | 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
-- vertices                == 'overlays' . map 'vertex'
-- 'hasVertex' x  . vertices == 'elem' x
-- 'vertexCount'  . vertices == 'length' . 'Data.List.nub'
-- 'vertexIntSet' . vertices == IntSet.'IntSet.fromList'
-- @
vertices :: [Int] -> AdjacencyIntMap
vertices :: [Int] -> AdjacencyIntMap
vertices = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> ([Int] -> IntMap IntSet) -> [Int] -> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, IntSet)] -> IntMap IntSet
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, IntSet)] -> IntMap IntSet)
-> ([Int] -> [(Int, IntSet)]) -> [Int] -> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Int, IntSet)) -> [Int] -> [(Int, IntSet)]
forall a b. (a -> b) -> [a] -> [b]
map (, IntSet
IntSet.empty)
{-# NOINLINE [1] vertices #-}

-- | Construct the graph from a list of edges.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- edges []          == 'empty'
-- edges [(x,y)]     == 'edge' x y
-- edges             == 'overlays' . 'map' ('uncurry' 'edge')
-- 'edgeCount' . edges == 'length' . 'Data.List.nub'
-- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'
-- @
edges :: [(Int, Int)] -> AdjacencyIntMap
edges :: [(Int, Int)] -> AdjacencyIntMap
edges = [(Int, IntSet)] -> AdjacencyIntMap
fromAdjacencyIntSets ([(Int, IntSet)] -> AdjacencyIntMap)
-> ([(Int, Int)] -> [(Int, IntSet)])
-> [(Int, Int)]
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, IntSet)) -> [(Int, Int)] -> [(Int, IntSet)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> IntSet) -> (Int, Int) -> (Int, IntSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> IntSet
IntSet.singleton)

-- | Overlay a given list of graphs.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- overlays []        == 'empty'
-- overlays [x]       == x
-- overlays [x,y]     == 'overlay' x y
-- overlays           == 'foldr' 'overlay' 'empty'
-- 'isEmpty' . overlays == 'all' 'isEmpty'
-- @
overlays :: [AdjacencyIntMap] -> AdjacencyIntMap
overlays :: [AdjacencyIntMap] -> AdjacencyIntMap
overlays = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> ([AdjacencyIntMap] -> IntMap IntSet)
-> [AdjacencyIntMap]
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet -> IntSet) -> [IntMap IntSet] -> IntMap IntSet
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith IntSet -> IntSet -> IntSet
IntSet.union ([IntMap IntSet] -> IntMap IntSet)
-> ([AdjacencyIntMap] -> [IntMap IntSet])
-> [AdjacencyIntMap]
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AdjacencyIntMap -> IntMap IntSet)
-> [AdjacencyIntMap] -> [IntMap IntSet]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap
{-# NOINLINE [1] overlays #-}

-- | Connect a given list of graphs.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- connects []        == 'empty'
-- connects [x]       == x
-- connects [x,y]     == 'connect' x y
-- connects           == 'foldr' 'connect' 'empty'
-- 'isEmpty' . connects == 'all' 'isEmpty'
-- @
connects :: [AdjacencyIntMap] -> AdjacencyIntMap
connects :: [AdjacencyIntMap] -> AdjacencyIntMap
connects  = (AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap)
-> AdjacencyIntMap -> [AdjacencyIntMap] -> AdjacencyIntMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
connect AdjacencyIntMap
empty
{-# NOINLINE [1] connects #-}

-- | 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 x             ('overlay' x y) ==  True
-- isSubgraphOf ('overlay' x y) ('connect' x y) ==  True
-- isSubgraphOf ('path' xs)     ('circuit' xs)  ==  True
-- isSubgraphOf x y                         ==> x <= y
-- @
isSubgraphOf :: AdjacencyIntMap -> AdjacencyIntMap -> Bool
isSubgraphOf :: AdjacencyIntMap -> AdjacencyIntMap -> Bool
isSubgraphOf (AM IntMap IntSet
x) (AM IntMap IntSet
y) = (IntSet -> IntSet -> Bool)
-> IntMap IntSet -> IntMap IntSet -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
IntMap.isSubmapOfBy IntSet -> IntSet -> Bool
IntSet.isSubsetOf IntMap IntSet
x IntMap IntSet
y

-- | Check if a graph is empty.
-- Complexity: /O(1)/ time.
--
-- @
-- isEmpty 'empty'                       == True
-- isEmpty ('overlay' 'empty' 'empty')       == True
-- isEmpty ('vertex' x)                  == False
-- isEmpty ('removeVertex' x $ 'vertex' x) == True
-- isEmpty ('removeEdge' x y $ 'edge' x y) == False
-- @
isEmpty :: AdjacencyIntMap -> Bool
isEmpty :: AdjacencyIntMap -> Bool
isEmpty = IntMap IntSet -> Bool
forall a. IntMap a -> Bool
IntMap.null (IntMap IntSet -> Bool)
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | 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 :: Int -> AdjacencyIntMap -> Bool
hasVertex :: Int -> AdjacencyIntMap -> Bool
hasVertex Int
x = Int -> IntMap IntSet -> Bool
forall a. Int -> IntMap a -> Bool
IntMap.member Int
x (IntMap IntSet -> Bool)
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | 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 x y ('edge' x y)       == True
-- hasEdge x y . 'removeEdge' x y == 'const' False
-- hasEdge x y                  == 'elem' (x,y) . 'edgeList'
-- @
hasEdge :: Int -> Int -> AdjacencyIntMap -> Bool
hasEdge :: Int -> Int -> AdjacencyIntMap -> Bool
hasEdge Int
u Int
v (AM IntMap IntSet
m) = case Int -> IntMap IntSet -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
u IntMap IntSet
m of
    Maybe IntSet
Nothing -> Bool
False
    Just IntSet
vs -> Int -> IntSet -> Bool
IntSet.member Int
v IntSet
vs

-- | 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 :: AdjacencyIntMap -> Int
vertexCount :: AdjacencyIntMap -> Int
vertexCount = IntMap IntSet -> Int
forall a. IntMap a -> Int
IntMap.size (IntMap IntSet -> Int)
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | The number of edges in a graph.
-- Complexity: /O(n)/ time.
--
-- @
-- edgeCount 'empty'      == 0
-- edgeCount ('vertex' x) == 0
-- edgeCount ('edge' x y) == 1
-- edgeCount            == 'length' . 'edgeList'
-- @
edgeCount :: AdjacencyIntMap -> Int
edgeCount :: AdjacencyIntMap -> Int
edgeCount = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int)
-> (AdjacencyIntMap -> Sum Int) -> AdjacencyIntMap -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> Sum Int) -> IntMap IntSet -> Sum Int
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (IntSet -> Int) -> IntSet -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Int
IntSet.size) (IntMap IntSet -> Sum Int)
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | 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 :: AdjacencyIntMap -> [Int]
vertexList :: AdjacencyIntMap -> [Int]
vertexList = IntMap IntSet -> [Int]
forall a. IntMap a -> [Int]
IntMap.keys (IntMap IntSet -> [Int])
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | The sorted list of edges of a graph.
-- Complexity: /O(n + m)/ time and /O(m)/ memory.
--
-- @
-- edgeList 'empty'          == []
-- edgeList ('vertex' x)     == []
-- edgeList ('edge' x y)     == [(x,y)]
-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]
-- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'
-- edgeList . 'transpose'    == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . edgeList
-- @
edgeList :: AdjacencyIntMap -> [(Int, Int)]
edgeList :: AdjacencyIntMap -> [(Int, Int)]
edgeList (AM IntMap IntSet
m) = [ (Int
x, Int
y) | (Int
x, IntSet
ys) <- IntMap IntSet -> [(Int, IntSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap IntSet
m, Int
y <- IntSet -> [Int]
IntSet.toAscList IntSet
ys ]
{-# INLINE edgeList #-}

-- | The set of vertices of a given graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexIntSet 'empty'      == IntSet.'IntSet.empty'
-- vertexIntSet . 'vertex'   == IntSet.'IntSet.singleton'
-- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'
-- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList'
-- @
vertexIntSet :: AdjacencyIntMap -> IntSet
vertexIntSet :: AdjacencyIntMap -> IntSet
vertexIntSet = IntMap IntSet -> IntSet
forall a. IntMap a -> IntSet
IntMap.keysSet (IntMap IntSet -> IntSet)
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | 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 ('edge' x y) == Set.'Set.singleton' (x,y)
-- edgeSet . 'edges'    == Set.'Set.fromList'
-- @
edgeSet :: AdjacencyIntMap -> Set (Int, Int)
edgeSet :: AdjacencyIntMap -> Set (Int, Int)
edgeSet = [(Int, Int)] -> Set (Int, Int)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(Int, Int)] -> Set (Int, Int))
-> (AdjacencyIntMap -> [(Int, Int)])
-> AdjacencyIntMap
-> Set (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> [(Int, Int)]
edgeList

-- | The sorted /adjacency list/ of a graph.
-- Complexity: /O(n + m)/ time and memory.
--
-- @
-- adjacencyList 'empty'          == []
-- adjacencyList ('vertex' x)     == [(x, [])]
-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]
-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]
-- 'stars' . adjacencyList        == id
-- @
adjacencyList :: AdjacencyIntMap -> [(Int, [Int])]
adjacencyList :: AdjacencyIntMap -> [(Int, [Int])]
adjacencyList = ((Int, IntSet) -> (Int, [Int]))
-> [(Int, IntSet)] -> [(Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map ((IntSet -> [Int]) -> (Int, IntSet) -> (Int, [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntSet -> [Int]
IntSet.toAscList) ([(Int, IntSet)] -> [(Int, [Int])])
-> (AdjacencyIntMap -> [(Int, IntSet)])
-> AdjacencyIntMap
-> [(Int, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap IntSet -> [(Int, IntSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList (IntMap IntSet -> [(Int, IntSet)])
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> [(Int, IntSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | The /preset/ (here @preIntSet@) of an element @x@ is the set of its
-- /direct predecessors/.
-- Complexity: /O(n * log(n))/ time and /O(n)/ memory.
--
-- @
-- preIntSet x 'empty'      == Set.'Set.empty'
-- preIntSet x ('vertex' x) == Set.'Set.empty'
-- preIntSet 1 ('edge' 1 2) == Set.'Set.empty'
-- preIntSet y ('edge' x y) == Set.'Set.fromList' [x]
-- @
preIntSet :: Int -> AdjacencyIntMap -> IntSet.IntSet
preIntSet :: Int -> AdjacencyIntMap -> IntSet
preIntSet Int
x = [Int] -> IntSet
IntSet.fromAscList ([Int] -> IntSet)
-> (AdjacencyIntMap -> [Int]) -> AdjacencyIntMap -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, IntSet) -> Int) -> [(Int, IntSet)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, IntSet) -> Int
forall a b. (a, b) -> a
fst ([(Int, IntSet)] -> [Int])
-> (AdjacencyIntMap -> [(Int, IntSet)]) -> AdjacencyIntMap -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, IntSet) -> Bool) -> [(Int, IntSet)] -> [(Int, IntSet)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, IntSet) -> Bool
p  ([(Int, IntSet)] -> [(Int, IntSet)])
-> (AdjacencyIntMap -> [(Int, IntSet)])
-> AdjacencyIntMap
-> [(Int, IntSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap IntSet -> [(Int, IntSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList (IntMap IntSet -> [(Int, IntSet)])
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> [(Int, IntSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap
  where
    p :: (Int, IntSet) -> Bool
p (Int
_, IntSet
set) = Int
x Int -> IntSet -> Bool
`IntSet.member` IntSet
set

-- | The /postset/ (here @postIntSet@) of a vertex is the set of its
-- /direct successors/.
--
-- @
-- postIntSet x 'empty'      == IntSet.'IntSet.empty'
-- postIntSet x ('vertex' x) == IntSet.'IntSet.empty'
-- postIntSet x ('edge' x y) == IntSet.'IntSet.fromList' [y]
-- postIntSet 2 ('edge' 1 2) == IntSet.'IntSet.empty'
-- @
postIntSet :: Int -> AdjacencyIntMap -> IntSet
postIntSet :: Int -> AdjacencyIntMap -> IntSet
postIntSet Int
x = IntSet -> Int -> IntMap IntSet -> IntSet
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault IntSet
IntSet.empty Int
x (IntMap IntSet -> IntSet)
-> (AdjacencyIntMap -> IntMap IntSet) -> AdjacencyIntMap -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | The /path/ on a list of vertices.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- path []        == 'empty'
-- path [x]       == 'vertex' x
-- path [x,y]     == 'edge' x y
-- path . 'reverse' == 'transpose' . path
-- @
path :: [Int] -> AdjacencyIntMap
path :: [Int] -> AdjacencyIntMap
path [Int]
xs = case [Int]
xs of []     -> AdjacencyIntMap
empty
                     [Int
x]    -> Int -> AdjacencyIntMap
vertex Int
x
                     (Int
_:[Int]
ys) -> [(Int, Int)] -> AdjacencyIntMap
edges ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [Int]
ys)

-- | The /circuit/ on a list of vertices.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- circuit []        == 'empty'
-- circuit [x]       == 'edge' x x
-- circuit [x,y]     == 'edges' [(x,y), (y,x)]
-- circuit . 'reverse' == 'transpose' . circuit
-- @
circuit :: [Int] -> AdjacencyIntMap
circuit :: [Int] -> AdjacencyIntMap
circuit []     = AdjacencyIntMap
empty
circuit (Int
x:[Int]
xs) = [Int] -> AdjacencyIntMap
path ([Int] -> AdjacencyIntMap) -> [Int] -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ [Int
x] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
x]

-- | The /clique/ on a list of vertices.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- clique []         == 'empty'
-- clique [x]        == 'vertex' x
-- clique [x,y]      == 'edge' x y
-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]
-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)
-- clique . 'reverse'  == 'transpose' . clique
-- @
clique :: [Int] -> AdjacencyIntMap
clique :: [Int] -> AdjacencyIntMap
clique = [(Int, IntSet)] -> AdjacencyIntMap
fromAdjacencyIntSets ([(Int, IntSet)] -> AdjacencyIntMap)
-> ([Int] -> [(Int, IntSet)]) -> [Int] -> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, IntSet)], IntSet) -> [(Int, IntSet)]
forall a b. (a, b) -> a
fst (([(Int, IntSet)], IntSet) -> [(Int, IntSet)])
-> ([Int] -> ([(Int, IntSet)], IntSet)) -> [Int] -> [(Int, IntSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ([(Int, IntSet)], IntSet)
go
  where
    go :: [Int] -> ([(Int, IntSet)], IntSet)
go []     = ([], IntSet
IntSet.empty)
    go (Int
x:[Int]
xs) = let ([(Int, IntSet)]
res, IntSet
set) = [Int] -> ([(Int, IntSet)], IntSet)
go [Int]
xs in ((Int
x, IntSet
set) (Int, IntSet) -> [(Int, IntSet)] -> [(Int, IntSet)]
forall a. a -> [a] -> [a]
: [(Int, IntSet)]
res, Int -> IntSet -> IntSet
IntSet.insert Int
x IntSet
set)
{-# NOINLINE [1] clique #-}

-- | The /biclique/ on two lists of vertices.
-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.
--
-- @
-- biclique []      []      == 'empty'
-- biclique [x]     []      == 'vertex' x
-- biclique []      [y]     == 'vertex' y
-- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]
-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys)
-- @
biclique :: [Int] -> [Int] -> AdjacencyIntMap
biclique :: [Int] -> [Int] -> AdjacencyIntMap
biclique [Int]
xs [Int]
ys = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ (Int -> IntSet) -> IntSet -> IntMap IntSet
forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet Int -> IntSet
adjacent (IntSet
x IntSet -> IntSet -> IntSet
`IntSet.union` IntSet
y)
  where
    x :: IntSet
x = [Int] -> IntSet
IntSet.fromList [Int]
xs
    y :: IntSet
y = [Int] -> IntSet
IntSet.fromList [Int]
ys
    adjacent :: Int -> IntSet
adjacent Int
v = if Int
v Int -> IntSet -> Bool
`IntSet.member` IntSet
x then IntSet
y else IntSet
IntSet.empty

-- TODO: Optimise.
-- | The /star/ formed by a centre vertex connected to a list of leaves.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- star x []    == 'vertex' x
-- star x [y]   == 'edge' x y
-- star x [y,z] == 'edges' [(x,y), (x,z)]
-- star x ys    == 'connect' ('vertex' x) ('vertices' ys)
-- @
star :: Int -> [Int] -> AdjacencyIntMap
star :: Int -> [Int] -> AdjacencyIntMap
star Int
x [] = Int -> AdjacencyIntMap
vertex Int
x
star Int
x [Int]
ys = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
connect (Int -> AdjacencyIntMap
vertex Int
x) ([Int] -> AdjacencyIntMap
vertices [Int]
ys)
{-# INLINE star #-}

-- | The /stars/ formed by overlaying a list of 'star's. An inverse of
-- 'adjacencyList'.
-- Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total
-- size of the input.
--
-- @
-- stars []                      == 'empty'
-- stars [(x, [])]               == 'vertex' x
-- stars [(x, [y])]              == 'edge' x y
-- stars [(x, ys)]               == 'star' x ys
-- stars                         == 'overlays' . 'map' ('uncurry' 'star')
-- stars . 'adjacencyList'         == id
-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)
-- @
stars :: [(Int, [Int])] -> AdjacencyIntMap
stars :: [(Int, [Int])] -> AdjacencyIntMap
stars = [(Int, IntSet)] -> AdjacencyIntMap
fromAdjacencyIntSets ([(Int, IntSet)] -> AdjacencyIntMap)
-> ([(Int, [Int])] -> [(Int, IntSet)])
-> [(Int, [Int])]
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Int]) -> (Int, IntSet))
-> [(Int, [Int])] -> [(Int, IntSet)]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> IntSet) -> (Int, [Int]) -> (Int, IntSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> IntSet
IntSet.fromList)

-- | Construct a graph from a list of adjacency sets; a variation of 'stars'.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- fromAdjacencyIntSets []                                     == 'empty'
-- fromAdjacencyIntSets [(x, IntSet.'IntSet.empty')]                    == 'vertex' x
-- fromAdjacencyIntSets [(x, IntSet.'IntSet.singleton' y)]              == 'edge' x y
-- fromAdjacencyIntSets . 'map' ('fmap' IntSet.'IntSet.fromList')           == 'stars'
-- 'overlay' (fromAdjacencyIntSets xs) (fromAdjacencyIntSets ys) == fromAdjacencyIntSets (xs ++ ys)
-- @
fromAdjacencyIntSets :: [(Int, IntSet)] -> AdjacencyIntMap
fromAdjacencyIntSets :: [(Int, IntSet)] -> AdjacencyIntMap
fromAdjacencyIntSets [(Int, IntSet)]
ss = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ (IntSet -> IntSet -> IntSet)
-> IntMap IntSet -> IntMap IntSet -> IntMap IntSet
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith IntSet -> IntSet -> IntSet
IntSet.union IntMap IntSet
vs IntMap IntSet
es
  where
    vs :: IntMap IntSet
vs = (Int -> IntSet) -> IntSet -> IntMap IntSet
forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (IntSet -> Int -> IntSet
forall a b. a -> b -> a
const IntSet
IntSet.empty) (IntSet -> IntMap IntSet)
-> ([IntSet] -> IntSet) -> [IntSet] -> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions ([IntSet] -> IntMap IntSet) -> [IntSet] -> IntMap IntSet
forall a b. (a -> b) -> a -> b
$ ((Int, IntSet) -> IntSet) -> [(Int, IntSet)] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd [(Int, IntSet)]
ss
    es :: IntMap IntSet
es = (IntSet -> IntSet -> IntSet) -> [(Int, IntSet)] -> IntMap IntSet
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith IntSet -> IntSet -> IntSet
IntSet.union [(Int, IntSet)]
ss

-- | The /tree graph/ constructed from a given 'Tree' data structure.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- tree (Node x [])                                         == 'vertex' x
-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]
-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]
-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]
-- @
tree :: Tree Int -> AdjacencyIntMap
tree :: Tree Int -> AdjacencyIntMap
tree (Node Int
x []) = Int -> AdjacencyIntMap
vertex Int
x
tree (Node Int
x [Tree Int]
f ) = Int -> [Int] -> AdjacencyIntMap
star Int
x ((Tree Int -> Int) -> [Tree Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Tree Int -> Int
forall a. Tree a -> a
rootLabel [Tree Int]
f)
    AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
`overlay` [Tree Int] -> AdjacencyIntMap
forest ((Tree Int -> Bool) -> [Tree Int] -> [Tree Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tree Int -> Bool) -> Tree Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree Int] -> Bool)
-> (Tree Int -> [Tree Int]) -> Tree Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Int -> [Tree Int]
forall a. Tree a -> Forest a
subForest) [Tree Int]
f)

-- | The /forest graph/ constructed from a given 'Forest' data structure.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- forest []                                                  == 'empty'
-- forest [x]                                                 == 'tree' x
-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]
-- forest                                                     == 'overlays' . 'map' 'tree'
-- @
forest :: Forest Int -> AdjacencyIntMap
forest :: [Tree Int] -> AdjacencyIntMap
forest = [AdjacencyIntMap] -> AdjacencyIntMap
overlays ([AdjacencyIntMap] -> AdjacencyIntMap)
-> ([Tree Int] -> [AdjacencyIntMap])
-> [Tree Int]
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree Int -> AdjacencyIntMap) -> [Tree Int] -> [AdjacencyIntMap]
forall a b. (a -> b) -> [a] -> [b]
map Tree Int -> AdjacencyIntMap
tree

-- | Remove a vertex from a given graph.
-- Complexity: /O(n*log(n))/ time.
--
-- @
-- removeVertex x ('vertex' x)       == 'empty'
-- removeVertex 1 ('vertex' 2)       == 'vertex' 2
-- removeVertex x ('edge' x x)       == 'empty'
-- removeVertex 1 ('edge' 1 2)       == 'vertex' 2
-- removeVertex x . removeVertex x == removeVertex x
-- @
removeVertex :: Int -> AdjacencyIntMap -> AdjacencyIntMap
removeVertex :: Int -> AdjacencyIntMap -> AdjacencyIntMap
removeVertex Int
x = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet) -> IntMap IntSet -> IntMap IntSet
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (Int -> IntSet -> IntSet
IntSet.delete Int
x) (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntMap IntSet -> IntMap IntSet
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
x (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | Remove an edge from a given graph.
-- Complexity: /O(log(n))/ time.
--
-- @
-- removeEdge x y ('edge' x y)       == 'vertices' [x,y]
-- removeEdge x y . removeEdge x y == removeEdge x y
-- removeEdge x y . 'removeVertex' x == 'removeVertex' x
-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2
-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2
-- @
removeEdge :: Int -> Int -> AdjacencyIntMap -> AdjacencyIntMap
removeEdge :: Int -> Int -> AdjacencyIntMap -> AdjacencyIntMap
removeEdge Int
x Int
y = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet) -> Int -> IntMap IntSet -> IntMap IntSet
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IntMap.adjust (Int -> IntSet -> IntSet
IntSet.delete Int
y) Int
x (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a
-- given 'AdjacencyIntMap'. If @y@ already exists, @x@ and @y@ will be merged.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- replaceVertex x x            == id
-- replaceVertex x y ('vertex' x) == 'vertex' y
-- replaceVertex x y            == 'mergeVertices' (== x) y
-- @
replaceVertex :: Int -> Int -> AdjacencyIntMap -> AdjacencyIntMap
replaceVertex :: Int -> Int -> AdjacencyIntMap -> AdjacencyIntMap
replaceVertex Int
u Int
v = (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap
gmap ((Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap)
-> (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ \Int
w -> if Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
u then Int
v else Int
w

-- | Merge vertices satisfying a given predicate into a given vertex.
-- Complexity: /O((n + m) * log(n))/ time, assuming that the predicate takes
-- constant time.
--
-- @
-- mergeVertices ('const' False) x    == id
-- mergeVertices (== x) y           == 'replaceVertex' x y
-- mergeVertices 'even' 1 (0 * 2)     == 1 * 1
-- mergeVertices 'odd'  1 (3 + 4 * 5) == 4 * 1
-- @
mergeVertices :: (Int -> Bool) -> Int -> AdjacencyIntMap -> AdjacencyIntMap
mergeVertices :: (Int -> Bool) -> Int -> AdjacencyIntMap -> AdjacencyIntMap
mergeVertices Int -> Bool
p Int
v = (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap
gmap ((Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap)
-> (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ \Int
u -> if Int -> Bool
p Int
u then Int
v else Int
u

-- | Transpose a given graph.
-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.
--
-- @
-- transpose 'empty'       == 'empty'
-- transpose ('vertex' x)  == 'vertex' x
-- transpose ('edge' x y)  == 'edge' y x
-- transpose . transpose == id
-- 'edgeList' . transpose  == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . 'edgeList'
-- @
transpose :: AdjacencyIntMap -> AdjacencyIntMap
transpose :: AdjacencyIntMap -> AdjacencyIntMap
transpose (AM IntMap IntSet
m) = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ (Int -> IntSet -> IntMap IntSet -> IntMap IntSet)
-> IntMap IntSet -> IntMap IntSet -> IntMap IntSet
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey Int -> IntSet -> IntMap IntSet -> IntMap IntSet
combine IntMap IntSet
vs IntMap IntSet
m
  where
    combine :: Int -> IntSet -> IntMap IntSet -> IntMap IntSet
combine Int
v IntSet
es = (IntSet -> IntSet -> IntSet)
-> IntMap IntSet -> IntMap IntSet -> IntMap IntSet
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith IntSet -> IntSet -> IntSet
IntSet.union ((Int -> IntSet) -> IntSet -> IntMap IntSet
forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (IntSet -> Int -> IntSet
forall a b. a -> b -> a
const (IntSet -> Int -> IntSet) -> IntSet -> Int -> IntSet
forall a b. (a -> b) -> a -> b
$ Int -> IntSet
IntSet.singleton Int
v) IntSet
es)
    vs :: IntMap IntSet
vs           = (Int -> IntSet) -> IntSet -> IntMap IntSet
forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (IntSet -> Int -> IntSet
forall a b. a -> b -> a
const IntSet
IntSet.empty) (IntMap IntSet -> IntSet
forall a. IntMap a -> IntSet
IntMap.keysSet IntMap IntSet
m)
{-# NOINLINE [1] transpose #-}

{-# RULES
"transpose/empty"    transpose empty = empty
"transpose/vertex"   forall x. transpose (vertex x) = vertex x
"transpose/overlay"  forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2)
"transpose/connect"  forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1)

"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs)
"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs))

"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs
"transpose/clique"   forall xs. transpose (clique xs)   = clique (reverse xs)
 #-}

-- | Transform a graph by applying a function to each of its vertices. This is
-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric
-- 'AdjacencyIntMap'.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- gmap f 'empty'      == 'empty'
-- gmap f ('vertex' x) == 'vertex' (f x)
-- gmap f ('edge' x y) == 'edge' (f x) (f y)
-- gmap id           == id
-- gmap f . gmap g   == gmap (f . g)
-- @
gmap :: (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap
gmap :: (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap
gmap Int -> Int
f = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet) -> IntMap IntSet -> IntMap IntSet
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map ((Int -> Int) -> IntSet -> IntSet
IntSet.map Int -> Int
f) (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet -> IntSet)
-> (Int -> Int) -> IntMap IntSet -> IntMap IntSet
forall a. (a -> a -> a) -> (Int -> Int) -> IntMap a -> IntMap a
IntMap.mapKeysWith IntSet -> IntSet -> IntSet
IntSet.union Int -> Int
f (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | 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 :: (Int -> Bool) -> AdjacencyIntMap -> AdjacencyIntMap
induce :: (Int -> Bool) -> AdjacencyIntMap -> AdjacencyIntMap
induce Int -> Bool
p = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet) -> IntMap IntSet -> IntMap IntSet
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map ((Int -> Bool) -> IntSet -> IntSet
IntSet.filter Int -> Bool
p) (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IntSet -> Bool) -> IntMap IntSet -> IntMap IntSet
forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IntMap.filterWithKey (\Int
k IntSet
_ -> Int -> Bool
p Int
k) (IntMap IntSet -> IntMap IntSet)
-> (AdjacencyIntMap -> IntMap IntSet)
-> AdjacencyIntMap
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> IntMap IntSet
adjacencyIntMap

-- | Left-to-right /relational composition/ of graphs: vertices @x@ and @z@ are
-- connected in the resulting graph if there is a vertex @y@, such that @x@ is
-- connected to @y@ in the first graph, and @y@ is connected to @z@ in the
-- second graph. There are no isolated vertices in the result. This operation is
-- associative, has 'empty' and single-'vertex' graphs as /annihilating zeroes/,
-- and distributes over 'overlay'.
-- Complexity: /O(n * m * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- compose 'empty'            x                == 'empty'
-- compose x                'empty'            == 'empty'
-- compose ('vertex' x)       y                == 'empty'
-- compose x                ('vertex' y)       == 'empty'
-- compose x                (compose y z)    == compose (compose x y) z
-- compose x                ('overlay' y z)    == 'overlay' (compose x y) (compose x z)
-- compose ('overlay' x y)    z                == 'overlay' (compose x z) (compose y z)
-- compose ('edge' x y)       ('edge' y z)       == 'edge' x z
-- compose ('path'    [1..5]) ('path'    [1..5]) == 'edges' [(1,3), (2,4), (3,5)]
-- compose ('circuit' [1..5]) ('circuit' [1..5]) == 'circuit' [1,3,5,2,4]
-- @
compose :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
compose :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
compose AdjacencyIntMap
x AdjacencyIntMap
y = [(Int, IntSet)] -> AdjacencyIntMap
fromAdjacencyIntSets
    [ (Int
t, IntSet
ys) | Int
v <- IntSet -> [Int]
IntSet.toList IntSet
vs, let ys :: IntSet
ys = Int -> AdjacencyIntMap -> IntSet
postIntSet Int
v AdjacencyIntMap
y
              , Bool -> Bool
not (IntSet -> Bool
IntSet.null IntSet
ys), Int
t <- IntSet -> [Int]
IntSet.toList (Int -> AdjacencyIntMap -> IntSet
postIntSet Int
v AdjacencyIntMap
tx) ]
  where
    tx :: AdjacencyIntMap
tx = AdjacencyIntMap -> AdjacencyIntMap
transpose AdjacencyIntMap
x
    vs :: IntSet
vs = AdjacencyIntMap -> IntSet
vertexIntSet AdjacencyIntMap
x IntSet -> IntSet -> IntSet
`IntSet.union` AdjacencyIntMap -> IntSet
vertexIntSet AdjacencyIntMap
y

-- | Compute the /reflexive and transitive closure/ of a graph.
-- Complexity: /O(n * m * log(n)^2)/ time.
--
-- @
-- closure 'empty'            == 'empty'
-- closure ('vertex' x)       == 'edge' x x
-- closure ('edge' x x)       == 'edge' x x
-- closure ('edge' x y)       == 'edges' [(x,x), (x,y), (y,y)]
-- closure ('path' $ 'Data.List.nub' xs) == 'reflexiveClosure' ('clique' $ 'Data.List.nub' xs)
-- closure                  == 'reflexiveClosure' . 'transitiveClosure'
-- closure                  == 'transitiveClosure' . 'reflexiveClosure'
-- closure . closure        == closure
-- 'postIntSet' x (closure y) == IntSet.'IntSet.fromList' ('Algebra.Graph.ToGraph.reachable' y x)
-- @
closure :: AdjacencyIntMap -> AdjacencyIntMap
closure :: AdjacencyIntMap -> AdjacencyIntMap
closure = AdjacencyIntMap -> AdjacencyIntMap
reflexiveClosure (AdjacencyIntMap -> AdjacencyIntMap)
-> (AdjacencyIntMap -> AdjacencyIntMap)
-> AdjacencyIntMap
-> AdjacencyIntMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyIntMap -> AdjacencyIntMap
transitiveClosure

-- | Compute the /reflexive closure/ of a graph by adding a self-loop to every
-- vertex.
-- Complexity: /O(n * log(n))/ time.
--
-- @
-- reflexiveClosure 'empty'              == 'empty'
-- reflexiveClosure ('vertex' x)         == 'edge' x x
-- reflexiveClosure ('edge' x x)         == 'edge' x x
-- reflexiveClosure ('edge' x y)         == 'edges' [(x,x), (x,y), (y,y)]
-- reflexiveClosure . reflexiveClosure == reflexiveClosure
-- @
reflexiveClosure :: AdjacencyIntMap -> AdjacencyIntMap
reflexiveClosure :: AdjacencyIntMap -> AdjacencyIntMap
reflexiveClosure (AM IntMap IntSet
m) = IntMap IntSet -> AdjacencyIntMap
AM (IntMap IntSet -> AdjacencyIntMap)
-> IntMap IntSet -> AdjacencyIntMap
forall a b. (a -> b) -> a -> b
$ (Int -> IntSet -> IntSet) -> IntMap IntSet -> IntMap IntSet
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> IntSet -> IntSet
IntSet.insert IntMap IntSet
m

-- | Compute the /symmetric closure/ of a graph by overlaying it with its own
-- transpose.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- symmetricClosure 'empty'              == 'empty'
-- symmetricClosure ('vertex' x)         == 'vertex' x
-- symmetricClosure ('edge' x y)         == 'edges' [(x,y), (y,x)]
-- symmetricClosure x                  == 'overlay' x ('transpose' x)
-- symmetricClosure . symmetricClosure == symmetricClosure
-- @
symmetricClosure :: AdjacencyIntMap -> AdjacencyIntMap
symmetricClosure :: AdjacencyIntMap -> AdjacencyIntMap
symmetricClosure AdjacencyIntMap
m = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
overlay AdjacencyIntMap
m (AdjacencyIntMap -> AdjacencyIntMap
transpose AdjacencyIntMap
m)

-- | Compute the /transitive closure/ of a graph.
-- Complexity: /O(n * m * log(n)^2)/ time.
--
-- @
-- transitiveClosure 'empty'               == 'empty'
-- transitiveClosure ('vertex' x)          == 'vertex' x
-- transitiveClosure ('edge' x y)          == 'edge' x y
-- transitiveClosure ('path' $ 'Data.List.nub' xs)     == 'clique' ('Data.List.nub' xs)
-- transitiveClosure . transitiveClosure == transitiveClosure
-- @
transitiveClosure :: AdjacencyIntMap -> AdjacencyIntMap
transitiveClosure :: AdjacencyIntMap -> AdjacencyIntMap
transitiveClosure AdjacencyIntMap
old
    | AdjacencyIntMap
old AdjacencyIntMap -> AdjacencyIntMap -> Bool
forall a. Eq a => a -> a -> Bool
== AdjacencyIntMap
new = AdjacencyIntMap
old
    | Bool
otherwise  = AdjacencyIntMap -> AdjacencyIntMap
transitiveClosure AdjacencyIntMap
new
  where
    new :: AdjacencyIntMap
new = AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
overlay AdjacencyIntMap
old (AdjacencyIntMap
old AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap
`compose` AdjacencyIntMap
old)

-- | Check that the internal graph representation is consistent, i.e. that all
-- edges refer to existing vertices. It should be impossible to create an
-- inconsistent adjacency map, and we use this function in testing.
--
-- @
-- consistent 'empty'         == True
-- consistent ('vertex' x)    == True
-- consistent ('overlay' x y) == True
-- consistent ('connect' x y) == True
-- consistent ('edge' x y)    == True
-- consistent ('edges' xs)    == True
-- consistent ('stars' xs)    == True
-- @
consistent :: AdjacencyIntMap -> Bool
consistent :: AdjacencyIntMap -> Bool
consistent (AM IntMap IntSet
m) = IntMap IntSet -> IntSet
referredToVertexSet IntMap IntSet
m IntSet -> IntSet -> Bool
`IntSet.isSubsetOf` IntMap IntSet -> IntSet
forall a. IntMap a -> IntSet
IntMap.keysSet IntMap IntSet
m

-- The set of vertices that are referred to by the edges
referredToVertexSet :: IntMap IntSet -> IntSet
referredToVertexSet :: IntMap IntSet -> IntSet
referredToVertexSet IntMap IntSet
m = [Int] -> IntSet
IntSet.fromList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Int
x, Int
y] | (Int
x, IntSet
ys) <- IntMap IntSet -> [(Int, IntSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap IntSet
m, Int
y <- IntSet -> [Int]
IntSet.toAscList IntSet
ys ]