-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module     : Algebra.Graph.AdjacencyMap
-- Copyright  : (c) Andrey Mokhov 2016-2024
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module defines the 'AdjacencyMap' data type and associated functions.
-- See "Algebra.Graph.AdjacencyMap.Algorithm" for basic graph algorithms.
-- 'AdjacencyMap' is an instance of the 'C.Graph' type class, which can be used
-- for polymorphic graph construction and manipulation.
-- "Algebra.Graph.AdjacencyIntMap" defines adjacency maps specialised to graphs
-- with @Int@ vertices.
module Cauldron.Graph
  ( -- * Data structure
    AdjacencyMap,
    adjacencyMap,

    -- * 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,
    fromAdjacencySets,
    tree,
    forest,

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

    -- * Graph composition
    compose,
    box,

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

    -- * Miscellaneous
    consistent,
  )
where

import Data.List ((\\))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe qualified as Maybe
import Data.Monoid
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String
import Data.Tree (Forest, Tree (..))
import GHC.Generics

-- | The 'AdjacencyMap' data type represents a graph by a map of vertices to
-- their adjacency sets. 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     :: AdjacencyMap Int) == "empty"
-- show (1         :: AdjacencyMap Int) == "vertex 1"
-- show (1 + 2     :: AdjacencyMap Int) == "vertices [1,2]"
-- show (1 * 2     :: AdjacencyMap Int) == "edge 1 2"
-- show (1 * 2 * 3 :: AdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]"
-- show (1 * 2 + 3 :: AdjacencyMap 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@
newtype AdjacencyMap a = AM
  { -- | The /adjacency map/ of a graph: each vertex is associated with a set of
    -- its direct successors. Complexity: /O(1)/ time and memory.
    --
    -- @
    -- adjacencyMap 'empty'      == Map.'Map.empty'
    -- adjacencyMap ('vertex' x) == Map.'Map.singleton' x Set.'Set.empty'
    -- adjacencyMap ('edge' 1 1) == Map.'Map.singleton' 1 (Set.'Set.singleton' 1)
    -- adjacencyMap ('edge' 1 2) == Map.'Map.fromList' [(1,Set.'Set.singleton' 2), (2,Set.'Set.empty')]
    -- @
    forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap :: Map a (Set a)
  }
  deriving (AdjacencyMap a -> AdjacencyMap a -> Bool
(AdjacencyMap a -> AdjacencyMap a -> Bool)
-> (AdjacencyMap a -> AdjacencyMap a -> Bool)
-> Eq (AdjacencyMap a)
forall a. Eq a => AdjacencyMap a -> AdjacencyMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AdjacencyMap a -> AdjacencyMap a -> Bool
== :: AdjacencyMap a -> AdjacencyMap a -> Bool
$c/= :: forall a. Eq a => AdjacencyMap a -> AdjacencyMap a -> Bool
/= :: AdjacencyMap a -> AdjacencyMap a -> Bool
Eq, (forall x. AdjacencyMap a -> Rep (AdjacencyMap a) x)
-> (forall x. Rep (AdjacencyMap a) x -> AdjacencyMap a)
-> Generic (AdjacencyMap a)
forall x. Rep (AdjacencyMap a) x -> AdjacencyMap a
forall x. AdjacencyMap a -> Rep (AdjacencyMap a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AdjacencyMap a) x -> AdjacencyMap a
forall a x. AdjacencyMap a -> Rep (AdjacencyMap a) x
$cfrom :: forall a x. AdjacencyMap a -> Rep (AdjacencyMap a) x
from :: forall x. AdjacencyMap a -> Rep (AdjacencyMap a) x
$cto :: forall a x. Rep (AdjacencyMap a) x -> AdjacencyMap a
to :: forall x. Rep (AdjacencyMap a) x -> AdjacencyMap a
Generic)

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

instance (Ord a, Show a) => Show (AdjacencyMap a) where
  showsPrec :: Int -> AdjacencyMap a -> ShowS
showsPrec Int
p am :: AdjacencyMap a
am@(AM Map a (Set a)
m)
    | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
vs = String -> ShowS
showString String
"empty"
    | [(a, a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, a)]
es = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [a] -> ShowS
forall {a}. Show a => [a] -> ShowS
vshow [a]
vs
    | [a]
vs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [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 [(a, a)]
es
    | Bool
otherwise =
        Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"overlay ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall {a}. Show a => [a] -> ShowS
vshow ([a]
vs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [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 [(a, a)]
es
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
    where
      vs :: [a]
vs = AdjacencyMap a -> [a]
forall a. AdjacencyMap a -> [a]
vertexList AdjacencyMap a
am
      es :: [(a, a)]
es = AdjacencyMap a -> [(a, a)]
forall a. AdjacencyMap a -> [(a, a)]
edgeList AdjacencyMap a
am
      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 :: [a]
used = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Map a (Set a) -> Set a
forall a. Ord a => Map a (Set a) -> Set a
referredToVertexSet Map a (Set a)
m)

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

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

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

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

-- | Construct the /empty graph/.
--
-- @
-- 'isEmpty'     empty == True
-- 'hasVertex' x empty == False
-- 'vertexCount' empty == 0
-- 'edgeCount'   empty == 0
-- @
empty :: AdjacencyMap a
empty :: forall a. AdjacencyMap a
empty = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM Map a (Set a)
forall k a. Map k a
Map.empty
{-# NOINLINE [1] 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 -> AdjacencyMap a
vertex :: forall a. a -> AdjacencyMap a
vertex a
x = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Map a (Set a)
forall k a. k -> a -> Map k a
Map.singleton a
x Set a
forall a. Set a
Set.empty
{-# NOINLINE [1] vertex #-}

-- | 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 -> AdjacencyMap a
edge :: forall a. Ord a => a -> a -> AdjacencyMap a
edge a
x a
y
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Map a (Set a)
forall k a. k -> a -> Map k a
Map.singleton a
x (a -> Set a
forall a. a -> Set a
Set.singleton a
y)
  | Bool
otherwise = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ [(a, Set a)] -> Map a (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(a
x, a -> Set a
forall a. a -> Set a
Set.singleton a
y), (a
y, Set 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) => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
overlay :: forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
overlay (AM Map a (Set a)
x) (AM Map a (Set a)
y) = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> Map a (Set a) -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map a (Set a)
x Map a (Set a)
y
{-# NOINLINE [1] overlay #-}

-- | /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) => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
connect :: forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
connect (AM Map a (Set a)
x) (AM Map a (Set a)
y) =
  Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$
    (Set a -> Set a -> Set a) -> [Map a (Set a)] -> Map a (Set a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith
      Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union
      [Map a (Set a)
x, Map a (Set a)
y, (a -> Set a) -> Set a -> Map a (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> a -> Set a
forall a b. a -> b -> a
const (Set a -> a -> Set a) -> Set a -> a -> Set a
forall a b. (a -> b) -> a -> b
$ Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
y) (Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
x)]
{-# NOINLINE [1] connect #-}

-- | 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] -> AdjacencyMap a
vertices :: forall a. Ord a => [a] -> AdjacencyMap a
vertices = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> ([a] -> Map a (Set a)) -> [a] -> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Set a)] -> Map a (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(a, Set a)] -> Map a (Set a))
-> ([a] -> [(a, Set a)]) -> [a] -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, Set a)) -> [a] -> [(a, Set a)]
forall a b. (a -> b) -> [a] -> [b]
map (,Set a
forall a. Set a
Set.empty)
{-# NOINLINE [1] vertices #-}

-- | 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'
-- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'
-- @
edges :: (Ord a) => [(a, a)] -> AdjacencyMap a
edges :: forall a. Ord a => [(a, a)] -> AdjacencyMap a
edges = [(a, Set a)] -> AdjacencyMap a
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
fromAdjacencySets ([(a, Set a)] -> AdjacencyMap a)
-> ([(a, a)] -> [(a, Set a)]) -> [(a, a)] -> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> (a, Set a)) -> [(a, a)] -> [(a, Set a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Set a) -> (a, a) -> (a, Set a)
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Set a
forall a. a -> Set a
Set.singleton)

-- | 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) => [AdjacencyMap a] -> AdjacencyMap a
overlays :: forall a. Ord a => [AdjacencyMap a] -> AdjacencyMap a
overlays = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> ([AdjacencyMap a] -> Map a (Set a))
-> [AdjacencyMap a]
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a -> Set a) -> [Map a (Set a)] -> Map a (Set a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Map a (Set a)] -> Map a (Set a))
-> ([AdjacencyMap a] -> [Map a (Set a)])
-> [AdjacencyMap a]
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AdjacencyMap a -> Map a (Set a))
-> [AdjacencyMap a] -> [Map a (Set a)]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap
{-# NOINLINE overlays #-}

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

-- | 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) => AdjacencyMap a -> AdjacencyMap a -> Bool
isSubgraphOf :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a -> Bool
isSubgraphOf (AM Map a (Set a)
x) (AM Map a (Set a)
y) = (Set a -> Set a -> Bool) -> Map a (Set a) -> Map a (Set a) -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Map a (Set a)
x Map a (Set a)
y

-- | Check if a graph 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 :: AdjacencyMap a -> Bool
isEmpty :: forall a. AdjacencyMap a -> Bool
isEmpty = Map a (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null (Map a (Set a) -> Bool)
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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 -> AdjacencyMap a -> Bool
hasVertex :: forall a. Ord a => a -> AdjacencyMap a -> Bool
hasVertex a
x = a -> Map a (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
x (Map a (Set a) -> Bool)
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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 -> AdjacencyMap a -> Bool
hasEdge :: forall a. Ord a => a -> a -> AdjacencyMap a -> Bool
hasEdge a
u a
v (AM Map a (Set a)
m) = case a -> Map a (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
u Map a (Set a)
m of
  Maybe (Set a)
Nothing -> Bool
False
  Just Set a
vs -> a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
v Set a
vs

-- | 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 :: AdjacencyMap a -> Int
vertexCount :: forall a. AdjacencyMap a -> Int
vertexCount = Map a (Set a) -> Int
forall k a. Map k a -> Int
Map.size (Map a (Set a) -> Int)
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | The number of edges in a graph.
-- Complexity: /O(n)/ time.
--
-- @
-- edgeCount 'empty'      == 0
-- edgeCount ('vertex' x) == 0
-- edgeCount ('edge' x y) == 1
-- edgeCount            == 'length' . 'edgeList'
-- @
edgeCount :: AdjacencyMap a -> Int
edgeCount :: forall a. AdjacencyMap a -> Int
edgeCount = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int)
-> (AdjacencyMap a -> Sum Int) -> AdjacencyMap a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Sum Int) -> Map a (Set a) -> Sum Int
forall m a. Monoid m => (a -> m) -> Map a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (Set a -> Int) -> Set a -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Int
forall a. Set a -> Int
Set.size) (Map a (Set a) -> Sum Int)
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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 :: AdjacencyMap a -> [a]
vertexList :: forall a. AdjacencyMap a -> [a]
vertexList = Map a (Set a) -> [a]
forall k a. Map k a -> [k]
Map.keys (Map a (Set a) -> [a])
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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 :: AdjacencyMap a -> [(a, a)]
edgeList :: forall a. AdjacencyMap a -> [(a, a)]
edgeList (AM Map a (Set a)
m) = [(a
x, a
y) | (a
x, Set a
ys) <- Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set a)
m, a
y <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
ys]
{-# INLINE edgeList #-}

-- | The set of vertices of a given graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexSet 'empty'      == Set.'Set.empty'
-- vertexSet . 'vertex'   == Set.'Set.singleton'
-- vertexSet . 'vertices' == Set.'Set.fromList'
-- @
vertexSet :: AdjacencyMap a -> Set a
vertexSet :: forall a. AdjacencyMap a -> Set a
vertexSet = Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Set a) -> Set a)
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | The set of edges of a given graph.
-- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory.
--
-- @
-- 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 :: (Eq a) => AdjacencyMap a -> Set (a, a)
edgeSet :: forall a. Eq a => AdjacencyMap a -> Set (a, a)
edgeSet = [(a, a)] -> Set (a, a)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(a, a)] -> Set (a, a))
-> (AdjacencyMap a -> [(a, a)]) -> AdjacencyMap a -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> [(a, a)]
forall a. AdjacencyMap a -> [(a, a)]
edgeList

-- | 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 :: AdjacencyMap a -> [(a, [a])]
adjacencyList :: forall a. AdjacencyMap a -> [(a, [a])]
adjacencyList = ((a, Set a) -> (a, [a])) -> [(a, Set a)] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (a, Set a) -> (a, [a])
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set a -> [a]
forall a. Set a -> [a]
Set.toAscList) ([(a, Set a)] -> [(a, [a])])
-> (AdjacencyMap a -> [(a, Set a)]) -> AdjacencyMap a -> [(a, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map a (Set a) -> [(a, Set a)])
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> [(a, Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | The /preset/ of an element @x@ is the set of its /direct predecessors/.
-- Complexity: /O(n * log(n))/ 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 -> AdjacencyMap a -> Set a
preSet :: forall a. Ord a => a -> AdjacencyMap a -> Set a
preSet a
x = [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList ([a] -> Set a)
-> (AdjacencyMap a -> [a]) -> AdjacencyMap a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Set a) -> a) -> [(a, Set a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Set a) -> a
forall a b. (a, b) -> a
fst ([(a, Set a)] -> [a])
-> (AdjacencyMap a -> [(a, Set a)]) -> AdjacencyMap a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Set a) -> Bool) -> [(a, Set a)] -> [(a, Set a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a, Set a) -> Bool
forall {a}. (a, Set a) -> Bool
p ([(a, Set a)] -> [(a, Set a)])
-> (AdjacencyMap a -> [(a, Set a)])
-> AdjacencyMap a
-> [(a, Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map a (Set a) -> [(a, Set a)])
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> [(a, Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap
  where
    p :: (a, Set a) -> Bool
p (a
_, Set a
set) = a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
set

-- | The /postset/ of a vertex is the set of its /direct successors/.
-- Complexity: /O(log(n))/ time and /O(1)/ 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 -> AdjacencyMap a -> Set a
postSet :: forall a. Ord a => a -> AdjacencyMap a -> Set a
postSet a
x = Set a -> a -> Map a (Set a) -> Set a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set a
forall a. Set a
Set.empty a
x (Map a (Set a) -> Set a)
-> (AdjacencyMap a -> Map a (Set a)) -> AdjacencyMap a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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] -> AdjacencyMap a
path :: forall a. Ord a => [a] -> AdjacencyMap a
path [a]
xs = case [a]
xs of
  [] -> AdjacencyMap a
forall a. AdjacencyMap a
empty
  [a
x] -> a -> AdjacencyMap a
forall a. a -> AdjacencyMap a
vertex a
x
  (a
_ : [a]
ys) -> [(a, a)] -> AdjacencyMap a
forall a. Ord a => [(a, a)] -> AdjacencyMap 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] -> AdjacencyMap a
circuit :: forall a. Ord a => [a] -> AdjacencyMap a
circuit [] = AdjacencyMap a
forall a. AdjacencyMap a
empty
circuit (a
x : [a]
xs) = [a] -> AdjacencyMap a
forall a. Ord a => [a] -> AdjacencyMap a
path ([a] -> AdjacencyMap a) -> [a] -> AdjacencyMap 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] -> AdjacencyMap a
clique :: forall a. Ord a => [a] -> AdjacencyMap a
clique = [(a, Set a)] -> AdjacencyMap a
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
fromAdjacencySets ([(a, Set a)] -> AdjacencyMap a)
-> ([a] -> [(a, Set a)]) -> [a] -> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, Set a)], Set a) -> [(a, Set a)]
forall a b. (a, b) -> a
fst (([(a, Set a)], Set a) -> [(a, Set a)])
-> ([a] -> ([(a, Set a)], Set a)) -> [a] -> [(a, Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ([(a, Set a)], Set a)
forall {a}. Ord a => [a] -> ([(a, Set a)], Set a)
go
  where
    go :: [a] -> ([(a, Set a)], Set a)
go [] = ([], Set a
forall a. Set a
Set.empty)
    go (a
x : [a]
xs) = let ([(a, Set a)]
res, Set a
set) = [a] -> ([(a, Set a)], Set a)
go [a]
xs in ((a
x, Set a
set) (a, Set a) -> [(a, Set a)] -> [(a, Set a)]
forall a. a -> [a] -> [a]
: [(a, Set a)]
res, a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
set)
{-# NOINLINE [1] clique #-}

-- | 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] -> AdjacencyMap a
biclique :: forall a. Ord a => [a] -> [a] -> AdjacencyMap a
biclique [a]
xs [a]
ys = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ (a -> Set a) -> Set a -> Map a (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet a -> Set a
adjacent (Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` 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
    adjacent :: a -> Set a
adjacent a
v = if a
v a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
x then Set a
y else Set a
forall a. Set a
Set.empty

-- 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] -> AdjacencyMap a
star :: forall a. Ord a => a -> [a] -> AdjacencyMap a
star a
x [] = a -> AdjacencyMap a
forall a. a -> AdjacencyMap a
vertex a
x
star a
x [a]
ys = AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
connect (a -> AdjacencyMap a
forall a. a -> AdjacencyMap a
vertex a
x) ([a] -> AdjacencyMap a
forall a. Ord a => [a] -> AdjacencyMap a
vertices [a]
ys)
{-# INLINE star #-}

-- | 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])] -> AdjacencyMap a
stars :: forall a. Ord a => [(a, [a])] -> AdjacencyMap a
stars = [(a, Set a)] -> AdjacencyMap a
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
fromAdjacencySets ([(a, Set a)] -> AdjacencyMap a)
-> ([(a, [a])] -> [(a, Set a)]) -> [(a, [a])] -> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [a]) -> (a, Set a)) -> [(a, [a])] -> [(a, Set a)]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> Set a) -> (a, [a]) -> (a, Set a)
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList)

-- | Construct a graph from a list of adjacency sets; a variation of 'stars'.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- fromAdjacencySets []                                  == 'empty'
-- fromAdjacencySets [(x, Set.'Set.empty')]                    == 'vertex' x
-- fromAdjacencySets [(x, Set.'Set.singleton' y)]              == 'edge' x y
-- fromAdjacencySets . 'map' ('fmap' Set.'Set.fromList')           == 'stars'
-- 'overlay' (fromAdjacencySets xs) (fromAdjacencySets ys) == fromAdjacencySets (xs '++' ys)
-- @
fromAdjacencySets :: (Ord a) => [(a, Set a)] -> AdjacencyMap a
fromAdjacencySets :: forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
fromAdjacencySets [(a, Set a)]
ss = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> Map a (Set a) -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map a (Set a)
forall {a}. Map a (Set a)
vs Map a (Set a)
es
  where
    vs :: Map a (Set a)
vs = (a -> Set a) -> Set a -> Map a (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> a -> Set a
forall a b. a -> b -> a
const Set a
forall a. Set a
Set.empty) (Set a -> Map a (Set a))
-> ([Set a] -> Set a) -> [Set a] -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set a] -> Map a (Set a)) -> [Set a] -> Map a (Set a)
forall a b. (a -> b) -> a -> b
$ ((a, Set a) -> Set a) -> [(a, Set a)] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Set a) -> Set a
forall a b. (a, b) -> b
snd [(a, Set a)]
ss
    es :: Map a (Set a)
es = (Set a -> Set a -> Set a) -> [(a, Set a)] -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union [(a, Set a)]
ss

-- | The /tree graph/ constructed from a given '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 a -> AdjacencyMap a
tree :: forall a. Ord a => Tree a -> AdjacencyMap a
tree (Node a
x []) = a -> AdjacencyMap a
forall a. a -> AdjacencyMap a
vertex a
x
tree (Node a
x [Tree a]
f) =
  a -> [a] -> AdjacencyMap a
forall a. Ord a => a -> [a] -> AdjacencyMap 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)
    AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
`overlay` [Tree a] -> AdjacencyMap a
forall a. Ord a => Forest a -> AdjacencyMap 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 a. [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 -> [Tree a]
subForest) [Tree a]
f)

-- | The /forest graph/ constructed from a given '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) => Forest a -> AdjacencyMap a
forest :: forall a. Ord a => Forest a -> AdjacencyMap a
forest = [AdjacencyMap a] -> AdjacencyMap a
forall a. Ord a => [AdjacencyMap a] -> AdjacencyMap a
overlays ([AdjacencyMap a] -> AdjacencyMap a)
-> (Forest a -> [AdjacencyMap a]) -> Forest a -> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> AdjacencyMap a) -> Forest a -> [AdjacencyMap a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> AdjacencyMap a
forall a. Ord a => Tree a -> AdjacencyMap a
tree

-- | Remove a vertex from a given graph.
-- Complexity: /O(n*log(n))/ 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 -> AdjacencyMap a -> AdjacencyMap a
removeVertex :: forall a. Ord a => a -> AdjacencyMap a -> AdjacencyMap a
removeVertex a
x = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
x) (Map a (Set a) -> Map a (Set a))
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
x (Map a (Set a) -> Map a (Set a))
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | Remove an edge from a given graph.
-- Complexity: /O(log(n))/ time.
--
-- @
-- removeEdge x y ('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 -> AdjacencyMap a -> AdjacencyMap a
removeEdge :: forall a. Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a
removeEdge a
x a
y = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a) -> a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
y) a
x (Map a (Set a) -> Map a (Set a))
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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 -> AdjacencyMap a -> AdjacencyMap a
replaceVertex :: forall a. Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a
replaceVertex a
u a
v = (a -> a) -> AdjacencyMap a -> AdjacencyMap a
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
gmap ((a -> a) -> AdjacencyMap a -> AdjacencyMap a)
-> (a -> a) -> AdjacencyMap a -> AdjacencyMap 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
-- 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 -> AdjacencyMap a -> AdjacencyMap a
mergeVertices :: forall a.
Ord a =>
(a -> Bool) -> a -> AdjacencyMap a -> AdjacencyMap a
mergeVertices a -> Bool
p a
v = (a -> a) -> AdjacencyMap a -> AdjacencyMap a
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
gmap ((a -> a) -> AdjacencyMap a -> AdjacencyMap a)
-> (a -> a) -> AdjacencyMap a -> AdjacencyMap 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(n))/ time, /O(n + m)/ memory.
--
-- @
-- 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) => AdjacencyMap a -> AdjacencyMap a
transpose :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transpose (AM Map a (Set a)
m) = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Map a (Set a) -> Map a (Set a))
-> Map a (Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey a -> Set a -> Map a (Set a) -> Map a (Set a)
forall {k} {a}.
(Ord k, Ord a) =>
a -> Set k -> Map k (Set a) -> Map k (Set a)
combine Map a (Set a)
forall {a}. Map a (Set a)
vs Map a (Set a)
m
  where
    combine :: a -> Set k -> Map k (Set a) -> Map k (Set a)
combine a
v Set k
es = (Set a -> Set a -> Set a)
-> Map k (Set a) -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((k -> Set a) -> Set k -> Map k (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> k -> Set a
forall a b. a -> b -> a
const (Set a -> k -> Set a) -> Set a -> k -> Set a
forall a b. (a -> b) -> a -> b
$ a -> Set a
forall a. a -> Set a
Set.singleton a
v) Set k
es)
    vs :: Map a (Set a)
vs = (a -> Set a) -> Set a -> Map a (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> a -> Set a
forall a b. a -> b -> a
const Set a
forall a. Set a
Set.empty) (Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
m)
{-# NOINLINE [1] transpose #-}

{-# RULES
"transpose/empty" transpose empty = empty
"transpose/vertex" forall x. transpose (vertex x) = vertex x
"transpose/overlay" forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2)
"transpose/connect" forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1)
"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs)
"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs))
"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs
"transpose/clique" forall xs. transpose (clique xs) = clique (reverse xs)
  #-}

-- | 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
-- 'AdjacencyMap'.
-- 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 a, Ord b) => (a -> b) -> AdjacencyMap a -> AdjacencyMap b
gmap :: forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
gmap a -> b
f = Map b (Set b) -> AdjacencyMap b
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map b (Set b) -> AdjacencyMap b)
-> (AdjacencyMap a -> Map b (Set b))
-> AdjacencyMap a
-> AdjacencyMap b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set b) -> Map b (Set a) -> Map b (Set b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> b) -> Set a -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f) (Map b (Set a) -> Map b (Set b))
-> (AdjacencyMap a -> Map b (Set a))
-> AdjacencyMap a
-> Map b (Set b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a -> Set a)
-> (a -> b) -> Map a (Set a) -> Map b (Set a)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union a -> b
f (Map a (Set a) -> Map b (Set a))
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> Map b (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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) -> AdjacencyMap a -> AdjacencyMap a
induce :: forall a. (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
induce a -> Bool
p = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter a -> Bool
p) (Map a (Set a) -> Map a (Set a))
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Bool) -> Map a (Set a) -> Map a (Set a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\a
k Set a
_ -> a -> Bool
p a
k) (Map a (Set a) -> Map a (Set a))
-> (AdjacencyMap a -> Map a (Set a))
-> AdjacencyMap a
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> Map a (Set a)
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap

-- | 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) => AdjacencyMap (Maybe a) -> AdjacencyMap a
induceJust :: forall a. Ord a => AdjacencyMap (Maybe a) -> AdjacencyMap a
induceJust = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> (AdjacencyMap (Maybe a) -> Map a (Set a))
-> AdjacencyMap (Maybe a)
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Maybe a) -> Set a) -> Map a (Set (Maybe a)) -> Map a (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Set (Maybe a) -> Set a
catMaybesSet (Map a (Set (Maybe a)) -> Map a (Set a))
-> (AdjacencyMap (Maybe a) -> Map a (Set (Maybe a)))
-> AdjacencyMap (Maybe a)
-> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Maybe a) (Set (Maybe a)) -> Map a (Set (Maybe a))
forall {a}. Map (Maybe a) a -> Map a a
catMaybesMap (Map (Maybe a) (Set (Maybe a)) -> Map a (Set (Maybe a)))
-> (AdjacencyMap (Maybe a) -> Map (Maybe a) (Set (Maybe a)))
-> AdjacencyMap (Maybe a)
-> Map a (Set (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap (Maybe a) -> Map (Maybe a) (Set (Maybe a))
forall a. AdjacencyMap a -> Map a (Set a)
adjacencyMap
  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
    catMaybesMap :: Map (Maybe a) a -> Map a a
catMaybesMap = (Maybe a -> a) -> Map (Maybe a) a -> Map a a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Map (Maybe a) a -> Map a a)
-> (Map (Maybe a) a -> Map (Maybe a) a)
-> Map (Maybe a) a
-> Map a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Map (Maybe a) a -> Map (Maybe a) a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Maybe a
forall a. Maybe a
Nothing

-- | 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(n))/ 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) => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
compose :: forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
compose AdjacencyMap a
x AdjacencyMap a
y =
  [(a, Set a)] -> AdjacencyMap a
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
fromAdjacencySets
    [ (a
t, Set a
ys) | a
v <- Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
vs, let ys :: Set a
ys = a -> AdjacencyMap a -> Set a
forall a. Ord a => a -> AdjacencyMap a -> Set a
postSet a
v AdjacencyMap a
y, Bool -> Bool
not (Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
ys), a
t <- Set a -> [a]
forall a. Set a -> [a]
Set.toList (a -> AdjacencyMap a -> Set a
forall a. Ord a => a -> AdjacencyMap a -> Set a
postSet a
v AdjacencyMap a
tx)
    ]
  where
    tx :: AdjacencyMap a
tx = AdjacencyMap a -> AdjacencyMap a
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transpose AdjacencyMap a
x
    vs :: Set a
vs = AdjacencyMap a -> Set a
forall a. AdjacencyMap a -> Set a
vertexSet AdjacencyMap a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` AdjacencyMap a -> Set a
forall a. AdjacencyMap a -> Set a
vertexSet AdjacencyMap a
y

-- | Compute the /Cartesian product/ of graphs.
-- Complexity: /O((n + m) * log(n))/ time and O(n + m) memory.
--
-- @
-- box ('path' [0,1]) ('path' "ab") == 'edges' [ ((0,\'a\'), (0,\'b\'))
--                                       , ((0,\'a\'), (1,\'a\'))
--                                       , ((0,\'b\'), (1,\'b\'))
--                                       , ((1,\'a\'), (1,\'b\')) ]
-- @
--
-- Up to isomorphism between the resulting vertex types, this operation is
-- /commutative/, /associative/, /distributes/ over 'overlay', has singleton
-- graphs as /identities/ and 'empty' as the /annihilating zero/. Below @~~@
-- stands for equality up to an isomorphism, e.g. @(x,@ @()) ~~ x@.
--
-- @
-- box x y               ~~ box y x
-- box x (box y z)       ~~ box (box x y) z
-- box x ('overlay' y z)   == 'overlay' (box x y) (box x z)
-- box x ('vertex' ())     ~~ x
-- box x 'empty'           ~~ 'empty'
-- 'transpose'   (box x y) == box ('transpose' x) ('transpose' y)
-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y
-- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y
-- @
box :: (Ord a, Ord b) => AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
box :: forall a b.
(Ord a, Ord b) =>
AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b)
box (AM Map a (Set a)
x) (AM Map b (Set b)
y) = AdjacencyMap (a, b) -> AdjacencyMap (a, b) -> AdjacencyMap (a, b)
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
overlay (Map (a, b) (Set (a, b)) -> AdjacencyMap (a, b)
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map (a, b) (Set (a, b)) -> AdjacencyMap (a, b))
-> Map (a, b) (Set (a, b)) -> AdjacencyMap (a, b)
forall a b. (a -> b) -> a -> b
$ [((a, b), Set (a, b))] -> Map (a, b) (Set (a, b))
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [((a, b), Set (a, b))]
xs) (Map (a, b) (Set (a, b)) -> AdjacencyMap (a, b)
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map (a, b) (Set (a, b)) -> AdjacencyMap (a, b))
-> Map (a, b) (Set (a, b)) -> AdjacencyMap (a, b)
forall a b. (a -> b) -> a -> b
$ [((a, b), Set (a, b))] -> Map (a, b) (Set (a, b))
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [((a, b), Set (a, b))]
ys)
  where
    xs :: [((a, b), Set (a, b))]
xs = do
      (a
a, Set a
as) <- Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set a)
x
      b
b <- Set b -> [b]
forall a. Set a -> [a]
Set.toAscList (Map b (Set b) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set b)
y)
      ((a, b), Set (a, b)) -> [((a, b), Set (a, b))]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a, b
b), (a -> (a, b)) -> Set a -> Set (a, b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (,b
b) Set a
as)
    ys :: [((a, b), Set (a, b))]
ys = do
      a
a <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
x)
      (b
b, Set b
bs) <- Map b (Set b) -> [(b, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map b (Set b)
y
      ((a, b), Set (a, b)) -> [((a, b), Set (a, b))]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a, b
b), (b -> (a, b)) -> Set b -> Set (a, b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a
a,) Set b
bs)

-- | Compute the /reflexive and transitive closure/ of a graph.
-- Complexity: /O(n * m * log(n)^2)/ 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) => AdjacencyMap a -> AdjacencyMap a
closure :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
closure = AdjacencyMap a -> AdjacencyMap a
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
reflexiveClosure (AdjacencyMap a -> AdjacencyMap a)
-> (AdjacencyMap a -> AdjacencyMap a)
-> AdjacencyMap a
-> AdjacencyMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a -> AdjacencyMap a
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transitiveClosure

-- | Compute the /reflexive closure/ of a graph by adding a self-loop to every
-- vertex.
-- Complexity: /O(n * log(n))/ 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) => AdjacencyMap a -> AdjacencyMap a
reflexiveClosure :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
reflexiveClosure (AM Map a (Set a)
m) = Map a (Set a) -> AdjacencyMap a
forall a. Map a (Set a) -> AdjacencyMap a
AM (Map a (Set a) -> AdjacencyMap a)
-> Map a (Set a) -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert Map a (Set a)
m

-- | Compute the /symmetric closure/ of a graph by overlaying it with its own
-- transpose.
-- Complexity: /O((n + m) * log(n))/ 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) => AdjacencyMap a -> AdjacencyMap a
symmetricClosure :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
symmetricClosure AdjacencyMap a
m = AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
overlay AdjacencyMap a
m (AdjacencyMap a -> AdjacencyMap a
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transpose AdjacencyMap a
m)

-- | Compute the /transitive closure/ of a graph.
-- Complexity: /O(n * m * log(n)^2)/ 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) => AdjacencyMap a -> AdjacencyMap a
transitiveClosure :: forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transitiveClosure AdjacencyMap a
old
  | AdjacencyMap a
old AdjacencyMap a -> AdjacencyMap a -> Bool
forall a. Eq a => a -> a -> Bool
== AdjacencyMap a
new = AdjacencyMap a
old
  | Bool
otherwise = AdjacencyMap a -> AdjacencyMap a
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
transitiveClosure AdjacencyMap a
new
  where
    new :: AdjacencyMap a
new = AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
overlay AdjacencyMap a
old (AdjacencyMap a
old AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
`compose` AdjacencyMap a
old)

-- | Check that the internal graph representation is consistent, i.e. that all
-- edges refer to existing vertices. It should be impossible to create an
-- inconsistent adjacency map, and we use this function in testing.
--
-- @
-- consistent 'empty'         == True
-- consistent ('vertex' x)    == True
-- consistent ('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) => AdjacencyMap a -> Bool
consistent :: forall a. Ord a => AdjacencyMap a -> Bool
consistent (AM Map a (Set a)
m) = Map a (Set a) -> Set a
forall a. Ord a => Map a (Set a) -> Set a
referredToVertexSet Map a (Set a)
m Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
m

-- The set of vertices that are referred to by the edges of an adjacency map.
referredToVertexSet :: (Ord a) => Map a (Set a) -> Set a
referredToVertexSet :: forall a. Ord a => Map a (Set a) -> Set a
referredToVertexSet Map a (Set a)
m =
  [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]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [[a
x, a
y] | (a
x, Set a
ys) <- Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set a)
m, a
y <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
ys]