Use new Tree functions internally

Author: meooow25

containers-tests/tests/graph-properties.hs

@@ -7,6 +7,7 @@ import qualified Data.Foldable as F
 import qualified Data.Graph as G
 import qualified Data.List as L
 import qualified Data.Set as S
+import qualified Data.Tree as Tree
 
 default (Int)
 
@@ -128,14 +129,14 @@ prop_dfs (Graph g) =
   in forAll vsgen $ \vs ->
     let ts = G.dfs g vs
     in S.fromList (concatMap F.toList ts) `S.isSubsetOf` S.fromList (G.vertices g) .&&.
-       S.fromList (concatMap treeEdges ts) `S.isSubsetOf` S.fromList (G.edges g)
+       S.fromList (concatMap Tree.edges ts) `S.isSubsetOf` S.fromList (G.edges g)
 
 -- Note: This tests some simple properties but not complete correctness
 prop_dff :: Graph -> Property
 prop_dff (Graph g) =
   let ts = G.dff g
   in L.sort (concatMap F.toList ts) === G.vertices g .&&.
-     S.fromList (concatMap treeEdges ts) `S.isSubsetOf` S.fromList (G.edges g)
+     S.fromList (concatMap Tree.edges ts) `S.isSubsetOf` S.fromList (G.edges g)
 
 prop_topSort :: DAG -> Property
 prop_topSort (DAG g) =
@@ -147,7 +148,7 @@ prop_scc :: Graph -> Property
 prop_scc (Graph g) =
   let ts = G.scc g
   in L.sort (concatMap F.toList ts) === G.vertices g .&&.
-     S.fromList (concatMap treeEdges ts) `S.isSubsetOf` S.fromList (G.edges g) .&&.
+     S.fromList (concatMap Tree.edges ts) `S.isSubsetOf` S.fromList (G.edges g) .&&.
      -- vertices in a component are mutually reachable
      and [G.path g u v | t <- ts, u <- F.toList t, v <- F.toList t] .&&.
      -- vertices in later components are not reachable from earlier components, due to reverse
@@ -160,7 +161,7 @@ prop_bcc (UndirectedG g) =
       comps = concatMap F.toList ts :: [[G.Vertex]]
   in S.fromList (concat comps) `S.isSubsetOf` S.fromList (G.vertices g) .&&.
      all testBCC comps .&&.
-     all (uncurry testBCCs) (concatMap treeEdges ts)
+     all (uncurry testBCCs) (concatMap Tree.edges ts)
   where
     -- a biconnected component remains connected even if any single vertex is removed
     testBCC c = and [subsetComponents (L.delete x c) == 1 | x <- c]
@@ -194,7 +195,3 @@ prop_stronglyConnCompR (AdjList adj) =
     testSCC (G.AcyclicSCC (_, k, ks)) = k `notElem` ks
     testSCC (G.CyclicSCC [(_, k, ks)]) = k `elem` ks
     testSCC (G.CyclicSCC xs) = and [G.path g (getv k) (getv k') | (_,k,_) <- xs , (_,k',_) <- xs]
-
-treeEdges :: G.Tree a -> [(a, a)]
-treeEdges t = go t []
-  where go (G.Node x ts) acc = [(x,y) | G.Node y _ <- ts] ++ foldr go acc ts

containers/src/Data/Graph.hs

@@ -119,6 +119,7 @@ import Data.IntSet (IntSet)
 import qualified Data.IntSet as Set
 #endif
 import Data.Tree (Tree(..), Forest)
+import qualified Data.Tree as Tree
 
 -- std interfaces
 import Data.Foldable as F
@@ -647,15 +648,6 @@ run _ f = fst (runSetM (f contains include) Set.empty)
 -- Algorithm 1: depth first search numbering
 ------------------------------------------------------------
 
-preorder' :: Tree a -> [a] -> [a]
-preorder' (Node a ts) = (a :) . preorderF' ts
-
-preorderF' :: [Tree a] -> [a] -> [a]
-preorderF' ts = foldr (.) id $ map preorder' ts
-
-preorderF :: [Tree a] -> [a]
-preorderF ts = preorderF' ts []
-
 tabulate        :: Bounds -> [Vertex] -> UArray Vertex Int
 tabulate bnds vs = UA.array bnds (zipWith (flip (,)) [1..] vs)
 -- Why zipWith (flip (,)) instead of just using zip with the
@@ -664,38 +656,33 @@ tabulate bnds vs = UA.array bnds (zipWith (flip (,)) [1..] vs)
 -- list argument.
 
 preArr          :: Bounds -> [Tree Vertex] -> UArray Vertex Int
-preArr bnds      = tabulate bnds . preorderF
+preArr bnds      = tabulate bnds . concatMap Tree.flatten
 
 ------------------------------------------------------------
 -- Algorithm 2: topological sorting
 ------------------------------------------------------------
 
-postorder :: Tree a -> [a] -> [a]
-postorder (Node a ts) = postorderF ts . (a :)
-
-postorderF   :: [Tree a] -> [a] -> [a]
-postorderF ts = foldr (.) id $ map postorder ts
-
-postOrd :: Graph -> [Vertex]
-postOrd g = postorderF (dff g) []
-
 -- | \(O(V+E)\). A topological sort of the graph.
 -- The order is partially specified by the condition that a vertex /i/
 -- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa.
 --
 -- Note: A topological sort exists only when there are no cycles in the graph.
 -- If the graph has cycles, the output of this function will not be a
 -- topological sort. In such a case consider using 'scc'.
-topSort      :: Graph -> [Vertex]
-topSort       = reverse . postOrd
+topSort :: Graph -> [Vertex]
+topSort = reversePostOrder . dff
+  where
+    reversePostOrder :: [Tree a] -> [a]
+    reversePostOrder =
+      F.foldl' (\vs t -> F.foldl' (flip (:)) vs (Tree.PostOrder t)) []
 
 -- | \(O(V+E)\). Reverse ordering of `topSort`.
 --
 -- See note in 'topSort'.
 --
 -- @since 0.6.4
 reverseTopSort :: Graph -> [Vertex]
-reverseTopSort = postOrd
+reverseTopSort = concatMap (F.toList . Tree.PostOrder) . dff
 
 ------------------------------------------------------------
 -- Algorithm 3: connected components
@@ -722,7 +709,7 @@ undirected g  = buildG (bounds g) (edges g ++ reverseE g)
 -- >      ,Node {rootLabel = 3, subForest = []}]
 
 scc  :: Graph -> [Tree Vertex]
-scc g = dfs g (reverse (postOrd (transposeG g)))
+scc g = dfs g (topSort (transposeG g))
 
 ------------------------------------------------------------
 -- Algorithm 5: Classifying edges
@@ -764,7 +751,7 @@ mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]
 --
 -- > reachable (buildG (0,2) [(0,1), (1,2)]) 0 == [0,1,2]
 reachable :: Graph -> Vertex -> [Vertex]
-reachable g v = preorderF (dfs g [v])
+reachable g v = concatMap Tree.flatten (dfs g [v])
 
 -- | \(O(V+E)\). Returns @True@ if the second vertex reachable from the first.
 --