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

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

    -- * Conversion functions
    toBipartite, toBipartiteWith, fromBipartite, fromBipartiteWith,

    -- * Graph properties
    isEmpty, hasLeftVertex, hasRightVertex, hasVertex, hasEdge, leftVertexCount,
    rightVertexCount, vertexCount, edgeCount, leftVertexList, rightVertexList,
    vertexList, edgeList, leftVertexSet, rightVertexSet, vertexSet, edgeSet,
    leftAdjacencyList, rightAdjacencyList,

    -- * Standard families of graphs
    List (..), evenList, oddList, path, circuit, biclique, star, stars, mesh,

    -- * Graph transformation
    removeLeftVertex, removeRightVertex, removeEdge, bimap,

    -- * Graph composition
    box, boxWith,

    -- * Miscellaneous
    consistent
    ) where

import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.State
import Data.Either
import Data.Foldable (asum)
import Data.List ((\\), sort)
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Set (Set)
import GHC.Exts (IsList(..))
import GHC.Generics

import qualified Algebra.Graph              as G
import qualified Algebra.Graph.AdjacencyMap as AM

import qualified Data.Map.Strict as Map
import qualified Data.Set        as Set
import qualified Data.Tuple

{-| The 'Bipartite.AdjacencyMap' data type represents an undirected bipartite
graph. The two type parameters determine the types of vertices of each part. If
the types coincide, the vertices of the left part are still treated as disjoint
from the vertices of the right part. See examples for more details.

We define a 'Num' instance as a convenient notation for working with bipartite
graphs:

@
0                     == 'rightVertex' 0
'swap' 1                == 'leftVertex' 1
'swap' 1 + 2            == 'vertices' [1] [2]
'swap' 1 * 2            == 'edge' 1 2
'swap' 1 + 2 * 'swap' 3   == 'overlay' ('leftVertex' 1) ('edge' 3 2)
'swap' 1 * (2 + 'swap' 3) == 'connect' ('leftVertex' 1) ('vertices' [3] [2])
@

__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                 == "empty"
show 1                     == "rightVertex 1"
show ('swap' 2)              == "leftVertex 2"
show (1 + 2)               == "vertices [] [1,2]"
show ('swap' (1 + 2))        == "vertices [1,2] []"
show ('swap' 1 * 2)          == "edge 1 2"
show ('swap' 1 * 2 * 'swap' 3) == "edges [(1,2),(3,2)]"
show ('swap' 1 * 2 + 'swap' 3) == "overlay (leftVertex 3) (edge 1 2)"
@

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

    * 'overlay' is commutative and associative:

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

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

        >   x * empty == x
        >   empty * x == x
        >       x * y == y * 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

    * 'connect' has the same effect as 'overlay' on vertices of the same part:

        >  leftVertex x * leftVertex y  ==  leftVertex x + leftVertex y
        > rightVertex x * rightVertex y == rightVertex x + rightVertex y

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 of the graph, respectively. In
addition, /l/ and /r/ will denote the number of vertices in the left and right
parts of the graph, respectively.
-}
data AdjacencyMap a b = BAM {
    -- | The /adjacency map/ of the left part of the graph: each left vertex is
    -- associated with a set of its right neighbours.
    -- Complexity: /O(1)/ time and memory.
    --
    -- @
    -- leftAdjacencyMap 'empty'           == Map.'Map.empty'
    -- leftAdjacencyMap ('leftVertex' x)  == Map.'Map.singleton' x Set.'Set.empty'
    -- leftAdjacencyMap ('rightVertex' x) == Map.'Map.empty'
    -- leftAdjacencyMap ('edge' x y)      == Map.'Map.singleton' x (Set.'Set.singleton' y)
    -- @
    forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap :: Map a (Set b),

    -- | The /adjacency map/ of the right part of the graph: each right vertex
    -- is associated with a set of its left neighbours.
    -- Complexity: /O(1)/ time and memory.
    --
    -- @
    -- rightAdjacencyMap 'empty'           == Map.'Map.empty'
    -- rightAdjacencyMap ('leftVertex' x)  == Map.'Map.empty'
    -- rightAdjacencyMap ('rightVertex' x) == Map.'Map.singleton' x Set.'Set.empty'
    -- rightAdjacencyMap ('edge' x y)      == Map.'Map.singleton' y (Set.'Set.singleton' x)
    -- @
    forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap :: Map b (Set a)
    } deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b
forall a b x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x
$cto :: forall a b x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b
$cfrom :: forall a b x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x
Generic

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

instance (Ord a, Ord b) => Eq (AdjacencyMap a b) where
    BAM Map a (Set b)
ab1 Map b (Set a)
ba1 == :: AdjacencyMap a b -> AdjacencyMap a b -> Bool
== BAM Map a (Set b)
ab2 Map b (Set a)
ba2 = Map a (Set b)
ab1 forall a. Eq a => a -> a -> Bool
== Map a (Set b)
ab2 Bool -> Bool -> Bool
&& forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba1 forall a. Eq a => a -> a -> Bool
== forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba2

instance (Ord a, Ord b) => Ord (AdjacencyMap a b) where
    compare :: AdjacencyMap a b -> AdjacencyMap a b -> Ordering
compare AdjacencyMap a b
x AdjacencyMap a b
y = forall a. Monoid a => [a] -> a
mconcat
        [ forall a. Ord a => a -> a -> Ordering
compare (forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
x) (forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
y)
        , forall a. Ord a => a -> a -> Ordering
compare (forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet   AdjacencyMap a b
x) (forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet   AdjacencyMap a b
y)
        , forall a. Ord a => a -> a -> Ordering
compare (forall a b. AdjacencyMap a b -> Int
edgeCount   AdjacencyMap a b
x) (forall a b. AdjacencyMap a b -> Int
edgeCount   AdjacencyMap a b
y)
        , forall a. Ord a => a -> a -> Ordering
compare (forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet     AdjacencyMap a b
x) (forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet     AdjacencyMap a b
y) ]

instance (Ord a, Ord b, Show a, Show b) => Show (AdjacencyMap a b) where
    showsPrec :: Int -> AdjacencyMap a b -> ShowS
showsPrec Int
p AdjacencyMap a b
g
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
bs             = String -> ShowS
showString String
"empty"
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
es                        = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Show a, Show a) => [a] -> [a] -> ShowS
vShow [a]
as [b]
bs
        | ([a]
as forall a. Eq a => a -> a -> Bool
== [a]
aUsed) Bool -> Bool -> Bool
&& ([b]
bs forall a. Eq a => a -> a -> Bool
== [b]
bUsed) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Show a, Show a) => [(a, a)] -> ShowS
eShow [(a, b)]
es
        | Bool
otherwise                      = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
                                         forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"overlay ("
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}. (Show a, Show a) => [Either a a] -> ShowS
veShow ([Either a b]
vs forall a. Eq a => [a] -> [a] -> [a]
\\ [Either a b]
used)
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") ("
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}. (Show a, Show a) => [(a, a)] -> ShowS
eShow [(a, b)]
es
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
      where
        as :: [a]
as = forall a b. AdjacencyMap a b -> [a]
leftVertexList AdjacencyMap a b
g
        bs :: [b]
bs = forall a b. AdjacencyMap a b -> [b]
rightVertexList AdjacencyMap a b
g
        vs :: [Either a b]
vs = forall a b. AdjacencyMap a b -> [Either a b]
vertexList AdjacencyMap a b
g
        es :: [(a, b)]
es = forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
g
        aUsed :: [a]
aUsed = forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> Set a
Set.fromAscList [ a
a | (a
a, b
_) <- forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
g ]
        bUsed :: [b]
bUsed = forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> Set a
Set.fromAscList [ b
b | (b
b, a
_) <- forall a b. AdjacencyMap a b -> [(a, b)]
edgeList (forall a b. AdjacencyMap a b -> AdjacencyMap b a
swap AdjacencyMap a b
g) ]
        used :: [Either a b]
used  = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [a]
aUsed forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [b]
bUsed
        vShow :: [a] -> [a] -> ShowS
vShow [a
a] []  = String -> ShowS
showString String
"leftVertex "  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
        vShow []  [a
b] = String -> ShowS
showString String
"rightVertex " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
b
        vShow [a]
as  [a]
bs  = String -> ShowS
showString String
"vertices "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
as
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
bs
        eShow :: [(a, a)] -> ShowS
eShow [(a
a, a
b)] = String -> ShowS
showString String
"edge " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
b
        eShow [(a, a)]
es       = String -> ShowS
showString String
"edges " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
es
        veShow :: [Either a a] -> ShowS
veShow [Either a a]
xs      = forall {a} {a}. (Show a, Show a) => [a] -> [a] -> ShowS
vShow (forall a b. [Either a b] -> [a]
lefts [Either a a]
xs) (forall a b. [Either a b] -> [b]
rights [Either a a]
xs)

-- | Defined via 'overlay'.
instance (Ord a, Ord b) => Semigroup (AdjacencyMap a b) where
    <> :: AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
(<>) = forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
overlay

-- | Defined via 'overlay' and 'empty'.
instance (Ord a, Ord b) => Monoid (AdjacencyMap a b) where
    mempty :: AdjacencyMap a b
mempty = forall a b. AdjacencyMap a b
empty

-- | Construct the /empty graph/.
--
-- @
-- 'isEmpty' empty           == True
-- 'leftAdjacencyMap' empty  == Map.'Map.empty'
-- 'rightAdjacencyMap' empty == Map.'Map.empty'
-- 'hasVertex' x empty       == False
-- @
empty :: AdjacencyMap a b
empty :: forall a b. AdjacencyMap a b
empty = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty

-- | Construct the graph comprising /a single isolated vertex/ in the left part.
--
-- @
-- 'leftAdjacencyMap' (leftVertex x)  == Map.'Map.singleton' x Set.'Set.empty'
-- 'rightAdjacencyMap' (leftVertex x) == Map.'Map.empty'
-- 'hasLeftVertex' x (leftVertex y)   == (x == y)
-- 'hasRightVertex' x (leftVertex y)  == False
-- 'hasEdge' x y (leftVertex z)       == False
-- @
leftVertex :: a -> AdjacencyMap a b
leftVertex :: forall a b. a -> AdjacencyMap a b
leftVertex a
a = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. k -> a -> Map k a
Map.singleton a
a forall a. Set a
Set.empty) forall k a. Map k a
Map.empty

-- | Construct the graph comprising /a single isolated vertex/ in the right part.
--
-- @
-- 'leftAdjacencyMap' (rightVertex x)  == Map.'Map.empty'
-- 'rightAdjacencyMap' (rightVertex x) == Map.'Map.singleton' x Set.'Set.empty'
-- 'hasLeftVertex' x (rightVertex y)   == False
-- 'hasRightVertex' x (rightVertex y)  == (x == y)
-- 'hasEdge' x y (rightVertex z)       == False
-- @
rightVertex :: b -> AdjacencyMap a b
rightVertex :: forall b a. b -> AdjacencyMap a b
rightVertex b
b = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM forall k a. Map k a
Map.empty (forall k a. k -> a -> Map k a
Map.singleton b
b forall a. Set a
Set.empty)

-- | Construct the graph comprising /a single isolated vertex/.
--
-- @
-- vertex . Left  == 'leftVertex'
-- vertex . Right == 'rightVertex'
-- @
vertex :: Either a b -> AdjacencyMap a b
vertex :: forall a b. Either a b -> AdjacencyMap a b
vertex (Left  a
a) = forall a b. a -> AdjacencyMap a b
leftVertex a
a
vertex (Right b
b) = forall b a. b -> AdjacencyMap a b
rightVertex b
b

-- | Construct the graph comprising /a single edge/.
--
-- @
-- edge x y                     == 'connect' ('leftVertex' x) ('rightVertex' y)
-- 'leftAdjacencyMap' (edge x y)  == Map.'Map.singleton' x (Set.'Set.singleton' y)
-- 'rightAdjacencyMap' (edge x y) == Map.'Map.singleton' y (Set.'Set.singleton' x)
-- 'hasEdge' x y (edge x y)       == True
-- 'hasEdge' 1 2 (edge 2 1)       == False
-- @
edge :: a -> b -> AdjacencyMap a b
edge :: forall a b. a -> b -> AdjacencyMap a b
edge a
a b
b =
    forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. k -> a -> Map k a
Map.singleton a
a (forall a. a -> Set a
Set.singleton b
b)) (forall k a. k -> a -> Map k a
Map.singleton b
b (forall a. a -> Set a
Set.singleton a
a))

-- | /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
-- @
overlay :: (Ord a, Ord b) => AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
overlay :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
overlay (BAM Map a (Set b)
ab1 Map b (Set a)
ba1) (BAM Map a (Set b)
ab2 Map b (Set a)
ba2) =
    forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Ord a => Set a -> Set a -> Set a
Set.union Map a (Set b)
ab1 Map a (Set b)
ab2) (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Ord a => Set a -> Set a -> Set a
Set.union Map b (Set a)
ba1 Map b (Set a)
ba2)

-- | /Connect/ two graphs, filtering out the edges between vertices of the same
-- part. This is a commutative and 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 in the arguments: /O(m1 + m2 + l1 * r2 + l2 * r1)/.
--
-- @
-- connect ('leftVertex' x)     ('leftVertex' y)     == 'vertices' [x,y] []
-- connect ('leftVertex' x)     ('rightVertex' y)    == 'edge' x y
-- connect ('rightVertex' x)    ('leftVertex' y)     == 'edge' y x
-- connect ('rightVertex' x)    ('rightVertex' y)    == 'vertices' [] [x,y]
-- connect ('vertices' xs1 ys1) ('vertices' xs2 ys2) == 'overlay' ('biclique' xs1 ys2) ('biclique' xs2 ys1)
-- '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)                     >= 'leftVertexCount' x * 'rightVertexCount' y
-- 'edgeCount'   (connect x y)                     <= 'leftVertexCount' x * 'rightVertexCount' y + 'rightVertexCount' x * 'leftVertexCount' y + 'edgeCount' x + 'edgeCount' y
-- @
connect :: (Ord a, Ord b) => AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect (BAM Map a (Set b)
ab1 Map b (Set a)
ba1) (BAM Map a (Set b)
ab2 Map b (Set a)
ba2) = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map a (Set b)
ab Map b (Set a)
ba
  where
    a1 :: Set a
a1 = forall k a. Map k a -> Set k
Map.keysSet Map a (Set b)
ab1
    a2 :: Set a
a2 = forall k a. Map k a -> Set k
Map.keysSet Map a (Set b)
ab2
    b1 :: Set b
b1 = forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba1
    b2 :: Set b
b2 = forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba2
    ab :: Map a (Set b)
ab = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Ord a => Set a -> Set a -> Set a
Set.union
        [ Map a (Set b)
ab1, Map a (Set b)
ab2, forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (forall a b. a -> b -> a
const Set b
b2) Set a
a1, forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (forall a b. a -> b -> a
const Set b
b1) Set a
a2 ]
    ba :: Map b (Set a)
ba = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Ord a => Set a -> Set a -> Set a
Set.union
        [ Map b (Set a)
ba1, Map b (Set a)
ba2, forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (forall a b. a -> b -> a
const Set a
a2) Set b
b1, forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (forall a b. a -> b -> a
const Set a
a1) Set b
b2 ]

-- | Construct the graph comprising given lists of isolated vertices in each
-- part.
-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the total
-- length of two lists.
--
-- @
-- vertices [] []                    == 'empty'
-- vertices [x] []                   == 'leftVertex' x
-- vertices [] [x]                   == 'rightVertex' x
-- vertices xs ys                    == 'overlays' ('map' 'leftVertex' xs ++ 'map' 'rightVertex' ys)
-- 'hasLeftVertex'  x (vertices xs ys) == 'elem' x xs
-- 'hasRightVertex' y (vertices xs ys) == 'elem' y ys
-- @
vertices :: (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
vertices :: forall a b. (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
vertices [a]
as [b]
bs = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (a
a, forall a. Set a
Set.empty) | a
a <- [a]
as ])
                     (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (b
b, forall a. Set a
Set.empty) | b
b <- [b]
bs ])

-- | 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')
-- 'hasEdge' x y . edges == 'elem' (x,y)
-- 'edgeCount'   . edges == 'length' . 'nub'
-- @
edges :: (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges :: forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges [(a, b)]
es = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (a
a, forall a. a -> Set a
Set.singleton b
b) | (a
a, b
b) <- [(a, b)]
es ])
               (forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (b
b, forall a. a -> Set a
Set.singleton a
a) | (a
a, b
b) <- [(a, b)]
es ])

-- | 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 :: (Ord a, Ord b) => [AdjacencyMap a b] -> AdjacencyMap a b
overlays :: forall a b.
(Ord a, Ord b) =>
[AdjacencyMap a b] -> AdjacencyMap a b
overlays [AdjacencyMap a b]
xs = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a b. (a -> b) -> [a] -> [b]
map forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap  [AdjacencyMap a b]
xs))
                  (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a b. (a -> b) -> [a] -> [b]
map forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap [AdjacencyMap a b]
xs))

-- | 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 :: (Ord a, Ord b) => [AdjacencyMap a b] -> AdjacencyMap a b
connects :: forall a b.
(Ord a, Ord b) =>
[AdjacencyMap a b] -> AdjacencyMap a b
connects = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect forall a b. AdjacencyMap a b
empty

-- | Swap the parts of a given graph.
-- Complexity: /O(1)/ time and memory.
--
-- @
-- swap 'empty'            == 'empty'
-- swap . 'leftVertex'     == 'rightVertex'
-- swap ('vertices' xs ys) == 'vertices' ys xs
-- swap ('edge' x y)       == 'edge' y x
-- swap . 'edges'          == 'edges' . 'map' Data.Tuple.'Data.Tuple.swap'
-- swap . swap           == 'id'
-- @
swap :: AdjacencyMap a b -> AdjacencyMap b a
swap :: forall a b. AdjacencyMap a b -> AdjacencyMap b a
swap (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map b (Set a)
ba Map a (Set b)
ab

-- | Construct a bipartite 'AdjacencyMap' from an "Algebra.Graph.AdjacencyMap",
-- adding any missing edges to make the graph undirected and filtering out the
-- edges within the same parts.
-- Complexity: /O(m * log(n))/.
--
-- @
-- toBipartite 'Algebra.Graph.AdjacencyMap.empty'                      == 'empty'
-- toBipartite ('Algebra.Graph.AdjacencyMap.vertex' (Left x))          == 'leftVertex' x
-- toBipartite ('Algebra.Graph.AdjacencyMap.vertex' (Right x))         == 'rightVertex' x
-- toBipartite ('Algebra.Graph.AdjacencyMap.edge' (Left x) (Left y))   == 'vertices' [x,y] []
-- toBipartite ('Algebra.Graph.AdjacencyMap.edge' (Left x) (Right y))  == 'edge' x y
-- toBipartite ('Algebra.Graph.AdjacencyMap.edge' (Right x) (Left y))  == 'edge' y x
-- toBipartite ('Algebra.Graph.AdjacencyMap.edge' (Right x) (Right y)) == 'vertices' [] [x,y]
-- toBipartite . 'Algebra.Graph.AdjacencyMap.clique'                   == 'uncurry' 'biclique' . 'partitionEithers'
-- toBipartite . 'fromBipartite'            == 'id'
-- @
toBipartite :: (Ord a, Ord b) => AM.AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite AdjacencyMap (Either a b)
g = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (a
a, forall {a}. Set (Either a b) -> Set b
getRights Set (Either a b)
vs) | (Left  a
a, Set (Either a b)
vs) <- [(Either a b, Set (Either a b))]
am ])
                    (forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (b
b, forall {b}. Set (Either a b) -> Set a
getLefts  Set (Either a b)
vs) | (Right b
b, Set (Either a b)
vs) <- [(Either a b, Set (Either a b))]
am ])
  where
    getRights :: Set (Either a b) -> Set b
getRights = forall a. Eq a => [a] -> Set a
Set.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList
    getLefts :: Set (Either a b) -> Set a
getLefts  = forall a. Eq a => [a] -> Set a
Set.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [a]
lefts  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList
    am :: [(Either a b, Set (Either a b))]
am        = forall k a. Map k a -> [(k, a)]
Map.toAscList forall a b. (a -> b) -> a -> b
$ forall a. AdjacencyMap a -> Map a (Set a)
AM.adjacencyMap forall a b. (a -> b) -> a -> b
$ forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
AM.symmetricClosure AdjacencyMap (Either a b)
g

-- | Construct a bipartite 'AdjacencyMap' from an "Algebra.Graph.AdjacencyMap",
-- where the two parts are identified by a separate function, adding any missing
-- edges to make the graph undirected and filtering out the edges within the
-- same parts.
-- Complexity: /O(m * log(n))/.
--
-- @
-- toBipartiteWith f 'Algebra.Graph.AdjacencyMap.empty' == 'empty'
-- toBipartiteWith Left x  == 'vertices' ('vertexList' x) []
-- toBipartiteWith Right x == 'vertices' [] ('vertexList' x)
-- toBipartiteWith f       == 'toBipartite' . 'Algebra.Graph.AdjacencyMap.gmap' f
-- toBipartiteWith id      == 'toBipartite'
-- @
toBipartiteWith :: (Ord a, Ord b, Ord c) => (a -> Either b c) -> AM.AdjacencyMap a -> AdjacencyMap b c
toBipartiteWith :: forall a b c.
(Ord a, Ord b, Ord c) =>
(a -> Either b c) -> AdjacencyMap a -> AdjacencyMap b c
toBipartiteWith a -> Either b c
f = forall a b.
(Ord a, Ord b) =>
AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap a -> Either b c
f

-- | Construct an "Algebra.Graph.AdjacencyMap" from a bipartite 'AdjacencyMap'.
-- Complexity: /O(m * log(n))/.
--
-- @
-- fromBipartite 'empty'          == 'Algebra.Graph.AdjacencyMap.empty'
-- fromBipartite ('leftVertex' x) == 'Algebra.Graph.AdjacencyMap.vertex' (Left x)
-- fromBipartite ('edge' x y)     == 'Algebra.Graph.AdjacencyMap.edges' [(Left x, Right y), (Right y, Left x)]
-- 'toBipartite' . fromBipartite  == 'id'
-- @
fromBipartite :: (Ord a, Ord b) => AdjacencyMap a b -> AM.AdjacencyMap (Either a b)
fromBipartite :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap (Either a b)
fromBipartite (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets forall a b. (a -> b) -> a -> b
$
    [ (forall a b. a -> Either a b
Left  a
a, forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a b. b -> Either a b
Right Set b
bs) | (a
a, Set b
bs) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab ] forall a. [a] -> [a] -> [a]
++
    [ (forall a b. b -> Either a b
Right b
b, forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a b. a -> Either a b
Left  Set a
as) | (b
b, Set a
as) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map b (Set a)
ba ]

-- | Construct an "Algebra.Graph.AdjacencyMap" from a bipartite 'AdjacencyMap'
-- given a way to inject vertices of the two parts into the resulting vertex
-- type.
-- Complexity: /O(m * log(n))/.
--
-- @
-- fromBipartiteWith Left Right             == 'fromBipartite'
-- fromBipartiteWith id id ('vertices' xs ys) == 'Algebra.Graph.AdjacencyMap.vertices' (xs ++ ys)
-- fromBipartiteWith id id . 'edges'          == 'Algebra.Graph.AdjacencyMap.symmetricClosure' . 'Algebra.Graph.AdjacencyMap.edges'
-- @
fromBipartiteWith :: Ord c => (a -> c) -> (b -> c) -> AdjacencyMap a b -> AM.AdjacencyMap c
fromBipartiteWith :: forall c a b.
Ord c =>
(a -> c) -> (b -> c) -> AdjacencyMap a b -> AdjacencyMap c
fromBipartiteWith a -> c
f b -> c
g (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets forall a b. (a -> b) -> a -> b
$
    [ (a -> c
f a
a, forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map b -> c
g Set b
bs) | (a
a, Set b
bs) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab ] forall a. [a] -> [a] -> [a]
++
    [ (b -> c
g b
b, forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> c
f Set a
as) | (b
b, Set a
as) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map b (Set a)
ba ]

-- | Check if a graph is empty.
-- Complexity: /O(1)/ time.
--
-- @
-- isEmpty 'empty'                 == True
-- isEmpty ('overlay' 'empty' 'empty') == True
-- isEmpty ('vertex' x)            == False
-- isEmpty                       == (==) 'empty'
-- @
isEmpty :: AdjacencyMap a b -> Bool
isEmpty :: forall a b. AdjacencyMap a b -> Bool
isEmpty (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall k a. Map k a -> Bool
Map.null Map a (Set b)
ab Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map b (Set a)
ba

-- | Check if a graph contains a given vertex in the left part.
-- Complexity: /O(log(l))/ time.
--
-- @
-- hasLeftVertex x 'empty'           == False
-- hasLeftVertex x ('leftVertex' y)  == (x == y)
-- hasLeftVertex x ('rightVertex' y) == False
-- @
hasLeftVertex :: Ord a => a -> AdjacencyMap a b -> Bool
hasLeftVertex :: forall a b. Ord a => a -> AdjacencyMap a b -> Bool
hasLeftVertex a
a (BAM Map a (Set b)
ab Map b (Set a)
_) = forall k a. Ord k => k -> Map k a -> Bool
Map.member a
a Map a (Set b)
ab

-- | Check if a graph contains a given vertex in the right part.
-- Complexity: /O(log(r))/ time.
--
-- @
-- hasRightVertex x 'empty'           == False
-- hasRightVertex x ('leftVertex' y)  == False
-- hasRightVertex x ('rightVertex' y) == (x == y)
-- @
hasRightVertex :: Ord b => b -> AdjacencyMap a b -> Bool
hasRightVertex :: forall b a. Ord b => b -> AdjacencyMap a b -> Bool
hasRightVertex b
b (BAM Map a (Set b)
_ Map b (Set a)
ba) = forall k a. Ord k => k -> Map k a -> Bool
Map.member b
b Map b (Set a)
ba

-- | Check if a graph contains a given vertex.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasVertex . Left  == 'hasLeftVertex'
-- hasVertex . Right == 'hasRightVertex'
-- @
hasVertex :: (Ord a, Ord b) => Either a b -> AdjacencyMap a b -> Bool
hasVertex :: forall a b.
(Ord a, Ord b) =>
Either a b -> AdjacencyMap a b -> Bool
hasVertex (Left  a
a) = forall a b. Ord a => a -> AdjacencyMap a b -> Bool
hasLeftVertex a
a
hasVertex (Right b
b) = forall b a. Ord b => b -> AdjacencyMap a b -> Bool
hasRightVertex b
b

-- | 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            == 'elem' (x,y) . 'edgeList'
-- @
hasEdge :: (Ord a, Ord b) => a -> b -> AdjacencyMap a b -> Bool
hasEdge :: forall a b. (Ord a, Ord b) => a -> b -> AdjacencyMap a b -> Bool
hasEdge a
a b
b (BAM Map a (Set b)
ab Map b (Set a)
_) = (forall a. Ord a => a -> Set a -> Bool
Set.member b
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
a Map a (Set b)
ab) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True

-- | The number of vertices in the left part of a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- leftVertexCount 'empty'           == 0
-- leftVertexCount ('leftVertex' x)  == 1
-- leftVertexCount ('rightVertex' x) == 0
-- leftVertexCount ('edge' x y)      == 1
-- leftVertexCount . 'edges'         == 'length' . 'nub' . 'map' 'fst'
-- @
leftVertexCount :: AdjacencyMap a b -> Int
leftVertexCount :: forall a b. AdjacencyMap a b -> Int
leftVertexCount = forall k a. Map k a -> Int
Map.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap

-- | The number of vertices in the right part of a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- rightVertexCount 'empty'           == 0
-- rightVertexCount ('leftVertex' x)  == 0
-- rightVertexCount ('rightVertex' x) == 1
-- rightVertexCount ('edge' x y)      == 1
-- rightVertexCount . 'edges'         == 'length' . 'nub' . 'map' 'snd'
-- @
rightVertexCount :: AdjacencyMap a b -> Int
rightVertexCount :: forall a b. AdjacencyMap a b -> Int
rightVertexCount = forall k a. Map k a -> Int
Map.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap

-- | The number of vertices in a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- vertexCount 'empty'      == 0
-- vertexCount ('vertex' x) == 1
-- vertexCount ('edge' x y) == 2
-- vertexCount x          == 'leftVertexCount' x + 'rightVertexCount' x
-- @
vertexCount :: AdjacencyMap a b -> Int
vertexCount :: forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
g = forall a b. AdjacencyMap a b -> Int
leftVertexCount AdjacencyMap a b
g forall a. Num a => a -> a -> a
+ forall a b. AdjacencyMap a b -> Int
rightVertexCount AdjacencyMap a b
g

-- | The number of edges in a graph.
-- Complexity: /O(l)/ time.
--
-- @
-- edgeCount 'empty'      == 0
-- edgeCount ('vertex' x) == 0
-- edgeCount ('edge' x y) == 1
-- edgeCount . 'edges'    == 'length' . 'nub'
-- @
edgeCount :: AdjacencyMap a b -> Int
edgeCount :: forall a b. AdjacencyMap a b -> Int
edgeCount = forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Int
Set.size) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap

-- | The sorted list of vertices of the left part of a graph.
-- Complexity: /O(l)/ time and memory.
--
-- @
-- leftVertexList 'empty'              == []
-- leftVertexList ('leftVertex' x)     == [x]
-- leftVertexList ('rightVertex' x)    == []
-- leftVertexList . 'flip' 'vertices' [] == 'nub' . 'sort'
-- @
leftVertexList :: AdjacencyMap a b -> [a]
leftVertexList :: forall a b. AdjacencyMap a b -> [a]
leftVertexList = forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap

-- | The sorted list of vertices of the right part of a graph.
-- Complexity: /O(r)/ time and memory.
--
-- @
-- rightVertexList 'empty'           == []
-- rightVertexList ('leftVertex' x)  == []
-- rightVertexList ('rightVertex' x) == [x]
-- rightVertexList . 'vertices' []   == 'nub' . 'sort'
-- @
rightVertexList :: AdjacencyMap a b -> [b]
rightVertexList :: forall a b. AdjacencyMap a b -> [b]
rightVertexList = forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap

-- | The sorted list of vertices of a graph.
-- Complexity: /O(n)/ time and memory
--
-- @
-- vertexList 'empty'                             == []
-- vertexList ('vertex' x)                        == [x]
-- vertexList ('edge' x y)                        == [Left x, Right y]
-- vertexList ('vertices' ('lefts' xs) ('rights' xs)) == 'nub' ('sort' xs)
-- @
vertexList :: AdjacencyMap a b -> [Either a b]
vertexList :: forall a b. AdjacencyMap a b -> [Either a b]
vertexList AdjacencyMap a b
g = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left (forall a b. AdjacencyMap a b -> [a]
leftVertexList AdjacencyMap a b
g) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right (forall a b. AdjacencyMap a b -> [b]
rightVertexList AdjacencyMap a b
g)

-- | 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 . 'edges'    == 'nub' . 'sort'
-- @
edgeList :: AdjacencyMap a b -> [(a, b)]
edgeList :: forall a b. AdjacencyMap a b -> [(a, b)]
edgeList (BAM Map a (Set b)
ab Map b (Set a)
_) = [ (a
a, b
b) | (a
a, Set b
bs) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab, b
b <- forall a. Set a -> [a]
Set.toAscList Set b
bs ]

-- | The set of vertices of the left part of a graph.
-- Complexity: /O(l)/ time and memory.
--
-- @
-- leftVertexSet 'empty'              == Set.'Set.empty'
-- leftVertexSet . 'leftVertex'       == Set.'Set.singleton'
-- leftVertexSet . 'rightVertex'      == 'const' Set.'Set.empty'
-- leftVertexSet . 'flip' 'vertices' [] == Set.'Set.fromList'
-- @
leftVertexSet :: AdjacencyMap a b -> Set a
leftVertexSet :: forall a b. AdjacencyMap a b -> Set a
leftVertexSet = forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap

-- | The set of vertices of the right part of a graph.
-- Complexity: /O(r)/ time and memory.
--
-- @
-- rightVertexSet 'empty'         == Set.'Set.empty'
-- rightVertexSet . 'leftVertex'  == 'const' Set.'Set.empty'
-- rightVertexSet . 'rightVertex' == Set.'Set.singleton'
-- rightVertexSet . 'vertices' [] == Set.'Set.fromList'
-- @
rightVertexSet :: AdjacencyMap a b -> Set b
rightVertexSet :: forall a b. AdjacencyMap a b -> Set b
rightVertexSet = forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap

-- TODO: Check if implementing this via 'Set.mapMonotonic' would be faster.
-- | The set of vertices of a graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexSet 'empty'                             == Set.'Set.empty'
-- vertexSet . 'vertex'                          == Set.'Set.singleton'
-- vertexSet ('edge' x y)                        == Set.'Set.fromList' [Left x, Right y]
-- vertexSet ('vertices' ('lefts' xs) ('rights' xs)) == Set.'Set.fromList' xs
-- @
vertexSet :: (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet :: forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet = forall a. Eq a => [a] -> Set a
Set.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> [Either a b]
vertexList

-- | The set of edges of a graph.
-- Complexity: /O(n + m)/ time and /O(m)/ memory.
--
-- @
-- edgeSet 'empty'      == Set.'Data.Set.empty'
-- edgeSet ('vertex' x) == Set.'Data.Set.empty'
-- edgeSet ('edge' x y) == Set.'Data.Set.singleton' (x,y)
-- edgeSet . 'edges'    == Set.'Data.Set.fromList'
-- @
edgeSet :: (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet :: forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet = forall a. Eq a => [a] -> Set a
Set.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. AdjacencyMap a b -> [(a, b)]
edgeList

-- | The sorted /adjacency list/ of the left part of a graph.
-- Complexity: /O(n + m)/ time and memory.
--
-- @
-- leftAdjacencyList 'empty'            == []
-- leftAdjacencyList ('vertices' [] xs) == []
-- leftAdjacencyList ('vertices' xs []) == [(x, []) | x <- 'nub' ('sort' xs)]
-- leftAdjacencyList ('edge' x y)       == [(x, [y])]
-- leftAdjacencyList ('star' x ys)      == [(x, 'nub' ('sort' ys))]
-- @
leftAdjacencyList :: AdjacencyMap a b -> [(a, [b])]
leftAdjacencyList :: forall a b. AdjacencyMap a b -> [(a, [b])]
leftAdjacencyList (BAM Map a (Set b)
ab Map b (Set a)
_) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Set a -> [a]
Set.toAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab

-- | The sorted /adjacency list/ of the right part of a graph.
-- Complexity: /O(n + m)/ time and memory.
--
-- @
-- rightAdjacencyList 'empty'            == []
-- rightAdjacencyList ('vertices' [] xs) == [(x, []) | x <- 'nub' ('sort' xs)]
-- rightAdjacencyList ('vertices' xs []) == []
-- rightAdjacencyList ('edge' x y)       == [(y, [x])]
-- rightAdjacencyList ('star' x ys)      == [(y, [x])  | y <- 'nub' ('sort' ys)]
-- @
rightAdjacencyList :: AdjacencyMap a b -> [(b, [a])]
rightAdjacencyList :: forall a b. AdjacencyMap a b -> [(b, [a])]
rightAdjacencyList (BAM Map a (Set b)
_ Map b (Set a)
ba) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Set a -> [a]
Set.toAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toAscList Map b (Set a)
ba

-- | A list of values of two alternating types. The first type argument denotes
-- the type of the value at the head.
--
-- With the @OverloadedLists@ extension it is possible to use the standard list
-- notation to construct a 'List' where the two types coincide, for example:
--
-- @
-- [1, 2, 3, 4, 5] :: List Int Int
-- @
--
-- We make use of this shorthand notation in the examples below.
data List a b = Nil | Cons a (List b a) deriving (List a b -> List a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => List a b -> List a b -> Bool
/= :: List a b -> List a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => List a b -> List a b -> Bool
== :: List a b -> List a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => List a b -> List a b -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (List a b) x -> List a b
forall a b x. List a b -> Rep (List a b) x
$cto :: forall a b x. Rep (List a b) x -> List a b
$cfrom :: forall a b x. List a b -> Rep (List a b) x
Generic, List a b -> List a b -> Bool
List a b -> List a b -> Ordering
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} {b}. (Ord a, Ord b) => Eq (List a b)
forall a b. (Ord a, Ord b) => List a b -> List a b -> Bool
forall a b. (Ord a, Ord b) => List a b -> List a b -> Ordering
forall a b. (Ord a, Ord b) => List a b -> List a b -> List a b
min :: List a b -> List a b -> List a b
$cmin :: forall a b. (Ord a, Ord b) => List a b -> List a b -> List a b
max :: List a b -> List a b -> List a b
$cmax :: forall a b. (Ord a, Ord b) => List a b -> List a b -> List a b
>= :: List a b -> List a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => List a b -> List a b -> Bool
> :: List a b -> List a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => List a b -> List a b -> Bool
<= :: List a b -> List a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => List a b -> List a b -> Bool
< :: List a b -> List a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => List a b -> List a b -> Bool
compare :: List a b -> List a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => List a b -> List a b -> Ordering
Ord, Int -> List a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> List a b -> ShowS
forall a b. (Show a, Show b) => [List a b] -> ShowS
forall a b. (Show a, Show b) => List a b -> String
showList :: [List a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [List a b] -> ShowS
show :: List a b -> String
$cshow :: forall a b. (Show a, Show b) => List a b -> String
showsPrec :: Int -> List a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> List a b -> ShowS
Show)

instance IsList (List a a) where
    type Item (List a a) = a

    fromList :: [Item (List a a)] -> List a a
fromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. a -> List b a -> List a b
Cons forall a b. List a b
Nil

    toList :: List a a -> [Item (List a a)]
toList List a a
Nil         = []
    toList (Cons a
a List a a
as) = a
a forall a. a -> [a] -> [a]
: forall l. IsList l => l -> [Item l]
toList List a a
as

-- | Construct a 'List' of even length from a list of pairs.
--
-- @
-- evenList []                 == 'Nil'
-- evenList [(1,2), (3,4)]     == [1, 2, 3, 4] :: 'List' Int Int
-- evenList [(1,\'a\'), (2,\'b\')] == 'Cons' 1 ('Cons' \'a\' ('Cons' 2 ('Cons' \'b\' 'Nil')))
-- @
evenList :: [(a, b)] -> List a b
evenList :: forall a b. [(a, b)] -> List a b
evenList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a, b
b) -> forall a b. a -> List b a -> List a b
Cons a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> List b a -> List a b
Cons b
b) forall a b. List a b
Nil

-- | Construct a 'List' of odd length given the first element and a list of pairs.
--
-- @
-- oddList 1 []                 == 'Cons' 1 'Nil'
-- oddList 1 [(2,3), (4,5)]     == [1, 2, 3, 4, 5] :: 'List' Int Int
-- oddList 1 [(\'a\',2), (\'b\',3)] == 'Cons' 1 ('Cons' \'a\' ('Cons' 2 ('Cons' \'b\' ('Cons' 3 'Nil'))))
-- @
oddList :: a -> [(b, a)] -> List a b
oddList :: forall a b. a -> [(b, a)] -> List a b
oddList a
a = forall a b. a -> List b a -> List a b
Cons a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> List a b
evenList

-- | The /path/ on a 'List' of vertices.
-- Complexity: /O(L * log(L))/ time, where /L/ is the length of the given list.
--
-- @
-- path 'Nil'                   == 'empty'
-- path ('Cons' x 'Nil')          == 'leftVertex' x
-- path ('Cons' x ('Cons' y 'Nil')) == 'edge' x y
-- path [1, 2, 3, 4, 5]       == 'edges' [(1,2), (3,2), (3,4), (5,4)]
-- @
path :: (Ord a, Ord b) => List a b -> AdjacencyMap a b
path :: forall a b. (Ord a, Ord b) => List a b -> AdjacencyMap a b
path List a b
Nil          = forall a b. AdjacencyMap a b
empty
path (Cons a
a List b a
Nil) = forall a b. a -> AdjacencyMap a b
leftVertex a
a
path List a b
abs          = forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [b]
bs forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> [a] -> [a]
drop Int
1 [a]
as) [b]
bs)
  where
    ([a]
as, [b]
bs) = forall a b. List a b -> ([a], [b])
split List a b
abs

    split :: List a b -> ([a], [b])
    split :: forall a b. List a b -> ([a], [b])
split List a b
xs = case List a b
xs of
        List a b
Nil                 -> ([], [])
        Cons a
a List b a
Nil          -> ([a
a], [])
        Cons a
a (Cons b
b List a b
abs) -> (a
a forall a. a -> [a] -> [a]
: [a]
as, b
b forall a. a -> [a] -> [a]
: [b]
bs) where ([a]
as, [b]
bs) = forall a b. List a b -> ([a], [b])
split List a b
abs

-- | The /circuit/ on a list of pairs of vertices.
-- Complexity: /O(L * log(L))/ time, where L is the length of the given list.
--
-- @
-- circuit []                    == 'empty'
-- circuit [(x,y)]               == 'edge' x y
-- circuit [(1,2), (3,4), (5,6)] == 'edges' [(1,2), (3,2), (3,4), (5,4), (5,6), (1,6)]
-- circuit . 'reverse'             == 'swap' . circuit . 'map' Data.Tuple.'Data.Tuple.swap'
-- @
circuit :: (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
circuit :: forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
circuit [] = forall a b. AdjacencyMap a b
empty
circuit [(a, b)]
xs = forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [a]
as) [b]
bs
  where
    ([a]
as, [b]
bs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
xs

-- | The /biclique/ on two lists of vertices.
-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.
--
-- @
-- biclique [] [] == 'empty'
-- biclique xs [] == 'vertices' xs []
-- biclique [] ys == 'vertices' [] ys
-- biclique xs ys == 'connect' ('vertices' xs []) ('vertices' [] ys)
-- @
biclique :: (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
biclique :: forall a b. (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
biclique [a]
xs [b]
ys = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (forall a b. a -> b -> a
const Set b
sys) Set a
sxs) (forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (forall a b. a -> b -> a
const Set a
sxs) Set b
sys)
  where
    sxs :: Set a
sxs = forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs
    sys :: Set b
sys = forall a. Ord a => [a] -> Set a
Set.fromList [b]
ys

-- | The /star/ formed by a center vertex connected to a list of leaves.
-- Complexity: /O(L * log(L))/ time, where /L/ is the length of the given list.
--
-- @
-- star x []    == 'leftVertex' x
-- star x [y]   == 'edge' x y
-- star x [y,z] == 'edges' [(x,y), (x,z)]
-- star x ys    == 'connect' ('leftVertex' x) ('vertices' [] ys)
-- @
star :: (Ord a, Ord b) => a -> [b] -> AdjacencyMap a b
star :: forall a b. (Ord a, Ord b) => a -> [b] -> AdjacencyMap a b
star a
x [b]
ys = forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect (forall a b. a -> AdjacencyMap a b
leftVertex a
x) (forall a b. (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
vertices [] [b]
ys)

-- | The /stars/ formed by overlaying a list of 'star's.
-- Complexity: /O(L * log(L))/ time, where /L/ is the total size of the input.
--
-- @
-- stars []                      == 'empty'
-- stars [(x, [])]               == 'leftVertex' x
-- stars [(x, [y])]              == 'edge' x y
-- stars [(x, ys)]               == 'star' x ys
-- stars                         == 'overlays' . 'map' ('uncurry' 'star')
-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)
-- @
stars :: (Ord a, Ord b) => [(a, [b])] -> AdjacencyMap a b
stars :: forall a b. (Ord a, Ord b) => [(a, [b])] -> AdjacencyMap a b
stars = forall a b.
(Ord a, Ord b) =>
[AdjacencyMap a b] -> AdjacencyMap a b
overlays forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (Ord a, Ord b) => a -> [b] -> AdjacencyMap a b
star)

-- | Remove a vertex from the left part of a given graph.
-- Complexity: /O(r * log(l))/ time.
--
-- @
-- removeLeftVertex x ('leftVertex' x)       == 'empty'
-- removeLeftVertex 1 ('leftVertex' 2)       == 'leftVertex' 2
-- removeLeftVertex x ('rightVertex' y)      == 'rightVertex' y
-- removeLeftVertex x ('edge' x y)           == 'rightVertex' y
-- removeLeftVertex x . removeLeftVertex x == removeLeftVertex x
-- @
removeLeftVertex :: Ord a => a -> AdjacencyMap a b -> AdjacencyMap a b
removeLeftVertex :: forall a b. Ord a => a -> AdjacencyMap a b -> AdjacencyMap a b
removeLeftVertex a
a (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
a Map a (Set b)
ab) (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Ord a => a -> Set a -> Set a
Set.delete a
a) Map b (Set a)
ba)

-- | Remove a vertex from the right part of a given graph.
-- Complexity: /O(l * log(r))/ time.
--
-- @
-- removeRightVertex x ('rightVertex' x)       == 'empty'
-- removeRightVertex 1 ('rightVertex' 2)       == 'rightVertex' 2
-- removeRightVertex x ('leftVertex' y)        == 'leftVertex' y
-- removeRightVertex y ('edge' x y)            == 'leftVertex' x
-- removeRightVertex x . removeRightVertex x == removeRightVertex x
-- @
removeRightVertex :: Ord b => b -> AdjacencyMap a b -> AdjacencyMap a b
removeRightVertex :: forall b a. Ord b => b -> AdjacencyMap a b -> AdjacencyMap a b
removeRightVertex b
b (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Ord a => a -> Set a -> Set a
Set.delete b
b) Map a (Set b)
ab) (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete b
b Map b (Set a)
ba)

-- | Remove an edge from a given graph.
-- Complexity: /O(log(l) + log(r))/ time.
--
-- @
-- removeEdge x y ('edge' x y)            == 'vertices' [x] [y]
-- removeEdge x y . removeEdge x y      == removeEdge x y
-- removeEdge x y . 'removeLeftVertex' x  == 'removeLeftVertex' x
-- removeEdge x y . 'removeRightVertex' y == 'removeRightVertex' y
-- @
removeEdge :: (Ord a, Ord b) => a -> b -> AdjacencyMap a b -> AdjacencyMap a b
removeEdge :: forall a b.
(Ord a, Ord b) =>
a -> b -> AdjacencyMap a b -> AdjacencyMap a b
removeEdge a
a b
b (BAM Map a (Set b)
ab Map b (Set a)
ba) =
    forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall a. Ord a => a -> Set a -> Set a
Set.delete b
b) a
a Map a (Set b)
ab) (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall a. Ord a => a -> Set a -> Set a
Set.delete a
a) b
b Map b (Set a)
ba)

-- | Transform a graph by applying given functions to the vertices of each part.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- bimap f g 'empty'           == 'empty'
-- bimap f g . 'vertex'        == 'vertex' . Data.Bifunctor.'Data.Bifunctor.bimap' f g
-- bimap f g ('edge' x y)      == 'edge' (f x) (g y)
-- bimap 'id' 'id'               == 'id'
-- bimap f1 g1 . bimap f2 g2 == bimap (f1 . f2) (g1 . g2)
-- @
bimap :: (Ord a, Ord b, Ord c, Ord d) => (a -> c) -> (b -> d) -> AdjacencyMap a b -> AdjacencyMap c d
bimap :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
(a -> c) -> (b -> d) -> AdjacencyMap a b -> AdjacencyMap c d
bimap a -> c
f b -> d
g (BAM Map a (Set b)
ab Map b (Set a)
ba) = forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map c (Set d)
cd Map d (Set c)
dc
  where
    cd :: Map c (Set d)
cd = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map b -> d
g) forall a b. (a -> b) -> a -> b
$ forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall a. Ord a => Set a -> Set a -> Set a
Set.union a -> c
f Map a (Set b)
ab
    dc :: Map d (Set c)
dc = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> c
f) forall a b. (a -> b) -> a -> b
$ forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall a. Ord a => Set a -> Set a -> Set a
Set.union b -> d
g Map b (Set a)
ba

-- TODO: Add torus?
-- | Construct a /mesh/ graph from two lists of vertices.
-- Complexity: /O(L1 * L2 * log(L1 * L2))/ time, where /L1/ and /L2/ are the
-- lengths of the given lists.
--
-- @
-- mesh xs []           == 'empty'
-- mesh [] ys           == 'empty'
-- mesh [x] [y]         == 'leftVertex' (x,y)
-- mesh [1,1] [\'a\',\'b\'] == 'biclique' [(1,\'a\'), (1,\'b\')] [(1,\'a\'), (1,\'b\')]
-- mesh [1,2] [\'a\',\'b\'] == 'biclique' [(1,\'a\'), (2,\'b\')] [(1,\'b\'), (2,\'a\')]
-- @
mesh :: (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap (a, b) (a, b)
mesh :: forall a b.
(Ord a, Ord b) =>
[a] -> [b] -> AdjacencyMap (a, b) (a, b)
mesh [a]
as [b]
bs = forall a b.
(Ord a, Ord b) =>
AdjacencyMap a a -> AdjacencyMap b b -> AdjacencyMap (a, b) (a, b)
box (forall a b. (Ord a, Ord b) => List a b -> AdjacencyMap a b
path forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [a]
as) (forall a b. (Ord a, Ord b) => List a b -> AdjacencyMap a b
path forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [b]
bs)

-- | Compute the /Cartesian product/ of two graphs.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- 'box' ('path' [0,1]) ('path' [\'a\',\'b\']) == 'edges' [ ((0,\'a\'), (0,\'b\'))
--                                            , ((0,\'a\'), (1,\'a\'))
--                                            , ((1,\'b\'), (0,\'b\'))
--                                            , ((1,\'b\'), (1,\'a\')) ]
-- @
-- Up to isomorphism between the resulting vertex types, this operation is
-- /commutative/, /associative/, /distributes/ over 'overlay', has singleton
-- graphs as /identities/ and /swapping 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 ('overlay' y z)    == 'overlay' (box x y) (box x z)
-- box x ('leftVertex' ())  ~~ x
-- box x ('rightVertex' ()) ~~ 'swap' x
-- box x 'empty'            ~~ 'empty'
-- '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 a -> AdjacencyMap b b -> AdjacencyMap (a, b) (a, b)
box :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a a -> AdjacencyMap b b -> AdjacencyMap (a, b) (a, b)
box = forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
(a -> c -> e)
-> (b -> d -> e)
-> (a -> d -> f)
-> (b -> c -> f)
-> AdjacencyMap a b
-> AdjacencyMap c d
-> AdjacencyMap e f
boxWith (,) (,) (,) (,)

-- | Compute the generalised /Cartesian product/ of two graphs. The resulting
-- vertices are obtained using the given vertex combinators.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- See 'box' for some examples.
--
-- @
-- box == boxWith (,) (,) (,) (,)
-- @
boxWith :: (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)
        => (a -> c -> e) -> (b -> d -> e) -> (a -> d -> f) -> (b -> c -> f)
        -> AdjacencyMap a b -> AdjacencyMap c d -> AdjacencyMap e f
boxWith :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
(a -> c -> e)
-> (b -> d -> e)
-> (a -> d -> f)
-> (b -> c -> f)
-> AdjacencyMap a b
-> AdjacencyMap c d
-> AdjacencyMap e f
boxWith a -> c -> e
ac b -> d -> e
bd a -> d -> f
ad b -> c -> f
bc AdjacencyMap a b
x AdjacencyMap c d
y = forall a b.
(Ord a, Ord b) =>
AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite (forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap (Either a b, Either c d) -> Either e f
combine AdjacencyMap (Either a b, Either c d)
ambox)
  where
    -- ambox :: AM.AdjacencyMap (Either a b, Either c d)
    ambox :: AdjacencyMap (Either a b, Either c d)
ambox = forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
AM.box (forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap (Either a b)
fromBipartite AdjacencyMap a b
x) (forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap (Either a b)
fromBipartite AdjacencyMap c d
y)

    -- combine :: (Either a b, Either c d) -> Either e f
    combine :: (Either a b, Either c d) -> Either e f
combine (Left  a
a, Left  c
c) = forall a b. a -> Either a b
Left  (a -> c -> e
ac a
a c
c)
    combine (Left  a
a, Right d
d) = forall a b. b -> Either a b
Right (a -> d -> f
ad a
a d
d)
    combine (Right b
b, Left  c
c) = forall a b. b -> Either a b
Right (b -> c -> f
bc b
b c
c)
    combine (Right b
b, Right d
d) = forall a b. a -> Either a b
Left  (b -> d -> e
bd b
b d
d)

-- | Check that the internal graph representation is consistent, i.e. that all
-- edges that are present in the 'leftAdjacencyMap' are also present in the
-- 'rightAdjacencyMap' map. 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 ('edge' x y)      == True
-- consistent ('edges' x)       == True
-- consistent ('toBipartite' x) == True
-- consistent ('swap' x)        == True
-- consistent ('circuit' x)     == True
-- consistent ('biclique' x y)  == True
-- @
consistent :: (Ord a, Ord b) => AdjacencyMap a b -> Bool
consistent :: forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Bool
consistent (BAM Map a (Set b)
lr Map b (Set a)
rl) = forall {a} {b}. Map a (Set b) -> [(a, b)]
edgeList Map a (Set b)
lr forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
Data.Tuple.swap forall a b. (a -> b) -> a -> b
$ forall {a} {b}. Map a (Set b) -> [(a, b)]
edgeList Map b (Set a)
rl)
  where
    edgeList :: Map a (Set b) -> [(a, b)]
edgeList Map a (Set b)
lr = [ (a
u, b
v) | (a
u, Set b
vs) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
lr, b
v <- forall a. Set a -> [a]
Set.toAscList Set b
vs ]