From e0a8655558fcf915f282f2cf82e089ed69594de0 Mon Sep 17 00:00:00 2001 From: adrian Date: Sun, 7 Apr 2019 12:18:57 -0700 Subject: [PATCH 1/8] Added bfsForest to Algorithm.hs, with helped functions. Complexity analysis is missing. --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 65 ++++++++++++++++++++- 1 file changed, 64 insertions(+), 1 deletion(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 79ad606cd..1fada640d 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap.Algorithm ( -- * Algorithms - dfsForest, dfsForestFrom, dfs, reachable, topSort, isAcyclic, scc, + dfsForest, dfsForestFrom, dfs, bfsForest, reachable, topSort, isAcyclic, scc, -- * Correctness properties isDfsForestOf, isTopSortOf @@ -233,3 +233,66 @@ isTopSortOf xs m = go Set.empty xs && go newSeen vs where newSeen = Set.insert v seen + +-- | Compute the /breadth-first search/ forest of a graph that corresponds to +-- searching from each of the graph vertices in the 'Ord' @a@ order. +-- +-- @ +-- bfsForest 'empty' == [] +-- 'forest' (bfsForest $ 'edge' 1 1) == 'vertex' 1 +-- 'forest' (bfsForest $ 'edge' 1 2) == 'edge' 1 2 +-- 'forest' (bfsForest $ 'edge' 2 1) == 'vertices' [1,2] +-- 'isSubgraphOf' ('forest' $ bfsForest x) x == True +-- 'isbfsForestOf' (bfsForest x) x == True +-- bfsForest . 'forest' . bfsForest == bfsForest +-- bfsForest ('vertices' vs) == 'map' (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs) +-- bfsForest $ 1 * (3+5+7) + 3 * (5+4) + (4+3+5+7) * 6 == [Node {rootLabel = 1 +-- , subForest = [Node {rootLabel = 3 +-- , subForest = [ Node {rootLabel = 4 +-- , subForest = [] } +-- , Node {rootLabel = 6 +-- , subForest = [] }]} +-- , Node {rootLabel = 5 +-- , subForest = [] } +-- , Node {rootLabel = 7 +-- , subForest = [] }]}] +-- @ +bfsForest :: Ord a => AdjacencyMap a -> [Tree a] +bfsForest g + | isEmpty g = [] + | otherwise = headTree : (bfsForest . induce remove) g + where headTree = bfsTree ((head . vertexList) g) g + remove x = not $ elem x $ flatten headTree + + +-- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to +-- searching from a single vertex of the graph. +-- This is just for internal use. Might move it to `*.Internal` then? +-- +bfsTreeAdjacencyMap :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a +bfsTreeAdjacencyMap s g = if (hasVertex s g) + then bfsTreeAdjacencyMapUtil [s] (Set.singleton s) g + else empty + +-- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to +-- searching from the head of a queue (followed by other vertices to search from), +-- given a Set of seen vertices (vertices that shouldn't be visited). +-- This is just for internal use. Might move it to `*.Internal` then? +-- +bfsTreeAdjacencyMapUtil :: Ord a => [a] -> Set.Set a -> AdjacencyMap a -> AdjacencyMap a +bfsTreeAdjacencyMapUtil [] _ _ = empty +bfsTreeAdjacencyMapUtil queue@(v:qv) seen g = overlay (AM.AM $ Map.singleton v vSet) (bfsTreeAdjacencyMapUtil newQueue newSeen g) + where + neighbors = postSet v g + vSet = Set.difference neighbors seen + newSeen = Set.union seen neighbors + newQueue = qv ++ (Set.toAscList vSet) + +-- | Compute the /breadth-first search/ Tree of a graph that corresponds to +-- searching from a single vertex of the graph. This is just for internal use. +-- Might move it to `*.Internal` then? +-- +bfsTree :: Ord a => a -> AdjacencyMap a -> Tree a +bfsTree s g = unfoldTree neighbors s + where neighbors b = (b, Set.toAscList . postSet b $ bfs) + bfs = bfsTreeAdjacencyMap s g From 56e9b792bd65b15285a1bafad41b680ec80068d4 Mon Sep 17 00:00:00 2001 From: adrian Date: Sun, 7 Apr 2019 15:44:08 -0700 Subject: [PATCH 2/8] Added bfsForestFrom and bfs. Two versions of bfs are provided as the desired output is still ambigous. --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 40 +++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 1fada640d..ae33a6d5b 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -296,3 +296,43 @@ bfsTree :: Ord a => a -> AdjacencyMap a -> Tree a bfsTree s g = unfoldTree neighbors s where neighbors b = (b, Set.toAscList . postSet b $ bfs) bfs = bfsTreeAdjacencyMap s g + + +-- bfsForestFrom vs 'empty' == [] +-- 'forest' (bfsForestFrom [1] $ 'edge' 1 1) == 'vertex' 1 +-- 'forest' (bfsForestFrom [1] $ 'edge' 1 2) == 'edge' 1 2 +-- 'forest' (bfsForestFrom [2] $ 'edge' 1 2) == 'vertex' 2 +-- 'forest' (bfsForestFrom [3] $ 'edge' 1 2) == 'empty' +-- 'forest' (bfsForestFrom [2,1] $ 'edge' 1 2) == 'vertices' [1,2] +-- 'isSubgraphOf' ('forest' $ bfsForestFrom vs x) x == True +-- bfsForestFrom ('vertexList' x) x == 'bfsForest' x +-- bfsForestFrom vs ('vertices' vs) == 'map' (\\v -> Node v []) ('Data.List.nub' vs) +-- bfsForestFrom [] x == [] +-- bfsForestFrom [1,4] $ 1 * (3+5+7) + 3 * (5+4) + (4+3+5+7) * 6 == [ Node { rootLabel = 3 +-- , subForest = [ Node { rootLabel = 4 +-- , subForest = []} +-- , Node { rootLabel = 5 +-- , subForest = []} +-- , Node { rootLabel = 6 +-- , subForest = [] }]} +-- , Node { rootLabel = 1 +-- , subForest = [ Node { rootLabel = 7 +-- , subForest = [] }]}] +-- @ +bfsForestFrom :: Ord a => [a] -> AdjacencyMap a -> Forest a +bfsForestFrom [] _ = [] +bfsForestFrom (v:vs) g + | hasVertex v g = headTree:bfsForestFrom vs (induce (\x -> not $ elem x removedVertices) g) + | otherwise = bfsForestFrom vs g + where headTree = bfsTree v g + removedVertices = flatten headTree + +-- One of the next two should be deleted probably. bfs2 computes [[a]] while bfs computes [[[a]]]. +bfs2 :: Ord a => [a] -> AdjacencyMap a -> [[a]] +bfs2 vs g = foldr (zipWith (++)) acc (map (++ repeat []) l) + where l = bfs vs g + maxLength = maximum (map length l) + acc = [ [] | _<-[1..maxLength]] + +bfs :: Ord a => [a] -> AdjacencyMap a -> [[[a]]] +bfs vs = (map levels . bfsForestFrom vs) \ No newline at end of file From c002734c6ecc03853a933514b39f25d99c4ae89c Mon Sep 17 00:00:00 2001 From: adrian Date: Sun, 7 Apr 2019 15:47:01 -0700 Subject: [PATCH 3/8] Added functions to export --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index ae33a6d5b..242bc9d2d 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap.Algorithm ( -- * Algorithms - dfsForest, dfsForestFrom, dfs, bfsForest, reachable, topSort, isAcyclic, scc, + dfsForest, dfsForestFrom, dfs, bfsForest, bfsForestFrom, bfs, reachable, topSort, isAcyclic, scc, -- * Correctness properties isDfsForestOf, isTopSortOf From 16b231152577f5e46e5f4514bcca1b681a1d3b13 Mon Sep 17 00:00:00 2001 From: adrian Date: Wed, 17 Apr 2019 15:26:00 -0700 Subject: [PATCH 4/8] Added rough estimate of time complexity, cleaned up documentation and rewrote bfsForest to reutilize code and make it cleaner. --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 74 ++++++++++++++------- 1 file changed, 51 insertions(+), 23 deletions(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 242bc9d2d..745626129 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -236,7 +236,7 @@ isTopSortOf xs m = go Set.empty xs -- | Compute the /breadth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. --- +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. -- @ -- bfsForest 'empty' == [] -- 'forest' (bfsForest $ 'edge' 1 1) == 'vertex' 1 @@ -257,18 +257,13 @@ isTopSortOf xs m = go Set.empty xs -- , Node {rootLabel = 7 -- , subForest = [] }]}] -- @ -bfsForest :: Ord a => AdjacencyMap a -> [Tree a] -bfsForest g - | isEmpty g = [] - | otherwise = headTree : (bfsForest . induce remove) g - where headTree = bfsTree ((head . vertexList) g) g - remove x = not $ elem x $ flatten headTree +bfsForest :: Ord a => AdjacencyMap a -> Forest a +bfsForest g = bfsForestFrom (vertexList g) g -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from a single vertex of the graph. --- This is just for internal use. Might move it to `*.Internal` then? --- +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. bfsTreeAdjacencyMap :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a bfsTreeAdjacencyMap s g = if (hasVertex s g) then bfsTreeAdjacencyMapUtil [s] (Set.singleton s) g @@ -277,8 +272,7 @@ bfsTreeAdjacencyMap s g = if (hasVertex s g) -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from the head of a queue (followed by other vertices to search from), -- given a Set of seen vertices (vertices that shouldn't be visited). --- This is just for internal use. Might move it to `*.Internal` then? --- +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. bfsTreeAdjacencyMapUtil :: Ord a => [a] -> Set.Set a -> AdjacencyMap a -> AdjacencyMap a bfsTreeAdjacencyMapUtil [] _ _ = empty bfsTreeAdjacencyMapUtil queue@(v:qv) seen g = overlay (AM.AM $ Map.singleton v vSet) (bfsTreeAdjacencyMapUtil newQueue newSeen g) @@ -291,13 +285,16 @@ bfsTreeAdjacencyMapUtil queue@(v:qv) seen g = overlay (AM.AM $ Map.singleton v v -- | Compute the /breadth-first search/ Tree of a graph that corresponds to -- searching from a single vertex of the graph. This is just for internal use. -- Might move it to `*.Internal` then? --- +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. bfsTree :: Ord a => a -> AdjacencyMap a -> Tree a bfsTree s g = unfoldTree neighbors s - where neighbors b = (b, Set.toAscList . postSet b $ bfs) - bfs = bfsTreeAdjacencyMap s g - + where neighbors b = (b, Set.toAscList . postSet b $ bfsAM) + bfsAM = bfsTreeAdjacencyMap s g +-- | Compute the /breadth-first search/ forest of a graph, searching from each of +-- the given vertices in order. Note that the resulting forest does not +-- necessarily span the whole graph, as some vertices may be unreachable. +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. -- bfsForestFrom vs 'empty' == [] -- 'forest' (bfsForestFrom [1] $ 'edge' 1 1) == 'vertex' 1 -- 'forest' (bfsForestFrom [1] $ 'edge' 1 2) == 'edge' 1 2 @@ -322,17 +319,48 @@ bfsTree s g = unfoldTree neighbors s bfsForestFrom :: Ord a => [a] -> AdjacencyMap a -> Forest a bfsForestFrom [] _ = [] bfsForestFrom (v:vs) g - | hasVertex v g = headTree:bfsForestFrom vs (induce (\x -> not $ elem x removedVertices) g) + | hasVertex v g = headTree:bfsForestFrom vs (induce remove g) | otherwise = bfsForestFrom vs g where headTree = bfsTree v g removedVertices = flatten headTree + remove x = not $ elem x removedVertices --- One of the next two should be deleted probably. bfs2 computes [[a]] while bfs computes [[[a]]]. -bfs2 :: Ord a => [a] -> AdjacencyMap a -> [[a]] -bfs2 vs g = foldr (zipWith (++)) acc (map (++ repeat []) l) - where l = bfs vs g - maxLength = maximum (map length l) +-- -- | Compute the list of vertices visited by the /breadth-first search/ by level in a +-- graph, when searching from each of the given vertices in order. +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- @ +-- bfs vs $ 'empty' == [] +-- bfs [1] $ 'edge' 1 1 == [[1]] +-- bfs [1] $ 'edge' 1 2 == [[1],[2]] +-- bfs [2] $ 'edge' 1 2 == [[2]] +-- bfs [3] $ 'edge' 1 2 == [] +-- bfs [1,2] $ 'edge' 1 2 == [[1],[2]] +-- bfs [2,1] $ 'edge' 1 2 == [[2,1]] +-- bfs [] $ x == [] +-- bfs [1,4] $ 3 * (1 + 4) * (1 + 5) == [[1,4],[5]] +-- @ +bfs :: Ord a => [a] -> AdjacencyMap a -> [[a]] +bfs vs g = foldr (zipWith (++)) acc (map (++ repeat []) l) + where l = bfsPerTree vs g + maxLength = case l of + [] -> 0 + _ -> maximum (map length l) acc = [ [] | _<-[1..maxLength]] -bfs :: Ord a => [a] -> AdjacencyMap a -> [[[a]]] -bfs vs = (map levels . bfsForestFrom vs) \ No newline at end of file + +-- -- | Compute the list of vertices visited by the /breadth-first search/ in a graph. +-- For every tree in the forest, a different list of vertices by level is given. +-- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- @ +-- bfsPerTree vs $ 'empty' == [] +-- bfsPerTree [1] $ 'edge' 1 1 == [[[1]]] +-- bfsPerTree [1] $ 'edge' 1 2 == [[[1],[2]]] +-- bfsPerTree [2] $ 'edge' 1 2 == [[[2]]] +-- bfsPerTree [3] $ 'edge' 1 2 == [] +-- bfsPerTree [1,2] $ 'edge' 1 2 == [[[1],[2]]] +-- bfsPerTree [2,1] $ 'edge' 1 2 == [[[2]],[[1]]] +-- bfsPerTree [] $ x == [] +-- bfsPerTree [1,4] $ 3 * (1 + 4) * (1 + 5) == [[[1],[5]],[[4]]] +-- @ +bfsPerTree :: Ord a => [a] -> AdjacencyMap a -> [[[a]]] +bfsPerTree vs = (map levels . bfsForestFrom vs) \ No newline at end of file From 1d798fb9c0a94add12c0b054fe3b955e6a5f61a5 Mon Sep 17 00:00:00 2001 From: adrian Date: Wed, 24 Apr 2019 02:55:18 -0700 Subject: [PATCH 5/8] Got bfsForest time complexity down to O(v+e*log(v)) --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 50 +++++++++++++-------- 1 file changed, 32 insertions(+), 18 deletions(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 745626129..29f6a4cd0 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -34,6 +34,7 @@ import qualified Data.Graph as KL import qualified Data.Graph.Typed as Typed import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import qualified Data.Sequence as Seq -- | Compute the /depth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. @@ -236,7 +237,7 @@ isTopSortOf xs m = go Set.empty xs -- | Compute the /breadth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. -- @ -- bfsForest 'empty' == [] -- 'forest' (bfsForest $ 'edge' 1 1) == 'vertex' 1 @@ -263,29 +264,42 @@ bfsForest g = bfsForestFrom (vertexList g) g -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from a single vertex of the graph. --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. bfsTreeAdjacencyMap :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a -bfsTreeAdjacencyMap s g = if (hasVertex s g) - then bfsTreeAdjacencyMapUtil [s] (Set.singleton s) g - else empty +bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of + True -> bfsTreeAdjacencyMapUtil2 (Seq.singleton s) initVisited g + where initVisited = Map.unionsWith (||) $ ( Map.singleton s True):(map (\x -> Map.singleton x False) (vertexList g)) + _ -> empty -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from the head of a queue (followed by other vertices to search from), -- given a Set of seen vertices (vertices that shouldn't be visited). --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. -bfsTreeAdjacencyMapUtil :: Ord a => [a] -> Set.Set a -> AdjacencyMap a -> AdjacencyMap a -bfsTreeAdjacencyMapUtil [] _ _ = empty -bfsTreeAdjacencyMapUtil queue@(v:qv) seen g = overlay (AM.AM $ Map.singleton v vSet) (bfsTreeAdjacencyMapUtil newQueue newSeen g) - where - neighbors = postSet v g - vSet = Set.difference neighbors seen - newSeen = Set.union seen neighbors - newQueue = qv ++ (Set.toAscList vSet) +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +bfsTreeAdjacencyMapUtil :: Ord a => Seq.Seq a -> Map.Map a Bool -> AdjacencyMap a -> AdjacencyMap a +bfsTreeAdjacencyMapUtil2 queue visited g + | queue == Seq.empty = empty + | otherwise = overlay (AM.AM $ Map.singleton v vSet) (bfsTreeAdjacencyMapUtil2 newQueue newVisited g) + where + v Seq.:< qv = Seq.viewl queue + neighbors = postSet v g + (newQueue, newVisited, vSet) = bfsTreeNewParams neighbors visited qv + + +-- | Compute the /breadth-first search/ intermediate values for `bfsTreeAdjacencyMapUtil`. Given a set of neighbors +-- (source doesnt matter), a map of visisted nodes (Map a Bool) and a queue (Sequence), obtain the new queue, update +-- map and set of vertices to add to the graph. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +bfsTreeNewParams :: (Ord a) => Set.Set a -> Map.Map a Bool -> Seq.Seq a -> (Seq.Seq a, Map.Map a Bool, Set.Set a) +bfsTreeNewParams neighbors visited queue = (newQueue, newVisited, vSet ) + where vSet = Set.filter (\x -> (not . fromJust . Map.lookup x) visited) neighbors + vList = Set.toAscList vSet + newQueue = foldl (Seq.|>) queue vList + newVisited = Map.unionsWith (||) $ visited : (map (\x -> Map.singleton x True) vList) -- | Compute the /breadth-first search/ Tree of a graph that corresponds to -- searching from a single vertex of the graph. This is just for internal use. -- Might move it to `*.Internal` then? --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. bfsTree :: Ord a => a -> AdjacencyMap a -> Tree a bfsTree s g = unfoldTree neighbors s where neighbors b = (b, Set.toAscList . postSet b $ bfsAM) @@ -294,7 +308,7 @@ bfsTree s g = unfoldTree neighbors s -- | Compute the /breadth-first search/ forest of a graph, searching from each of -- the given vertices in order. Note that the resulting forest does not -- necessarily span the whole graph, as some vertices may be unreachable. --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. -- bfsForestFrom vs 'empty' == [] -- 'forest' (bfsForestFrom [1] $ 'edge' 1 1) == 'vertex' 1 -- 'forest' (bfsForestFrom [1] $ 'edge' 1 2) == 'edge' 1 2 @@ -327,7 +341,7 @@ bfsForestFrom (v:vs) g -- -- | Compute the list of vertices visited by the /breadth-first search/ by level in a -- graph, when searching from each of the given vertices in order. --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. -- @ -- bfs vs $ 'empty' == [] -- bfs [1] $ 'edge' 1 1 == [[1]] @@ -350,7 +364,7 @@ bfs vs g = foldr (zipWith (++)) acc (map (++ repeat []) l) -- -- | Compute the list of vertices visited by the /breadth-first search/ in a graph. -- For every tree in the forest, a different list of vertices by level is given. --- Complexity: /O(n^2 * log(n))/ time and O(n) memory. +-- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. -- @ -- bfsPerTree vs $ 'empty' == [] -- bfsPerTree [1] $ 'edge' 1 1 == [[[1]]] From df85ca78ce203539d18670ce6c5f20f384da9fb9 Mon Sep 17 00:00:00 2001 From: adrian Date: Mon, 29 Apr 2019 16:16:51 -0700 Subject: [PATCH 6/8] Changing v and e notation to n and m, respectively. --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 29f6a4cd0..51a719acf 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -237,7 +237,7 @@ isTopSortOf xs m = go Set.empty xs -- | Compute the /breadth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. -- @ -- bfsForest 'empty' == [] -- 'forest' (bfsForest $ 'edge' 1 1) == 'vertex' 1 @@ -264,7 +264,7 @@ bfsForest g = bfsForestFrom (vertexList g) g -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from a single vertex of the graph. --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. bfsTreeAdjacencyMap :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of True -> bfsTreeAdjacencyMapUtil2 (Seq.singleton s) initVisited g @@ -274,7 +274,7 @@ bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from the head of a queue (followed by other vertices to search from), -- given a Set of seen vertices (vertices that shouldn't be visited). --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. bfsTreeAdjacencyMapUtil :: Ord a => Seq.Seq a -> Map.Map a Bool -> AdjacencyMap a -> AdjacencyMap a bfsTreeAdjacencyMapUtil2 queue visited g | queue == Seq.empty = empty @@ -288,7 +288,7 @@ bfsTreeAdjacencyMapUtil2 queue visited g -- | Compute the /breadth-first search/ intermediate values for `bfsTreeAdjacencyMapUtil`. Given a set of neighbors -- (source doesnt matter), a map of visisted nodes (Map a Bool) and a queue (Sequence), obtain the new queue, update -- map and set of vertices to add to the graph. --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. bfsTreeNewParams :: (Ord a) => Set.Set a -> Map.Map a Bool -> Seq.Seq a -> (Seq.Seq a, Map.Map a Bool, Set.Set a) bfsTreeNewParams neighbors visited queue = (newQueue, newVisited, vSet ) where vSet = Set.filter (\x -> (not . fromJust . Map.lookup x) visited) neighbors @@ -299,7 +299,7 @@ bfsTreeNewParams neighbors visited queue = (newQueue, newVisited, vSet ) -- | Compute the /breadth-first search/ Tree of a graph that corresponds to -- searching from a single vertex of the graph. This is just for internal use. -- Might move it to `*.Internal` then? --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. bfsTree :: Ord a => a -> AdjacencyMap a -> Tree a bfsTree s g = unfoldTree neighbors s where neighbors b = (b, Set.toAscList . postSet b $ bfsAM) @@ -308,7 +308,7 @@ bfsTree s g = unfoldTree neighbors s -- | Compute the /breadth-first search/ forest of a graph, searching from each of -- the given vertices in order. Note that the resulting forest does not -- necessarily span the whole graph, as some vertices may be unreachable. --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. -- bfsForestFrom vs 'empty' == [] -- 'forest' (bfsForestFrom [1] $ 'edge' 1 1) == 'vertex' 1 -- 'forest' (bfsForestFrom [1] $ 'edge' 1 2) == 'edge' 1 2 @@ -341,7 +341,7 @@ bfsForestFrom (v:vs) g -- -- | Compute the list of vertices visited by the /breadth-first search/ by level in a -- graph, when searching from each of the given vertices in order. --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. -- @ -- bfs vs $ 'empty' == [] -- bfs [1] $ 'edge' 1 1 == [[1]] @@ -364,7 +364,7 @@ bfs vs g = foldr (zipWith (++)) acc (map (++ repeat []) l) -- -- | Compute the list of vertices visited by the /breadth-first search/ in a graph. -- For every tree in the forest, a different list of vertices by level is given. --- Complexity: /O(v + e * log(v))/ time and O(v+e) memory. +-- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. -- @ -- bfsPerTree vs $ 'empty' == [] -- bfsPerTree [1] $ 'edge' 1 1 == [[[1]]] From 9a62c2ce771e41d1e75a279fb9108fda6fe94a88 Mon Sep 17 00:00:00 2001 From: adrian Date: Mon, 29 Apr 2019 16:25:12 -0700 Subject: [PATCH 7/8] Corrected parenthesis for bfs complexity --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 51a719acf..9b6aeb97b 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -237,7 +237,7 @@ isTopSortOf xs m = go Set.empty xs -- | Compute the /breadth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. -- @ -- bfsForest 'empty' == [] -- 'forest' (bfsForest $ 'edge' 1 1) == 'vertex' 1 @@ -264,7 +264,7 @@ bfsForest g = bfsForestFrom (vertexList g) g -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from a single vertex of the graph. --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. bfsTreeAdjacencyMap :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of True -> bfsTreeAdjacencyMapUtil2 (Seq.singleton s) initVisited g @@ -274,7 +274,7 @@ bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of -- | Compute the /breadth-first search/ AdjacencyMap of a graph that corresponds to -- searching from the head of a queue (followed by other vertices to search from), -- given a Set of seen vertices (vertices that shouldn't be visited). --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. bfsTreeAdjacencyMapUtil :: Ord a => Seq.Seq a -> Map.Map a Bool -> AdjacencyMap a -> AdjacencyMap a bfsTreeAdjacencyMapUtil2 queue visited g | queue == Seq.empty = empty @@ -288,7 +288,7 @@ bfsTreeAdjacencyMapUtil2 queue visited g -- | Compute the /breadth-first search/ intermediate values for `bfsTreeAdjacencyMapUtil`. Given a set of neighbors -- (source doesnt matter), a map of visisted nodes (Map a Bool) and a queue (Sequence), obtain the new queue, update -- map and set of vertices to add to the graph. --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. bfsTreeNewParams :: (Ord a) => Set.Set a -> Map.Map a Bool -> Seq.Seq a -> (Seq.Seq a, Map.Map a Bool, Set.Set a) bfsTreeNewParams neighbors visited queue = (newQueue, newVisited, vSet ) where vSet = Set.filter (\x -> (not . fromJust . Map.lookup x) visited) neighbors @@ -299,7 +299,7 @@ bfsTreeNewParams neighbors visited queue = (newQueue, newVisited, vSet ) -- | Compute the /breadth-first search/ Tree of a graph that corresponds to -- searching from a single vertex of the graph. This is just for internal use. -- Might move it to `*.Internal` then? --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. bfsTree :: Ord a => a -> AdjacencyMap a -> Tree a bfsTree s g = unfoldTree neighbors s where neighbors b = (b, Set.toAscList . postSet b $ bfsAM) @@ -308,7 +308,7 @@ bfsTree s g = unfoldTree neighbors s -- | Compute the /breadth-first search/ forest of a graph, searching from each of -- the given vertices in order. Note that the resulting forest does not -- necessarily span the whole graph, as some vertices may be unreachable. --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. -- bfsForestFrom vs 'empty' == [] -- 'forest' (bfsForestFrom [1] $ 'edge' 1 1) == 'vertex' 1 -- 'forest' (bfsForestFrom [1] $ 'edge' 1 2) == 'edge' 1 2 @@ -341,7 +341,7 @@ bfsForestFrom (v:vs) g -- -- | Compute the list of vertices visited by the /breadth-first search/ by level in a -- graph, when searching from each of the given vertices in order. --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. -- @ -- bfs vs $ 'empty' == [] -- bfs [1] $ 'edge' 1 1 == [[1]] @@ -364,7 +364,7 @@ bfs vs g = foldr (zipWith (++)) acc (map (++ repeat []) l) -- -- | Compute the list of vertices visited by the /breadth-first search/ in a graph. -- For every tree in the forest, a different list of vertices by level is given. --- Complexity: /O(n + m * log(n))/ time and O(n+m) memory. +-- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. -- @ -- bfsPerTree vs $ 'empty' == [] -- bfsPerTree [1] $ 'edge' 1 1 == [[[1]]] From b09bb4b76061ed96ab2f688d453bf4e9c78273ef Mon Sep 17 00:00:00 2001 From: adrian Date: Mon, 29 Apr 2019 17:35:52 -0700 Subject: [PATCH 8/8] Corrected type signatures --- src/Algebra/Graph/AdjacencyMap/Algorithm.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs index 9b6aeb97b..a7bd34fa5 100644 --- a/src/Algebra/Graph/AdjacencyMap/Algorithm.hs +++ b/src/Algebra/Graph/AdjacencyMap/Algorithm.hs @@ -266,8 +266,8 @@ bfsForest g = bfsForestFrom (vertexList g) g -- searching from a single vertex of the graph. -- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. bfsTreeAdjacencyMap :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a -bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of - True -> bfsTreeAdjacencyMapUtil2 (Seq.singleton s) initVisited g +bfsTreeAdjacencyMap s g = case (hasVertex s g) of + True -> bfsTreeAdjacencyMapUtil (Seq.singleton s) initVisited g where initVisited = Map.unionsWith (||) $ ( Map.singleton s True):(map (\x -> Map.singleton x False) (vertexList g)) _ -> empty @@ -276,9 +276,9 @@ bfsTreeAdjacencyMap2 s g = case (hasVertex s g) of -- given a Set of seen vertices (vertices that shouldn't be visited). -- Complexity: /O((n + m) * log(n))/ time and O(n+m) memory. bfsTreeAdjacencyMapUtil :: Ord a => Seq.Seq a -> Map.Map a Bool -> AdjacencyMap a -> AdjacencyMap a -bfsTreeAdjacencyMapUtil2 queue visited g +bfsTreeAdjacencyMapUtil queue visited g | queue == Seq.empty = empty - | otherwise = overlay (AM.AM $ Map.singleton v vSet) (bfsTreeAdjacencyMapUtil2 newQueue newVisited g) + | otherwise = overlay (AM.AM $ Map.singleton v vSet) (bfsTreeAdjacencyMapUtil newQueue newVisited g) where v Seq.:< qv = Seq.viewl queue neighbors = postSet v g