-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Relation
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : [email protected]
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module defines the 'Relation' data type, as well as associated
-- operations and algorithms. 'Relation' is an instance of the 'C.Graph' type
-- class, which can be used for polymorphic graph construction and manipulation.
-----------------------------------------------------------------------------
module Algebra.Graph.Relation (
    -- * Data structure
    Relation, domain, relation,

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

    -- * Relations on graphs
    isSubgraphOf,

    -- * Graph properties
    isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,
    adjacencyList, vertexSet, edgeSet, preSet, postSet,

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

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

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

    -- * Miscellaneous
    consistent
    ) where

import Control.DeepSeq
import Data.Bifunctor
import Data.Set (Set, union)
import Data.String
import Data.Tree
import Data.Tuple

import qualified Data.IntSet as IntSet
import qualified Data.Maybe  as Maybe
import qualified Data.Set    as Set
import qualified Data.Tree   as Tree

import Algebra.Graph.Internal

import qualified Algebra.Graph                 as G
import qualified Algebra.Graph.AdjacencyIntMap as AIM
import qualified Algebra.Graph.AdjacencyMap    as AM
import qualified Algebra.Graph.ToGraph         as T

{-| The 'Relation' data type represents a graph as a /binary relation/. We
define a 'Num' instance as a convenient notation for working with graphs:

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

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

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

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

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

    * 'overlay' is commutative and associative:

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

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

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

    * 'connect' distributes over 'overlay':

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

    * 'connect' can be decomposed:

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

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

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

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

    * Absorption and saturation of 'connect':

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

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

The total order on graphs is defined using /size-lexicographic/ comparison:

* Compare the number of vertices. In case of a tie, continue.
* Compare the sets of vertices. In case of a tie, continue.
* Compare the number of edges. In case of a tie, continue.
* Compare the sets of edges.

Here are a few examples:

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

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

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

@'empty' <= x
x     <= x + y
x + y <= x * y@
-}
data Relation a = Relation {
    -- | The /domain/ of the relation. Complexity: /O(1)/ time and memory.
    forall a. Relation a -> Set a
domain :: Set a,
    -- | The set of pairs of elements that are /related/. It is guaranteed that
    -- each element belongs to the domain. Complexity: /O(1)/ time and memory.
    forall a. Relation a -> Set (a, a)
relation :: Set (a, a)
  } deriving Relation a -> Relation a -> Bool
forall a. Eq a => Relation a -> Relation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation a -> Relation a -> Bool
$c/= :: forall a. Eq a => Relation a -> Relation a -> Bool
== :: Relation a -> Relation a -> Bool
$c== :: forall a. Eq a => Relation a -> Relation a -> Bool
Eq

instance (Ord a, Show a) => Show (Relation a) where
    showsPrec :: Int -> Relation a -> ShowS
showsPrec Int
p (Relation Set a
d Set (a, a)
r)
        | forall a. Set a -> Bool
Set.null Set a
d = String -> ShowS
showString String
"empty"
        | forall a. Set a -> Bool
Set.null Set (a, a)
r = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> ShowS
vshow (forall a. Set a -> [a]
Set.toAscList Set a
d)
        | Set a
d forall a. Eq a => a -> a -> Bool
== Set a
used  = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Show a, Show a) => [(a, a)] -> ShowS
eshow (forall a. Set a -> [a]
Set.toAscList Set (a, a)
r)
        | Bool
otherwise  = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
                           String -> ShowS
showString String
"overlay (" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           forall {a}. Show a => [a] -> ShowS
vshow (forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
d Set a
used) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           String -> ShowS
showString String
") (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}. (Show a, Show a) => [(a, a)] -> ShowS
eshow (forall a. Set a -> [a]
Set.toAscList Set (a, a)
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           String -> ShowS
showString String
")"
      where
        vshow :: [a] -> ShowS
vshow [a
x]      = String -> ShowS
showString String
"vertex "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
        vshow [a]
xs       = String -> ShowS
showString String
"vertices " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
xs
        eshow :: [(a, a)] -> ShowS
eshow [(a
x, a
y)] = String -> ShowS
showString String
"edge "     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         String -> ShowS
showString String
" "         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
y
        eshow [(a, a)]
xs       = String -> ShowS
showString String
"edges "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
xs
        used :: Set a
used           = forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r

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

instance NFData a => NFData (Relation a) where
    rnf :: Relation a -> ()
rnf (Relation Set a
d Set (a, a)
r) = forall a. NFData a => a -> ()
rnf Set a
d seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Set (a, a)
r

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

instance IsString a => IsString (Relation a) where
    fromString :: String -> Relation a
fromString = forall a. a -> Relation a
vertex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

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

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

instance Ord a => T.ToGraph (Relation a) where
    type ToVertex (Relation a) = a
    toGraph :: Relation a -> Graph (ToVertex (Relation a))
toGraph Relation a
r                  = forall a. [a] -> Graph a
G.vertices (forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Relation a -> Set a
domain   Relation a
r) forall a. Graph a -> Graph a -> Graph a
`G.overlay`
                                 forall a. [(a, a)] -> Graph a
G.edges    (forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Relation a -> Set (a, a)
relation Relation a
r)
    isEmpty :: Relation a -> Bool
isEmpty                    = forall a. Relation a -> Bool
isEmpty
    hasVertex :: Eq (ToVertex (Relation a)) =>
ToVertex (Relation a) -> Relation a -> Bool
hasVertex                  = forall a. Ord a => a -> Relation a -> Bool
hasVertex
    hasEdge :: Eq (ToVertex (Relation a)) =>
ToVertex (Relation a)
-> ToVertex (Relation a) -> Relation a -> Bool
hasEdge                    = forall a. Ord a => a -> a -> Relation a -> Bool
hasEdge
    vertexCount :: Ord (ToVertex (Relation a)) => Relation a -> Int
vertexCount                = forall a. Relation a -> Int
vertexCount
    edgeCount :: Ord (ToVertex (Relation a)) => Relation a -> Int
edgeCount                  = forall a. Relation a -> Int
edgeCount
    vertexList :: Ord (ToVertex (Relation a)) =>
Relation a -> [ToVertex (Relation a)]
vertexList                 = forall a. Relation a -> [a]
vertexList
    vertexSet :: Ord (ToVertex (Relation a)) =>
Relation a -> Set (ToVertex (Relation a))
vertexSet                  = forall a. Relation a -> Set a
vertexSet
    vertexIntSet :: (ToVertex (Relation a) ~ Int) => Relation a -> IntSet
vertexIntSet               = [Int] -> IntSet
IntSet.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> [a]
vertexList
    edgeList :: Ord (ToVertex (Relation a)) =>
Relation a -> [(ToVertex (Relation a), ToVertex (Relation a))]
edgeList                   = forall a. Relation a -> [(a, a)]
edgeList
    edgeSet :: Ord (ToVertex (Relation a)) =>
Relation a -> Set (ToVertex (Relation a), ToVertex (Relation a))
edgeSet                    = forall a. Relation a -> Set (a, a)
edgeSet
    adjacencyList :: Ord (ToVertex (Relation a)) =>
Relation a -> [(ToVertex (Relation a), [ToVertex (Relation a)])]
adjacencyList              = forall a. Eq a => Relation a -> [(a, [a])]
adjacencyList
    toAdjacencyMap :: Ord (ToVertex (Relation a)) =>
Relation a -> AdjacencyMap (ToVertex (Relation a))
toAdjacencyMap             = forall a. Ord a => [(a, [a])] -> AdjacencyMap a
AM.stars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => Relation a -> [(a, [a])]
adjacencyList
    toAdjacencyIntMap :: (ToVertex (Relation a) ~ Int) => Relation a -> AdjacencyIntMap
toAdjacencyIntMap          = [(Int, [Int])] -> AdjacencyIntMap
AIM.stars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => Relation a -> [(a, [a])]
adjacencyList
    toAdjacencyMapTranspose :: Ord (ToVertex (Relation a)) =>
Relation a -> AdjacencyMap (ToVertex (Relation a))
toAdjacencyMapTranspose    = forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
AM.transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
(ToGraph t, Ord (ToVertex t)) =>
t -> AdjacencyMap (ToVertex t)
T.toAdjacencyMap
    toAdjacencyIntMapTranspose :: (ToVertex (Relation a) ~ Int) => Relation a -> AdjacencyIntMap
toAdjacencyIntMapTranspose = AdjacencyIntMap -> AdjacencyIntMap
AIM.transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. (ToGraph t, ToVertex t ~ Int) => t -> AdjacencyIntMap
T.toAdjacencyIntMap

-- | Construct the /empty graph/.
--
-- @
-- 'isEmpty'     empty == True
-- 'hasVertex' x empty == False
-- 'vertexCount' empty == 0
-- 'edgeCount'   empty == 0
-- @
empty :: Relation a
empty :: forall a. Relation a
empty = forall a. Set a -> Set (a, a) -> Relation a
Relation forall a. Set a
Set.empty forall a. Set a
Set.empty

-- | Construct the graph comprising /a single isolated vertex/.
--
-- @
-- 'isEmpty'     (vertex x) == False
-- 'hasVertex' x (vertex y) == (x == y)
-- 'vertexCount' (vertex x) == 1
-- 'edgeCount'   (vertex x) == 0
-- @
vertex :: a -> Relation a
vertex :: forall a. a -> Relation a
vertex a
x = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. a -> Set a
Set.singleton a
x) forall a. Set a
Set.empty

-- | Construct the graph comprising /a single edge/.
--
-- @
-- edge x y               == 'connect' ('vertex' x) ('vertex' y)
-- 'hasEdge' x y (edge x y) == True
-- 'edgeCount'   (edge x y) == 1
-- 'vertexCount' (edge 1 1) == 1
-- 'vertexCount' (edge 1 2) == 2
-- @
edge :: Ord a => a -> a -> Relation a
edge :: forall a. Ord a => a -> a -> Relation a
edge a
x a
y = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => [a] -> Set a
Set.fromList [a
x, a
y]) (forall a. a -> Set a
Set.singleton (a
x, a
y))

-- | /Overlay/ two graphs. This is a commutative, associative and idempotent
-- operation with the identity 'empty'.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'vertexCount' (overlay x y) >= 'vertexCount' x
-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y
-- 'edgeCount'   (overlay x y) >= 'edgeCount' x
-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y
-- 'vertexCount' (overlay 1 2) == 2
-- 'edgeCount'   (overlay 1 2) == 0
-- @
overlay :: Ord a => Relation a -> Relation a -> Relation a
overlay :: forall a. Ord a => Relation a -> Relation a -> Relation a
overlay Relation a
x Relation a
y = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Relation a -> Set a
domain Relation a
x forall a. Ord a => Set a -> Set a -> Set a
`union` forall a. Relation a -> Set a
domain Relation a
y) (forall a. Relation a -> Set (a, a)
relation Relation a
x forall a. Ord a => Set a -> Set a -> Set a
`union` forall a. Relation a -> Set (a, a)
relation Relation a
y)

-- | /Connect/ two graphs. This is an associative operation with the identity
-- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the
-- number of edges in the resulting graph is quadratic with respect to the number
-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.
--
-- @
-- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'vertexCount' (connect x y) >= 'vertexCount' x
-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y
-- 'edgeCount'   (connect x y) >= 'edgeCount' x
-- 'edgeCount'   (connect x y) >= 'edgeCount' y
-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y
-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y
-- 'vertexCount' (connect 1 2) == 2
-- 'edgeCount'   (connect 1 2) == 1
-- @
connect :: Ord a => Relation a -> Relation a -> Relation a
connect :: forall a. Ord a => Relation a -> Relation a -> Relation a
connect Relation a
x Relation a
y = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Relation a -> Set a
domain Relation a
x forall a. Ord a => Set a -> Set a -> Set a
`union` forall a. Relation a -> Set a
domain Relation a
y)
    (forall a. Relation a -> Set (a, a)
relation Relation a
x forall a. Ord a => Set a -> Set a -> Set a
`union` forall a. Relation a -> Set (a, a)
relation Relation a
y forall a. Ord a => Set a -> Set a -> Set a
`union` (forall a. Relation a -> Set a
domain Relation a
x forall a b. Set a -> Set b -> Set (a, b)
`Set.cartesianProduct` forall a. Relation a -> Set a
domain Relation a
y))

-- | Construct the graph comprising a given list of isolated vertices.
-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length
-- of the given list.
--
-- @
-- vertices []            == 'empty'
-- vertices [x]           == 'vertex' x
-- vertices               == 'overlays' . map 'vertex'
-- 'hasVertex' x . vertices == 'elem' x
-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'
-- 'vertexSet'   . vertices == Set.'Set.fromList'
-- @
vertices :: Ord a => [a] -> Relation a
vertices :: forall a. Ord a => [a] -> Relation a
vertices [a]
xs = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) forall a. Set a
Set.empty

-- | Construct the graph from a list of edges.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- edges []          == 'empty'
-- edges [(x,y)]     == 'edge' x y
-- edges             == 'overlays' . 'map' ('uncurry' 'edge')
-- 'edgeCount' . edges == 'length' . 'Data.List.nub'
-- @
edges :: Ord a => [(a, a)] -> Relation a
edges :: forall a. Ord a => [(a, a)] -> Relation a
edges [(a, a)]
es = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall a b. [(a, b)] -> ([a], [b])
unzip [(a, a)]
es) (forall a. Ord a => [a] -> Set a
Set.fromList [(a, a)]
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 => [Relation a] -> Relation a
overlays :: forall a. Ord a => [Relation a] -> Relation a
overlays [Relation a]
xs = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Relation a -> Set a
domain [Relation a]
xs) (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Relation a -> Set (a, a)
relation [Relation a]
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 => [Relation a] -> Relation a
connects :: forall a. Ord a => [Relation a] -> Relation a
connects = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Relation a -> Relation a -> Relation a
connect forall a. Relation a
empty

-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the
-- first graph is a /subgraph/ of the second.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- isSubgraphOf 'empty'         x             ==  True
-- isSubgraphOf ('vertex' x)    'empty'         ==  False
-- isSubgraphOf x             ('overlay' x y) ==  True
-- isSubgraphOf ('overlay' x y) ('connect' x y) ==  True
-- isSubgraphOf ('path' xs)     ('circuit' xs)  ==  True
-- isSubgraphOf x y                         ==> x <= y
-- @
isSubgraphOf :: Ord a => Relation a -> Relation a -> Bool
isSubgraphOf :: forall a. Ord a => Relation a -> Relation a -> Bool
isSubgraphOf Relation a
x Relation a
y = forall a. Relation a -> Set a
domain   Relation a
x forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` forall a. Relation a -> Set a
domain   Relation a
y
                Bool -> Bool -> Bool
&& forall a. Relation a -> Set (a, a)
relation Relation a
x forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` forall a. Relation a -> Set (a, a)
relation Relation a
y

-- | Check if a relation is empty.
-- Complexity: /O(1)/ time.
--
-- @
-- isEmpty 'empty'                       == True
-- isEmpty ('overlay' 'empty' 'empty')       == True
-- isEmpty ('vertex' x)                  == False
-- isEmpty ('removeVertex' x $ 'vertex' x) == True
-- isEmpty ('removeEdge' x y $ 'edge' x y) == False
-- @
isEmpty :: Relation a -> Bool
isEmpty :: forall a. Relation a -> Bool
isEmpty = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set a
domain

-- | Check if a graph contains a given vertex.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasVertex x 'empty'            == False
-- hasVertex x ('vertex' y)       == (x == y)
-- hasVertex x . 'removeVertex' x == 'const' False
-- @
hasVertex :: Ord a => a -> Relation a -> Bool
hasVertex :: forall a. Ord a => a -> Relation a -> Bool
hasVertex a
x = forall a. Ord a => a -> Set a -> Bool
Set.member a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set a
domain

-- | Check if a graph contains a given edge.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasEdge x y 'empty'            == False
-- hasEdge x y ('vertex' z)       == False
-- hasEdge x y ('edge' x y)       == True
-- hasEdge x y . 'removeEdge' x y == 'const' False
-- hasEdge x y                  == 'elem' (x,y) . 'edgeList'
-- @
hasEdge :: Ord a => a -> a -> Relation a -> Bool
hasEdge :: forall a. Ord a => a -> a -> Relation a -> Bool
hasEdge a
x a
y = forall a. Ord a => a -> Set a -> Bool
Set.member (a
x, a
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set (a, a)
relation

-- | The number of vertices in a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- vertexCount 'empty'             ==  0
-- vertexCount ('vertex' x)        ==  1
-- vertexCount                   ==  'length' . 'vertexList'
-- vertexCount x \< vertexCount y ==> x \< y
-- @
vertexCount :: Relation a -> Int
vertexCount :: forall a. Relation a -> Int
vertexCount = forall a. Set a -> Int
Set.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set a
domain

-- | The number of edges in a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- edgeCount 'empty'      == 0
-- edgeCount ('vertex' x) == 0
-- edgeCount ('edge' x y) == 1
-- edgeCount            == 'length' . 'edgeList'
-- @
edgeCount :: Relation a -> Int
edgeCount :: forall a. Relation a -> Int
edgeCount = forall a. Set a -> Int
Set.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set (a, a)
relation

-- | The sorted list of vertices of a given graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexList 'empty'      == []
-- vertexList ('vertex' x) == [x]
-- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'
-- @
vertexList :: Relation a -> [a]
vertexList :: forall a. Relation a -> [a]
vertexList = forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set a
domain

-- | The sorted list of edges of a graph.
-- Complexity: /O(n + m)/ time and /O(m)/ memory.
--
-- @
-- edgeList 'empty'          == []
-- edgeList ('vertex' x)     == []
-- edgeList ('edge' x y)     == [(x,y)]
-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]
-- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'
-- edgeList . 'transpose'    == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . edgeList
-- @
edgeList :: Relation a -> [(a, a)]
edgeList :: forall a. Relation a -> [(a, a)]
edgeList = forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set (a, a)
relation

-- | The set of vertices of a given graph.
-- Complexity: /O(1)/ time.
--
-- @
-- vertexSet 'empty'      == Set.'Set.empty'
-- vertexSet . 'vertex'   == Set.'Set.singleton'
-- vertexSet . 'vertices' == Set.'Set.fromList'
-- @
vertexSet :: Relation a -> Set.Set a
vertexSet :: forall a. Relation a -> Set a
vertexSet = forall a. Relation a -> Set a
domain

-- | The set of edges of a given graph.
-- Complexity: /O(1)/ time.
--
-- @
-- edgeSet 'empty'      == Set.'Set.empty'
-- edgeSet ('vertex' x) == Set.'Set.empty'
-- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y)
-- edgeSet . 'edges'    == Set.'Set.fromList'
-- @
edgeSet :: Relation a -> Set.Set (a, a)
edgeSet :: forall a. Relation a -> Set (a, a)
edgeSet = forall a. Relation a -> Set (a, a)
relation

-- | The sorted /adjacency list/ of a graph.
-- Complexity: /O(n + m)/ time and memory.
--
-- @
-- adjacencyList 'empty'          == []
-- adjacencyList ('vertex' x)     == [(x, [])]
-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]
-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]
-- 'stars' . adjacencyList        == id
-- @
adjacencyList :: Eq a => Relation a -> [(a, [a])]
adjacencyList :: forall a. Eq a => Relation a -> [(a, [a])]
adjacencyList Relation a
r = forall {a} {a}. Eq a => [a] -> [(a, a)] -> [(a, [a])]
go (forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ forall a. Relation a -> Set a
domain Relation a
r) (forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ forall a. Relation a -> Set (a, a)
relation Relation a
r)
  where
    go :: [a] -> [(a, a)] -> [(a, [a])]
go [] [(a, a)]
_      = []
    go [a]
vs []     = forall a b. (a -> b) -> [a] -> [b]
map (, []) [a]
vs
    go (a
x:[a]
vs) [(a, a)]
es = let ([(a, a)]
ys, [(a, a)]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
==a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(a, a)]
es in (a
x, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, a)]
ys) forall a. a -> [a] -> [a]
: [a] -> [(a, a)] -> [(a, [a])]
go [a]
vs [(a, a)]
zs

-- | The /preset/ of an element @x@ is the set of elements that are related to
-- it on the /left/, i.e. @preSet x == { a | aRx }@. In the context of directed
-- graphs, this corresponds to the set of /direct predecessors/ of vertex @x@.
-- Complexity: /O(n + m)/ time and /O(n)/ memory.
--
-- @
-- preSet x 'empty'      == Set.'Set.empty'
-- preSet x ('vertex' x) == Set.'Set.empty'
-- preSet 1 ('edge' 1 2) == Set.'Set.empty'
-- preSet y ('edge' x y) == Set.'Set.fromList' [x]
-- @
preSet :: Ord a => a -> Relation a -> Set.Set a
preSet :: forall a. Ord a => a -> Relation a -> Set a
preSet a
x = forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((forall a. Eq a => a -> a -> Bool
== a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set (a, a)
relation

-- | The /postset/ of an element @x@ is the set of elements that are related to
-- it on the /right/, i.e. @postSet x == { a | xRa }@. In the context of directed
-- graphs, this corresponds to the set of /direct successors/ of vertex @x@.
-- Complexity: /O(n + m)/ time and /O(n)/ memory.
--
-- @
-- postSet x 'empty'      == Set.'Set.empty'
-- postSet x ('vertex' x) == Set.'Set.empty'
-- postSet x ('edge' x y) == Set.'Set.fromList' [y]
-- postSet 2 ('edge' 1 2) == Set.'Set.empty'
-- @
postSet :: Ord a => a -> Relation a -> Set.Set a
postSet :: forall a. Ord a => a -> Relation a -> Set a
postSet a
x = forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((forall a. Eq a => a -> a -> Bool
== a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relation a -> Set (a, a)
relation

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

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

-- | The /clique/ on a list of vertices.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- clique []         == 'empty'
-- clique [x]        == 'vertex' x
-- clique [x,y]      == 'edge' x y
-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]
-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)
-- clique . 'reverse'  == 'transpose' . clique
-- @
clique :: Ord a => [a] -> Relation a
clique :: forall a. Ord a => [a] -> Relation a
clique [a]
xs = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall {a}. Ord a => [a] -> (Set (a, a), Set a)
go [a]
xs)
  where
    go :: [a] -> (Set (a, a), Set a)
go []     = (forall a. Set a
Set.empty, forall a. Set a
Set.empty)
    go (a
x:[a]
xs) = (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (a, a)
res (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a
x,) Set a
set), forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
set)
      where
        (Set (a, a)
res, Set a
set) = [a] -> (Set (a, a), Set a)
go [a]
xs

-- | The /biclique/ on two lists of vertices.
-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.
--
-- @
-- biclique []      []      == 'empty'
-- biclique [x]     []      == 'vertex' x
-- biclique []      [y]     == 'vertex' y
-- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]
-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys)
-- @
biclique :: Ord a => [a] -> [a] -> Relation a
biclique :: forall a. Ord a => [a] -> [a] -> Relation a
biclique [a]
xs [a]
ys = forall a. Set a -> Set (a, a) -> Relation a
Relation (Set a
x forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
y) (Set a
x forall a b. Set a -> Set b -> Set (a, b)
`Set.cartesianProduct` Set a
y)
  where
    x :: Set a
x = forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs
    y :: Set a
y = forall a. Ord a => [a] -> Set a
Set.fromList [a]
ys

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

-- | The /stars/ formed by overlaying a list of 'star's. An inverse of
-- 'adjacencyList'.
-- Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total
-- size of the input.
--
-- @
-- stars []                      == 'empty'
-- stars [(x, [])]               == 'vertex' x
-- stars [(x, [y])]              == 'edge' x y
-- stars [(x, ys)]               == 'star' x ys
-- stars                         == 'overlays' . 'map' ('uncurry' 'star')
-- stars . 'adjacencyList'         == id
-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)
-- @
stars :: Ord a => [(a, [a])] -> Relation a
stars :: forall a. Ord a => [(a, [a])] -> Relation a
stars [(a, [a])]
as = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => [a] -> Set a
Set.fromList [a]
vs) (forall a. Ord a => [a] -> Set a
Set.fromList [(a, a)]
es)
  where
    vs :: [a]
vs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)) [(a, [a])]
as
    es :: [(a, a)]
es = [ (a
x, a
y) | (a
x, [a]
ys) <- [(a, [a])]
as, a
y <- [a]
ys ]

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

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

-- | Remove a vertex from a given graph.
-- Complexity: /O(n + m)/ time.
--
-- @
-- removeVertex x ('vertex' x)       == 'empty'
-- removeVertex 1 ('vertex' 2)       == 'vertex' 2
-- removeVertex x ('edge' x x)       == 'empty'
-- removeVertex 1 ('edge' 1 2)       == 'vertex' 2
-- removeVertex x . removeVertex x == removeVertex x
-- @
removeVertex :: Ord a => a -> Relation a -> Relation a
removeVertex :: forall a. Ord a => a -> Relation a -> Relation a
removeVertex a
x (Relation Set a
d Set (a, a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => a -> Set a -> Set a
Set.delete a
x Set a
d) (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (a, a) -> Bool
notx Set (a, a)
r)
  where
    notx :: (a, a) -> Bool
notx (a
a, a
b) = a
a forall a. Eq a => a -> a -> Bool
/= a
x Bool -> Bool -> Bool
&& a
b forall a. Eq a => a -> a -> Bool
/= a
x

-- | Remove an edge from a given graph.
-- Complexity: /O(log(m))/ time.
--
-- @
-- removeEdge x y ('AdjacencyMap.edge' x y)       == 'vertices' [x,y]
-- removeEdge x y . removeEdge x y == removeEdge x y
-- removeEdge x y . 'removeVertex' x == 'removeVertex' x
-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2
-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2
-- @
removeEdge :: Ord a => a -> a -> Relation a -> Relation a
removeEdge :: forall a. Ord a => a -> a -> Relation a -> Relation a
removeEdge a
x a
y (Relation Set a
d Set (a, a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (forall a. Ord a => a -> Set a -> Set a
Set.delete (a
x, a
y) Set (a, a)
r)

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

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

-- | Transpose a given graph.
-- Complexity: /O(m * log(m))/ time.
--
-- @
-- transpose 'empty'       == 'empty'
-- transpose ('vertex' x)  == 'vertex' x
-- transpose ('edge' x y)  == 'edge' y x
-- transpose . transpose == id
-- 'edgeList' . transpose  == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . 'edgeList'
-- @
transpose :: Ord a => Relation a -> Relation a
transpose :: forall a. Ord a => Relation a -> Relation a
transpose (Relation Set a
d Set (a, a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a b. (a, b) -> (b, a)
swap Set (a, a)
r)

-- | Transform a graph by applying a function to each of its vertices. This is
-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric
-- 'Relation'.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- gmap f 'empty'      == 'empty'
-- gmap f ('vertex' x) == 'vertex' (f x)
-- gmap f ('edge' x y) == 'edge' (f x) (f y)
-- gmap id           == id
-- gmap f . gmap g   == gmap (f . g)
-- @
gmap :: Ord b => (a -> b) -> Relation a -> Relation b
gmap :: forall b a. Ord b => (a -> b) -> Relation a -> Relation b
gmap a -> b
f (Relation Set a
d Set (a, a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f Set a
d) (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f a -> b
f) Set (a, a)
r)

-- | Construct the /induced subgraph/ of a given graph by removing the
-- vertices that do not satisfy a given predicate.
-- Complexity: /O(n + m)/ time, assuming that the predicate takes constant time.
--
-- @
-- induce ('const' True ) x      == x
-- induce ('const' False) x      == 'empty'
-- induce (/= x)               == 'removeVertex' x
-- induce p . induce q         == induce (\\x -> p x && q x)
-- 'isSubgraphOf' (induce p x) x == True
-- @
induce :: (a -> Bool) -> Relation a -> Relation a
induce :: forall a. (a -> Bool) -> Relation a -> Relation a
induce a -> Bool
p (Relation Set a
d Set (a, a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. (a -> Bool) -> Set a -> Set a
Set.filter a -> Bool
p Set a
d) (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (a, a) -> Bool
pp Set (a, a)
r)
  where
    pp :: (a, a) -> Bool
pp (a
x, a
y) = a -> Bool
p a
x Bool -> Bool -> Bool
&& a -> Bool
p a
y

-- | Construct the /induced subgraph/ of a given graph by removing the vertices
-- that are 'Nothing'.
-- Complexity: /O(n + m)/ time.
--
-- @
-- induceJust ('vertex' 'Nothing')                               == 'empty'
-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
-- induceJust . 'gmap' 'Just'                                    == 'id'
-- induceJust . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
-- @
induceJust :: Ord a => Relation (Maybe a) -> Relation a
induceJust :: forall a. Ord a => Relation (Maybe a) -> Relation a
induceJust (Relation Set (Maybe a)
d Set (Maybe a, Maybe a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation (Set (Maybe a) -> Set a
catMaybesSet Set (Maybe a)
d) (forall {b} {d}. Set (Maybe b, Maybe d) -> Set (b, d)
catMaybesSet2 Set (Maybe a, Maybe a)
r)
  where
    catMaybesSet :: Set (Maybe a) -> Set a
catMaybesSet         = forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a. HasCallStack => Maybe a -> a
Maybe.fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
Set.delete forall a. Maybe a
Nothing
    catMaybesSet2 :: Set (Maybe b, Maybe d) -> Set (b, d)
catMaybesSet2        = forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. HasCallStack => Maybe a -> a
Maybe.fromJust forall a. HasCallStack => Maybe a -> a
Maybe.fromJust)
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Set a -> Set a
Set.filter forall {a} {a}. (Maybe a, Maybe a) -> Bool
p
    p :: (Maybe a, Maybe a) -> Bool
p (Maybe a
Nothing, Maybe a
_)       = Bool
False
    p (Maybe a
_,       Maybe a
Nothing) = Bool
False
    p (Maybe a
_,       Maybe a
_)       = Bool
True

-- | Left-to-right /relational composition/ of graphs: vertices @x@ and @z@ are
-- connected in the resulting graph if there is a vertex @y@, such that @x@ is
-- connected to @y@ in the first graph, and @y@ is connected to @z@ in the
-- second graph. There are no isolated vertices in the result. This operation is
-- associative, has 'empty' and single-'vertex' graphs as /annihilating zeroes/,
-- and distributes over 'overlay'.
-- Complexity: /O(n * m * log(m))/ time and /O(n + m)/ memory.
--
-- @
-- compose 'empty'            x                == 'empty'
-- compose x                'empty'            == 'empty'
-- compose ('vertex' x)       y                == 'empty'
-- compose x                ('vertex' y)       == 'empty'
-- compose x                (compose y z)    == compose (compose x y) z
-- compose x                ('overlay' y z)    == 'overlay' (compose x y) (compose x z)
-- compose ('overlay' x y)    z                == 'overlay' (compose x z) (compose y z)
-- compose ('edge' x y)       ('edge' y z)       == 'edge' x z
-- compose ('path'    [1..5]) ('path'    [1..5]) == 'edges' [(1,3), (2,4), (3,5)]
-- compose ('circuit' [1..5]) ('circuit' [1..5]) == 'circuit' [1,3,5,2,4]
-- @
compose :: Ord a => Relation a -> Relation a -> Relation a
compose :: forall a. Ord a => Relation a -> Relation a -> Relation a
compose Relation a
x Relation a
y = forall a. Set a -> Set (a, a) -> Relation a
Relation (forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r) Set (a, a)
r
  where
    vs :: [a]
vs = forall a. Set a -> [a]
Set.toAscList (forall a. Relation a -> Set a
domain Relation a
x forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Relation a -> Set a
domain Relation a
y)
    r :: Set (a, a)
r  = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ forall a. Ord a => a -> Relation a -> Set a
preSet a
v Relation a
x forall a b. Set a -> Set b -> Set (a, b)
`Set.cartesianProduct` forall a. Ord a => a -> Relation a -> Set a
postSet a
v Relation a
y | a
v <- [a]
vs ]

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

-- | Compute the /reflexive closure/ of a graph.
-- Complexity: /O(n * log(m))/ time.
--
-- @
-- reflexiveClosure 'empty'              == 'empty'
-- reflexiveClosure ('vertex' x)         == 'edge' x x
-- reflexiveClosure ('edge' x x)         == 'edge' x x
-- reflexiveClosure ('edge' x y)         == 'edges' [(x,x), (x,y), (y,y)]
-- reflexiveClosure . reflexiveClosure == reflexiveClosure
-- @
reflexiveClosure :: Ord a => Relation a -> Relation a
reflexiveClosure :: forall a. Ord a => Relation a -> Relation a
reflexiveClosure (Relation Set a
d Set (a, a)
r) =
    forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d forall a b. (a -> b) -> a -> b
$ Set (a, a)
r forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. [a] -> Set a
Set.fromDistinctAscList [ (a
a, a
a) | a
a <- forall a. Set a -> [a]
Set.toAscList Set a
d ]

-- | Compute the /symmetric closure/ of a graph.
-- Complexity: /O(m * log(m))/ time.
--
-- @
-- symmetricClosure 'empty'              == 'empty'
-- symmetricClosure ('vertex' x)         == 'vertex' x
-- symmetricClosure ('edge' x y)         == 'edges' [(x,y), (y,x)]
-- symmetricClosure x                  == 'overlay' x ('transpose' x)
-- symmetricClosure . symmetricClosure == symmetricClosure
-- @
symmetricClosure :: Ord a => Relation a -> Relation a
symmetricClosure :: forall a. Ord a => Relation a -> Relation a
symmetricClosure (Relation Set a
d Set (a, a)
r) = forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d forall a b. (a -> b) -> a -> b
$ Set (a, a)
r forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a b. (a, b) -> (b, a)
swap Set (a, a)
r

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

-- | Check that the internal representation of a relation is consistent, i.e. if all
-- pairs of elements in the 'relation' refer to existing elements in the 'domain'.
-- It should be impossible to create an inconsistent 'Relation', and we use this
-- function in testing.
--
-- @
-- consistent 'empty'         == True
-- consistent ('vertex' x)    == True
-- consistent ('overlay' x y) == True
-- consistent ('connect' x y) == True
-- consistent ('edge' x y)    == True
-- consistent ('edges' xs)    == True
-- consistent ('stars' xs)    == True
-- @
consistent :: Ord a => Relation a -> Bool
consistent :: forall a. Ord a => Relation a -> Bool
consistent (Relation Set a
d Set (a, a)
r) = forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
d

-- The set of elements that appear in a given set of pairs.
referredToVertexSet :: Ord a => Set (a, a) -> Set a
referredToVertexSet :: forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList