content: ----------------------------------------------------------------------------
  -- |
  -- Module     : Algebra.Graph.Bipartite.AdjacencyMap
  -- Copyright  : (c) Andrey Mokhov 2016-2025
  -- License    : MIT (see the file LICENSE)
  -- Maintainer : andrey.mokhov@gmail.com
  -- Stability  : experimental
  --
  -- __Alga__ is a library for algebraic construction and manipulation of graphs
  -- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for
  -- the motivation behind the library, the underlying theory, and
  -- implementation details.
  --
  -- This module defines the 'AdjacencyMap' data type 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 Data.Either
  import Data.List ((\\), sort)
  import Data.Map.Strict (Map)
  import Data.Set (Set)
  import GHC.Exts (IsList(..))
  import GHC.Generics
  
  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)
      -- @
      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)
      -- @
      rightAdjacencyMap :: Map b (Set a)
      } deriving 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 = rightVertex . fromInteger
      (+)         = overlay
      (*)         = connect
      signum      = const empty
      abs         = id
      negate      = id
  
  instance (Ord a, Ord b) => Eq (AdjacencyMap a b) where
      BAM ab1 ba1 == BAM ab2 ba2 = ab1 == ab2 && Map.keysSet ba1 == Map.keysSet ba2
  
  instance (Ord a, Ord b) => Ord (AdjacencyMap a b) where
      compare x y = mconcat
          [ compare (vertexCount x) (vertexCount y)
          , compare (vertexSet   x) (vertexSet   y)
          , compare (edgeCount   x) (edgeCount   y)
          , compare (edgeSet     x) (edgeSet     y) ]
  
  instance (Ord a, Ord b, Show a, Show b) => Show (AdjacencyMap a b) where
      showsPrec p g
          | null as && null bs             = showString "empty"
          | null es                        = showParen (p > 10) $ vShow as bs
          | (as == aUsed) && (bs == bUsed) = showParen (p > 10) $ eShow es
          | otherwise                      = showParen (p > 10)
                                           $ showString "overlay ("
                                           . veShow (vs \\ used)
                                           . showString ") ("
                                           . eShow es
                                           . showString ")"
        where
          as = leftVertexList g
          bs = rightVertexList g
          vs = vertexList g
          es = edgeList g
          aUsed = Set.toAscList $ Set.fromAscList [ a | (a, _) <- edgeList g ]
          bUsed = Set.toAscList $ Set.fromAscList [ b | (b, _) <- edgeList (swap g) ]
          used  = map Left aUsed ++ map Right bUsed
          vShow [a] []  = showString "leftVertex "  . showsPrec 11 a
          vShow []  [b] = showString "rightVertex " . showsPrec 11 b
          vShow as  bs  = showString "vertices "    . showsPrec 11 as
                        . showString " " . showsPrec 11 bs
          eShow [(a, b)] = showString "edge " . showsPrec 11 a
                         . showString " " . showsPrec 11 b
          eShow es       = showString "edges " . showsPrec 11 es
          veShow xs      = vShow (lefts xs) (rights xs)
  
  -- | Defined via 'overlay'.
  instance (Ord a, Ord b) => Semigroup (AdjacencyMap a b) where
      (<>) = overlay
  
  -- | Defined via 'overlay' and 'empty'.
  instance (Ord a, Ord b) => Monoid (AdjacencyMap a b) where
      mempty = 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 = BAM Map.empty 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 a = BAM (Map.singleton a Set.empty) 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 b = BAM Map.empty (Map.singleton b Set.empty)
  
  -- | Construct the graph comprising /a single isolated vertex/.
  --
  -- @
  -- vertex . Left  == 'leftVertex'
  -- vertex . Right == 'rightVertex'
  -- @
  vertex :: Either a b -> AdjacencyMap a b
  vertex (Left  a) = leftVertex a
  vertex (Right b) = rightVertex 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 a b =
      BAM (Map.singleton a (Set.singleton b)) (Map.singleton b (Set.singleton 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 (BAM ab1 ba1) (BAM ab2 ba2) =
      BAM (Map.unionWith Set.union ab1 ab2) (Map.unionWith Set.union ba1 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 (BAM ab1 ba1) (BAM ab2 ba2) = BAM ab ba
    where
      a1 = Map.keysSet ab1
      a2 = Map.keysSet ab2
      b1 = Map.keysSet ba1
      b2 = Map.keysSet ba2
      ab = Map.unionsWith Set.union
          [ ab1, ab2, Map.fromSet (const b2) a1, Map.fromSet (const b1) a2 ]
      ba = Map.unionsWith Set.union
          [ ba1, ba2, Map.fromSet (const a2) b1, Map.fromSet (const a1) 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 as bs = BAM (Map.fromList [ (a, Set.empty) | a <- as ])
                       (Map.fromList [ (b, Set.empty) | 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 es = BAM (Map.fromListWith Set.union [ (a, Set.singleton b) | (a, b) <- es ])
                 (Map.fromListWith Set.union [ (b, Set.singleton a) | (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 xs = BAM (Map.unionsWith Set.union (map leftAdjacencyMap  xs))
                    (Map.unionsWith Set.union (map rightAdjacencyMap 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 = foldr connect 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 (BAM ab ba) = BAM ba 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 g = BAM (Map.fromAscList [ (a, getRights vs) | (Left  a, vs) <- am ])
                      (Map.fromAscList [ (b, getLefts  vs) | (Right b, vs) <- am ])
    where
      getRights = Set.fromAscList . rights . Set.toAscList
      getLefts  = Set.fromAscList . lefts  . Set.toAscList
      am        = Map.toAscList $ AM.adjacencyMap $ AM.symmetricClosure 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 f = toBipartite . AM.gmap 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 (BAM ab ba) = AM.fromAdjacencySets $
      [ (Left  a, Set.mapMonotonic Right bs) | (a, bs) <- Map.toAscList ab ] ++
      [ (Right b, Set.mapMonotonic Left  as) | (b, as) <- Map.toAscList 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 f g (BAM ab ba) = AM.fromAdjacencySets $
      [ (f a, Set.map g bs) | (a, bs) <- Map.toAscList ab ] ++
      [ (g b, Set.map f as) | (b, as) <- Map.toAscList 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 (BAM ab ba) = Map.null ab && Map.null 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 a (BAM ab _) = Map.member a 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 b (BAM _ ba) = Map.member b 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 (Left  a) = hasLeftVertex a
  hasVertex (Right b) = hasRightVertex 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 a b (BAM ab _) = (Set.member b <$> Map.lookup a ab) == Just 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 = Map.size . 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 = Map.size . 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 g = leftVertexCount g + rightVertexCount 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 = Map.foldr ((+) . Set.size) 0 . 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 = Map.keys . 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 = Map.keys . 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 g = map Left (leftVertexList g) ++ map Right (rightVertexList 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 (BAM ab _) = [ (a, b) | (a, bs) <- Map.toAscList ab, b <- Set.toAscList 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 = Map.keysSet . 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 = Map.keysSet . 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 = Set.fromAscList . 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 = Set.fromAscList . 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 (BAM ab _) = fmap Set.toAscList <$> Map.toAscList 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 (BAM _ ba) = fmap Set.toAscList <$> Map.toAscList 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 (Eq, Generic, Ord, Show)
  
  instance IsList (List a a) where
      type Item (List a a) = a
  
      fromList = foldr Cons Nil
  
      toList Nil         = []
      toList (Cons a as) = a : toList 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 = foldr (\(a, b) -> Cons a . Cons 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 a = Cons a . 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 Nil          = empty
  path (Cons a Nil) = leftVertex a
  path abs          = edges (zip as bs ++ zip (drop 1 as) bs)
    where
      (as, bs) = split abs
  
      split :: List a b -> ([a], [b])
      split xs = case xs of
          Nil                 -> ([], [])
          Cons a Nil          -> ([a], [])
          Cons a (Cons b abs) -> (a : as, b : bs) where (as, bs) = split 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 [] = empty
  circuit xs = edges $ xs ++ zip (drop 1 $ cycle as) bs
    where
      (as, bs) = unzip 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 xs ys = BAM (Map.fromSet (const sys) sxs) (Map.fromSet (const sxs) sys)
    where
      sxs = Set.fromList xs
      sys = Set.fromList 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 x ys = connect (leftVertex x) (vertices [] 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 = overlays . map (uncurry 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 a (BAM ab ba) = BAM (Map.delete a ab) (Map.map (Set.delete 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 b (BAM ab ba) = BAM (Map.map (Set.delete b) ab) (Map.delete b 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 a b (BAM ab ba) =
      BAM (Map.adjust (Set.delete b) a ab) (Map.adjust (Set.delete a) b 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 f g (BAM ab ba) = BAM cd dc
    where
      cd = Map.map (Set.map g) $ Map.mapKeysWith Set.union f ab
      dc = Map.map (Set.map f) $ Map.mapKeysWith Set.union g 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 as bs = box (path $ fromList as) (path $ fromList 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 = 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 ac bd ad bc x y = toBipartite (AM.gmap combine ambox)
    where
      -- ambox :: AM.AdjacencyMap (Either a b, Either c d)
      ambox = AM.box (fromBipartite x) (fromBipartite y)
  
      -- combine :: (Either a b, Either c d) -> Either e f
      combine (Left  a, Left  c) = Left  (ac a c)
      combine (Left  a, Right d) = Right (ad a d)
      combine (Right b, Left  c) = Right (bc b c)
      combine (Right b, Right d) = Left  (bd b 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 (BAM lr rl) = edgeList lr == sort (map Data.Tuple.swap $ edgeList rl)
    where
      edgeList lr = [ (u, v) | (u, vs) <- Map.toAscList lr, v <- Set.toAscList vs ]
  