-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Labelled.AdjacencyMap
-- 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 defines the 'AdjacencyMap' data type for edge-labelled graphs, as
-- well as associated operations and algorithms. 'AdjacencyMap' is an instance
-- of the 'C.Graph' type class, which can be used for polymorphic graph
-- construction and manipulation.
-----------------------------------------------------------------------------
module Algebra.Graph.Labelled.AdjacencyMap (
    -- * Data structure
    AdjacencyMap, adjacencyMap,

    -- * Basic graph construction primitives
    empty, vertex, edge, (-<), (>-), overlay, connect, vertices, edges,
    overlays, fromAdjacencyMaps,

    -- * Relations on graphs
    isSubgraphOf,

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

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

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

    -- * Miscellaneous
    consistent
    ) where

import Control.DeepSeq
import Data.Maybe
import Data.Map (Map)
import Data.Monoid (Sum (..))
import Data.Set (Set, (\\))
import Data.String
import GHC.Generics

import Algebra.Graph.Label

import qualified Algebra.Graph.AdjacencyMap as AM
import qualified Data.Map.Strict            as Map
import qualified Data.Set                   as Set

-- | Edge-labelled graphs, where the type variable @e@ stands for edge labels.
-- For example, 'AdjacencyMap' @Bool@ @a@ is isomorphic to unlabelled graphs
-- defined in the top-level module "Algebra.Graph.AdjacencyMap", where @False@
-- and @True@ denote the lack of and the existence of an unlabelled edge,
-- respectively.
newtype AdjacencyMap e a = AM {
    -- | The /adjacency map/ of an edge-labelled graph: each vertex is
    -- associated with a map from its direct successors to the corresponding
    -- edge labels.
    AdjacencyMap e a -> Map a (Map a e)
adjacencyMap :: Map a (Map a e) } deriving (AdjacencyMap e a -> AdjacencyMap e a -> Bool
(AdjacencyMap e a -> AdjacencyMap e a -> Bool)
-> (AdjacencyMap e a -> AdjacencyMap e a -> Bool)
-> Eq (AdjacencyMap e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a.
(Eq a, Eq e) =>
AdjacencyMap e a -> AdjacencyMap e a -> Bool
/= :: AdjacencyMap e a -> AdjacencyMap e a -> Bool
$c/= :: forall e a.
(Eq a, Eq e) =>
AdjacencyMap e a -> AdjacencyMap e a -> Bool
== :: AdjacencyMap e a -> AdjacencyMap e a -> Bool
$c== :: forall e a.
(Eq a, Eq e) =>
AdjacencyMap e a -> AdjacencyMap e a -> Bool
Eq, (forall x. AdjacencyMap e a -> Rep (AdjacencyMap e a) x)
-> (forall x. Rep (AdjacencyMap e a) x -> AdjacencyMap e a)
-> Generic (AdjacencyMap e a)
forall x. Rep (AdjacencyMap e a) x -> AdjacencyMap e a
forall x. AdjacencyMap e a -> Rep (AdjacencyMap e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (AdjacencyMap e a) x -> AdjacencyMap e a
forall e a x. AdjacencyMap e a -> Rep (AdjacencyMap e a) x
$cto :: forall e a x. Rep (AdjacencyMap e a) x -> AdjacencyMap e a
$cfrom :: forall e a x. AdjacencyMap e a -> Rep (AdjacencyMap e a) x
Generic, AdjacencyMap e a -> ()
(AdjacencyMap e a -> ()) -> NFData (AdjacencyMap e a)
forall a. (a -> ()) -> NFData a
forall e a. (NFData a, NFData e) => AdjacencyMap e a -> ()
rnf :: AdjacencyMap e a -> ()
$crnf :: forall e a. (NFData a, NFData e) => AdjacencyMap e a -> ()
NFData)

instance (Ord a, Show a, Ord e, Show e) => Show (AdjacencyMap e a) where
    showsPrec :: Int -> AdjacencyMap e a -> ShowS
showsPrec Int
p lam :: AdjacencyMap e a
lam@(AM Map a (Map a e)
m)
        | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
vs = String -> ShowS
showString String
"empty"
        | [(e, a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(e, a, a)]
es     = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Set a -> ShowS
forall a. Show a => Set a -> ShowS
vshow Set a
vs
        | Set a
vs Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
used  = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [(e, a, a)] -> ShowS
forall a a a. (Show a, Show a, Show a) => [(a, a, a)] -> ShowS
eshow [(e, a, a)]
es
        | Bool
otherwise   = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                            String -> ShowS
showString String
"overlay (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> ShowS
forall a. Show a => Set a -> ShowS
vshow (Set a
vs Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
\\ Set a
used) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            String -> ShowS
showString String
") ("       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(e, a, a)] -> ShowS
forall a a a. (Show a, Show a, Show a) => [(a, a, a)] -> ShowS
eshow [(e, a, a)]
es ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
      where
        vs :: Set a
vs   = AdjacencyMap e a -> Set a
forall e a. AdjacencyMap e a -> Set a
vertexSet AdjacencyMap e a
lam
        es :: [(e, a, a)]
es   = AdjacencyMap e a -> [(e, a, a)]
forall e a. AdjacencyMap e a -> [(e, a, a)]
edgeList AdjacencyMap e a
lam
        used :: Set a
used = Map a (Map a e) -> Set a
forall a e. Ord a => Map a (Map a e) -> Set a
referredToVertexSet Map a (Map a e)
m
        vshow :: Set a -> ShowS
vshow Set a
vs = case Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
vs of
            [a
x] -> String -> ShowS
showString String
"vertex "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
            [a]
xs  -> String -> ShowS
showString String
"vertices " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
xs
        eshow :: [(a, a, a)] -> ShowS
eshow [(a, a, a)]
es = case [(a, a, a)]
es of
            [(a
e, a
x, a
y)] -> String -> ShowS
showString String
"edge "  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           String -> ShowS
showString String
" "      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           String -> ShowS
showString String
" "      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
y
            [(a, a, a)]
xs          -> String -> ShowS
showString String
"edges " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a, a)]
xs

instance (Ord e, Monoid e, Ord a) => Ord (AdjacencyMap e a) where
    compare :: AdjacencyMap e a -> AdjacencyMap e a -> Ordering
compare AdjacencyMap e a
x AdjacencyMap e a
y = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
        [ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap e a -> Int
forall e a. AdjacencyMap e a -> Int
vertexCount AdjacencyMap e a
x) (AdjacencyMap e a -> Int
forall e a. AdjacencyMap e a -> Int
vertexCount AdjacencyMap e a
y)
        , Set a -> Set a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap e a -> Set a
forall e a. AdjacencyMap e a -> Set a
vertexSet   AdjacencyMap e a
x) (AdjacencyMap e a -> Set a
forall e a. AdjacencyMap e a -> Set a
vertexSet   AdjacencyMap e a
y)
        , Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap e a -> Int
forall e a. AdjacencyMap e a -> Int
edgeCount   AdjacencyMap e a
x) (AdjacencyMap e a -> Int
forall e a. AdjacencyMap e a -> Int
edgeCount   AdjacencyMap e a
y)
        , Set (a, a) -> Set (a, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap e a -> Set (a, a)
eSet        AdjacencyMap e a
x) (AdjacencyMap e a -> Set (a, a)
eSet        AdjacencyMap e a
y)
        , Ordering
cmp ]
      where
        eSet :: AdjacencyMap e a -> Set (a, a)
eSet = ((e, a, a) -> (a, a)) -> Set (e, a, a) -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(e
_, a
x, a
y) -> (a
x, a
y)) (Set (e, a, a) -> Set (a, a))
-> (AdjacencyMap e a -> Set (e, a, a))
-> AdjacencyMap e a
-> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e a -> Set (e, a, a)
forall a e. (Eq a, Eq e) => AdjacencyMap e a -> Set (e, a, a)
edgeSet
        cmp :: Ordering
cmp | AdjacencyMap e a
x AdjacencyMap e a -> AdjacencyMap e a -> Bool
forall a. Eq a => a -> a -> Bool
== AdjacencyMap e a
y               = Ordering
EQ
            | [AdjacencyMap e a] -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
[AdjacencyMap e a] -> AdjacencyMap e a
overlays [AdjacencyMap e a
x, AdjacencyMap e a
y] AdjacencyMap e a -> AdjacencyMap e a -> Bool
forall a. Eq a => a -> a -> Bool
== AdjacencyMap e a
y = Ordering
LT
            | Bool
otherwise            = AdjacencyMap e a -> AdjacencyMap e a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AdjacencyMap e a
x AdjacencyMap e a
y

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

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

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

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

-- | Construct the /empty graph/.
--
-- @
-- 'isEmpty'     empty == True
-- 'hasVertex' x empty == False
-- 'vertexCount' empty == 0
-- 'edgeCount'   empty == 0
-- @
empty :: AdjacencyMap e a
empty :: AdjacencyMap e a
empty = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM Map a (Map a e)
forall k a. Map k a
Map.empty

-- | Construct the graph comprising /a single isolated vertex/.
--
-- @
-- 'isEmpty'     (vertex x) == False
-- 'hasVertex' x (vertex y) == (x == y)
-- 'vertexCount' (vertex x) == 1
-- 'edgeCount'   (vertex x) == 0
-- @
vertex :: a -> AdjacencyMap e a
vertex :: a -> AdjacencyMap e a
vertex a
x = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ a -> Map a e -> Map a (Map a e)
forall k a. k -> a -> Map k a
Map.singleton a
x Map a e
forall k a. Map k a
Map.empty

-- | Construct the graph comprising /a single 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
-- 'edgeCount'     (edge e x y) == if e == 'zero' then 0 else 1
-- 'vertexCount'   (edge e 1 1) == 1
-- 'vertexCount'   (edge e 1 2) == 2
-- @
edge :: (Eq e, Monoid e, Ord a) => e -> a -> a -> AdjacencyMap e a
edge :: e -> a -> a -> AdjacencyMap e a
edge e
e a
x a
y | e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
forall a. Monoid a => a
zero = [a] -> AdjacencyMap e a
forall a e. Ord a => [a] -> AdjacencyMap e a
vertices [a
x, a
y]
           | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ a -> Map a e -> Map a (Map a e)
forall k a. k -> a -> Map k a
Map.singleton a
x (a -> e -> Map a e
forall k a. k -> a -> Map k a
Map.singleton a
x e
e)
           | Bool
otherwise = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ [(a, Map a e)] -> Map a (Map a e)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(a
x, a -> e -> Map a e
forall k a. k -> a -> Map k a
Map.singleton a
y e
e), (a
y, Map a e
forall k a. Map k a
Map.empty)]

-- | 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
-- @
(>-) :: (Eq e, Monoid e, Ord a) => (a, e) -> a -> AdjacencyMap e a
(a
x, e
e) >- :: (a, e) -> a -> AdjacencyMap e a
>- a
y = e -> a -> a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
e -> a -> a -> AdjacencyMap e a
edge e
e a
x a
y

infixl 5 -<
infixl 5 >-

-- | /Overlay/ two graphs. This is a commutative, associative and idempotent
-- operation with the identity 'empty'.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'vertexCount' (overlay x y) >= 'vertexCount' x
-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y
-- 'edgeCount'   (overlay x y) >= 'edgeCount' x
-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y
-- 'vertexCount' (overlay 1 2) == 2
-- 'edgeCount'   (overlay 1 2) == 0
-- @
--
-- 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 :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
overlay :: AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
overlay (AM Map a (Map a e)
x) (AM Map a (Map a e)
y) = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ (Map a e -> Map a e -> Map a e)
-> Map a (Map a e) -> Map a (Map a e) -> Map a (Map a e)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map a e -> Map a e -> Map a e
forall e a.
(Eq e, Monoid e, Ord a) =>
Map a e -> Map a e -> Map a e
nonZeroUnion Map a (Map a e)
x Map a (Map a e)
y

-- Union maps, removing zero elements from the result.
nonZeroUnion :: (Eq e, Monoid e, Ord a) => Map a e -> Map a e -> Map a e
nonZeroUnion :: Map a e -> Map a e -> Map a e
nonZeroUnion Map a e
x Map a e
y = (e -> Bool) -> Map a e -> Map a e
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
/= e
forall a. Monoid a => a
zero) (Map a e -> Map a e) -> Map a e -> Map a e
forall a b. (a -> b) -> a -> b
$ (e -> e -> e) -> Map a e -> Map a e -> Map a e
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith e -> e -> e
forall a. Monoid a => a -> a -> a
mappend Map a e
x Map a e
y

-- Drop all edges with zero labels.
trimZeroes :: (Eq e, Monoid e) => Map a (Map a e) -> Map a (Map a e)
trimZeroes :: Map a (Map a e) -> Map a (Map a e)
trimZeroes = (Map a e -> Map a e) -> Map a (Map a e) -> Map a (Map a e)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((e -> Bool) -> Map a e -> Map a e
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
/= e
forall a. Monoid a => a
zero))

-- | /Connect/ two graphs with edges labelled by a given label. When applied to
-- the same labels, this is an associative operation with the identity 'empty',
-- which distributes over 'overlay' and obeys the decomposition axiom.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the
-- number of edges in the resulting graph is quadratic with respect to the
-- number of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.
--
-- @
-- 'isEmpty'     (connect e x y) == 'isEmpty'   x   && 'isEmpty'   y
-- 'hasVertex' z (connect e x y) == 'hasVertex' z x || 'hasVertex' z y
-- 'vertexCount' (connect e x y) >= 'vertexCount' x
-- 'vertexCount' (connect e x y) <= 'vertexCount' x + 'vertexCount' y
-- 'edgeCount'   (connect e x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y
-- 'vertexCount' (connect e 1 2) == 2
-- 'edgeCount'   (connect e 1 2) == if e == 'zero' then 0 else 1
-- @
connect :: (Eq e, Monoid e, Ord a) => e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
connect :: e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
connect e
e (AM Map a (Map a e)
x) (AM Map a (Map a e)
y)
    | e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
forall a. Monoid a => a
mempty = AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
overlay (Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM Map a (Map a e)
x) (Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM Map a (Map a e)
y)
    | Bool
otherwise   = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ (Map a e -> Map a e -> Map a e)
-> [Map a (Map a e)] -> Map a (Map a e)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Map a e -> Map a e -> Map a e
forall e a.
(Eq e, Monoid e, Ord a) =>
Map a e -> Map a e -> Map a e
nonZeroUnion ([Map a (Map a e)] -> Map a (Map a e))
-> [Map a (Map a e)] -> Map a (Map a e)
forall a b. (a -> b) -> a -> b
$ Map a (Map a e)
x Map a (Map a e) -> [Map a (Map a e)] -> [Map a (Map a e)]
forall a. a -> [a] -> [a]
: Map a (Map a e)
y Map a (Map a e) -> [Map a (Map a e)] -> [Map a (Map a e)]
forall a. a -> [a] -> [a]
:
        [ (a -> Map a e) -> Set a -> Map a (Map a e)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Map a e -> a -> Map a e
forall a b. a -> b -> a
const Map a e
targets) (Map a (Map a e) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Map a e)
x) ]
  where
    targets :: Map a e
targets = (a -> e) -> Set a -> Map a e
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (e -> a -> e
forall a b. a -> b -> a
const e
e) (Map a (Map a e) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Map a e)
y)

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

-- | Construct the graph from a list of edges.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- edges []        == 'empty'
-- edges [(e,x,y)] == 'edge' e x y
-- edges           == 'overlays' . 'map' (\\(e, x, y) -> 'edge' e x y)
-- @
edges :: (Eq e, Monoid e, Ord a) => [(e, a, a)] -> AdjacencyMap e a
edges :: [(e, a, a)] -> AdjacencyMap e a
edges [(e, a, a)]
es = [(a, Map a e)] -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
[(a, Map a e)] -> AdjacencyMap e a
fromAdjacencyMaps [ (a
x, a -> e -> Map a e
forall k a. k -> a -> Map k a
Map.singleton a
y e
e) | (e
e, a
x, a
y) <- [(e, a, a)]
es ]

-- | Overlay a given list of graphs.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- overlays []        == 'empty'
-- overlays [x]       == x
-- overlays [x,y]     == 'overlay' x y
-- overlays           == 'foldr' 'overlay' 'empty'
-- 'isEmpty' . overlays == 'all' 'isEmpty'
-- @
overlays :: (Eq e, Monoid e, Ord a) => [AdjacencyMap e a] -> AdjacencyMap e a
overlays :: [AdjacencyMap e a] -> AdjacencyMap e a
overlays = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> ([AdjacencyMap e a] -> Map a (Map a e))
-> [AdjacencyMap e a]
-> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a e -> Map a e -> Map a e)
-> [Map a (Map a e)] -> Map a (Map a e)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Map a e -> Map a e -> Map a e
forall e a.
(Eq e, Monoid e, Ord a) =>
Map a e -> Map a e -> Map a e
nonZeroUnion ([Map a (Map a e)] -> Map a (Map a e))
-> ([AdjacencyMap e a] -> [Map a (Map a e)])
-> [AdjacencyMap e a]
-> Map a (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AdjacencyMap e a -> Map a (Map a e))
-> [AdjacencyMap e a] -> [Map a (Map a e)]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyMap e a -> Map a (Map a e)
forall e a. AdjacencyMap e a -> Map a (Map a e)
adjacencyMap

-- | Construct a graph from a list of adjacency sets.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @
-- fromAdjacencyMaps []                                  == 'empty'
-- fromAdjacencyMaps [(x, Map.'Map.empty')]                    == 'vertex' x
-- fromAdjacencyMaps [(x, Map.'Map.singleton' y e)]            == if e == 'zero' then 'vertices' [x,y] else 'edge' e x y
-- 'overlay' (fromAdjacencyMaps xs) (fromAdjacencyMaps ys) == fromAdjacencyMaps (xs '++' ys)
-- @
fromAdjacencyMaps :: (Eq e, Monoid e, Ord a) => [(a, Map a e)] -> AdjacencyMap e a
fromAdjacencyMaps :: [(a, Map a e)] -> AdjacencyMap e a
fromAdjacencyMaps [(a, Map a e)]
xs = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ Map a (Map a e) -> Map a (Map a e)
forall e a. (Eq e, Monoid e) => Map a (Map a e) -> Map a (Map a e)
trimZeroes (Map a (Map a e) -> Map a (Map a e))
-> Map a (Map a e) -> Map a (Map a e)
forall a b. (a -> b) -> a -> b
$ (Map a e -> Map a e -> Map a e)
-> Map a (Map a e) -> Map a (Map a e) -> Map a (Map a e)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map a e -> Map a e -> Map a e
forall a. Monoid a => a -> a -> a
mappend Map a (Map a e)
vs Map a (Map a e)
es
  where
    vs :: Map a (Map a e)
vs = (a -> Map a e) -> Set a -> Map a (Map a e)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Map a e -> a -> Map a e
forall a b. a -> b -> a
const Map a e
forall k a. Map k a
Map.empty) (Set a -> Map a (Map a e))
-> ([Set a] -> Set a) -> [Set a] -> Map a (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set a] -> Map a (Map a e)) -> [Set a] -> Map a (Map a e)
forall a b. (a -> b) -> a -> b
$ ((a, Map a e) -> Set a) -> [(a, Map a e)] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map (Map a e -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a e -> Set a)
-> ((a, Map a e) -> Map a e) -> (a, Map a e) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Map a e) -> Map a e
forall a b. (a, b) -> b
snd) [(a, Map a e)]
xs
    es :: Map a (Map a e)
es = (Map a e -> Map a e -> Map a e)
-> [(a, Map a e)] -> Map a (Map a e)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((e -> e -> e) -> Map a e -> Map a e -> Map a e
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith e -> e -> e
forall a. Monoid a => a -> a -> a
mappend) [(a, Map a e)]
xs

-- | 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 y              ==> x <= y
-- @
isSubgraphOf :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> Bool
isSubgraphOf :: AdjacencyMap e a -> AdjacencyMap e a -> Bool
isSubgraphOf (AM Map a (Map a e)
x) (AM Map a (Map a e)
y) = (Map a e -> Map a e -> Bool)
-> Map a (Map a e) -> Map a (Map a e) -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy ((e -> e -> Bool) -> Map a e -> Map a e -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy e -> e -> Bool
forall a. (Eq a, Monoid a) => a -> a -> Bool
le) Map a (Map a e)
x Map a (Map a e)
y
  where
    le :: a -> a -> Bool
le a
x a
y = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
x a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

-- | Check if a graph is empty.
-- Complexity: /O(1)/ time.
--
-- @
-- isEmpty 'empty'                         == True
-- isEmpty ('overlay' 'empty' 'empty')         == True
-- isEmpty ('vertex' x)                    == False
-- isEmpty ('removeVertex' x $ 'vertex' x)   == True
-- isEmpty ('removeEdge' x y $ 'edge' e x y) == False
-- @
isEmpty :: AdjacencyMap e a -> Bool
isEmpty :: AdjacencyMap e a -> Bool
isEmpty = Map a (Map a e) -> Bool
forall k a. Map k a -> Bool
Map.null (Map a (Map a e) -> Bool)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Bool
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)
adjacencyMap

-- | Check if a graph contains a given vertex.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasVertex x 'empty'            == False
-- hasVertex x ('vertex' y)       == (x == y)
-- hasVertex x . 'removeVertex' x == 'const' False
-- @
hasVertex :: Ord a => a -> AdjacencyMap e a -> Bool
hasVertex :: a -> AdjacencyMap e a -> Bool
hasVertex a
x = a -> Map a (Map a e) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
x (Map a (Map a e) -> Bool)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Bool
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)
adjacencyMap

-- | Check if a graph contains a given edge.
-- Complexity: /O(log(n))/ time.
--
-- @
-- hasEdge x y 'empty'            == False
-- hasEdge x y ('vertex' z)       == False
-- hasEdge x y ('edge' 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 :: Ord a => a -> a -> AdjacencyMap e a -> Bool
hasEdge :: a -> a -> AdjacencyMap e a -> Bool
hasEdge a
x a
y (AM Map a (Map a e)
m) = Bool -> (Map a e -> Bool) -> Maybe (Map a e) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a -> Map a e -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
y) (a -> Map a (Map a e) -> Maybe (Map a e)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Map a (Map a e)
m)

-- | Extract the label of a specified edge in a graph.
-- Complexity: /O(log(n))/ time.
--
-- @
-- edgeLabel x y 'empty'         == 'zero'
-- edgeLabel x y ('vertex' z)    == 'zero'
-- edgeLabel x y ('edge' e x y)  == e
-- edgeLabel s t ('overlay' x y) == edgeLabel s t x <+> edgeLabel s t y
-- @
edgeLabel :: (Monoid e, Ord a) => a -> a -> AdjacencyMap e a -> e
edgeLabel :: a -> a -> AdjacencyMap e a -> e
edgeLabel a
x a
y (AM Map a (Map a e)
m) = e -> Maybe e -> e
forall a. a -> Maybe a -> a
fromMaybe e
forall a. Monoid a => a
zero (a -> Map a (Map a e) -> Maybe (Map a e)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Map a (Map a e)
m Maybe (Map a e) -> (Map a e -> Maybe e) -> Maybe e
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Map a e -> Maybe e
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
y)

-- | The number of vertices in a graph.
-- Complexity: /O(1)/ time.
--
-- @
-- vertexCount 'empty'             ==  0
-- vertexCount ('vertex' x)        ==  1
-- vertexCount                   ==  'length' . 'vertexList'
-- vertexCount x \< vertexCount y ==> x \< y
-- @
vertexCount :: AdjacencyMap e a -> Int
vertexCount :: AdjacencyMap e a -> Int
vertexCount = Map a (Map a e) -> Int
forall k a. Map k a -> Int
Map.size (Map a (Map a e) -> Int)
-> (AdjacencyMap e a -> Map a (Map a e)) -> AdjacencyMap e a -> Int
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)
adjacencyMap

-- | The number of (non-'zero') edges in a graph.
-- Complexity: /O(n)/ time.
--
-- @
-- edgeCount 'empty'        == 0
-- edgeCount ('vertex' x)   == 0
-- edgeCount ('edge' e x y) == if e == 'zero' then 0 else 1
-- edgeCount              == 'length' . 'edgeList'
-- @
edgeCount :: AdjacencyMap e a -> Int
edgeCount :: AdjacencyMap e a -> Int
edgeCount = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int)
-> (AdjacencyMap e a -> Sum Int) -> AdjacencyMap e a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a e -> Sum Int) -> Map a (Map a e) -> Sum Int
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (Map a e -> Int) -> Map a e -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a e -> Int
forall k a. Map k a -> Int
Map.size) (Map a (Map a e) -> Sum Int)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Sum Int
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)
adjacencyMap

-- | The sorted list of vertices of a given graph.
-- Complexity: /O(n)/ time and memory.
--
-- @
-- vertexList 'empty'      == []
-- vertexList ('vertex' x) == [x]
-- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'
-- @
vertexList :: AdjacencyMap e a -> [a]
vertexList :: AdjacencyMap e a -> [a]
vertexList = Map a (Map a e) -> [a]
forall k a. Map k a -> [k]
Map.keys (Map a (Map a e) -> [a])
-> (AdjacencyMap e a -> Map a (Map a e)) -> AdjacencyMap e a -> [a]
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)
adjacencyMap

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

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

-- | 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 a, Eq e) => AdjacencyMap e a -> Set (e, a, a)
edgeSet :: AdjacencyMap 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))
-> (AdjacencyMap e a -> [(e, a, a)])
-> AdjacencyMap e a
-> Set (e, a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e a -> [(e, a, a)]
forall e a. AdjacencyMap e a -> [(e, a, a)]
edgeList

-- | The /preset/ of an element @x@ is the set of its /direct predecessors/.
-- Complexity: /O(n * log(n))/ time and /O(n)/ memory.
--
-- @
-- preSet x 'empty'        == Set.'Set.empty'
-- preSet x ('vertex' x)   == Set.'Set.empty'
-- preSet 1 ('edge' e 1 2) == Set.'Set.empty'
-- preSet y ('edge' e x y) == if e == 'zero' then Set.'Set.empty' else Set.'Set.fromList' [x]
-- @
preSet :: Ord a => a -> AdjacencyMap e a -> Set a
preSet :: a -> AdjacencyMap e a -> Set a
preSet a
x (AM Map a (Map a e)
m) = [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList
    [ a
a | (a
a, Map a e
es) <- Map a (Map a e) -> [(a, Map a e)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Map a e)
m, a -> Map a e -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
x Map a e
es ]

-- | The /postset/ of a vertex is the set of its /direct successors/.
-- Complexity: /O(log(n))/ time and /O(1)/ memory.
--
-- @
-- postSet x 'empty'        == Set.'Set.empty'
-- postSet x ('vertex' x)   == Set.'Set.empty'
-- postSet x ('edge' e x y) == if e == 'zero' then Set.'Set.empty' else Set.'Set.fromList' [y]
-- postSet 2 ('edge' e 1 2) == Set.'Set.empty'
-- @
postSet :: Ord a => a -> AdjacencyMap e a -> Set a
postSet :: a -> AdjacencyMap e a -> Set a
postSet a
x = Map a e -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a e -> Set a)
-> (AdjacencyMap e a -> Map a e) -> AdjacencyMap e a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a e -> a -> Map a (Map a e) -> Map a e
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map a e
forall k a. Map k a
Map.empty a
x (Map a (Map a e) -> Map a e)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e 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)
adjacencyMap

-- TODO: Optimise.
-- | Convert a graph to the corresponding unlabelled 'AM.AdjacencyMap' by
-- forgetting labels on all non-'zero' edges.
-- Complexity: /O((n + m) * log(n))/ time and memory.
--
-- @
-- 'hasEdge' x y == 'AM.hasEdge' x y . skeleton
-- @
skeleton :: Ord a => AdjacencyMap e a -> AM.AdjacencyMap a
skeleton :: AdjacencyMap e a -> AdjacencyMap a
skeleton (AM Map a (Map a e)
m) = [(a, Set a)] -> AdjacencyMap a
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets ([(a, Set a)] -> AdjacencyMap a) -> [(a, Set a)] -> AdjacencyMap a
forall a b. (a -> b) -> a -> b
$ Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map a (Set a) -> [(a, Set a)]) -> Map a (Set a) -> [(a, Set a)]
forall a b. (a -> b) -> a -> b
$ (Map a e -> Set a) -> Map a (Map a e) -> Map a (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map a e -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Map a e)
m

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

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

-- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a
-- given 'AdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- replaceVertex x x            == id
-- replaceVertex x y ('vertex' x) == 'vertex' y
-- replaceVertex x y            == 'gmap' (\\v -> if v == x then y else v)
-- @
replaceVertex :: (Eq e, Monoid e, Ord a) => a -> a -> AdjacencyMap e a -> AdjacencyMap e a
replaceVertex :: a -> a -> AdjacencyMap e a -> AdjacencyMap e a
replaceVertex a
u a
v = (a -> a) -> AdjacencyMap e a -> AdjacencyMap e a
forall e a b.
(Eq e, Monoid e, Ord a, Ord b) =>
(a -> b) -> AdjacencyMap e a -> AdjacencyMap e b
gmap ((a -> a) -> AdjacencyMap e a -> AdjacencyMap e a)
-> (a -> a) -> AdjacencyMap e a -> AdjacencyMap 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 -> AdjacencyMap e a -> AdjacencyMap e a
replaceEdge :: e -> a -> a -> AdjacencyMap e a -> AdjacencyMap e a
replaceEdge e
e a
x a
y
    | e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
forall a. Monoid a => a
zero  = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Map a e) -> Map a (Map a e)
addY (Map a (Map a e) -> Map a (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map a (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Map a e) -> Maybe (Map a e))
-> a -> Map a (Map a e) -> Map a (Map a e)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Map a e -> Maybe (Map a e)
forall a. a -> Maybe a
Just (Map a e -> Maybe (Map a e))
-> (Maybe (Map a e) -> Map a e)
-> Maybe (Map a e)
-> Maybe (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a e -> (Map a e -> Map a e) -> Maybe (Map a e) -> Map a e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map a e
forall k a. Map k a
Map.empty (a -> Map a e -> Map a e
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
y)) a
x (Map a (Map a e) -> Map a (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map 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)
adjacencyMap
    | Bool
otherwise  = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Map a e) -> Map a (Map a e)
addY (Map a (Map a e) -> Map a (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map a (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Map a e) -> Maybe (Map a e))
-> a -> Map a (Map a e) -> Map a (Map a e)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Map a e) -> Maybe (Map a e)
replace a
x (Map a (Map a e) -> Map a (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map 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)
adjacencyMap
  where
    addY :: Map a (Map a e) -> Map a (Map a e)
addY             = (Maybe (Map a e) -> Maybe (Map a e))
-> a -> Map a (Map a e) -> Map a (Map a e)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Map a e -> Maybe (Map a e)
forall a. a -> Maybe a
Just (Map a e -> Maybe (Map a e))
-> (Maybe (Map a e) -> Map a e)
-> Maybe (Map a e)
-> Maybe (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a e -> Maybe (Map a e) -> Map a e
forall a. a -> Maybe a -> a
fromMaybe Map a e
forall k a. Map k a
Map.empty) a
y
    replace :: Maybe (Map a e) -> Maybe (Map a e)
replace (Just Map a e
m) = Map a e -> Maybe (Map a e)
forall a. a -> Maybe a
Just (Map a e -> Maybe (Map a e)) -> Map a e -> Maybe (Map a e)
forall a b. (a -> b) -> a -> b
$ a -> e -> Map a e -> Map a e
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
y e
e Map a e
m
    replace Maybe (Map a e)
Nothing  = Map a e -> Maybe (Map a e)
forall a. a -> Maybe a
Just (Map a e -> Maybe (Map a e)) -> Map a e -> Maybe (Map a e)
forall a b. (a -> b) -> a -> b
$ a -> e -> Map a e
forall k a. k -> a -> Map k a
Map.singleton a
y e
e

-- | Transpose a given graph.
-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.
--
-- @
-- transpose 'empty'        == 'empty'
-- transpose ('vertex' x)   == 'vertex' x
-- transpose ('edge' e x y) == 'edge' e y x
-- transpose . transpose  == id
-- @
transpose :: (Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a
transpose :: AdjacencyMap e a -> AdjacencyMap e a
transpose (AM Map a (Map a e)
m) = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ (a -> Map a e -> Map a (Map a e) -> Map a (Map a e))
-> Map a (Map a e) -> Map a (Map a e) -> Map a (Map a e)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey a -> Map a e -> Map a (Map a e) -> Map a (Map a e)
forall k k a.
(Ord k, Ord k, Monoid a) =>
k -> Map k a -> Map k (Map k a) -> Map k (Map k a)
combine Map a (Map a e)
vs Map a (Map a e)
m
  where
    -- No need to use @nonZeroUnion@ here, since we do not add any new edges
    combine :: k -> Map k a -> Map k (Map k a) -> Map k (Map k a)
combine k
v Map k a
es = (Map k a -> Map k a -> Map k a)
-> Map k (Map k a) -> Map k (Map k a) -> Map k (Map k a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend) (Map k (Map k a) -> Map k (Map k a) -> Map k (Map k a))
-> Map k (Map k a) -> Map k (Map k a) -> Map k (Map k a)
forall a b. (a -> b) -> a -> b
$
        [(k, Map k a)] -> Map k (Map k a)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (k
u, k -> a -> Map k a
forall k a. k -> a -> Map k a
Map.singleton k
v a
e) | (k
u, a
e) <- Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k a
es ]
    vs :: Map a (Map a e)
vs = (a -> Map a e) -> Set a -> Map a (Map a e)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Map a e -> a -> Map a e
forall a b. a -> b -> a
const Map a e
forall k a. Map k a
Map.empty) (Map a (Map a e) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Map a e)
m)

-- | Transform a graph by applying a function to each of its vertices. This is
-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric
-- 'AdjacencyMap'.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- gmap f 'empty'        == 'empty'
-- gmap f ('vertex' x)   == 'vertex' (f x)
-- gmap f ('edge' e x y) == 'edge' e (f x) (f y)
-- gmap 'id'             == 'id'
-- gmap f . gmap g     == gmap (f . g)
-- @
gmap :: (Eq e, Monoid e, Ord a, Ord b) => (a -> b) -> AdjacencyMap e a -> AdjacencyMap e b
gmap :: (a -> b) -> AdjacencyMap e a -> AdjacencyMap e b
gmap a -> b
f = Map b (Map b e) -> AdjacencyMap e b
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map b (Map b e) -> AdjacencyMap e b)
-> (AdjacencyMap e a -> Map b (Map b e))
-> AdjacencyMap e a
-> AdjacencyMap e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map b (Map b e) -> Map b (Map b e)
forall e a. (Eq e, Monoid e) => Map a (Map a e) -> Map a (Map a e)
trimZeroes (Map b (Map b e) -> Map b (Map b e))
-> (AdjacencyMap e a -> Map b (Map b e))
-> AdjacencyMap e a
-> Map b (Map b e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a e -> Map b e) -> Map b (Map a e) -> Map b (Map b e)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((e -> e -> e) -> (a -> b) -> Map a e -> Map b e
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith e -> e -> e
forall a. Monoid a => a -> a -> a
mappend a -> b
f) (Map b (Map a e) -> Map b (Map b e))
-> (AdjacencyMap e a -> Map b (Map a e))
-> AdjacencyMap e a
-> Map b (Map b e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Map a e -> Map a e -> Map a e)
-> (a -> b) -> Map a (Map a e) -> Map b (Map a e)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith ((e -> e -> e) -> Map a e -> Map a e -> Map a e
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith e -> e -> e
forall a. Monoid a => a -> a -> a
mappend) a -> b
f (Map a (Map a e) -> Map b (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map b (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)
adjacencyMap

-- | Transform a graph by applying a function @h@ to each of its edge labels.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- 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 :: (Eq f, Monoid f) => (e -> f) -> AdjacencyMap e a -> AdjacencyMap f a
emap :: (e -> f) -> AdjacencyMap e a -> AdjacencyMap f a
emap e -> f
h = Map a (Map a f) -> AdjacencyMap f a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a f) -> AdjacencyMap f a)
-> (AdjacencyMap e a -> Map a (Map a f))
-> AdjacencyMap e a
-> AdjacencyMap f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Map a f) -> Map a (Map a f)
forall e a. (Eq e, Monoid e) => Map a (Map a e) -> Map a (Map a e)
trimZeroes (Map a (Map a f) -> Map a (Map a f))
-> (AdjacencyMap e a -> Map a (Map a f))
-> AdjacencyMap e a
-> Map a (Map a f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a e -> Map a f) -> Map a (Map a e) -> Map a (Map a f)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((e -> f) -> Map a e -> Map a f
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map e -> f
h) (Map a (Map a e) -> Map a (Map a f))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map a (Map a f)
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)
adjacencyMap

-- | Construct the /induced subgraph/ of a given graph by removing the
-- vertices that do not satisfy a given predicate.
-- Complexity: /O(n + m)/ time, assuming that the predicate takes constant time.
--
-- @
-- induce ('const' True ) x      == x
-- induce ('const' False) x      == 'empty'
-- induce (/= x)               == 'removeVertex' x
-- induce p . induce q         == induce (\\x -> p x && q x)
-- 'isSubgraphOf' (induce p x) x == True
-- @
induce :: (a -> Bool) -> AdjacencyMap e a -> AdjacencyMap e a
induce :: (a -> Bool) -> AdjacencyMap e a -> AdjacencyMap e a
induce a -> Bool
p = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a e -> Map a e) -> Map a (Map a e) -> Map a (Map a e)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> e -> Bool) -> Map a e -> Map a e
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\a
k e
_ -> a -> Bool
p a
k)) (Map a (Map a e) -> Map a (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map a (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (a -> Map a e -> Bool) -> Map a (Map a e) -> Map a (Map a e)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\a
k Map a e
_ -> a -> Bool
p a
k) (Map a (Map a e) -> Map a (Map a e))
-> (AdjacencyMap e a -> Map a (Map a e))
-> AdjacencyMap e a
-> Map 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)
adjacencyMap

-- | Construct the /induced subgraph/ of a given graph by removing the vertices
-- that are 'Nothing'.
-- Complexity: /O(n + m)/ time.
--
-- @
-- induceJust ('vertex' 'Nothing')                               == 'empty'
-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
-- induceJust . 'gmap' 'Just'                                    == 'id'
-- induceJust . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
-- @
induceJust :: Ord a => AdjacencyMap e (Maybe a) -> AdjacencyMap e a
induceJust :: AdjacencyMap e (Maybe a) -> AdjacencyMap e a
induceJust = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> (AdjacencyMap e (Maybe a) -> Map a (Map a e))
-> AdjacencyMap e (Maybe a)
-> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Maybe a) e -> Map a e)
-> Map a (Map (Maybe a) e) -> Map a (Map a e)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map (Maybe a) e -> Map a e
forall a. Map (Maybe a) a -> Map a a
catMaybesMap (Map a (Map (Maybe a) e) -> Map a (Map a e))
-> (AdjacencyMap e (Maybe a) -> Map a (Map (Maybe a) e))
-> AdjacencyMap e (Maybe a)
-> Map a (Map a e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Maybe a) (Map (Maybe a) e) -> Map a (Map (Maybe a) e)
forall a. Map (Maybe a) a -> Map a a
catMaybesMap (Map (Maybe a) (Map (Maybe a) e) -> Map a (Map (Maybe a) e))
-> (AdjacencyMap e (Maybe a) -> Map (Maybe a) (Map (Maybe a) e))
-> AdjacencyMap e (Maybe a)
-> Map a (Map (Maybe a) e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e (Maybe a) -> Map (Maybe a) (Map (Maybe a) e)
forall e a. AdjacencyMap e a -> Map a (Map a e)
adjacencyMap
  where
    catMaybesMap :: Map (Maybe a) a -> Map a a
catMaybesMap = (Maybe a -> a) -> Map (Maybe a) a -> Map a a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Map (Maybe a) a -> Map a a)
-> (Map (Maybe a) a -> Map (Maybe a) a)
-> Map (Maybe a) a
-> Map a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Map (Maybe a) a -> Map (Maybe a) a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Maybe a
forall a. Maybe a
Nothing

-- | 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
-- 'postSet' x (closure y) == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)
-- @
closure :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a
closure :: AdjacencyMap e a -> AdjacencyMap e a
closure = AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Ord a, StarSemiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
goWarshallFloydKleene (AdjacencyMap e a -> AdjacencyMap e a)
-> (AdjacencyMap e a -> AdjacencyMap e a)
-> AdjacencyMap e a
-> AdjacencyMap e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap e a -> AdjacencyMap e a
forall a e.
(Ord a, Semiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
reflexiveClosure

-- | 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) => AdjacencyMap e a -> AdjacencyMap e a
reflexiveClosure :: AdjacencyMap e a -> AdjacencyMap e a
reflexiveClosure (AM Map a (Map a e)
m) = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ (a -> Map a e -> Map a e) -> Map a (Map a e) -> Map a (Map a e)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\a
k -> (e -> e -> e) -> a -> e -> Map a e -> Map a e
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith e -> e -> e
forall a. Semigroup a => a -> a -> a
(<+>) a
k e
forall a. Semiring a => a
one) Map a (Map a e)
m

-- | Compute the /symmetric closure/ of a graph by overlaying it with its own
-- transpose.
-- Complexity: /O((n + m) * log(n))/ time.
--
-- @
-- symmetricClosure 'empty'              == 'empty'
-- symmetricClosure ('vertex' x)         == 'vertex' x
-- symmetricClosure ('edge' e x y)       == 'edges' [(e,x,y), (e,y,x)]
-- symmetricClosure x                  == 'overlay' x ('transpose' x)
-- symmetricClosure . symmetricClosure == symmetricClosure
-- @
symmetricClosure :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a
symmetricClosure :: AdjacencyMap e a -> AdjacencyMap e a
symmetricClosure AdjacencyMap e a
m = AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Monoid e, Ord a) =>
AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
overlay AdjacencyMap e a
m (AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Monoid e, Ord a) =>
AdjacencyMap e a -> AdjacencyMap e a
transpose AdjacencyMap 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) => AdjacencyMap e a -> AdjacencyMap e a
transitiveClosure :: AdjacencyMap e a -> AdjacencyMap e a
transitiveClosure = AdjacencyMap e a -> AdjacencyMap e a
forall e a.
(Eq e, Ord a, StarSemiring e) =>
AdjacencyMap e a -> AdjacencyMap e a
goWarshallFloydKleene

-- The iterative part of the Warshall-Floyd-Kleene algorithm
goWarshallFloydKleene :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a
goWarshallFloydKleene :: AdjacencyMap e a -> AdjacencyMap e a
goWarshallFloydKleene (AM Map a (Map a e)
m) = Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM (Map a (Map a e) -> AdjacencyMap e a)
-> Map a (Map a e) -> AdjacencyMap e a
forall a b. (a -> b) -> a -> b
$ (a -> Map a (Map a e) -> Map a (Map a e))
-> Map a (Map a e) -> [a] -> Map a (Map a e)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Map a (Map a e) -> Map a (Map a e)
update Map a (Map a e)
m [a]
vs
  where
    vs :: [a]
vs = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Map a (Map a e) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Map a e)
m)
    update :: a -> Map a (Map a e) -> Map a (Map a e)
update a
k Map a (Map a e)
cur = [(a, Map a e)] -> Map a (Map a e)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (a
i, a -> e -> Map a e
go a
i (a -> a -> e
get a
i a
k e -> e -> e
forall a. Semiring a => a -> a -> a
<.> e
starkk)) | a
i <- [a]
vs ]
      where
        get :: a -> a -> e
get a
i a
j = a -> a -> AdjacencyMap e a -> e
forall e a. (Monoid e, Ord a) => a -> a -> AdjacencyMap e a -> e
edgeLabel a
i a
j (Map a (Map a e) -> AdjacencyMap e a
forall e a. Map a (Map a e) -> AdjacencyMap e a
AM Map a (Map a e)
cur)
        starkk :: e
starkk  = e -> e
forall a. StarSemiring a => a -> a
star (a -> a -> e
get a
k a
k)
        go :: a -> e -> Map a e
go a
i e
ik = [(a, e)] -> Map a e
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
            [ (a
j, e
e) | a
j <- [a]
vs, let e :: e
e = a -> a -> e
get a
i a
j e -> e -> e
forall a. Semigroup a => a -> a -> a
<+> e
ik e -> e -> e
forall a. Semiring a => a -> a -> a
<.> a -> a -> e
get a
k a
j, e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
/= e
forall a. Monoid a => a
zero ]

-- | Check that the internal graph representation is consistent, i.e. that all
-- edges refer to existing vertices, and there are no 'zero'-labelled edges. It
-- should be impossible to create an inconsistent adjacency map, and we use this
-- function in testing.
consistent :: (Ord a, Eq e, Monoid e) => AdjacencyMap e a -> Bool
consistent :: AdjacencyMap e a -> Bool
consistent (AM Map a (Map a e)
m) = Map a (Map a e) -> Set a
forall a e. Ord a => Map a (Map a e) -> Set a
referredToVertexSet Map a (Map a e)
m Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map a (Map a e) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Map a e)
m
    Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
/= e
forall a. Monoid a => a
zero | (a
_, Map a e
es) <- Map a (Map a e) -> [(a, Map a e)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Map a e)
m, (a
_, e
e) <- Map a e -> [(a, e)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a e
es ]

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