diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2013, Jakub Waszczuk +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, this + list of conditions and the following disclaimer in the documentation and/or + other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/pedestrian-dag.cabal b/pedestrian-dag.cabal new file mode 100644 --- /dev/null +++ b/pedestrian-dag.cabal @@ -0,0 +1,36 @@ +name: pedestrian-dag +version: 0.2.0 +synopsis: A pedestrian implementation of directed acyclic graphs +description: + The library implements a pedestrian representation of + directed acyclic graphs. +license: BSD3 +license-file: LICENSE +cabal-version: >= 1.6 +copyright: Copyright (c) 2013-2018 Jakub Waszczuk +author: Jakub Waszczuk +maintainer: waszczuk.kuba@gmail.com +stability: experimental +category: Data, Data Structures +homepage: https://github.com/kawu/pedestrian-dag +build-type: Simple + +library + hs-source-dirs: src + build-depends: + base >= 4 && < 5 + , containers >= 0.4 && < 0.6 + , array >= 0.5 && < 0.6 + , binary >= 0.7 && < 0.9 + -- , vector >= 0.11 && < 0.12 + + exposed-modules: + Data.DAG + + -- other-modules: + + ghc-options: -Wall + +source-repository head + type: git + location: https://github.com/kawu/pedestrian-dag.git diff --git a/src/Data/DAG.hs b/src/Data/DAG.hs new file mode 100644 --- /dev/null +++ b/src/Data/DAG.hs @@ -0,0 +1,663 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + + +-- | A pedestrian implementation of a directed acyclic graph. Sharing is +-- explicitely represented by using node-level and edge-level identifiers. The +-- module may be convenient to use if your data structure doesn't change often. + + +module Data.DAG +( +-- * Types + DAG +, NodeID (..) +, EdgeID (..) +, Edge (..) + +-- * Primitive Operations +, begsWith +, endsWith +, ingoingEdges +, outgoingEdges +, maybeNodeLabel +, nodeLabel +, maybeEdgeLabel +, edgeLabel + +-- * Intermediate Operations +, prevEdges +, isInitialEdge +-- , isInitialNode +, nextEdges +, isFinalEdge + +, minEdge +, maxEdge + +, mapN +, mapE +, zipE +, zipE' + +-- * Advanced Operations +, dagNodes +, dagEdges + +-- * Conversion +, fromList +, fromList' +, fromEdgesUnsafe +-- -- ** Provisional +-- , toListProv + +-- * Splitting +, splitTmp + +-- * Filtering +, filterDAG + +-- * Check +, isOK +, isDAG + +-- * Topological sorting +, topoSort +) where + + +import Control.Applicative ((<|>)) +import Control.Arrow (first) +import Control.Monad (guard) +import qualified Data.Foldable as F +import qualified Data.List as L +import Data.Maybe (isJust) +import qualified Data.Traversable as T +import qualified Data.Array as A +-- import qualified Data.Vector as V + +import qualified Data.Set as S +import qualified Data.Map.Strict as M + +import Data.Binary (Binary, get, put) --, putWord8, getWord8) +-- import Data.Vector.Binary () +-- import qualified Data.Binary as B + + +------------------------------------------------------------------ +-- Types +------------------------------------------------------------------ + + +-- | A directed acyclic graph (DAG) with nodes of type `a` and +-- edges of type `b`. +data DAG a b = DAG + { nodeMap :: M.Map NodeID (Node a) + , edgeMap :: M.Map EdgeID (Edge b) + } deriving (Functor, F.Foldable, T.Traversable) + +-- The instance below is needed for Concraft. Something has to be done with +-- it. +instance (Binary a, Binary b) => Binary (DAG a b) where + put = undefined + get = undefined + + +-- | Node ID. +newtype NodeID = NodeID {unNodeID :: Int} + deriving (Show, Eq, Ord) + + +-- | Node of the DAG. +data Node a = Node + { ingoSet :: S.Set EdgeID + , outgoSet :: S.Set EdgeID + , ndLabel :: a } + deriving (Show, Eq, Ord) + + +-- | ID of an edge. The following properties must be satisfied by `EdgeID`: +-- +-- * The ordering of edge IDs (`Ord` instance) is consistent with the +-- topological ordering of the edges. (TODO 26/02/2018: be more specific +-- about what consistency means in this context) +-- * The smallest `EdgeID` of a given DAG, `minEdge`, is equal +-- to `0` (`EdgeID 0`). +-- +-- Additional important property, which guarantees that inference computations +-- over the DAG, based on dynamic programming, are efficient: +-- +-- * Let `e` be the greatest `EdgeID` in the DAG. Then, the set of `EdgeID`s +-- in the DAG is equal to {0 .. e}. +-- +-- However, this last property is not required for the correcntess of the +-- inference computations, it only improves their memory complexity. +-- +-- TODO (13/11/2017): It seems that the following is not required: +-- * The smallest `EdgeID` of a given DAG, `minEdge`, is equal +-- to `0` (`EdgeID 0`). +-- Verify that (see also `splitTmp`, whose second element does not satisfy the +-- above description)! +-- +-- TODO (26/02/2018): Perhaps we should also assume that node IDs are sorted +-- topologically? (see `splitTmp`). +newtype EdgeID = EdgeID {unEdgeID :: Int} + deriving (Show, Eq, Ord, Num, A.Ix) + + +-- | Edge of the DAG. +data Edge a = Edge + { tailNode :: NodeID + , headNode :: NodeID + , edLabel :: a } + deriving (Show, Eq, Ord, Functor, F.Foldable, T.Traversable) + + +------------------------------------------------------------------ +-- Primitive Operations +------------------------------------------------------------------ + + +-- | Return the edge for the given edge ID. +edgeOn :: EdgeID -> DAG a b -> Edge b +edgeOn i DAG{..} = case M.lookup i edgeMap of + Nothing -> error "edgeWith: incorrent edge ID" + Just edge -> edge + + +-- | Return the tail node of the given edge. +begsWith :: EdgeID -> DAG a b -> NodeID +begsWith i DAG{..} = case M.lookup i edgeMap of + Nothing -> error "begsWith: incorrent edge ID" + Just Edge{..} -> tailNode + + +-- | Return the head node of the given edge. +endsWith :: EdgeID -> DAG a b -> NodeID +endsWith i DAG{..} = case M.lookup i edgeMap of + Nothing -> error "endsWith: incorrent edge ID" + Just Edge{..} -> headNode + + +-- | The list of outgoint edges from the given node, in ascending order. +ingoingEdges :: NodeID -> DAG a b -> [EdgeID] +ingoingEdges i DAG{..} = case M.lookup i nodeMap of + Nothing -> error "ingoingEdges: incorrect ID" + Just Node{..} -> S.toAscList ingoSet + + +-- | The list of outgoint edges from the given node, in ascending order. +outgoingEdges :: NodeID -> DAG a b -> [EdgeID] +outgoingEdges i DAG{..} = case M.lookup i nodeMap of + Nothing -> error "outgoingEdges: incorrect ID" + Just Node{..} -> S.toAscList outgoSet + + +-- | The label assigned to the given node. Return `Nothing` if the node ID is +-- out of bounds. +maybeNodeLabel :: NodeID -> DAG a b -> Maybe a +maybeNodeLabel i DAG{..} = ndLabel <$> M.lookup i nodeMap + + +-- | The label assigned to the given node. +nodeLabel :: NodeID -> DAG a b -> a +nodeLabel i DAG{..} = case M.lookup i nodeMap of + Nothing -> error "nodeLabel: incorrect ID" + Just Node{..} -> ndLabel + + +-- | The label assigned to the given edge. Return `Nothing` if the edge ID is +-- out of bounds. +maybeEdgeLabel :: EdgeID -> DAG a b -> Maybe b +maybeEdgeLabel i DAG{..} = edLabel <$> M.lookup i edgeMap + + +-- | The label assigned to the given node. +edgeLabel :: EdgeID -> DAG a b -> b +edgeLabel i DAG{..} = case M.lookup i edgeMap of + Nothing -> error "edgeLabel: incorrent ID" + Just Edge{..} -> edLabel + + +-- | The greatest `EdgeID` in the DAG. +minEdge :: DAG a b -> EdgeID +minEdge = fst . M.findMin . edgeMap + + +-- | The greatest `EdgeID` in the DAG. +maxEdge :: DAG a b -> EdgeID +maxEdge = fst . M.findMax . edgeMap + + +------------------------------------------------------------------ +-- Not-so-primitive ops, but still looking at the implementation +------------------------------------------------------------------ + + +-- | The list of DAG nodes in ascending order. +dagNodes :: DAG a b -> [NodeID] +dagNodes = M.keys . nodeMap + + +-- | Map function over node labels. +mapN :: (a -> b) -> DAG a c -> DAG b c +mapN f dag = + dag {nodeMap = nodeMap'} + where + nodeMap' = M.fromList + [ (nodeID, node {ndLabel = newLabel}) + | (nodeID, node) <- M.toList (nodeMap dag) + , let newLabel = f (ndLabel node) ] + + +-- | The list of DAG edges in ascending order. +dagEdges :: DAG a b -> [EdgeID] +dagEdges = M.keys . edgeMap + + +-- | Similar to `fmap` but the mapping function has access to IDs of the +-- individual edges. +mapE :: (EdgeID -> b -> c) -> DAG a b -> DAG a c +mapE f dag = + dag {edgeMap = edgeMap'} + where + edgeMap' = M.fromList + [ (edgeID, edge {edLabel = newLabel}) + | (edgeID, edge) <- M.toList (edgeMap dag) + , let newLabel = f edgeID (edLabel edge) ] + + +-- | Zip labels assigned to the same edges in the two input DAGs. Node labels +-- from the first DAG are preserved. The function fails if the input DAGs +-- contain different sets of edge IDs or node IDs. +zipE :: DAG a b -> DAG x c -> DAG a (b, c) +zipE dagL dagR + | M.keysSet (nodeMap dagL) /= M.keysSet (nodeMap dagR) = + error "zipE: different sets of node IDs" + | M.keysSet (edgeMap dagL) /= M.keysSet (edgeMap dagR) = + error "zipE: different sets of edge IDs" + | otherwise = DAG + { nodeMap = newNodeMap + , edgeMap = newEdgeMap } + where + newNodeMap = nodeMap dagL + newEdgeMap = M.fromList + [ (edgeID, newEdge) + | edgeID <- M.keys (edgeMap dagL) + , let newEdge = mergeEdges + (edgeMap dagL M.! edgeID) + (edgeMap dagR M.! edgeID) ] + mergeEdges e1 e2 + | tailNode e1 /= tailNode e2 = + error "zipE.mergEdges: different tail nodes" + | headNode e1 /= headNode e2 = + error "zipE.mergEdges: different head nodes" + | otherwise = + let newLabel = (edLabel e1, edLabel e2) + in e1 {edLabel = newLabel} + + +-- | A version of `zipE` which does not require that the sets of edges/nodes be +-- the same. It does not preserve the node labels, though (it could be probably +-- easily modified so as to account for them, though). +zipE' :: DAG x a -> DAG y b -> DAG () (Maybe a, Maybe b) +zipE' dagL dagR +-- | M.keysSet (nodeMap dagL) /= M.keysSet (nodeMap dagR) = +-- error "zipE': different sets of node IDs" +-- | otherwise = fromEdgesUnsafe newEdgeList + = fromEdgesUnsafe newEdgeList + where + + edgesIn dag = map (flip edgeOn dag) (dagEdges dag) + + reconcile (x1, y1) (x2, y2) = (x1 <|> x2, y1 <|> y2) + newEdgeMap = M.fromListWith reconcile $ + [ ( (tailNode edge, headNode edge) + , (Just (edLabel edge), Nothing) ) + | edge <- edgesIn dagL ] ++ + [ ( (tailNode edge, headNode edge) + , (Nothing, Just (edLabel edge)) ) + | edge <- edgesIn dagR ] + + newEdgeList = + [ Edge {tailNode = from, headNode = to, edLabel = label} + | ((from, to), label) <- M.toList newEdgeMap ] + + +------------------------------------------------------------------ +-- Intermediate Operations +------------------------------------------------------------------ + + +-- | The list of the preceding edges of the given edge. +prevEdges :: EdgeID -> DAG a b -> [EdgeID] +prevEdges edgeID dag = + let tailNodeID = begsWith edgeID dag + in ingoingEdges tailNodeID dag + + +-- | Is the given edge initial? +isInitialEdge :: EdgeID -> DAG a b -> Bool +isInitialEdge edgeID = null . prevEdges edgeID + + +-- -- | Is the given node initial? +-- isInitialNode :: NodeID -> DAG a b -> Bool +-- isInitialNode nodeID = null . ingoingEdges nodeID + + +-- | The list of the succeding edges of the given edge. +nextEdges :: EdgeID -> DAG a b -> [EdgeID] +nextEdges edgeID dag = + let headNodeID = endsWith edgeID dag + in outgoingEdges headNodeID dag + + +-- | Is the given edge initial? +isFinalEdge :: EdgeID -> DAG a b -> Bool +isFinalEdge edgeID = null . nextEdges edgeID + + +------------------------------------------------------------------ +-- Conversion: List +------------------------------------------------------------------ + + +-- | Convert a sequence of (node label, edge label) pairs to a trivial DAG. +-- The first argument is the first node label. +_fromList :: a -> [(a, b)] -> DAG a b +_fromList nodeLabel0 xs = DAG + { nodeMap = newNodeMap -- M.unions [begNodeMap, middleNodeMap, endNodeMap] + , edgeMap = newEdgeMap } + where + + newNodeMap = M.fromList $ do + let nodeLabels = nodeLabel0 : map fst xs + xsLength = length xs + (i, y) <- zip [0 .. length xs] nodeLabels + let node = Node + { ingoSet = + if i > 0 + then S.singleton $ EdgeID (i-1) + else S.empty + , outgoSet = + if i < xsLength + then S.singleton $ EdgeID i + else S.empty + , ndLabel = y } + return (NodeID i, node) + + newEdgeMap = M.fromList $ do + (i, x) <- zip [0..] (map snd xs) + let edge = Edge + { tailNode = NodeID i + , headNode = NodeID (i+1) + , edLabel = x } + return (EdgeID i, edge) + + +-- | Convert a sequence of items to a trivial DAG. Afterwards, check if the +-- resulting DAG is well-structured and throw error if not. +fromList :: [a] -> DAG () a +fromList xs = + if isOK dag + then dag + else error "fromList: resulting DAG not `isOK`" + where + dag = _fromList () $ zip (repeat ()) xs + + +-- | Convert a sequence of items to a trivial DAG. Afterwards, check if the +-- resulting DAG is well-structured and throw error if not. +fromList' :: a -> [(a, b)] -> DAG a b +fromList' x xs = + if isOK dag + then dag + else error "fromList': resulting DAG not `isOK`" + where + dag = _fromList x xs + + +------------------------------------------------------------------ +-- Conversion: DAG +------------------------------------------------------------------ + + +-- | Convert a sequence of labeled edges into a dag. +-- The function assumes that edges are given in topological order. +_fromEdgesUnsafe :: [Edge a] -> DAG () a +_fromEdgesUnsafe edges = DAG + { nodeMap = newNodeMap + , edgeMap = newEdgeMap } + where + + newEdgeMap = M.fromList $ do + (i, edge) <- zip [0..] edges + return (EdgeID i, edge) + + tailMap = M.fromListWith S.union $ do + (i, edge) <- zip [0..] edges + return (tailNode edge, S.singleton $ EdgeID i) + + headMap = M.fromListWith S.union $ do + (i, edge) <- zip [0..] edges + return (headNode edge, S.singleton $ EdgeID i) + + newNodeMap = M.fromList $ do + nodeID <- S.toList $ S.union (M.keysSet headMap) (M.keysSet tailMap) + let ingo = case M.lookup nodeID headMap of + Nothing -> S.empty + Just st -> st + ougo = case M.lookup nodeID tailMap of + Nothing -> S.empty + Just st -> st + node = Node + { ingoSet = ingo + , outgoSet = ougo + , ndLabel = () } + return (nodeID, node) + + +-- | Convert a sequence of labeled edges into a dag. +-- The function assumes that edges are given in topological order. +fromEdgesUnsafe :: [Edge a] -> DAG () a +fromEdgesUnsafe xs = + if isOK dag + then dag + else error "fromEdgesUnsafe: resulting DAG not `isOK`" + where + dag = _fromEdgesUnsafe xs + + +------------------------------------------------------------------ +-- Splitting +------------------------------------------------------------------ + + +-- | Try to split the DAG on the given node, so that all the fst element of the +-- result contains all nodes and edges from the given node is reachable, while +-- the snd element contains all nodes/edges reachable from this node. +-- +-- NOTE: some edges can be discarded this way, it seems! +-- +-- TODO: A provisional function which does not necessarily work correctly. +-- Now it assumes that node IDs are sorted topologically. +splitTmp :: NodeID -> DAG a b -> Maybe (DAG a b, DAG a b) +splitTmp splitNodeID dag + | isOK dagLeft && isOK dagRight = Just (dagLeft, dagRight) + | otherwise = Nothing + where + + dagLeft = DAG nodesLeft edgesLeft + dagRight = DAG nodesRight edgesRight + + edgesLeft = M.fromList + [ (edgeID, edge) + | (edgeID, edge) <- M.toList (edgeMap dag) + , endsWith edgeID dag <= splitNodeID + ] + nodesLeft = M.fromList + [ (nodeID, trim node) + | (nodeID, node) <- M.toList (nodeMap dag) + , nodeID <= splitNodeID ] + where trim = trimNode (M.keysSet edgesLeft) + + edgesRight = M.fromList + [ (edgeID, edge) + | (edgeID, edge) <- M.toList (edgeMap dag) + , begsWith edgeID dag >= splitNodeID + ] + nodesRight = M.fromList + [ (nodeID, trim node) + | (nodeID, node) <- M.toList (nodeMap dag) + , nodeID >= splitNodeID ] + where trim = trimNode (M.keysSet edgesRight) + + trimNode edgeSet = trimIngo edgeSet . trimOutgo edgeSet + trimIngo edgeSet node = + node {ingoSet = ingoSet node `S.intersection` edgeSet} + trimOutgo edgeSet node = + node {outgoSet = outgoSet node `S.intersection` edgeSet} + + +----------------------------------------------------------------- +-- Filtering +------------------------------------------------------------------ + + +-- -- | Remove the nodes (and the corresponding edges) which are not in the given set. +-- filterDAG :: S.Set NodeID -> DAG a b -> DAG a b +-- filterDAG nodeSet DAG{..} = +-- DAG newNodeMap newEdgeMap +-- where +-- edgeSet = S.fromList +-- [ edgeID +-- | (edgeID, edge) <- M.toList edgeMap +-- , tailNode edge `S.member` nodeSet +-- , headNode edge `S.member` nodeSet ] +-- updNode nd = nd +-- { ingoSet = ingoSet nd `S.intersection` edgeSet +-- , outgoSet = outgoSet nd `S.intersection` edgeSet } +-- newNodeMap = M.fromList +-- [ (nodeID, updNode node) +-- | (nodeID, node) <- M.toList nodeMap +-- , nodeID `S.member` nodeSet ] +-- newEdgeMap = M.fromList +-- [ (edgeID, edge) +-- | (edgeID, edge) <- M.toList edgeMap +-- , tailNode edge `S.member` nodeSet +-- , headNode edge `S.member` nodeSet ] + + +-- | Remove the edges (and the corresponding nodes) which are not in the given set. +filterDAG :: S.Set EdgeID -> DAG a b -> DAG a b +filterDAG edgeSet DAG{..} = + DAG newNodeMap newEdgeMap + where + newEdgeMap = M.fromList $ do + (edgeID, edge) <- M.toList edgeMap + guard $ edgeID `S.member` edgeSet + return (edgeID, edge) + newNodeMap = M.fromList $ do + (nodeID, node) <- M.toList nodeMap + Just newNode <- return $ updNode node + return (nodeID, newNode) + updNode nd + -- removing disconnected nodes + | S.null newIngoSet && S.null newOutgoSet = Nothing + | otherwise = Just $ nd + { ingoSet = newIngoSet + , outgoSet = newOutgoSet } + where + newIngoSet = ingoSet nd `S.intersection` edgeSet + newOutgoSet = outgoSet nd `S.intersection` edgeSet + + +-- ------------------------------------------------------------------ +-- -- Provisional +-- ------------------------------------------------------------------ +-- +-- +-- -- | Convert the DAG to a list, provided that it was constructed from a list, +-- -- which is not checked. +-- toListProv :: DAG () a -> [a] +-- toListProv DAG{..} = +-- [ edLabel edge +-- | (_edgeID, edge) <- M.toAscList edgeMap ] + + +------------------------------------------------------------------ +-- Check +------------------------------------------------------------------ + + +-- | Check if the DAG is well-structured (see also `isDAG`). +isOK :: DAG a b -> Bool +isOK DAG{..} = + nodeMapOK && edgeMapOK + where + nodeMapOK = and + [ M.member edgeID edgeMap + | (_nodeID, Node{..}) <- M.toList nodeMap + , edgeID <- S.toList (S.union ingoSet outgoSet) ] + edgeMapOK = and + [ M.member nodeID nodeMap + | (_edgeID, Edge{..}) <- M.toList edgeMap + , nodeID <- [tailNode, headNode] ] + + +-- | Check if the DAG is actually acyclic. +isDAG :: DAG a b -> Bool +isDAG = isJust . topoSort + + +------------------------------------------------------------------ +-- Topological sorting +------------------------------------------------------------------ + + +-- | Retrieve the list of nodes sorted topologically. Returns `Nothing` if the +-- graph has cycles. +topoSort :: DAG a b -> Maybe [NodeID] +topoSort dag0 = + go dag0 $ S.fromList + [ nodeID | nodeID <- dagNodes dag0 + , null $ ingoingEdges nodeID dag0 ] + where + -- `noIncoming` is the set of nodes with no incoming edges. + go dag noIncoming = + case S.minView noIncoming of + Just (nodeID, rest) -> + let (dag', noIncoming') = removeNode nodeID dag + in (nodeID:) <$> go dag' (S.union rest noIncoming') + Nothing -> + if null dag + then Just [] + else Nothing + + +-- | Remove the node from the graph, together with all the outgoing edges, and +-- return the set of nodes in the resulting DAG which have no incoming edges. +removeNode :: NodeID -> DAG a b -> (DAG a b, S.Set NodeID) +removeNode nodeID dag0 = + first doRemoveNode $ L.foldl' f (dag0, S.empty) (outgoingEdges nodeID dag0) + where + doRemoveNode dag = dag + { nodeMap = M.delete nodeID (nodeMap dag) } + f (dag, nodeSet) edgeID = + let + nextID = endsWith edgeID dag + dag' = dag + { edgeMap = M.delete edgeID (edgeMap dag) + , nodeMap = + let adj node = + node {ingoSet = S.delete edgeID (ingoSet node)} + in M.adjust adj nextID (nodeMap dag) + } + in + if null $ ingoingEdges nextID dag' + then (dag', S.insert nextID nodeSet) + else (dag', nodeSet)