mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-10 10:26:46 +09:00
More compact buildTree impl using foldr
This commit is contained in:
parent
3807a02daf
commit
7ebf189e93
1 changed files with 21 additions and 1 deletions
|
@ -106,12 +106,20 @@ mkGraph nodeMap edges =
|
|||
keySet :: HashMap k v -> HashSet k
|
||||
keySet = S.fromMap . M.map (const ())
|
||||
|
||||
-- | Traverse a graph DFS-style and build a tree recording the traversal.
|
||||
--
|
||||
-- The code looks like a simple fold, because the edge labels are the ones
|
||||
-- responsible for limiting the recursion into a tree structure.
|
||||
--
|
||||
-- The graph should have at most one full out-edge per node, and\/or have no
|
||||
-- cycles, otherwise this function isn't guaranteed to stop.
|
||||
buildTree
|
||||
:: (Eq n, Hashable n)
|
||||
=> [(n, Maybe b)]
|
||||
-> Graph n a (Maybe b)
|
||||
-> [DagViewTree a (a, b)]
|
||||
buildTree nodes graph = go nodes
|
||||
buildTree nodes graph = -- go nodes
|
||||
{-
|
||||
where
|
||||
go [] = []
|
||||
go ((n, full) : ps) =
|
||||
|
@ -126,6 +134,18 @@ buildTree nodes graph = go nodes
|
|||
Just info ->
|
||||
let ts = go ps
|
||||
in LinkNode (fst c, info) : ts
|
||||
-}
|
||||
|
||||
let f (n, full) ts =
|
||||
case M.lookup n graph of
|
||||
Nothing -> ts
|
||||
Just c ->
|
||||
let t = case full of
|
||||
Nothing -> FullNode (fst c) (go $ snd c)
|
||||
Just info -> LinkNode (fst c, info)
|
||||
in t : ts
|
||||
go = foldr f []
|
||||
in go nodes
|
||||
|
||||
dagViewTree
|
||||
:: (Eq n, Ord n, Hashable n)
|
||||
|
|
Loading…
Reference in a new issue