-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Labelled
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module provides a minimal and experimental implementation of algebraic
-- graphs with edge labels. The API will be expanded in the next release.
-----------------------------------------------------------------------------
module Algebra.Graph.Labelled (
    -- * Algebraic data type for edge-labelled graphs
    Graph (..), empty, vertex, edge, (-<), (>-), overlay, connect, vertices,
    edges, overlays,

    -- * Graph folding
    foldg, buildg,

    -- * Relations on graphs
    isSubgraphOf,

    -- * Graph properties
    isEmpty, size, hasVertex, hasEdge, edgeLabel, vertexList, edgeList,
    vertexSet, edgeSet,

    -- * Graph transformation
    removeVertex, removeEdge, replaceVertex, replaceEdge, transpose, emap,
    induce, induceJust,

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

    -- * Types of edge-labelled graphs
    UnlabelledGraph, Automaton, Network,

    -- * Context
    Context (..), context
    ) where

import Data.Bifunctor
import Data.Monoid
import Data.String
import Control.DeepSeq
import GHC.Generics

import Algebra.Graph.Internal (List)
import Algebra.Graph.Label

import qualified Algebra.Graph.Labelled.AdjacencyMap as AM
import qualified Data.Set                            as Set
import qualified Data.Map                            as Map
import qualified GHC.Exts                            as Exts

-- | Edge-labelled graphs, where the type variable @e@ stands for edge labels.
-- For example, 'Graph' @Bool@ @a@ is isomorphic to unlabelled graphs defined in
-- the top-level module "Algebra.Graph.Graph", where @False@ and @True@ denote
-- the lack of and the existence of an unlabelled edge, respectively.
data Graph e a = Empty
               | Vertex a
               | Connect e (Graph e a) (Graph e a)
               deriving (a -> Graph e b -> Graph e a
(a -> b) -> Graph e a -> Graph e b
(forall a b. (a -> b) -> Graph e a -> Graph e b)
-> (forall a b. a -> Graph e b -> Graph e a) -> Functor (Graph e)
forall a b. a -> Graph e b -> Graph e a
forall a b. (a -> b) -> Graph e a -> Graph e b
forall e a b. a -> Graph e b -> Graph e a
forall e a b. (a -> b) -> Graph e a -> Graph e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Graph e b -> Graph e a
$c<$ :: forall e a b. a -> Graph e b -> Graph e a
fmap :: (a -> b) -> Graph e a -> Graph e b
$cfmap :: forall e a b. (a -> b) -> Graph e a -> Graph e b
Functor, Int -> Graph e a -> ShowS
[Graph e a] -> ShowS
Graph e a -> String
(Int -> Graph e a -> ShowS)
-> (Graph e a -> String)
-> ([Graph e a] -> ShowS)
-> Show (Graph e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show a, Show e) => Int -> Graph e a -> ShowS
forall e a. (Show a, Show e) => [Graph e a] -> ShowS
forall e a. (Show a, Show e) => Graph e a -> String
showList :: [Graph e a] -> ShowS
$cshowList :: forall e a. (Show a, Show e) => [Graph e a] -> ShowS
show :: Graph e a -> String
$cshow :: forall e a. (Show a, Show e) => Graph e a -> String
showsPrec :: Int -> Graph e a -> ShowS
$cshowsPrec :: forall e a. (Show a, Show e) => Int -> Graph e a -> ShowS
Show, (forall x. Graph e a -> Rep (Graph e a) x)
-> (forall x. Rep (Graph e a) x -> Graph e a)
-> Generic (Graph e a)
forall x. Rep (Graph e a) x -> Graph e a
forall x. Graph e a -> Rep (Graph e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Graph e a) x -> Graph e a
forall e a x. Graph e a -> Rep (Graph e a) x
$cto :: forall e a x. Rep (Graph e a) x -> Graph e a
$cfrom :: forall e a x. Graph e a -> Rep (Graph e a) x
Generic)

instance (Eq e, Monoid e, Ord a) => Eq (Graph e a) where
    Graph e a
x == :: Graph e a -> Graph e a -> Bool
== Graph e a
y = Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap Graph e a
x AdjacencyMap e a -> AdjacencyMap e a -> Bool
forall a. Eq a => a -> a -> Bool
== Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap Graph e a
y

instance (Eq e, Monoid e, Ord a, Ord e) => Ord (Graph e a) where
    compare :: Graph e a -> Graph e a -> Ordering
compare Graph e a
x Graph e a
y = AdjacencyMap e a -> AdjacencyMap e a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap Graph e a
x) (Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap Graph e a
y)

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

instance IsString a => IsString (Graph e a) where
    fromString :: String -> Graph e a
fromString = a -> Graph e a
forall e a. a -> Graph e a
Vertex (a -> Graph e a) -> (String -> a) -> String -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

instance Bifunctor Graph where
    bimap :: (a -> b) -> (c -> d) -> Graph a c -> Graph b d
bimap a -> b
f c -> d
g = Graph b d
-> (c -> Graph b d)
-> (a -> Graph b d -> Graph b d -> Graph b d)
-> Graph a c
-> Graph b d
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Graph b d
forall e a. Graph e a
Empty (d -> Graph b d
forall e a. a -> Graph e a
Vertex (d -> Graph b d) -> (c -> d) -> c -> Graph b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) (b -> Graph b d -> Graph b d -> Graph b d
forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect (b -> Graph b d -> Graph b d -> Graph b d)
-> (a -> b) -> a -> Graph b d -> Graph b d -> Graph b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance (NFData e, NFData a) => NFData (Graph e a) where
    rnf :: Graph e a -> ()
rnf Graph e a
Empty           = ()
    rnf (Vertex  a
x    ) = a -> ()
forall a. NFData a => a -> ()
rnf a
x
    rnf (Connect e
e Graph e a
x Graph e a
y) = e
e e -> () -> ()
`seq` Graph e a -> ()
forall a. NFData a => a -> ()
rnf Graph e a
x () -> () -> ()
`seq` Graph e a -> ()
forall a. NFData a => a -> ()
rnf Graph e a
y

-- | Defined via 'overlay'.
instance Monoid e => Semigroup (Graph e a) where
    <> :: Graph e a -> Graph e a -> Graph e a
(<>) = Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay

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

-- TODO: This is a very inefficient implementation. Find a way to construct an
-- adjacency map directly, without building intermediate representations for all
-- subgraphs.
-- Extract the adjacency map of a graph.
toAdjacencyMap :: (Eq e, Monoid e, Ord a) => Graph e a -> AM.AdjacencyMap e a
toAdjacencyMap :: Graph e a -> AdjacencyMap e a
toAdjacencyMap = AdjacencyMap e a
-> (a -> AdjacencyMap e a)
-> (e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a)
-> Graph e a
-> AdjacencyMap e a
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg AdjacencyMap e a
forall e a. AdjacencyMap e a
AM.empty a -> AdjacencyMap e a
forall a e. a -> AdjacencyMap e a
AM.vertex e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
AM.connect

-- Convert the adjacency map to a graph.
fromAdjacencyMap :: Monoid e => AM.AdjacencyMap e a -> Graph e a
fromAdjacencyMap :: AdjacencyMap e a -> Graph e a
fromAdjacencyMap = [Graph e a] -> Graph e a
forall e a. Monoid e => [Graph e a] -> Graph e a
overlays ([Graph e a] -> Graph e a)
-> (AdjacencyMap e a -> [Graph e a])
-> AdjacencyMap e a
-> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Map a e) -> Graph e a) -> [(a, Map a e)] -> [Graph e a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Map a e) -> Graph e a
forall e a. Monoid e => (a, Map a e) -> Graph e a
go ([(a, Map a e)] -> [Graph e a])
-> (AdjacencyMap e a -> [(a, Map a e)])
-> AdjacencyMap e a
-> [Graph e a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Map a e) -> [(a, Map a e)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a (Map a e) -> [(a, Map a e)])
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> [(a, Map a e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e a -> Map a (Map a e)
forall e a. AdjacencyMap e a -> Map a (Map a e)
AM.adjacencyMap
  where
    go :: (a, Map a e) -> Graph e a
go (a
u, Map a e
m) = Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay (a -> Graph e a
forall a e. a -> Graph e a
vertex a
u) ([(e, a, a)] -> Graph e a
forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges [ (e
e, a
u, a
v) | (a
v, e
e) <- Map a e -> [(a, e)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a e
m])

-- | Generalised 'Graph' folding: recursively collapse a 'Graph' by applying
-- the provided functions to the leaves and internal nodes of the expression.
-- The order of arguments is: empty, vertex and connect.
-- Complexity: /O(s)/ applications of the given functions. As an example, the
-- complexity of 'size' is /O(s)/, since 'const' and '+' have constant costs.
--
-- @
-- foldg 'empty'     'vertex'        'connect'             == 'id'
-- foldg 'empty'     'vertex'        ('fmap' 'flip' 'connect') == 'transpose'
-- foldg 1         ('const' 1)     ('const' (+))         == 'size'
-- foldg True      ('const' False) ('const' (&&))        == 'isEmpty'
-- foldg False     (== x)        ('const' (||))        == 'hasVertex' x
-- foldg Set.'Set.empty' Set.'Set.singleton' ('const' Set.'Set.union')   == 'vertexSet'
-- @
foldg :: b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg :: b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg b
e a -> b
v e -> b -> b -> b
c = Graph e a -> b
go
  where
    go :: Graph e a -> b
go Graph e a
Empty           = b
e
    go (Vertex    a
x  ) = a -> b
v a
x
    go (Connect e
e Graph e a
x Graph e a
y) = e -> b -> b -> b
c e
e (Graph e a -> b
go Graph e a
x) (Graph e a -> b
go Graph e a
y)

-- | Build a graph given an interpretation of the three graph construction
-- primitives 'empty', 'vertex' and 'connect', in this order. See examples for
-- further clarification.
--
-- @
-- buildg f                                               == f 'empty' 'vertex' 'connect'
-- buildg (\\e _ _ -> e)                                   == 'empty'
-- buildg (\\_ v _ -> v x)                                 == 'vertex' x
-- buildg (\\e v c -> c l ('foldg' e v c x) ('foldg' e v c y)) == 'connect' l x y
-- buildg (\\e v c -> 'foldr' (c 'zero') e ('map' v xs))         == 'vertices' xs
-- buildg (\\e v c -> 'foldg' e v ('flip' . c) g)              == 'transpose' g
-- 'foldg' e v c (buildg f)                                 == f e v c
-- @
buildg :: (forall r. r -> (a -> r) -> (e -> r -> r -> r) -> r) -> Graph e a
buildg :: (forall r. r -> (a -> r) -> (e -> r -> r -> r) -> r) -> Graph e a
buildg forall r. r -> (a -> r) -> (e -> r -> r -> r) -> r
f = Graph e a
-> (a -> Graph e a)
-> (e -> Graph e a -> Graph e a -> Graph e a)
-> Graph e a
forall r. r -> (a -> r) -> (e -> r -> r -> r) -> r
f Graph e a
forall e a. Graph e a
Empty a -> Graph e a
forall e a. a -> Graph e a
Vertex e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect

-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the
-- first graph is a /subgraph/ of the second.
-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a
-- graph can be quadratic with respect to the expression size /s/.
--
-- @
-- isSubgraphOf 'empty'         x             ==  True
-- isSubgraphOf ('vertex' x)    'empty'         ==  False
-- isSubgraphOf x             ('overlay' x y) ==  True
-- isSubgraphOf ('overlay' x y) ('connect' x y) ==  True
-- isSubgraphOf x y                         ==> x <= y
-- @
isSubgraphOf :: (Eq e, Monoid e, Ord a) => Graph e a -> Graph e a -> Bool
isSubgraphOf :: Graph e a -> Graph e a -> Bool
isSubgraphOf Graph e a
x Graph e a
y = Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
x Graph e a
y Graph e a -> Graph e a -> Bool
forall a. Eq a => a -> a -> Bool
== Graph e a
y

-- | Construct the /empty graph/. An alias for the constructor 'Empty'.
--
-- @
-- 'isEmpty'     empty == True
-- 'hasVertex' x empty == False
-- 'Algebra.Graph.ToGraph.vertexCount' empty == 0
-- 'Algebra.Graph.ToGraph.edgeCount'   empty == 0
-- @
empty :: Graph e a
empty :: Graph e a
empty = Graph e a
forall e a. Graph e a
Empty

-- | Construct the graph comprising /a single isolated vertex/. An alias for the
-- constructor 'Vertex'.
--
-- @
-- 'isEmpty'     (vertex x) == False
-- 'hasVertex' x (vertex y) == (x == y)
-- 'Algebra.Graph.ToGraph.vertexCount' (vertex x) == 1
-- 'Algebra.Graph.ToGraph.edgeCount'   (vertex x) == 0
-- @
vertex :: a -> Graph e a
vertex :: a -> Graph e a
vertex = a -> Graph e a
forall e a. a -> Graph e a
Vertex

-- | Construct the graph comprising /a single labelled edge/.
--
-- @
-- edge e    x y              == 'connect' e ('vertex' x) ('vertex' y)
-- edge 'zero' x y              == 'vertices' [x,y]
-- 'hasEdge'   x y (edge e x y) == (e /= 'zero')
-- 'edgeLabel' x y (edge e x y) == e
-- 'Algebra.Graph.ToGraph.edgeCount'     (edge e x y) == if e == 'zero' then 0 else 1
-- 'Algebra.Graph.ToGraph.vertexCount'   (edge e 1 1) == 1
-- 'Algebra.Graph.ToGraph.vertexCount'   (edge e 1 2) == 2
-- @
edge :: e -> a -> a -> Graph e a
edge :: e -> a -> a -> Graph e a
edge e
e a
x a
y = e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect e
e (a -> Graph e a
forall a e. a -> Graph e a
vertex a
x) (a -> Graph e a
forall a e. a -> Graph e a
vertex a
y)

-- | The left-hand part of a convenient ternary-ish operator @x-\<e\>-y@ for
-- creating labelled edges.
--
-- @
-- x -\<e\>- y == 'edge' e x y
-- @
(-<) :: a -> e -> (a, e)
a
g -< :: a -> e -> (a, e)
-< e
e = (a
g, e
e)

-- | The right-hand part of a convenient ternary-ish operator @x-\<e\>-y@ for
-- creating labelled edges.
--
-- @
-- x -\<e\>- y == 'edge' e x y
-- @
(>-) :: (a, e) -> a -> Graph e a
(a
x, e
e) >- :: (a, e) -> a -> Graph e a
>- a
y = e -> a -> a -> Graph e a
forall e a. e -> a -> a -> Graph e a
edge e
e a
x a
y

infixl 5 -<
infixl 5 >-

-- | /Overlay/ two graphs. An alias for 'Connect' 'zero'.
-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size.
--
-- @
-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'Algebra.Graph.ToGraph.vertexCount' (overlay x y) >= 'Algebra.Graph.ToGraph.vertexCount' x
-- 'Algebra.Graph.ToGraph.vertexCount' (overlay x y) <= 'Algebra.Graph.ToGraph.vertexCount' x + 'Algebra.Graph.ToGraph.vertexCount' y
-- 'Algebra.Graph.ToGraph.edgeCount'   (overlay x y) >= 'Algebra.Graph.ToGraph.edgeCount' x
-- 'Algebra.Graph.ToGraph.edgeCount'   (overlay x y) <= 'Algebra.Graph.ToGraph.edgeCount' x   + 'Algebra.Graph.ToGraph.edgeCount' y
-- 'Algebra.Graph.ToGraph.vertexCount' (overlay 1 2) == 2
-- 'Algebra.Graph.ToGraph.edgeCount'   (overlay 1 2) == 0
-- @
--
-- Note: 'overlay' composes edges in parallel using the operator '<+>' with
-- 'zero' acting as the identity:
--
-- @
-- 'edgeLabel' x y $ overlay ('edge' e x y) ('edge' 'zero' x y) == e
-- 'edgeLabel' x y $ overlay ('edge' e x y) ('edge' f    x y) == e '<+>' f
-- @
--
-- Furthermore, when applied to transitive graphs, 'overlay' composes edges in
-- sequence using the operator '<.>' with 'one' acting as the identity:
--
-- @
-- 'edgeLabel' x z $ 'transitiveClosure' (overlay ('edge' e x y) ('edge' 'one' y z)) == e
-- 'edgeLabel' x z $ 'transitiveClosure' (overlay ('edge' e x y) ('edge' f   y z)) == e '<.>' f
-- @
overlay :: Monoid e => Graph e a -> Graph e a -> Graph e a
overlay :: Graph e a -> Graph e a -> Graph e a
overlay = e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect e
forall a. Monoid a => a
zero

-- | /Connect/ two graphs with edges labelled by a given label. An alias for
-- 'Connect'.
-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. 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 e x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (connect e x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'Algebra.Graph.ToGraph.vertexCount' (connect e x y) >= 'Algebra.Graph.ToGraph.vertexCount' x
-- 'Algebra.Graph.ToGraph.vertexCount' (connect e x y) <= 'Algebra.Graph.ToGraph.vertexCount' x + 'Algebra.Graph.ToGraph.vertexCount' y
-- 'Algebra.Graph.ToGraph.edgeCount'   (connect e x y) <= 'Algebra.Graph.ToGraph.vertexCount' x * 'Algebra.Graph.ToGraph.vertexCount' y + 'Algebra.Graph.ToGraph.edgeCount' x + 'Algebra.Graph.ToGraph.edgeCount' y
-- 'Algebra.Graph.ToGraph.vertexCount' (connect e 1 2) == 2
-- 'Algebra.Graph.ToGraph.edgeCount'   (connect e 1 2) == if e == 'zero' then 0 else 1
-- @
connect :: e -> Graph e a -> Graph e a -> Graph e a
connect :: e -> Graph e a -> Graph e a -> Graph e a
connect = e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect

-- | Construct the graph comprising a given list of isolated vertices.
-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the
-- given list.
--
-- @
-- vertices []            == 'empty'
-- vertices [x]           == 'vertex' x
-- vertices               == 'overlays' . map 'vertex'
-- 'hasVertex' x . vertices == 'elem' x
-- 'Algebra.Graph.ToGraph.vertexCount' . vertices == 'length' . 'Data.List.nub'
-- 'Algebra.Graph.ToGraph.vertexSet'   . vertices == Set.'Set.fromList'
-- @
vertices :: Monoid e => [a] -> Graph e a
vertices :: [a] -> Graph e a
vertices = [Graph e a] -> Graph e a
forall e a. Monoid e => [Graph e a] -> Graph e a
overlays ([Graph e a] -> Graph e a)
-> ([a] -> [Graph e a]) -> [a] -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Graph e a) -> [a] -> [Graph e a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Graph e a
forall a e. a -> Graph e a
vertex

-- | Construct the graph from a list of labelled edges.
-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the
-- given list.
--
-- @
-- edges []        == 'empty'
-- edges [(e,x,y)] == 'edge' e x y
-- edges           == 'overlays' . 'map' (\\(e, x, y) -> 'edge' e x y)
-- @
edges :: Monoid e => [(e, a, a)] -> Graph e a
edges :: [(e, a, a)] -> Graph e a
edges = [Graph e a] -> Graph e a
forall e a. Monoid e => [Graph e a] -> Graph e a
overlays ([Graph e a] -> Graph e a)
-> ([(e, a, a)] -> [Graph e a]) -> [(e, a, a)] -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, a, a) -> Graph e a) -> [(e, a, a)] -> [Graph e a]
forall a b. (a -> b) -> [a] -> [b]
map (\(e
e, a
x, a
y) -> e -> a -> a -> Graph e a
forall e a. e -> a -> a -> Graph e a
edge e
e a
x a
y)

-- | Overlay a given list of graphs.
-- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length
-- of the given list, and /S/ is the sum of sizes of the graphs in the list.
--
-- @
-- overlays []        == 'empty'
-- overlays [x]       == x
-- overlays [x,y]     == 'overlay' x y
-- overlays           == 'foldr' 'overlay' 'empty'
-- 'isEmpty' . overlays == 'all' 'isEmpty'
-- @
overlays :: Monoid e => [Graph e a] -> Graph e a
overlays :: [Graph e a] -> Graph e a
overlays = (Graph e a -> Graph e a -> Graph e a)
-> Graph e a -> [Graph e a] -> Graph e a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
forall e a. Graph e a
empty

-- | Check if a graph is empty.
-- Complexity: /O(s)/ time.
--
-- @
-- isEmpty 'empty'                         == True
-- isEmpty ('overlay' 'empty' 'empty')         == True
-- isEmpty ('vertex' x)                    == False
-- isEmpty ('removeVertex' x $ 'vertex' x)   == True
-- isEmpty ('removeEdge' x y $ 'edge' e x y) == False
-- @
isEmpty :: Graph e a -> Bool
isEmpty :: Graph e a -> Bool
isEmpty = Bool
-> (a -> Bool) -> (e -> Bool -> Bool -> Bool) -> Graph e a -> Bool
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Bool
True (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False) ((Bool -> Bool -> Bool) -> e -> Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool -> Bool -> Bool
(&&))

-- | The /size/ of a graph, i.e. the number of leaves of the expression
-- including 'empty' leaves.
-- Complexity: /O(s)/ time.
--
-- @
-- size 'empty'         == 1
-- size ('vertex' x)    == 1
-- size ('overlay' x y) == size x + size y
-- size ('connect' x y) == size x + size y
-- size x             >= 1
-- size x             >= 'Algebra.Graph.ToGraph.vertexCount' x
-- @
size :: Graph e a -> Int
size :: Graph e a -> Int
size = Int -> (a -> Int) -> (e -> Int -> Int -> Int) -> Graph e a -> Int
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Int
1 (Int -> a -> Int
forall a b. a -> b -> a
const Int
1) ((Int -> Int -> Int) -> e -> Int -> Int -> Int
forall a b. a -> b -> a
const Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))

-- | Check if a graph contains a given vertex.
-- Complexity: /O(s)/ time.
--
-- @
-- hasVertex x 'empty'            == False
-- hasVertex x ('vertex' y)       == (x == y)
-- hasVertex x . 'removeVertex' x == 'const' False
-- @
hasVertex :: Eq a => a -> Graph e a -> Bool
hasVertex :: a -> Graph e a -> Bool
hasVertex a
x = Bool
-> (a -> Bool) -> (e -> Bool -> Bool -> Bool) -> Graph e a -> Bool
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Bool
False (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) ((Bool -> Bool -> Bool) -> e -> Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool -> Bool -> Bool
(||))

-- | Check if a graph contains a given edge.
-- Complexity: /O(s)/ time.
--
-- @
-- hasEdge x y 'empty'            == False
-- hasEdge x y ('vertex' z)       == False
-- hasEdge x y ('edge' e x y)     == (e /= 'zero')
-- hasEdge x y . 'removeEdge' x y == 'const' False
-- hasEdge x y                  == 'not' . 'null' . 'filter' (\\(_,ex,ey) -> ex == x && ey == y) . 'edgeList'
-- @
hasEdge :: (Eq e, Monoid e, Ord a) => a -> a -> Graph e a -> Bool
hasEdge :: a -> a -> Graph e a -> Bool
hasEdge a
x a
y = (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
/= e
forall a. Monoid a => a
zero) (e -> Bool) -> (Graph e a -> e) -> Graph e a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Graph e a -> e
forall a e. (Eq a, Monoid e) => a -> a -> Graph e a -> e
edgeLabel a
x a
y

-- | Extract the label of a specified edge from a graph.
edgeLabel :: (Eq a, Monoid e) => a -> a -> Graph e a -> e
edgeLabel :: a -> a -> Graph e a -> e
edgeLabel a
s a
t Graph e a
g = let (e
res, Bool
_, Bool
_) = (e, Bool, Bool)
-> (a -> (e, Bool, Bool))
-> (e -> (e, Bool, Bool) -> (e, Bool, Bool) -> (e, Bool, Bool))
-> Graph e a
-> (e, Bool, Bool)
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg (e, Bool, Bool)
e a -> (e, Bool, Bool)
v e -> (e, Bool, Bool) -> (e, Bool, Bool) -> (e, Bool, Bool)
forall a.
Monoid a =>
a -> (a, Bool, Bool) -> (a, Bool, Bool) -> (a, Bool, Bool)
c Graph e a
g in e
res
  where
    e :: (e, Bool, Bool)
e                                         = (e
forall a. Monoid a => a
zero               , Bool
False   , Bool
False   )
    v :: a -> (e, Bool, Bool)
v a
x                                       = (e
forall a. Monoid a => a
zero               , a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s  , a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t  )
    c :: a -> (a, Bool, Bool) -> (a, Bool, Bool) -> (a, Bool, Bool)
c a
l (a
l1, Bool
s1, Bool
t1) (a
l2, Bool
s2, Bool
t2) | Bool
s1 Bool -> Bool -> Bool
&& Bool
t2  = ([a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
l1, a
l, a
l2], Bool
s1 Bool -> Bool -> Bool
|| Bool
s2, Bool
t1 Bool -> Bool -> Bool
|| Bool
t2)
                                  | Bool
otherwise = ([a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
l1,    a
l2], Bool
s1 Bool -> Bool -> Bool
|| Bool
s2, Bool
t1 Bool -> Bool -> Bool
|| Bool
t2)

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

-- | The list of edges of a graph, sorted lexicographically with respect to
-- pairs of connected vertices (i.e. edge-labels are ignored when sorting).
-- Complexity: /O(n + m)/ time and /O(m)/ memory.
--
-- @
-- edgeList 'empty'        == []
-- edgeList ('vertex' x)   == []
-- edgeList ('edge' e x y) == if e == 'zero' then [] else [(e,x,y)]
-- @
edgeList :: (Eq e, Monoid e, Ord a) => Graph e a -> [(e, a, a)]
edgeList :: Graph e a -> [(e, a, a)]
edgeList = AdjacencyMap e a -> [(e, a, a)]
forall e a. AdjacencyMap e a -> [(e, a, a)]
AM.edgeList (AdjacencyMap e a -> [(e, a, a)])
-> (Graph e a -> AdjacencyMap e a) -> Graph e a -> [(e, a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap

-- | The set of vertices of a given graph.
-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
--
-- @
-- vertexSet 'empty'      == Set.'Set.empty'
-- vertexSet . 'vertex'   == Set.'Set.singleton'
-- vertexSet . 'vertices' == Set.'Set.fromList'
-- @
vertexSet :: Ord a => Graph e a -> Set.Set a
vertexSet :: Graph e a -> Set a
vertexSet = Set a
-> (a -> Set a)
-> (e -> Set a -> Set a -> Set a)
-> Graph e a
-> Set a
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Set a
forall a. Set a
Set.empty a -> Set a
forall a. a -> Set a
Set.singleton ((Set a -> Set a -> Set a) -> e -> Set a -> Set a -> Set a
forall a b. a -> b -> a
const Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union)

-- | The set of edges of a given graph.
-- Complexity: /O(n + m)/ time and /O(m)/ memory.
--
-- @
-- edgeSet 'empty'        == Set.'Set.empty'
-- edgeSet ('vertex' x)   == Set.'Set.empty'
-- edgeSet ('edge' e x y) == if e == 'zero' then Set.'Set.empty' else Set.'Set.singleton' (e,x,y)
-- @
edgeSet :: (Eq e, Monoid e, Ord a) => Graph e a -> Set.Set (e, a, a)
edgeSet :: Graph e a -> Set (e, a, a)
edgeSet = [(e, a, a)] -> Set (e, a, a)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(e, a, a)] -> Set (e, a, a))
-> (Graph e a -> [(e, a, a)]) -> Graph e a -> Set (e, a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph e a -> [(e, a, a)]
forall e a. (Eq e, Monoid e, Ord a) => Graph e a -> [(e, a, a)]
edgeList

-- | Remove a vertex from a given graph.
-- Complexity: /O(s)/ time, memory and size.
--
-- @
-- removeVertex x ('vertex' x)       == 'empty'
-- removeVertex 1 ('vertex' 2)       == 'vertex' 2
-- removeVertex x ('edge' e x x)     == 'empty'
-- removeVertex 1 ('edge' e 1 2)     == 'vertex' 2
-- removeVertex x . removeVertex x == removeVertex x
-- @
removeVertex :: Eq a => a -> Graph e a -> Graph e a
removeVertex :: a -> Graph e a -> Graph e a
removeVertex a
x = (a -> Bool) -> Graph e a -> Graph e a
forall a e. (a -> Bool) -> Graph e a -> Graph e a
induce (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x)

-- | Remove an edge from a given graph.
-- Complexity: /O(s)/ time, memory and size.
--
-- @
-- removeEdge x y ('edge' e 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 :: (Eq a, Eq e, Monoid e) => a -> a -> Graph e a -> Graph e a
removeEdge :: a -> a -> Graph e a -> Graph e a
removeEdge a
s a
t = a -> (a -> Bool) -> (a -> Bool) -> Graph e a -> Graph e a
forall a e.
(Eq a, Eq e, Monoid e) =>
a -> (a -> Bool) -> (a -> Bool) -> Graph e a -> Graph e a
filterContext a
s (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
s) (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
t)

-- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a
-- given 'Graph'. If @y@ already exists, @x@ and @y@ will be merged.
-- Complexity: /O(s)/ time, memory and size.
--
-- @
-- replaceVertex x x            == id
-- replaceVertex x y ('vertex' x) == 'vertex' y
-- replaceVertex x y            == 'fmap' (\\v -> if v == x then y else v)
-- @
replaceVertex :: Eq a => a -> a -> Graph e a -> Graph e a
replaceVertex :: a -> a -> Graph e a -> Graph e a
replaceVertex a
u a
v = (a -> a) -> Graph e a -> Graph e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Graph e a -> Graph e a)
-> (a -> a) -> Graph e a -> Graph e 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

-- | Replace an edge from a given graph. If it doesn't exist, it will be created.
-- Complexity: /O(log(n))/ time.
--
-- @
-- replaceEdge e x y z                 == 'overlay' (removeEdge x y z) ('edge' e x y)
-- replaceEdge e x y ('edge' f x y)      == 'edge' e x y
-- 'edgeLabel' x y (replaceEdge e x y z) == e
-- @
replaceEdge :: (Eq e, Monoid e, Ord a) => e -> a -> a -> Graph e a -> Graph e a
replaceEdge :: e -> a -> a -> Graph e a -> Graph e a
replaceEdge e
e a
x a
y = Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay (e -> a -> a -> Graph e a
forall e a. e -> a -> a -> Graph e a
edge e
e a
x a
y) (Graph e a -> Graph e a)
-> (Graph e a -> Graph e a) -> Graph e a -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Graph e a -> Graph e a
forall a e.
(Eq a, Eq e, Monoid e) =>
a -> a -> Graph e a -> Graph e a
removeEdge a
x a
y

-- | Transpose a given graph.
-- Complexity: /O(s)/ time, memory and size.
--
-- @
-- transpose 'empty'        == 'empty'
-- transpose ('vertex' x)   == 'vertex' x
-- transpose ('edge' e x y) == 'edge' e y x
-- transpose . transpose  == id
-- @
transpose :: Graph e a -> Graph e a
transpose :: Graph e a -> Graph e a
transpose = Graph e a
-> (a -> Graph e a)
-> (e -> Graph e a -> Graph e a -> Graph e a)
-> Graph e a
-> Graph e a
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Graph e a
forall e a. Graph e a
empty a -> Graph e a
forall a e. a -> Graph e a
vertex (((Graph e a -> Graph e a -> Graph e a)
 -> Graph e a -> Graph e a -> Graph e a)
-> (e -> Graph e a -> Graph e a -> Graph e a)
-> e
-> Graph e a
-> Graph e a
-> Graph e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Graph e a -> Graph e a -> Graph e a)
-> Graph e a -> Graph e a -> Graph e a
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect)

-- | Transform a graph by applying a function to each of its edge labels.
-- Complexity: /O(s)/ time, memory and size.
--
-- The function @h@ is required to be a /homomorphism/ on the underlying type of
-- labels @e@. At the very least it must preserve 'zero' and '<+>':
--
-- @
-- h 'zero'      == 'zero'
-- h x '<+>' h y == h (x '<+>' y)
-- @
--
-- If @e@ is also a semiring, then @h@ must also preserve the multiplicative
-- structure:
--
-- @
-- h 'one'       == 'one'
-- h x '<.>' h y == h (x '<.>' y)
-- @
--
-- If the above requirements hold, then the implementation provides the
-- following guarantees.
--
-- @
-- emap h 'empty'           == 'empty'
-- emap h ('vertex' x)      == 'vertex' x
-- emap h ('edge' e x y)    == 'edge' (h e) x y
-- emap h ('overlay' x y)   == 'overlay' (emap h x) (emap h y)
-- emap h ('connect' e x y) == 'connect' (h e) (emap h x) (emap h y)
-- emap 'id'                == 'id'
-- emap g . emap h        == emap (g . h)
-- @
emap :: (e -> f) -> Graph e a -> Graph f a
emap :: (e -> f) -> Graph e a -> Graph f a
emap e -> f
f = Graph f a
-> (a -> Graph f a)
-> (e -> Graph f a -> Graph f a -> Graph f a)
-> Graph e a
-> Graph f a
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Graph f a
forall e a. Graph e a
Empty a -> Graph f a
forall e a. a -> Graph e a
Vertex (f -> Graph f a -> Graph f a -> Graph f a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect (f -> Graph f a -> Graph f a -> Graph f a)
-> (e -> f) -> e -> Graph f a -> Graph f a -> Graph f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> f
f)

-- | Construct the /induced subgraph/ of a given graph by removing the
-- vertices that do not satisfy a given predicate.
-- Complexity: /O(s)/ time, memory and size, 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) -> Graph e a -> Graph e a
induce :: (a -> Bool) -> Graph e a -> Graph e a
induce a -> Bool
p = Graph e (Maybe a) -> Graph e a
forall e a. Graph e (Maybe a) -> Graph e a
induceJust (Graph e (Maybe a) -> Graph e a)
-> (Graph e a -> Graph e (Maybe a)) -> Graph e a -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> Graph e a -> Graph e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> if a -> Bool
p a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing)

-- | Construct the /induced subgraph/ of a given graph by removing the vertices
-- that are 'Nothing'.
-- Complexity: /O(s)/ time, memory and size.
--
-- @
-- induceJust ('vertex' 'Nothing')                               == 'empty'
-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
-- induceJust . 'fmap' 'Just'                                    == 'id'
-- induceJust . 'fmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
-- @
induceJust :: Graph e (Maybe a) -> Graph e a
induceJust :: Graph e (Maybe a) -> Graph e a
induceJust = Graph e a
-> (Maybe a -> Graph e a)
-> (e -> Graph e a -> Graph e a -> Graph e a)
-> Graph e (Maybe a)
-> Graph e a
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Graph e a
forall e a. Graph e a
Empty (Graph e a -> (a -> Graph e a) -> Maybe a -> Graph e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Graph e a
forall e a. Graph e a
Empty a -> Graph e a
forall e a. a -> Graph e a
Vertex) e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
c
  where
    c :: e -> Graph e a -> Graph e a -> Graph e a
c e
_ Graph e a
x     Graph e a
Empty = Graph e a
x -- Constant folding to get rid of Empty leaves
    c e
_ Graph e a
Empty Graph e a
y     = Graph e a
y
    c e
e Graph e a
x     Graph e a
y     = e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect e
e Graph e a
x Graph e a
y

-- | Compute the /reflexive and transitive closure/ of a graph over the
-- underlying star semiring using the Warshall-Floyd-Kleene algorithm.
--
-- @
-- closure 'empty'         == 'empty'
-- closure ('vertex' x)    == 'edge' 'one' x x
-- closure ('edge' e x x)  == 'edge' 'one' x x
-- closure ('edge' e x y)  == 'edges' [('one',x,x), (e,x,y), ('one',y,y)]
-- closure               == 'reflexiveClosure' . 'transitiveClosure'
-- closure               == 'transitiveClosure' . 'reflexiveClosure'
-- closure . closure     == closure
-- 'Algebra.Graph.ToGraph.postSet' x (closure y) == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)
-- @
closure :: (Eq e, Ord a, StarSemiring e) => Graph e a -> Graph e a
closure :: Graph e a -> Graph e a
closure = AdjacencyMap e a -> Graph e a
forall e a. Monoid e => AdjacencyMap e a -> Graph e a
fromAdjacencyMap (AdjacencyMap e a -> Graph e a)
-> (Graph e a -> AdjacencyMap e a) -> Graph e a -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Ord a, StarSemiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
AM.closure (AdjacencyMap e a -> AdjacencyMap e a)
-> (Graph e a -> AdjacencyMap e a) -> Graph e a -> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap

-- | Compute the /reflexive closure/ of a graph over the underlying semiring by
-- adding a self-loop of weight 'one' to every vertex.
-- Complexity: /O(n * log(n))/ time.
--
-- @
-- reflexiveClosure 'empty'              == 'empty'
-- reflexiveClosure ('vertex' x)         == 'edge' 'one' x x
-- reflexiveClosure ('edge' e x x)       == 'edge' 'one' x x
-- reflexiveClosure ('edge' e x y)       == 'edges' [('one',x,x), (e,x,y), ('one',y,y)]
-- reflexiveClosure . reflexiveClosure == reflexiveClosure
-- @
reflexiveClosure :: (Ord a, Semiring e) => Graph e a -> Graph e a
reflexiveClosure :: Graph e a -> Graph e a
reflexiveClosure Graph e a
x = Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
x (Graph e a -> Graph e a) -> Graph e a -> Graph e a
forall a b. (a -> b) -> a -> b
$ [(e, a, a)] -> Graph e a
forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges [ (e
forall a. Semiring a => a
one, a
v, a
v) | a
v <- Graph e a -> [a]
forall a e. Ord a => Graph e a -> [a]
vertexList Graph e a
x ]

-- | 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' e x y)       == 'edges' [(e,x,y), (e,y,x)]
-- symmetricClosure x                  == 'overlay' x ('transpose' x)
-- symmetricClosure . symmetricClosure == symmetricClosure
-- @
symmetricClosure :: Monoid e => Graph e a -> Graph e a
symmetricClosure :: Graph e a -> Graph e a
symmetricClosure Graph e a
m = Graph e a -> Graph e a -> Graph e a
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
m (Graph e a -> Graph e a
forall e a. Graph e a -> Graph e a
transpose Graph e a
m)

-- | Compute the /transitive closure/ of a graph over the underlying star
-- semiring using a modified version of the Warshall-Floyd-Kleene algorithm,
-- which omits the reflexivity step.
--
-- @
-- transitiveClosure 'empty'               == 'empty'
-- transitiveClosure ('vertex' x)          == 'vertex' x
-- transitiveClosure ('edge' e x y)        == 'edge' e x y
-- transitiveClosure . transitiveClosure == transitiveClosure
-- @
transitiveClosure :: (Eq e, Ord a, StarSemiring e) => Graph e a -> Graph e a
transitiveClosure :: Graph e a -> Graph e a
transitiveClosure = AdjacencyMap e a -> Graph e a
forall e a. Monoid e => AdjacencyMap e a -> Graph e a
fromAdjacencyMap (AdjacencyMap e a -> Graph e a)
-> (Graph e a -> AdjacencyMap e a) -> Graph e a -> Graph e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Ord a, StarSemiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
AM.transitiveClosure (AdjacencyMap e a -> AdjacencyMap e a)
-> (Graph e a -> AdjacencyMap e a) -> Graph e a -> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap

-- | A type synonym for /unlabelled graphs/.
type UnlabelledGraph a = Graph Any a

-- | A type synonym for /automata/ or /labelled transition systems/.
type Automaton a s = Graph (RegularExpression a) s

-- | A /network/ is a graph whose edges are labelled with distances.
type Network e a = Graph (Distance e) a

-- Filter vertices in a subgraph context.
filterContext :: (Eq a, Eq e, Monoid e) => a -> (a -> Bool) -> (a -> Bool) -> Graph e a -> Graph e a
filterContext :: a -> (a -> Bool) -> (a -> Bool) -> Graph e a -> Graph e a
filterContext a
s a -> Bool
i a -> Bool
o Graph e a
g = Graph e a
-> (Context e a -> Graph e a) -> Maybe (Context e a) -> Graph e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Graph e a
g Context e a -> Graph e a
go (Maybe (Context e a) -> Graph e a)
-> Maybe (Context e a) -> Graph e a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Graph e a -> Maybe (Context e a)
forall e a.
(Eq e, Monoid e) =>
(a -> Bool) -> Graph e a -> Maybe (Context e a)
context (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
s) Graph e a
g
  where
    go :: Context e a -> Graph e a
go (Context [(e, a)]
is [(e, a)]
os) = [Graph e a] -> Graph e a
forall e a. Monoid e => [Graph e a] -> Graph e a
overlays [ a -> Graph e a
forall a e. a -> Graph e a
vertex a
s
                                  , (a -> Bool) -> Graph e a -> Graph e a
forall a e. (a -> Bool) -> Graph e a -> Graph e a
induce (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
s) Graph e a
g
                                  , [(e, a, a)] -> Graph e a
forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges [ (e
e, a
v, a
s) | (e
e, a
v) <- [(e, a)]
is, a -> Bool
i a
v ]
                                  , [(e, a, a)] -> Graph e a
forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges [ (e
e, a
s, a
v) | (e
e, a
v) <- [(e, a)]
os, a -> Bool
o a
v ] ]

-- The /focus/ of a graph expression is a flattened representation of the
-- subgraph under focus, its context, as well as the list of all encountered
-- vertices. See 'removeEdge' for a use-case example.
data Focus e a = Focus
    { Focus e a -> Bool
ok :: Bool        -- ^ True if focus on the specified subgraph is obtained.
    , Focus e a -> List (e, a)
is :: List (e, a) -- ^ Inputs into the focused subgraph.
    , Focus e a -> List (e, a)
os :: List (e, a) -- ^ Outputs out of the focused subgraph.
    , Focus e a -> List a
vs :: List a    } -- ^ All vertices (leaves) of the graph expression.

-- Focus on the 'empty' graph.
emptyFocus :: Focus e a
emptyFocus :: Focus e a
emptyFocus = Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus Bool
False List (e, a)
forall a. Monoid a => a
mempty List (e, a)
forall a. Monoid a => a
mempty List a
forall a. Monoid a => a
mempty

-- | Focus on the graph with a single vertex, given a predicate indicating
-- whether the vertex is of interest.
vertexFocus :: (a -> Bool) -> a -> Focus e a
vertexFocus :: (a -> Bool) -> a -> Focus e a
vertexFocus a -> Bool
f a
x = Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus (a -> Bool
f a
x) List (e, a)
forall a. Monoid a => a
mempty List (e, a)
forall a. Monoid a => a
mempty (a -> List a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

-- | Connect two foci.
connectFoci :: (Eq e, Monoid e) => e -> Focus e a -> Focus e a -> Focus e a
connectFoci :: e -> Focus e a -> Focus e a -> Focus e a
connectFoci e
e Focus e a
x Focus e a
y
    | e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
forall a. Monoid a => a
mempty = Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus (Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
x Bool -> Bool -> Bool
|| Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
y) (Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
is Focus e a
x List (e, a) -> List (e, a) -> List (e, a)
forall a. Semigroup a => a -> a -> a
<> Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
is Focus e a
y) (Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
os Focus e a
x List (e, a) -> List (e, a) -> List (e, a)
forall a. Semigroup a => a -> a -> a
<> Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
os Focus e a
y) (Focus e a -> List a
forall e a. Focus e a -> List a
vs Focus e a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus e a -> List a
forall e a. Focus e a -> List a
vs Focus e a
y)
    | Bool
otherwise   = Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus (Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
x Bool -> Bool -> Bool
|| Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
y) (List (e, a)
xs   List (e, a) -> List (e, a) -> List (e, a)
forall a. Semigroup a => a -> a -> a
<> Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
is Focus e a
y) (Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
os Focus e a
x List (e, a) -> List (e, a) -> List (e, a)
forall a. Semigroup a => a -> a -> a
<> List (e, a)
ys  ) (Focus e a -> List a
forall e a. Focus e a -> List a
vs Focus e a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus e a -> List a
forall e a. Focus e a -> List a
vs Focus e a
y)
  where
    xs :: List (e, a)
xs = if Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
y then (a -> (e, a)) -> List a -> List (e, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e
e,) (Focus e a -> List a
forall e a. Focus e a -> List a
vs Focus e a
x) else Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
is Focus e a
x
    ys :: List (e, a)
ys = if Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
x then (a -> (e, a)) -> List a -> List (e, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e
e,) (Focus e a -> List a
forall e a. Focus e a -> List a
vs Focus e a
y) else Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
os Focus e a
y

-- | 'Focus' on a specified subgraph.
focus :: (Eq e, Monoid e) => (a -> Bool) -> Graph e a -> Focus e a
focus :: (a -> Bool) -> Graph e a -> Focus e a
focus a -> Bool
f = Focus e a
-> (a -> Focus e a)
-> (e -> Focus e a -> Focus e a -> Focus e a)
-> Graph e a
-> Focus e a
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Focus e a
forall e a. Focus e a
emptyFocus ((a -> Bool) -> a -> Focus e a
forall a e. (a -> Bool) -> a -> Focus e a
vertexFocus a -> Bool
f) e -> Focus e a -> Focus e a -> Focus e a
forall e a.
(Eq e, Monoid e) =>
e -> Focus e a -> Focus e a -> Focus e a
connectFoci

-- | The 'Context' of a subgraph comprises its 'inputs' and 'outputs', i.e. all
-- the vertices that are connected to the subgraph's vertices (along with the
-- corresponding edge labels). Note that inputs and outputs can belong to the
-- subgraph itself. In general, there are no guarantees on the order of vertices
-- in 'inputs' and 'outputs'; furthermore, there may be repetitions.
data Context e a = Context { Context e a -> [(e, a)]
inputs :: [(e, a)], Context e a -> [(e, a)]
outputs :: [(e, a)] }
    deriving (Context e a -> Context e a -> Bool
(Context e a -> Context e a -> Bool)
-> (Context e a -> Context e a -> Bool) -> Eq (Context e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Context e a -> Context e a -> Bool
/= :: Context e a -> Context e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Context e a -> Context e a -> Bool
== :: Context e a -> Context e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Context e a -> Context e a -> Bool
Eq, Int -> Context e a -> ShowS
[Context e a] -> ShowS
Context e a -> String
(Int -> Context e a -> ShowS)
-> (Context e a -> String)
-> ([Context e a] -> ShowS)
-> Show (Context e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Context e a -> ShowS
forall e a. (Show e, Show a) => [Context e a] -> ShowS
forall e a. (Show e, Show a) => Context e a -> String
showList :: [Context e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Context e a] -> ShowS
show :: Context e a -> String
$cshow :: forall e a. (Show e, Show a) => Context e a -> String
showsPrec :: Int -> Context e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Context e a -> ShowS
Show)

-- | Extract the 'Context' of a subgraph specified by a given predicate. Returns
-- @Nothing@ if the specified subgraph is empty.
--
-- @
-- context ('const' False) x                   == Nothing
-- context (== 1)        ('edge' e 1 2)        == if e == 'zero' then Just ('Context' [] []) else Just ('Context' [     ] [(e,2)])
-- context (== 2)        ('edge' e 1 2)        == if e == 'zero' then Just ('Context' [] []) else Just ('Context' [(e,1)] [     ])
-- context ('const' True ) ('edge' e 1 2)        == if e == 'zero' then Just ('Context' [] []) else Just ('Context' [(e,1)] [(e,2)])
-- context (== 4)        (3 * 1 * 4 * 1 * 5) == Just ('Context' [('one',3), ('one',1)] [('one',1), ('one',5)])
-- @
context :: (Eq e, Monoid e) => (a -> Bool) -> Graph e a -> Maybe (Context e a)
context :: (a -> Bool) -> Graph e a -> Maybe (Context e a)
context a -> Bool
p Graph e a
g | Focus e a -> Bool
forall e a. Focus e a -> Bool
ok Focus e a
f      = Context e a -> Maybe (Context e a)
forall a. a -> Maybe a
Just (Context e a -> Maybe (Context e a))
-> Context e a -> Maybe (Context e a)
forall a b. (a -> b) -> a -> b
$ [(e, a)] -> [(e, a)] -> Context e a
forall e a. [(e, a)] -> [(e, a)] -> Context e a
Context (List (e, a) -> [Item (List (e, a))]
forall l. IsList l => l -> [Item l]
Exts.toList (List (e, a) -> [Item (List (e, a))])
-> List (e, a) -> [Item (List (e, a))]
forall a b. (a -> b) -> a -> b
$ Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
is Focus e a
f) (List (e, a) -> [Item (List (e, a))]
forall l. IsList l => l -> [Item l]
Exts.toList (List (e, a) -> [Item (List (e, a))])
-> List (e, a) -> [Item (List (e, a))]
forall a b. (a -> b) -> a -> b
$ Focus e a -> List (e, a)
forall e a. Focus e a -> List (e, a)
os Focus e a
f)
            | Bool
otherwise = Maybe (Context e a)
forall a. Maybe a
Nothing
  where
    f :: Focus e a
f = (a -> Bool) -> Graph e a -> Focus e a
forall e a.
(Eq e, Monoid e) =>
(a -> Bool) -> Graph e a -> Focus e a
focus a -> Bool
p Graph e a
g