----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Bipartite.AdjacencyMap
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for
-- the motivation behind the library, the underlying theory, and
-- implementation details.
--
-- This module defines the '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)
    -- @
    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)
    -- @
    AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap :: Map b (Set a)
    } deriving (forall x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x)
-> (forall x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b)
-> Generic (AdjacencyMap a b)
forall x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b
forall x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x
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 = b -> AdjacencyMap a b
forall b a. b -> AdjacencyMap a b
rightVertex (b -> AdjacencyMap a b)
-> (Integer -> b) -> Integer -> AdjacencyMap a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> b
forall a. Num a => Integer -> a
fromInteger
    + :: AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
(+)         = 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
(*)         = 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      = AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
forall a b. a -> b -> a
const AdjacencyMap a b
forall a b. AdjacencyMap a b
empty
    abs :: AdjacencyMap a b -> AdjacencyMap a b
abs         = AdjacencyMap a b -> AdjacencyMap a b
forall a. a -> a
id
    negate :: AdjacencyMap a b -> AdjacencyMap a b
negate      = AdjacencyMap a b -> AdjacencyMap a b
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 Map a (Set b) -> Map a (Set b) -> Bool
forall a. Eq a => a -> a -> Bool
== Map a (Set b)
ab2 Bool -> Bool -> Bool
&& Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba1 Set b -> Set b -> Bool
forall a. Eq a => a -> a -> Bool
== Map b (Set a) -> Set b
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 = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
        [ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
x) (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
y)
        , Set (Either a b) -> Set (Either a b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Set (Either a b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet   AdjacencyMap a b
x) (AdjacencyMap a b -> Set (Either a b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet   AdjacencyMap a b
y)
        , Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
edgeCount   AdjacencyMap a b
x) (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
edgeCount   AdjacencyMap a b
y)
        , Set (a, b) -> Set (a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Set (a, b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet     AdjacencyMap a b
x) (AdjacencyMap a b -> Set (a, b)
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
        | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as Bool -> Bool -> Bool
&& [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
bs             = String -> ShowS
showString String
"empty"
        | [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
es                        = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> ShowS
forall a a. (Show a, Show a) => [a] -> [a] -> ShowS
vShow [a]
as [b]
bs
        | ([a]
as [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
aUsed) Bool -> Bool -> Bool
&& ([b]
bs [b] -> [b] -> Bool
forall a. Eq a => a -> a -> Bool
== [b]
bUsed) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eShow [(a, b)]
es
        | Bool
otherwise                      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
                                         (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"overlay ("
                                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> ShowS
forall a a. (Show a, Show a) => [Either a a] -> ShowS
veShow ([Either a b]
vs [Either a b] -> [Either a b] -> [Either a b]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Either a b]
used)
                                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") ("
                                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eShow [(a, b)]
es
                                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
      where
        as :: [a]
as = AdjacencyMap a b -> [a]
forall a b. AdjacencyMap a b -> [a]
leftVertexList AdjacencyMap a b
g
        bs :: [b]
bs = AdjacencyMap a b -> [b]
forall a b. AdjacencyMap a b -> [b]
rightVertexList AdjacencyMap a b
g
        vs :: [Either a b]
vs = AdjacencyMap a b -> [Either a b]
forall a b. AdjacencyMap a b -> [Either a b]
vertexList AdjacencyMap a b
g
        es :: [(a, b)]
es = AdjacencyMap a b -> [(a, b)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
g
        aUsed :: [a]
aUsed = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList [ a
a | (a
a, b
_) <- AdjacencyMap a b -> [(a, b)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
g ]
        bUsed :: [b]
bUsed = Set b -> [b]
forall a. Set a -> [a]
Set.toAscList (Set b -> [b]) -> Set b -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> Set b
forall a. Eq a => [a] -> Set a
Set.fromAscList [ b
b | (b
b, a
_) <- AdjacencyMap b a -> [(b, a)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList (AdjacencyMap a b -> AdjacencyMap b a
forall a b. AdjacencyMap a b -> AdjacencyMap b a
swap AdjacencyMap a b
g) ]
        used :: [Either a b]
used  = (a -> Either a b) -> [a] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a b
forall a b. a -> Either a b
Left [a]
aUsed [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (b -> Either a b) -> [b] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either a b
forall a b. b -> Either a b
Right [b]
bUsed
        vShow :: [a] -> [a] -> ShowS
vShow [a
a] []  = String -> ShowS
showString String
"leftVertex "  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
        vShow []  [a
b] = String -> ShowS
showString String
"rightVertex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
b
        vShow [a]
as  [a]
bs  = String -> ShowS
showString String
"vertices "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
as
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
bs
        eShow :: [(a, a)] -> ShowS
eShow [(a
a, a
b)] = String -> ShowS
showString String
"edge " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
                       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
b
        eShow [(a, a)]
es       = String -> ShowS
showString String
"edges " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
es
        veShow :: [Either a a] -> ShowS
veShow [Either a a]
xs      = [a] -> [a] -> ShowS
forall a a. (Show a, Show a) => [a] -> [a] -> ShowS
vShow ([Either a a] -> [a]
forall a b. [Either a b] -> [a]
lefts [Either a a]
xs) ([Either a a] -> [a]
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
(<>) = 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 = AdjacencyMap a b
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 :: AdjacencyMap a b
empty = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map a (Set b)
forall k a. Map k a
Map.empty Map b (Set a)
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 :: a -> AdjacencyMap a b
leftVertex a
a = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (a -> Set b -> Map a (Set b)
forall k a. k -> a -> Map k a
Map.singleton a
a Set b
forall a. Set a
Set.empty) Map b (Set a)
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 :: b -> AdjacencyMap a b
rightVertex b
b = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map a (Set b)
forall k a. Map k a
Map.empty (b -> Set a -> Map b (Set a)
forall k a. k -> a -> Map k a
Map.singleton b
b Set a
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 :: Either a b -> AdjacencyMap a b
vertex (Left  a
a) = a -> AdjacencyMap a b
forall a b. a -> AdjacencyMap a b
leftVertex a
a
vertex (Right b
b) = b -> AdjacencyMap a 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 :: a -> b -> AdjacencyMap a b
edge a
a b
b =
    Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (a -> Set b -> Map a (Set b)
forall k a. k -> a -> Map k a
Map.singleton a
a (b -> Set b
forall a. a -> Set a
Set.singleton b
b)) (b -> Set a -> Map b (Set a)
forall k a. k -> a -> Map k a
Map.singleton b
b (a -> Set a
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 :: 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) =
    Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map a (Set b)
ab1 Map a (Set b)
ab2) ((Set a -> Set a -> Set a)
-> Map b (Set a) -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
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 :: 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) = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
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 = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set b)
ab1
    a2 :: Set a
a2 = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set b)
ab2
    b1 :: Set b
b1 = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba1
    b2 :: Set b
b2 = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
ba2
    ab :: Map a (Set b)
ab = (Set b -> Set b -> Set b) -> [Map a (Set b)] -> Map a (Set b)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union
        [ Map a (Set b)
ab1, Map a (Set b)
ab2, (a -> Set b) -> Set a -> Map a (Set b)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set b -> a -> Set b
forall a b. a -> b -> a
const Set b
b2) Set a
a1, (a -> Set b) -> Set a -> Map a (Set b)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set b -> a -> Set b
forall a b. a -> b -> a
const Set b
b1) Set a
a2 ]
    ba :: Map b (Set a)
ba = (Set a -> Set a -> Set a) -> [Map b (Set a)] -> Map b (Set a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union
        [ Map b (Set a)
ba1, Map b (Set a)
ba2, (b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> b -> Set a
forall a b. a -> b -> a
const Set a
a2) Set b
b1, (b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> b -> Set a
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 :: [a] -> [b] -> AdjacencyMap a b
vertices [a]
as [b]
bs = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ([(a, Set b)] -> Map a (Set b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (a
a, Set b
forall a. Set a
Set.empty) | a
a <- [a]
as ])
                     ([(b, Set a)] -> Map b (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (b
b, Set a
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 :: [(a, b)] -> AdjacencyMap a b
edges [(a, b)]
es = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b -> Set b) -> [(a, Set b)] -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (a
a, b -> Set b
forall a. a -> Set a
Set.singleton b
b) | (a
a, b
b) <- [(a, b)]
es ])
               ((Set a -> Set a -> Set a) -> [(b, Set a)] -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (b
b, a -> Set a
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 :: [AdjacencyMap a b] -> AdjacencyMap a b
overlays [AdjacencyMap a b]
xs = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b -> Set b) -> [Map a (Set b)] -> Map a (Set b)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((AdjacencyMap a b -> Map a (Set b))
-> [AdjacencyMap a b] -> [Map a (Set b)]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyMap a b -> Map a (Set b)
forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap  [AdjacencyMap a b]
xs))
                  ((Set a -> Set a -> Set a) -> [Map b (Set a)] -> Map b (Set a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((AdjacencyMap a b -> Map b (Set a))
-> [AdjacencyMap a b] -> [Map b (Set a)]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyMap a b -> Map b (Set a)
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 :: [AdjacencyMap a b] -> AdjacencyMap a b
connects = (AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b)
-> AdjacencyMap a b -> [AdjacencyMap a b] -> AdjacencyMap a b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 AdjacencyMap a b
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 :: AdjacencyMap a b -> AdjacencyMap b a
swap (BAM Map a (Set b)
ab Map b (Set a)
ba) = Map b (Set a) -> Map a (Set b) -> AdjacencyMap b a
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 :: AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite AdjacencyMap (Either a b)
g = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ([(a, Set b)] -> Map a (Set b)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (a
a, Set (Either a b) -> Set b
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 ])
                    ([(b, Set a)] -> Map b (Set a)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (b
b, Set (Either a b) -> Set a
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 = [b] -> Set b
forall a. Eq a => [a] -> Set a
Set.fromAscList ([b] -> Set b)
-> (Set (Either a b) -> [b]) -> Set (Either a b) -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> [b]
forall a b. [Either a b] -> [b]
rights ([Either a b] -> [b])
-> (Set (Either a b) -> [Either a b]) -> Set (Either a b) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either a b) -> [Either a b]
forall a. Set a -> [a]
Set.toAscList
    getLefts :: Set (Either a b) -> Set a
getLefts  = [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList ([a] -> Set a)
-> (Set (Either a b) -> [a]) -> Set (Either a b) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> [a]
forall a b. [Either a b] -> [a]
lefts  ([Either a b] -> [a])
-> (Set (Either a b) -> [Either a b]) -> Set (Either a b) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either a b) -> [Either a b]
forall a. Set a -> [a]
Set.toAscList
    am :: [(Either a b, Set (Either a b))]
am        = Map (Either a b) (Set (Either a b))
-> [(Either a b, Set (Either a b))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map (Either a b) (Set (Either a b))
 -> [(Either a b, Set (Either a b))])
-> Map (Either a b) (Set (Either a b))
-> [(Either a b, Set (Either a b))]
forall a b. (a -> b) -> a -> b
$ AdjacencyMap (Either a b) -> Map (Either a b) (Set (Either a b))
forall a. AdjacencyMap a -> Map a (Set a)
AM.adjacencyMap (AdjacencyMap (Either a b) -> Map (Either a b) (Set (Either a b)))
-> AdjacencyMap (Either a b) -> Map (Either a b) (Set (Either a b))
forall a b. (a -> b) -> a -> b
$ AdjacencyMap (Either a b) -> AdjacencyMap (Either 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 :: (a -> Either b c) -> AdjacencyMap a -> AdjacencyMap b c
toBipartiteWith a -> Either b c
f = AdjacencyMap (Either b c) -> AdjacencyMap b c
forall a b.
(Ord a, Ord b) =>
AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite (AdjacencyMap (Either b c) -> AdjacencyMap b c)
-> (AdjacencyMap a -> AdjacencyMap (Either b c))
-> AdjacencyMap a
-> AdjacencyMap b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either b c) -> AdjacencyMap a -> AdjacencyMap (Either b 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 :: AdjacencyMap a b -> AdjacencyMap (Either a b)
fromBipartite (BAM Map a (Set b)
ab Map b (Set a)
ba) = [(Either a b, Set (Either a b))] -> AdjacencyMap (Either a b)
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets ([(Either a b, Set (Either a b))] -> AdjacencyMap (Either a b))
-> [(Either a b, Set (Either a b))] -> AdjacencyMap (Either a b)
forall a b. (a -> b) -> a -> b
$
    [ (a -> Either a b
forall a b. a -> Either a b
Left  a
a, (b -> Either a b) -> Set b -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic b -> Either a b
forall a b. b -> Either a b
Right Set b
bs) | (a
a, Set b
bs) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab ] [(Either a b, Set (Either a b))]
-> [(Either a b, Set (Either a b))]
-> [(Either a b, Set (Either a b))]
forall a. [a] -> [a] -> [a]
++
    [ (b -> Either a b
forall a b. b -> Either a b
Right b
b, (a -> Either a b) -> Set a -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic a -> Either a b
forall a b. a -> Either a b
Left  Set a
as) | (b
b, Set a
as) <- Map b (Set a) -> [(b, Set a)]
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 :: (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) = [(c, Set c)] -> AdjacencyMap c
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets ([(c, Set c)] -> AdjacencyMap c) -> [(c, Set c)] -> AdjacencyMap c
forall a b. (a -> b) -> a -> b
$
    [ (a -> c
f a
a, (b -> c) -> Set b -> Set c
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map b -> c
g Set b
bs) | (a
a, Set b
bs) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab ] [(c, Set c)] -> [(c, Set c)] -> [(c, Set c)]
forall a. [a] -> [a] -> [a]
++
    [ (b -> c
g b
b, (a -> c) -> Set a -> Set c
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> c
f Set a
as) | (b
b, Set a
as) <- Map b (Set a) -> [(b, Set a)]
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 :: AdjacencyMap a b -> Bool
isEmpty (BAM Map a (Set b)
ab Map b (Set a)
ba) = Map a (Set b) -> Bool
forall k a. Map k a -> Bool
Map.null Map a (Set b)
ab Bool -> Bool -> Bool
&& Map b (Set a) -> 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 :: a -> AdjacencyMap a b -> Bool
hasLeftVertex a
a (BAM Map a (Set b)
ab Map b (Set a)
_) = a -> Map a (Set b) -> Bool
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 :: b -> AdjacencyMap a b -> Bool
hasRightVertex b
b (BAM Map a (Set b)
_ Map b (Set a)
ba) = b -> Map b (Set a) -> Bool
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 :: Either a b -> AdjacencyMap a b -> Bool
hasVertex (Left  a
a) = a -> AdjacencyMap a b -> Bool
forall a b. Ord a => a -> AdjacencyMap a b -> Bool
hasLeftVertex a
a
hasVertex (Right b
b) = b -> AdjacencyMap a b -> Bool
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 :: a -> b -> AdjacencyMap a b -> Bool
hasEdge a
a b
b (BAM Map a (Set b)
ab Map b (Set a)
_) = (b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member b
b (Set b -> Bool) -> Maybe (Set b) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Map a (Set b) -> Maybe (Set b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
a Map a (Set b)
ab) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe 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 :: AdjacencyMap a b -> Int
leftVertexCount = Map a (Set b) -> Int
forall k a. Map k a -> Int
Map.size (Map a (Set b) -> Int)
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
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 :: AdjacencyMap a b -> Int
rightVertexCount = Map b (Set a) -> Int
forall k a. Map k a -> Int
Map.size (Map b (Set a) -> Int)
-> (AdjacencyMap a b -> Map b (Set a)) -> AdjacencyMap a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map b (Set a)
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 :: AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
g = AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
leftVertexCount AdjacencyMap a b
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AdjacencyMap a b -> Int
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 :: AdjacencyMap a b -> Int
edgeCount = (Set b -> Int -> Int) -> Int -> Map a (Set b) -> Int
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Set b -> Int) -> Set b -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set b -> Int
forall a. Set a -> Int
Set.size) Int
0 (Map a (Set b) -> Int)
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
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 :: AdjacencyMap a b -> [a]
leftVertexList = Map a (Set b) -> [a]
forall k a. Map k a -> [k]
Map.keys (Map a (Set b) -> [a])
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
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 :: AdjacencyMap a b -> [b]
rightVertexList = Map b (Set a) -> [b]
forall k a. Map k a -> [k]
Map.keys (Map b (Set a) -> [b])
-> (AdjacencyMap a b -> Map b (Set a)) -> AdjacencyMap a b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map b (Set a)
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 :: AdjacencyMap a b -> [Either a b]
vertexList AdjacencyMap a b
g = (a -> Either a b) -> [a] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a b
forall a b. a -> Either a b
Left (AdjacencyMap a b -> [a]
forall a b. AdjacencyMap a b -> [a]
leftVertexList AdjacencyMap a b
g) [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (b -> Either a b) -> [b] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either a b
forall a b. b -> Either a b
Right (AdjacencyMap a b -> [b]
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 :: 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) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
ab, b
b <- Set 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 :: AdjacencyMap a b -> Set a
leftVertexSet = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Set b) -> Set a)
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
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 :: AdjacencyMap a b -> Set b
rightVertexSet = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet (Map b (Set a) -> Set b)
-> (AdjacencyMap a b -> Map b (Set a)) -> AdjacencyMap a b -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map b (Set a)
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 :: AdjacencyMap a b -> Set (Either a b)
vertexSet = [Either a b] -> Set (Either a b)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([Either a b] -> Set (Either a b))
-> (AdjacencyMap a b -> [Either a b])
-> AdjacencyMap a b
-> Set (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> [Either a b]
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 :: AdjacencyMap a b -> Set (a, b)
edgeSet = [(a, b)] -> Set (a, b)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(a, b)] -> Set (a, b))
-> (AdjacencyMap a b -> [(a, b)]) -> AdjacencyMap a b -> Set (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> [(a, b)]
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 :: AdjacencyMap a b -> [(a, [b])]
leftAdjacencyList (BAM Map a (Set b)
ab Map b (Set a)
_) = (Set b -> [b]) -> (a, Set b) -> (a, [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set b -> [b]
forall a. Set a -> [a]
Set.toAscList ((a, Set b) -> (a, [b])) -> [(a, Set b)] -> [(a, [b])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a (Set b) -> [(a, Set 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 :: AdjacencyMap a b -> [(b, [a])]
rightAdjacencyList (BAM Map a (Set b)
_ Map b (Set a)
ba) = (Set a -> [a]) -> (b, Set a) -> (b, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set a -> [a]
forall a. Set a -> [a]
Set.toAscList ((b, Set a) -> (b, [a])) -> [(b, Set a)] -> [(b, [a])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map b (Set a) -> [(b, Set a)]
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
(List a b -> List a b -> Bool)
-> (List a b -> List a b -> Bool) -> Eq (List a b)
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 x. List a b -> Rep (List a b) x)
-> (forall x. Rep (List a b) x -> List a b) -> Generic (List a b)
forall x. Rep (List a b) x -> List a b
forall x. List a b -> Rep (List a b) x
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, Eq (List a b)
Eq (List a b)
-> (List a b -> List a b -> Ordering)
-> (List a b -> List a b -> Bool)
-> (List a b -> List a b -> Bool)
-> (List a b -> List a b -> Bool)
-> (List a b -> List a b -> Bool)
-> (List a b -> List a b -> List a b)
-> (List a b -> List a b -> List a b)
-> Ord (List a b)
List a b -> List a b -> Bool
List a b -> List a b -> Ordering
List a b -> List a b -> List a b
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
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (List a b)
Ord, Int -> List a b -> ShowS
[List a b] -> ShowS
List a b -> String
(Int -> List a b -> ShowS)
-> (List a b -> String) -> ([List a b] -> ShowS) -> Show (List a b)
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 = (a -> List a a -> List a a) -> List a a -> [a] -> List a a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> List a a -> List a a
forall a b. a -> List b a -> List a b
Cons List a a
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: List a a -> [Item (List 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 :: [(a, b)] -> List a b
evenList = ((a, b) -> List a b -> List a b)
-> List a b -> [(a, b)] -> List a b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a, b
b) -> a -> List b a -> List a b
forall a b. a -> List b a -> List a b
Cons a
a (List b a -> List a b)
-> (List a b -> List b a) -> List a b -> List a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> List a b -> List b a
forall a b. a -> List b a -> List a b
Cons b
b) List a 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 :: a -> [(b, a)] -> List a b
oddList a
a = a -> List b a -> List a b
forall a b. a -> List b a -> List a b
Cons a
a (List b a -> List a b)
-> ([(b, a)] -> List b a) -> [(b, a)] -> List a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, a)] -> List b a
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 :: List a b -> AdjacencyMap a b
path List a b
Nil          = AdjacencyMap a b
forall a b. AdjacencyMap a b
empty
path (Cons a
a List b a
Nil) = a -> AdjacencyMap a b
forall a b. a -> AdjacencyMap a b
leftVertex a
a
path List a b
abs          = [(a, b)] -> AdjacencyMap a b
forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges ([a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [b]
bs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
as) [b]
bs)
  where
    ([a]
as, [b]
bs) = List a b -> ([a], [b])
forall a b. List a b -> ([a], [b])
split List a b
abs

    split :: List a b -> ([a], [b])
    split :: 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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as, b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs) where ([a]
as, [b]
bs) = List a b -> ([a], [b])
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 :: [(a, b)] -> AdjacencyMap a b
circuit [] = AdjacencyMap a b
forall a b. AdjacencyMap a b
empty
circuit [(a, b)]
xs = [(a, b)] -> AdjacencyMap a b
forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges ([(a, b)] -> AdjacencyMap a b) -> [(a, b)] -> AdjacencyMap a b
forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
cycle [a]
as) [b]
bs
  where
    ([a]
as, [b]
bs) = [(a, b)] -> ([a], [b])
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 :: [a] -> [b] -> AdjacencyMap a b
biclique [a]
xs [b]
ys = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((a -> Set b) -> Set a -> Map a (Set b)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set b -> a -> Set b
forall a b. a -> b -> a
const Set b
sys) Set a
sxs) ((b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> b -> Set a
forall a b. a -> b -> a
const Set a
sxs) Set b
sys)
  where
    sxs :: Set a
sxs = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs
    sys :: Set b
sys = [b] -> Set b
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 :: a -> [b] -> AdjacencyMap a b
star a
x [b]
ys = 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 (a -> AdjacencyMap a b
forall a b. a -> AdjacencyMap a b
leftVertex a
x) ([a] -> [b] -> AdjacencyMap a b
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 :: [(a, [b])] -> AdjacencyMap a b
stars = [AdjacencyMap a b] -> AdjacencyMap a b
forall a b.
(Ord a, Ord b) =>
[AdjacencyMap a b] -> AdjacencyMap a b
overlays ([AdjacencyMap a b] -> AdjacencyMap a b)
-> ([(a, [b])] -> [AdjacencyMap a b])
-> [(a, [b])]
-> AdjacencyMap a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [b]) -> AdjacencyMap a b) -> [(a, [b])] -> [AdjacencyMap a b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> [b] -> AdjacencyMap a b) -> (a, [b]) -> AdjacencyMap a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [b] -> AdjacencyMap a b
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 :: a -> AdjacencyMap a b -> AdjacencyMap a b
removeLeftVertex a
a (BAM Map a (Set b)
ab Map b (Set a)
ba) = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (a -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
a Map a (Set b)
ab) ((Set a -> Set a) -> Map b (Set a) -> Map b (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (a -> Set a -> Set a
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 :: b -> AdjacencyMap a b -> AdjacencyMap a b
removeRightVertex b
b (BAM Map a (Set b)
ab Map b (Set a)
ba) = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b) -> Map a (Set b) -> Map a (Set b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.delete b
b) Map a (Set b)
ab) (b -> Map b (Set a) -> Map b (Set a)
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 :: a -> b -> AdjacencyMap a b -> AdjacencyMap a b
removeEdge a
a b
b (BAM Map a (Set b)
ab Map b (Set a)
ba) =
    Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b) -> a -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.delete b
b) a
a Map a (Set b)
ab) ((Set a -> Set a) -> b -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (a -> Set a -> Set a
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 :: (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) = Map c (Set d) -> Map d (Set c) -> AdjacencyMap c d
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 = (Set b -> Set d) -> Map c (Set b) -> Map c (Set d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> d) -> Set b -> Set d
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map b -> d
g) (Map c (Set b) -> Map c (Set d)) -> Map c (Set b) -> Map c (Set d)
forall a b. (a -> b) -> a -> b
$ (Set b -> Set b -> Set b)
-> (a -> c) -> Map a (Set b) -> Map c (Set b)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Set b -> Set b -> Set b
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 = (Set a -> Set c) -> Map d (Set a) -> Map d (Set c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> c) -> Set a -> Set c
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> c
f) (Map d (Set a) -> Map d (Set c)) -> Map d (Set a) -> Map d (Set c)
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> (b -> d) -> Map b (Set a) -> Map d (Set a)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Set a -> Set a -> Set a
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 :: [a] -> [b] -> AdjacencyMap (a, b) (a, b)
mesh [a]
as [b]
bs = AdjacencyMap a a -> AdjacencyMap b b -> AdjacencyMap (a, b) (a, b)
forall a b.
(Ord a, Ord b) =>
AdjacencyMap a a -> AdjacencyMap b b -> AdjacencyMap (a, b) (a, b)
box (List a a -> AdjacencyMap a a
forall a b. (Ord a, Ord b) => List a b -> AdjacencyMap a b
path (List a a -> AdjacencyMap a a) -> List a a -> AdjacencyMap a a
forall a b. (a -> b) -> a -> b
$ [Item (List a a)] -> List a a
forall l. IsList l => [Item l] -> l
fromList [a]
[Item (List a a)]
as) (List b b -> AdjacencyMap b b
forall a b. (Ord a, Ord b) => List a b -> AdjacencyMap a b
path (List b b -> AdjacencyMap b b) -> List b b -> AdjacencyMap b b
forall a b. (a -> b) -> a -> b
$ [Item (List b b)] -> List b b
forall l. IsList l => [Item l] -> l
fromList [b]
[Item (List b 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 :: AdjacencyMap a a -> AdjacencyMap b b -> AdjacencyMap (a, b) (a, b)
box = (a -> b -> (a, b))
-> (a -> b -> (a, b))
-> (a -> b -> (a, b))
-> (a -> b -> (a, b))
-> AdjacencyMap a a
-> AdjacencyMap b b
-> AdjacencyMap (a, b) (a, b)
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 :: (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 = AdjacencyMap (Either e f) -> AdjacencyMap e f
forall a b.
(Ord a, Ord b) =>
AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite (((Either a b, Either c d) -> Either e f)
-> AdjacencyMap (Either a b, Either c d)
-> AdjacencyMap (Either e f)
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 = AdjacencyMap (Either a b)
-> AdjacencyMap (Either c d)
-> AdjacencyMap (Either a b, Either c d)
forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
AM.box (AdjacencyMap a b -> AdjacencyMap (Either a b)
forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap (Either a b)
fromBipartite AdjacencyMap a b
x) (AdjacencyMap c d -> AdjacencyMap (Either c d)
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) = e -> Either e f
forall a b. a -> Either a b
Left  (a -> c -> e
ac a
a c
c)
    combine (Left  a
a, Right d
d) = f -> Either e f
forall a b. b -> Either a b
Right (a -> d -> f
ad a
a d
d)
    combine (Right b
b, Left  c
c) = f -> Either e f
forall a b. b -> Either a b
Right (b -> c -> f
bc b
b c
c)
    combine (Right b
b, Right d
d) = e -> Either e f
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 :: AdjacencyMap a b -> Bool
consistent (BAM Map a (Set b)
lr Map b (Set a)
rl) = Map a (Set b) -> [(a, b)]
forall a b. Map a (Set b) -> [(a, b)]
edgeList Map a (Set b)
lr [(a, b)] -> [(a, b)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(a, b)] -> [(a, b)]
forall a. Ord a => [a] -> [a]
sort (((b, a) -> (a, b)) -> [(b, a)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> (a, b)
forall a b. (a, b) -> (b, a)
Data.Tuple.swap ([(b, a)] -> [(a, b)]) -> [(b, a)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ Map b (Set a) -> [(b, a)]
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) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
lr, b
v <- Set b -> [b]
forall a. Set a -> [a]
Set.toAscList Set b
vs ]