-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Relation
-- Copyright  : (c) Andrey Mokhov 2016-2019
-- 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 '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.Set (Set, union)
import Data.Tree
import Data.Tuple

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

import Algebra.Graph.Internal

{-| 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.
    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.
    Relation a -> Set (a, a)
relation :: Set (a, a)
  } deriving Relation a -> Relation a -> Bool
(Relation a -> Relation a -> Bool)
-> (Relation a -> Relation a -> Bool) -> Eq (Relation a)
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)
        | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
d = String -> ShowS
showString String
"empty"
        | Set (a, a) -> Bool
forall a. Set a -> Bool
Set.null Set (a, a)
r = 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] -> ShowS
forall a. Show a => [a] -> ShowS
vshow (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
d)
        | Set a
d Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
used  = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow (Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList Set (a, a)
r)
        | 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
.
                           [a] -> ShowS
forall a. Show a => [a] -> ShowS
vshow (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
d Set a
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, a)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow (Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList Set (a, a)
r) ShowS -> ShowS -> ShowS
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 "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
        vshow [a]
xs       = String -> ShowS
showString String
"vertices " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
xs
        eshow :: [(a, a)] -> ShowS
eshow [(a
x, a
y)] = String -> ShowS
showString String
"edge "     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         String -> ShowS
showString String
" "         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
y
        eshow [(a, a)]
xs       = String -> ShowS
showString String
"edges "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
xs
        used :: Set a
used           = Set (a, a) -> Set a
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 = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
        [ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Int
forall a. Relation a -> Int
vertexCount Relation a
x) (Relation a -> Int
forall a. Relation a -> Int
vertexCount  Relation a
y)
        , Set a -> Set a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Set a
forall a. Relation a -> Set a
vertexSet   Relation a
x) (Relation a -> Set a
forall a. Relation a -> Set a
vertexSet    Relation a
y)
        , Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Int
forall a. Relation a -> Int
edgeCount   Relation a
x) (Relation a -> Int
forall a. Relation a -> Int
edgeCount    Relation a
y)
        , Set (a, a) -> Set (a, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
edgeSet     Relation a
x) (Relation a -> Set (a, a)
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) = Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
d () -> () -> ()
`seq` Set (a, a) -> ()
forall a. NFData a => a -> ()
rnf Set (a, a)
r () -> () -> ()
`seq` ()

-- | __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 = a -> Relation a
forall a. a -> Relation a
vertex (a -> Relation a) -> (Integer -> a) -> Integer -> Relation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
    + :: Relation a -> Relation a -> Relation a
(+)         = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
overlay
    * :: Relation a -> Relation a -> Relation a
(*)         = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
connect
    signum :: Relation a -> Relation a
signum      = Relation a -> Relation a -> Relation a
forall a b. a -> b -> a
const Relation a
forall a. Relation a
empty
    abs :: Relation a -> Relation a
abs         = Relation a -> Relation a
forall a. a -> a
id
    negate :: Relation a -> Relation a
negate      = Relation a -> Relation a
forall a. a -> a
id

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

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

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

-- | Construct the graph comprising /a single edge/.
-- Complexity: /O(1)/ time, memory and size.
--
-- @
-- 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 :: a -> a -> Relation a
edge a
x a
y = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a
x, a
y]) ((a, a) -> Set (a, a)
forall a. a -> Set a
Set.singleton (a
x, 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
-- 'hasVertex' x . vertices == 'elem' x
-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'
-- 'vertexSet'   . vertices == Set.'Set.fromList'
-- @
vertices :: Ord a => [a] -> Relation a
vertices :: [a] -> Relation a
vertices [a]
xs = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) Set (a, a)
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 :: [(a, a)] -> Relation a
edges [(a, a)]
es = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (([a], [a]) -> [a]) -> ([a], [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> ([a], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, a)]
es) ([(a, a)] -> Set (a, a)
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 :: [Relation a] -> Relation a
overlays [Relation a]
xs = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set a] -> Set a) -> [Set a] -> Set a
forall a b. (a -> b) -> a -> b
$ (Relation a -> Set a) -> [Relation a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map Relation a -> Set a
forall a. Relation a -> Set a
domain [Relation a]
xs) ([Set (a, a)] -> Set (a, a)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (a, a)] -> Set (a, a)) -> [Set (a, a)] -> Set (a, a)
forall a b. (a -> b) -> a -> b
$ (Relation a -> Set (a, a)) -> [Relation a] -> [Set (a, a)]
forall a b. (a -> b) -> [a] -> [b]
map Relation a -> Set (a, a)
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 :: [Relation a] -> Relation a
connects = (Relation a -> Relation a -> Relation a)
-> Relation a -> [Relation a] -> Relation a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
connect Relation a
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 :: Relation a -> Relation a -> Bool
isSubgraphOf Relation a
x Relation a
y = Relation a -> Set a
forall a. Relation a -> Set a
domain   Relation a
x Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Relation a -> Set a
forall a. Relation a -> Set a
domain   Relation a
y
                Bool -> Bool -> Bool
&& Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
x Set (a, a) -> Set (a, a) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Relation a -> Set (a, a)
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 :: Relation a -> Bool
isEmpty = Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set a -> Bool) -> (Relation a -> Set a) -> Relation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
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 :: a -> Relation a -> Bool
hasVertex a
x = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x (Set a -> Bool) -> (Relation a -> Set a) -> Relation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
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 :: a -> a -> Relation a -> Bool
hasEdge a
x a
y = (a, a) -> Set (a, a) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (a
x, a
y) (Set (a, a) -> Bool)
-> (Relation a -> Set (a, a)) -> Relation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
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 :: Relation a -> Int
vertexCount = Set a -> Int
forall a. Set a -> Int
Set.size (Set a -> Int) -> (Relation a -> Set a) -> Relation a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
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 :: Relation a -> Int
edgeCount = Set (a, a) -> Int
forall a. Set a -> Int
Set.size (Set (a, a) -> Int)
-> (Relation a -> Set (a, a)) -> Relation a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
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 :: Relation a -> [a]
vertexList = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> (Relation a -> Set a) -> Relation a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
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 :: Relation a -> [(a, a)]
edgeList = Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList (Set (a, a) -> [(a, a)])
-> (Relation a -> Set (a, a)) -> Relation a -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
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 :: Relation a -> Set a
vertexSet = Relation a -> Set a
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 :: Relation a -> Set (a, a)
edgeSet = Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation

-- | The sorted /adjacency list/ of a graph.
-- Complexity: /O(n + m)/ time and /O(m)/ 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 :: Relation a -> [(a, [a])]
adjacencyList Relation a
r = [a] -> [(a, a)] -> [(a, [a])]
forall a a. Eq a => [a] -> [(a, a)] -> [(a, [a])]
go (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
r) (Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList (Set (a, a) -> [(a, a)]) -> Set (a, a) -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
r)
  where
    go :: [a] -> [(a, a)] -> [(a, [a])]
go [] [(a, a)]
_      = []
    go [a]
vs []     = (a -> (a, [a])) -> [a] -> [(a, [a])]
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) = ((a, a) -> Bool) -> [(a, a)] -> ([(a, a)], [(a, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) [(a, a)]
es in (a
x, ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
ys) (a, [a]) -> [(a, [a])] -> [(a, [a])]
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 :: a -> Relation a -> Set a
preSet a
x = ((a, a) -> a) -> Set (a, a) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a, a) -> a
forall a b. (a, b) -> a
fst (Set (a, a) -> Set a)
-> (Relation a -> Set (a, a)) -> Relation a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> b
snd) (Set (a, a) -> Set (a, a))
-> (Relation a -> Set (a, a)) -> Relation a -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
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 :: a -> Relation a -> Set a
postSet a
x = ((a, a) -> a) -> Set (a, a) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a, a) -> a
forall a b. (a, b) -> b
snd (Set (a, a) -> Set a)
-> (Relation a -> Set (a, a)) -> Relation a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) (Set (a, a) -> Set (a, a))
-> (Relation a -> Set (a, a)) -> Relation a -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
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 :: [a] -> Relation a
path [a]
xs = case [a]
xs of []     -> Relation a
forall a. Relation a
empty
                     [a
x]    -> a -> Relation a
forall a. a -> Relation a
vertex a
x
                     (a
_:[a]
ys) -> [(a, a)] -> Relation a
forall a. Ord a => [(a, a)] -> Relation a
edges ([a] -> [a] -> [(a, a)]
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 :: [a] -> Relation a
circuit []     = Relation a
forall a. Relation a
empty
circuit (a
x:[a]
xs) = [a] -> Relation a
forall a. Ord a => [a] -> Relation a
path ([a] -> Relation a) -> [a] -> Relation a
forall a b. (a -> b) -> a -> b
$ [a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs [a] -> [a] -> [a]
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 :: [a] -> Relation a
clique [a]
xs = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) ((Set (a, a), Set a) -> Set (a, a)
forall a b. (a, b) -> a
fst ((Set (a, a), Set a) -> Set (a, a))
-> (Set (a, a), Set a) -> Set (a, a)
forall a b. (a -> b) -> a -> b
$ [a] -> (Set (a, a), Set a)
forall a. Ord a => [a] -> (Set (a, a), Set a)
go [a]
xs)
  where
    go :: [a] -> (Set (a, a), Set a)
go []     = (Set (a, a)
forall a. Set a
Set.empty, Set a
forall a. Set a
Set.empty)
    go (a
x:[a]
xs) = (Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (a, a)
res ((a -> (a, a)) -> Set a -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a
x,) Set a
set), a -> Set a -> Set a
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 :: [a] -> [a] -> Relation a
biclique [a]
xs [a]
ys = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
y) (Set a
x Set a -> Set a -> Set (a, a)
forall a b. Set a -> Set b -> Set (a, b)
`setProduct` Set a
y)
  where
    x :: Set a
x = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs
    y :: Set a
y = [a] -> Set a
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 :: a -> [a] -> Relation a
star a
x [] = a -> Relation a
forall a. a -> Relation a
vertex a
x
star a
x [a]
ys = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
connect (a -> Relation a
forall a. a -> Relation a
vertex a
x) ([a] -> Relation a
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 :: [(a, [a])] -> Relation a
stars [(a, [a])]
as = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
vs) ([(a, a)] -> Set (a, a)
forall a. Ord a => [a] -> Set a
Set.fromList [(a, a)]
es)
  where
    vs :: [a]
vs = ((a, [a]) -> [a]) -> [(a, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> [a] -> [a]) -> (a, [a]) -> [a]
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 :: Tree a -> Relation a
tree (Node a
x []) = a -> Relation a
forall a. a -> Relation a
vertex a
x
tree (Node a
x [Tree a]
f ) = a -> [a] -> Relation a
forall a. Ord a => a -> [a] -> Relation a
star a
x ((Tree a -> a) -> [Tree a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> a
forall a. Tree a -> a
rootLabel [Tree a]
f)
    Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
`overlay` [Tree a] -> Relation a
forall a. Ord a => Forest a -> Relation a
forest ((Tree a -> Bool) -> [Tree a] -> [Tree a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tree a -> Bool) -> Tree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree a] -> Bool) -> (Tree a -> [Tree a]) -> Tree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Tree a]
forall a. Tree a -> Forest 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 :: Forest a -> Relation a
forest = [Relation a] -> Relation a
forall a. Ord a => [Relation a] -> Relation a
overlays([Relation a] -> Relation a)
-> (Forest a -> [Relation a]) -> Forest a -> Relation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> Relation a) -> Forest a -> [Relation a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Relation a
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 :: a -> Relation a -> Relation a
removeVertex a
x (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
x Set a
d) (((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x Bool -> Bool -> Bool
&& a
b a -> a -> Bool
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 :: a -> a -> Relation a -> Relation a
removeEdge a
x a
y (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d ((a, a) -> Set (a, a) -> Set (a, a)
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 :: a -> a -> Relation a -> Relation a
replaceVertex a
u a
v = (a -> a) -> Relation a -> Relation a
forall b a. Ord b => (a -> b) -> Relation a -> Relation b
gmap ((a -> a) -> Relation a -> Relation a)
-> (a -> a) -> Relation a -> Relation a
forall a b. (a -> b) -> a -> b
$ \a
w -> if a
w a -> a -> Bool
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
-- /O(1)/ to be evaluated.
--
-- @
-- 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 :: (a -> Bool) -> a -> Relation a -> Relation a
mergeVertices a -> Bool
p a
v = (a -> a) -> Relation a -> Relation a
forall b a. Ord b => (a -> b) -> Relation a -> Relation b
gmap ((a -> a) -> Relation a -> Relation a)
-> (a -> a) -> Relation a -> Relation a
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 :: Relation a -> Relation a
transpose (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (((a, a) -> (a, a)) -> Set (a, a) -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a, a) -> (a, a)
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 :: (a -> b) -> Relation a -> Relation b
gmap a -> b
f (Relation Set a
d Set (a, a)
r) = Set b -> Set (b, b) -> Relation b
forall a. Set a -> Set (a, a) -> Relation a
Relation ((a -> b) -> Set a -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f Set a
d) (((a, a) -> (b, b)) -> Set (a, a) -> Set (b, b)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(a
x, a
y) -> (a -> b
f a
x, a -> b
f a
y)) 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 /O(1)/ to
-- be evaluated.
--
-- @
-- 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 :: (a -> Bool) -> Relation a -> Relation a
induce a -> Bool
p (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter a -> Bool
p Set a
d) (((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
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 :: Relation (Maybe a) -> Relation a
induceJust (Relation Set (Maybe a)
d Set (Maybe a, Maybe a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Set (Maybe a) -> Set a
catMaybesSet Set (Maybe a)
d) (Set (Maybe a, Maybe a) -> Set (a, a)
forall a b. Set (Maybe a, Maybe b) -> Set (a, b)
catMaybesSet2 Set (Maybe a, Maybe a)
r)
  where
    catMaybesSet :: Set (Maybe a) -> Set a
catMaybesSet         = (Maybe a -> a) -> Set (Maybe a) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Set (Maybe a) -> Set a)
-> (Set (Maybe a) -> Set (Maybe a)) -> Set (Maybe a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Set (Maybe a) -> Set (Maybe a)
forall a. Ord a => a -> Set a -> Set a
Set.delete Maybe a
forall a. Maybe a
Nothing
    catMaybesSet2 :: Set (Maybe a, Maybe b) -> Set (a, b)
catMaybesSet2        = ((Maybe a, Maybe b) -> (a, b))
-> Set (Maybe a, Maybe b) -> Set (a, b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (\(Maybe a
x, Maybe b
y) -> (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust Maybe a
x, Maybe b -> b
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust Maybe b
y))
                         (Set (Maybe a, Maybe b) -> Set (a, b))
-> (Set (Maybe a, Maybe b) -> Set (Maybe a, Maybe b))
-> Set (Maybe a, Maybe b)
-> Set (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe a, Maybe b) -> Bool)
-> Set (Maybe a, Maybe b) -> Set (Maybe a, Maybe b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Maybe a, Maybe b) -> Bool
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 :: Relation a -> Relation a -> Relation a
compose Relation a
x Relation a
y = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Set (a, a) -> Set a
forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r) Set (a, a)
r
  where
    d :: Set a
d = Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
y
    r :: Set (a, a)
r = [Set (a, a)] -> Set (a, a)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ a -> Relation a -> Set a
forall a. Ord a => a -> Relation a -> Set a
preSet a
v Relation a
x Set a -> Set a -> Set (a, a)
forall a b. Set a -> Set b -> Set (a, b)
`setProduct` a -> Relation a -> Set a
forall a. Ord a => a -> Relation a -> Set a
postSet a
v Relation a
y | a
v <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
d ]

-- | 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' x y)
-- @
closure :: Ord a => Relation a -> Relation a
closure :: Relation a -> Relation a
closure = Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
reflexiveClosure (Relation a -> Relation a)
-> (Relation a -> Relation a) -> Relation a -> Relation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Relation a
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 :: Relation a -> Relation a
reflexiveClosure (Relation Set a
d Set (a, a)
r) =
    Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (Set (a, a) -> Relation a) -> Set (a, a) -> Relation a
forall a b. (a -> b) -> a -> b
$ Set (a, a)
r Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` [(a, a)] -> Set (a, a)
forall a. [a] -> Set a
Set.fromDistinctAscList [ (a
a, a
a) | a
a <- Set 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 :: Relation a -> Relation a
symmetricClosure (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (Set (a, a) -> Relation a) -> Set (a, a) -> Relation a
forall a b. (a -> b) -> a -> b
$ Set (a, a)
r Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` ((a, a) -> (a, a)) -> Set (a, a) -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a, a) -> (a, a)
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 :: Relation a -> Relation a
transitiveClosure Relation a
old
    | Relation a
old Relation a -> Relation a -> Bool
forall a. Eq a => a -> a -> Bool
== Relation a
new = Relation a
old
    | Bool
otherwise  = Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
transitiveClosure Relation a
new
  where
    new :: Relation a
new = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
overlay Relation a
old (Relation a
old Relation a -> Relation a -> Relation a
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 :: Relation a -> Bool
consistent (Relation Set a
d Set (a, a)
r) = Set (a, a) -> Set a
forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r Set a -> Set a -> Bool
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 :: Set (a, a) -> Set a
referredToVertexSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> (Set (a, a) -> [a]) -> Set (a, a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (([a], [a]) -> [a])
-> (Set (a, a) -> ([a], [a])) -> Set (a, a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> ([a], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, a)] -> ([a], [a]))
-> (Set (a, a) -> [(a, a)]) -> Set (a, a) -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList