DAG in the style of algebraic-graphs.

DAlGa.hs

module DAlGa where

import Data.Foldable

import qualified Data.Set as S
import qualified Data.Map.Strict as M

-- Note: this is identical to algebraic-graphs' Graph type,
-- but has different semantics in that 'Connect' is not commutative.
data DAG v = Empty | Vertex v | Connect (DAG v) (DAG v) | Overlay (DAG v) (DAG v)
  deriving Functor

vertices :: Ord v => DAG v -> S.Set v
vertices = \case
  Empty -> S.empty
  Vertex v -> S.singleton v
  Connect p c -> vertices p `S.union` vertices c
  Overlay x y -> vertices x `S.union` vertices y

inGraph :: Eq v => v -> DAG v -> Bool
inGraph v = \case
  Empty       -> False
  Vertex v'   -> v == v'
  Connect p c -> v `inGraph` p || v `inGraph` c
  Overlay x y -> v `inGraph` x || v `inGraph` c

children :: Ord v => DAG v -> v -> S.Set v
children Empty         _ = S.empty
children (Vertex v')   _ = S.empty
children (Connect p c) v = if v `inGraph` p then vertices c else S.empty
children (Overlay x y) v = children x v `S.union` children y v

parents :: Ord v => DAG v -> v -> S.Set v
parents Empty         _ = S.empty
parents (Vertex v')   _ = S.empty
parents (Connect p c) v = if v `inGraph` c then vertices p else S.empty
parents (Overlay x y) v = parents x v `S.union` parents y v

valid :: Ord v => DAG v -> Bool
valid = all (==1) . countOccs
  where
    countOccs Empty         = M.empty
    countOccs (Vertex v)    = M.singleton v 1
    countOccs (Connect p c) = M.unionWith (+) (countOccs p) (countOccs c)
    countOccs (Overlay x y) = M.unionWith (+) (countOccs x) (countOccs y)