-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Labelled
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : [email protected]
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module 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 Algebra.Graph.ToGraph               as T

import qualified Data.IntSet as IntSet
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 (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
<$ :: forall a b. a -> Graph e b -> Graph e a
$c<$ :: forall e a b. a -> Graph e b -> Graph e a
fmap :: forall a b. (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
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 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 = forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap Graph e a
x forall a. Eq a => a -> a -> Bool
== 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 = forall a. Ord a => a -> a -> Ordering
compare (forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap Graph e a
x) (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 = forall a e. a -> Graph e a
vertex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
    + :: 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
(*)         = forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect forall a. Semiring a => a
one
    signum :: Graph e a -> Graph e a
signum      = forall a b. a -> b -> a
const forall e a. Graph e a
empty
    abs :: Graph e a -> Graph e a
abs         = forall a. a -> a
id
    negate :: Graph e a -> Graph e a
negate      = forall a. a -> a
id

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

instance Bifunctor Graph where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Graph a c -> Graph b d
bimap a -> b
f c -> d
g = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall e a. Graph e a
Empty (forall e a. a -> Graph e a
Vertex forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) (forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect 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    ) = forall a. NFData a => a -> ()
rnf a
x
    rnf (Connect e
e Graph e a
x Graph e a
y) = e
e seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Graph e a
x seq :: forall a b. a -> b -> b
`seq` 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
(<>) = 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 = forall e a. Graph e a
empty

-- TODO: Add tests.
instance (Eq e, Monoid e, Ord a) => T.ToGraph (Graph e a) where
    type ToVertex (Graph e a)  = a
    foldg :: forall r.
r
-> (ToVertex (Graph e a) -> r)
-> (r -> r -> r)
-> (r -> r -> r)
-> Graph e a
-> r
foldg r
e ToVertex (Graph e a) -> r
v r -> r -> r
o r -> r -> r
c              = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg r
e ToVertex (Graph e a) -> r
v (\e
e -> if e
e forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then r -> r -> r
o else r -> r -> r
c)
    vertexList :: Ord (ToVertex (Graph e a)) => Graph e a -> [ToVertex (Graph e a)]
vertexList                 = forall a e. Ord a => Graph e a -> [a]
vertexList
    vertexSet :: Ord (ToVertex (Graph e a)) =>
Graph e a -> Set (ToVertex (Graph e a))
vertexSet                  = forall a e. Ord a => Graph e a -> Set a
vertexSet
    toAdjacencyMap :: Ord (ToVertex (Graph e a)) =>
Graph e a -> AdjacencyMap (ToVertex (Graph e a))
toAdjacencyMap             = forall a e. Ord a => AdjacencyMap e a -> AdjacencyMap a
AM.skeleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap
    toAdjacencyMapTranspose :: Ord (ToVertex (Graph e a)) =>
Graph e a -> AdjacencyMap (ToVertex (Graph e a))
toAdjacencyMapTranspose    = forall t.
(ToGraph t, Ord (ToVertex t)) =>
t -> AdjacencyMap (ToVertex t)
T.toAdjacencyMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Graph e a -> Graph e a
transpose
    toAdjacencyIntMap :: (ToVertex (Graph e a) ~ Int) => Graph e a -> AdjacencyIntMap
toAdjacencyIntMap          = forall t. (ToGraph t, ToVertex t ~ Int) => t -> AdjacencyIntMap
T.toAdjacencyIntMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap
    toAdjacencyIntMapTranspose :: (ToVertex (Graph e a) ~ Int) => Graph e a -> AdjacencyIntMap
toAdjacencyIntMapTranspose = forall t. (ToGraph t, ToVertex t ~ Int) => t -> AdjacencyIntMap
T.toAdjacencyIntMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
(ToGraph t, Ord (ToVertex t)) =>
t -> AdjacencyMap (ToVertex t)
T.toAdjacencyMapTranspose

-- 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 :: forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> AdjacencyMap e a
toAdjacencyMap = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall e a. AdjacencyMap e a
AM.empty forall a e. a -> AdjacencyMap e a
AM.vertex 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 :: forall e a. Monoid e => AdjacencyMap e a -> Graph e a
fromAdjacencyMap = forall e a. Monoid e => [Graph e a] -> Graph e a
overlays forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {e} {a}. Monoid e => (a, Map a e) -> Graph e a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay (forall a e. a -> Graph e a
vertex a
u) (forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges [ (e
e, a
u, a
v) | (a
v, e
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 :: forall b a e. 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 a e.
(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 = forall r. r -> (a -> r) -> (e -> r -> r -> r) -> r
f forall e a. Graph e a
Empty forall e a. a -> Graph e a
Vertex 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 :: forall e a.
(Eq e, Monoid e, Ord a) =>
Graph e a -> Graph e a -> Bool
isSubgraphOf Graph e a
x Graph e a
y = forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
x Graph e a
y 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 :: forall e a. Graph e a
empty = 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 :: forall a e. a -> Graph e a
vertex = 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 :: forall e a. e -> a -> a -> Graph e a
edge e
e a
x a
y = forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect e
e (forall a e. a -> Graph e a
vertex a
x) (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 -< :: forall a e. 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) >- :: forall a e. (a, e) -> a -> Graph e a
>- a
y = 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 :: forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay = forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect 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 :: forall e a. e -> Graph e a -> Graph e a -> Graph e a
connect = 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 :: forall e a. Monoid e => [a] -> Graph e a
vertices = forall e a. Monoid e => [Graph e a] -> Graph e a
overlays forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges = forall e a. Monoid e => [Graph e a] -> Graph e a
overlays forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(e
e, a
x, a
y) -> 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 :: forall e a. Monoid e => [Graph e a] -> Graph e a
overlays = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay 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 :: forall e a. Graph e a -> Bool
isEmpty = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Bool
True (forall a b. a -> b -> a
const Bool
False) (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 :: forall e a. Graph e a -> Int
size = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Int
1 (forall a b. a -> b -> a
const Int
1) (forall a b. a -> b -> a
const 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 :: forall a e. Eq a => a -> Graph e a -> Bool
hasVertex a
x = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg Bool
False (forall a. Eq a => a -> a -> Bool
==a
x) (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 :: forall e a. (Eq e, Monoid e, Ord a) => a -> a -> Graph e a -> Bool
hasEdge a
x a
y = (forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a e. (Eq a, Monoid e) => a -> a -> Graph e a -> e
edgeLabel a
s a
t Graph e a
g = let (e
res, 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 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                                         = (forall a. Monoid a => a
zero               , Bool
False   , Bool
False   )
    v :: a -> (e, Bool, Bool)
v a
x                                       = (forall a. Monoid a => a
zero               , a
x forall a. Eq a => a -> a -> Bool
== a
s  , a
x 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  = (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 = (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 :: forall a e. Ord a => Graph e a -> [a]
vertexList = forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall e a. (Eq e, Monoid e, Ord a) => Graph e a -> [(e, a, a)]
edgeList = forall e a. AdjacencyMap e a -> [(e, a, a)]
AM.edgeList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a e. Ord a => Graph e a -> Set a
vertexSet = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall a. Set a
Set.empty forall a. a -> Set a
Set.singleton (forall a b. a -> b -> a
const 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 :: forall e a. (Eq e, Monoid e, Ord a) => Graph e a -> Set (e, a, a)
edgeSet = forall a. Eq a => [a] -> Set a
Set.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a e. Eq a => a -> Graph e a -> Graph e a
removeVertex a
x = forall a e. (a -> Bool) -> Graph e a -> Graph e a
induce (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 :: forall a e.
(Eq a, Eq e, Monoid e) =>
a -> a -> Graph e a -> Graph e a
removeEdge a
s a
t = forall a e.
(Eq a, Eq e, Monoid e) =>
a -> (a -> Bool) -> (a -> Bool) -> Graph e a -> Graph e a
filterContext a
s (forall a. Eq a => a -> a -> Bool
/=a
s) (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 :: forall a e. Eq a => a -> a -> Graph e a -> Graph e a
replaceVertex a
u a
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \a
w -> if a
w forall a. Eq a => a -> a -> Bool
== a
u then a
v else a
w

-- | 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 :: forall e a.
(Eq e, Monoid e, Ord a) =>
e -> a -> a -> Graph e a -> Graph e a
replaceEdge e
e a
x a
y = forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay (forall e a. e -> a -> a -> Graph e a
edge e
e a
x a
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall e a. Graph e a -> Graph e a
transpose = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall e a. Graph e a
empty forall a e. a -> Graph e a
vertex (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall a b c. (a -> b) -> Graph a c -> Graph b c
emap e -> f
f = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall e a. Graph e a
Empty forall e a. a -> Graph e a
Vertex (forall e a. e -> Graph e a -> Graph e a -> Graph e a
Connect 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 :: forall a e. (a -> Bool) -> Graph e a -> Graph e a
induce a -> Bool
p = forall e a. Graph e (Maybe a) -> Graph e a
induceJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> if a -> Bool
p a
a then forall a. a -> Maybe a
Just a
a else 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 :: forall e a. Graph e (Maybe a) -> Graph e a
induceJust = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall e a. Graph e a
Empty (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e a. Graph e a
Empty forall e a. a -> Graph e a
Vertex) 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     = 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' y x)
-- @
closure :: (Eq e, Ord a, StarSemiring e) => Graph e a -> Graph e a
closure :: forall e a. (Eq e, Ord a, StarSemiring e) => Graph e a -> Graph e a
closure = forall e a. Monoid e => AdjacencyMap e a -> Graph e a
fromAdjacencyMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
(Eq e, Ord a, StarSemiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
AM.closure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a e. (Ord a, Semiring e) => Graph e a -> Graph e a
reflexiveClosure Graph e a
x = forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
x forall a b. (a -> b) -> a -> b
$ forall e a. Monoid e => [(e, a, a)] -> Graph e a
edges [ (forall a. Semiring a => a
one, a
v, a
v) | a
v <- 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 :: forall e a. Monoid e => Graph e a -> Graph e a
symmetricClosure Graph e a
m = forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Graph e a
m (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 :: forall e a. (Eq e, Ord a, StarSemiring e) => Graph e a -> Graph e a
transitiveClosure = forall e a. Monoid e => AdjacencyMap e a -> Graph e a
fromAdjacencyMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
(Eq e, Ord a, StarSemiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
AM.transitiveClosure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a e.
(Eq a, Eq e, Monoid e) =>
a -> (a -> Bool) -> (a -> Bool) -> Graph e a -> Graph e a
filterContext a
s a -> Bool
i a -> Bool
o Graph e a
g = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Graph e a
g Context e a -> Graph e a
go forall a b. (a -> b) -> a -> b
$ forall e a.
(Eq e, Monoid e) =>
(a -> Bool) -> Graph e a -> Maybe (Context e a)
context (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) = forall e a. Monoid e => [Graph e a] -> Graph e a
overlays [ forall a e. a -> Graph e a
vertex a
s
                                  , forall a e. (a -> Bool) -> Graph e a -> Graph e a
induce (forall a. Eq a => a -> a -> Bool
/=a
s) Graph e a
g
                                  , 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 ]
                                  , 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
    { forall e a. Focus e a -> Bool
ok :: Bool        -- ^ True if focus on the specified subgraph is obtained.
    , forall e a. Focus e a -> List (e, a)
is :: List (e, a) -- ^ Inputs into the focused subgraph.
    , forall e a. Focus e a -> List (e, a)
os :: List (e, a) -- ^ Outputs out of the focused subgraph.
    , forall e a. 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 :: forall e a. Focus e a
emptyFocus = forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus Bool
False forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty 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 :: forall a e. (a -> Bool) -> a -> Focus e a
vertexFocus a -> Bool
f a
x = forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus (a -> Bool
f a
x) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (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 :: forall e a.
(Eq e, Monoid e) =>
e -> Focus e a -> Focus e a -> Focus e a
connectFoci e
e Focus e a
x Focus e a
y
    | e
e forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus (forall e a. Focus e a -> Bool
ok Focus e a
x Bool -> Bool -> Bool
|| forall e a. Focus e a -> Bool
ok Focus e a
y) (forall e a. Focus e a -> List (e, a)
is Focus e a
x forall a. Semigroup a => a -> a -> a
<> forall e a. Focus e a -> List (e, a)
is Focus e a
y) (forall e a. Focus e a -> List (e, a)
os Focus e a
x forall a. Semigroup a => a -> a -> a
<> forall e a. Focus e a -> List (e, a)
os Focus e a
y) (forall e a. Focus e a -> List a
vs Focus e a
x forall a. Semigroup a => a -> a -> a
<> forall e a. Focus e a -> List a
vs Focus e a
y)
    | Bool
otherwise   = forall e a.
Bool -> List (e, a) -> List (e, a) -> List a -> Focus e a
Focus (forall e a. Focus e a -> Bool
ok Focus e a
x Bool -> Bool -> Bool
|| forall e a. Focus e a -> Bool
ok Focus e a
y) (List (e, a)
xs   forall a. Semigroup a => a -> a -> a
<> forall e a. Focus e a -> List (e, a)
is Focus e a
y) (forall e a. Focus e a -> List (e, a)
os Focus e a
x forall a. Semigroup a => a -> a -> a
<> List (e, a)
ys  ) (forall e a. Focus e a -> List a
vs Focus e a
x forall a. Semigroup a => a -> a -> a
<> forall e a. Focus e a -> List a
vs Focus e a
y)
  where
    xs :: List (e, a)
xs = if forall e a. Focus e a -> Bool
ok Focus e a
y then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e
e,) (forall e a. Focus e a -> List a
vs Focus e a
x) else forall e a. Focus e a -> List (e, a)
is Focus e a
x
    ys :: List (e, a)
ys = if forall e a. Focus e a -> Bool
ok Focus e a
x then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e
e,) (forall e a. Focus e a -> List a
vs Focus e a
y) else 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 :: forall e a.
(Eq e, Monoid e) =>
(a -> Bool) -> Graph e a -> Focus e a
focus a -> Bool
f = forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
foldg forall e a. Focus e a
emptyFocus (forall a e. (a -> Bool) -> a -> Focus e a
vertexFocus a -> Bool
f) 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 { forall e a. Context e a -> [(e, a)]
inputs :: [(e, a)], forall e a. Context e a -> [(e, a)]
outputs :: [(e, a)] }
    deriving (Context e a -> Context e a -> Bool
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
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 :: forall e a.
(Eq e, Monoid e) =>
(a -> Bool) -> Graph e a -> Maybe (Context e a)
context a -> Bool
p Graph e a
g | forall e a. Focus e a -> Bool
ok Focus e a
f      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall e a. [(e, a)] -> [(e, a)] -> Context e a
Context (forall l. IsList l => l -> [Item l]
Exts.toList forall a b. (a -> b) -> a -> b
$ forall e a. Focus e a -> List (e, a)
is Focus e a
f) (forall l. IsList l => l -> [Item l]
Exts.toList forall a b. (a -> b) -> a -> b
$ forall e a. Focus e a -> List (e, a)
os Focus e a
f)
            | Bool
otherwise = forall a. Maybe a
Nothing
  where
    f :: Focus e a
f = forall e a.
(Eq e, Monoid e) =>
(a -> Bool) -> Graph e a -> Focus e a
focus a -> Bool
p Graph e a
g