pedestrian-dag (empty) → 0.2.0
raw patch · 4 files changed
+726/−0 lines, 4 filesdep +arraydep +basedep +binarysetup-changed
Dependencies added: array, base, binary, containers
Files
- LICENSE +23/−0
- Setup.lhs +4/−0
- pedestrian-dag.cabal +36/−0
- src/Data/DAG.hs +663/−0
+ LICENSE view
@@ -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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ pedestrian-dag.cabal view
@@ -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
+ src/Data/DAG.hs view
@@ -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)