From 54100e47e530a1d22382abf8fd62685490b1706b Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Mon, 2 Jul 2018 17:56:58 +0200 Subject: [PATCH 1/8] RocketPowered --- src/Algebra/Graph.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs index e242e2db7..243e8e54f 100644 --- a/src/Algebra/Graph.hs +++ b/src/Algebra/Graph.hs @@ -459,8 +459,23 @@ hasVertex x = foldg False (==x) (||) (||) -- hasEdge x y == 'elem' (x,y) . 'edgeList' -- @ {-# SPECIALISE hasEdge :: Int -> Int -> Graph Int -> Bool #-} -hasEdge :: Ord a => a -> a -> Graph a -> Bool -hasEdge u v = (edge u v `isSubgraphOf`) . induce (`elem` [u, v]) +hasEdge :: Eq a => a -> a -> Graph a -> Bool +hasEdge s t = hasEdge' . induce' + where + hasEdge' g = case foldg e v o c g of (_, _, r) -> r + where + e = (False , False , False ) + v x = (x , not x , False ) + o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) + c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) + induce' = foldg Empty + (\x -> if x == s then Vertex True else if x == t then Vertex False else Empty) + (k Overlay) + (k Connect) + where + k _ x Empty = x -- Constant folding to get rid of Empty leaves + k _ Empty y = y + k f x y = f x y -- | Check if a graph contains a given loop. -- Complexity: /O(s)/ time. From 0eeebc5a743c14cd02c0601565bc9e5e22933531 Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Mon, 2 Jul 2018 19:13:44 +0200 Subject: [PATCH 2/8] Working amelioration --- src/Algebra/Graph.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs index 243e8e54f..5d44f8e95 100644 --- a/src/Algebra/Graph.hs +++ b/src/Algebra/Graph.hs @@ -465,11 +465,14 @@ hasEdge s t = hasEdge' . induce' hasEdge' g = case foldg e v o c g of (_, _, r) -> r where e = (False , False , False ) - v x = (x , not x , False ) + v (x,y) = (x , y , False ) o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) induce' = foldg Empty - (\x -> if x == s then Vertex True else if x == t then Vertex False else Empty) + (\x -> let !l = x == s + !r = x == t + in if l || r then Vertex (l,r) else Empty + ) (k Overlay) (k Connect) where From 3b791bb0c57305b1a4550be4fd85dab1387dc9e4 Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Mon, 2 Jul 2018 19:22:36 +0200 Subject: [PATCH 3/8] Remove TODO comment --- src/Algebra/Graph.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs index 5d44f8e95..0986e7521 100644 --- a/src/Algebra/Graph.hs +++ b/src/Algebra/Graph.hs @@ -446,8 +446,6 @@ size = foldg 1 (const 1) (+) (+) hasVertex :: Eq a => a -> Graph a -> Bool hasVertex x = foldg False (==x) (||) (||) --- TODO: Benchmark to see if this implementation is faster than the default --- implementation provided by the ToGraph type class. -- | Check if a graph contains a given edge. -- Complexity: /O(s)/ time. -- From 3050195052214043f6db74b5a9c6dd548b3271ca Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Mon, 2 Jul 2018 19:43:21 +0200 Subject: [PATCH 4/8] Remove bang --- src/Algebra/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs index 0986e7521..44c307627 100644 --- a/src/Algebra/Graph.hs +++ b/src/Algebra/Graph.hs @@ -467,8 +467,8 @@ hasEdge s t = hasEdge' . induce' o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) induce' = foldg Empty - (\x -> let !l = x == s - !r = x == t + (\x -> let l = x == s + r = x == t in if l || r then Vertex (l,r) else Empty ) (k Overlay) From 0a21b213b6511efc616f2f4996f4e18e82f5f13a Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Wed, 4 Jul 2018 05:25:19 +0200 Subject: [PATCH 5/8] Add optimization for NonEmptyGraph --- src/Algebra/Graph/NonEmpty.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Algebra/Graph/NonEmpty.hs b/src/Algebra/Graph/NonEmpty.hs index fd1df062d..b39e93598 100644 --- a/src/Algebra/Graph/NonEmpty.hs +++ b/src/Algebra/Graph/NonEmpty.hs @@ -378,7 +378,23 @@ hasVertex v = foldg1 (==v) (||) (||) -- hasEdge x y == 'elem' (x,y) . 'edgeList' -- @ hasEdge :: Eq a => a -> a -> NonEmptyGraph a -> Bool -hasEdge = T.hasEdge +hasEdge s t = maybe False hasEdge' . induce' + where + hasEdge' g = case foldg1 v o c g of (_, _, r) -> r + where + v (x,y) = (x , y , False ) + o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) + c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) + induce' = foldg1 (\x -> let l = x == s + r = x == t + in if l || r then Just (Vertex (l,r)) else Nothing + ) + (k Overlay) + (k Connect) + where + k _ x Nothing = x -- Constant folding to get rid of Empty leaves + k _ Nothing y = y + k f (Just x) (Just y) = Just $ f x y -- | Check if a graph contains a given loop. -- Complexity: /O(s)/ time. From 911170155050b90e7debc09d6f72fbe986a6718f Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Wed, 4 Jul 2018 14:53:32 +0200 Subject: [PATCH 6/8] Even better hasEdge, testing for loop --- src/Algebra/Graph.hs | 16 +++++++++------- src/Algebra/Graph/NonEmpty.hs | 8 +++++++- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs index 44c307627..849c5b0af 100644 --- a/src/Algebra/Graph.hs +++ b/src/Algebra/Graph.hs @@ -458,19 +458,21 @@ hasVertex x = foldg False (==x) (||) (||) -- @ {-# SPECIALISE hasEdge :: Int -> Int -> Graph Int -> Bool #-} hasEdge :: Eq a => a -> a -> Graph a -> Bool -hasEdge s t = hasEdge' . induce' - where +hasEdge s t = if s == t -- We test if we search for a loop + then hasSelfLoop s + else hasEdge' . induce' -- if not, we convert the supplied @Graph a@ to a @Graph Bool@ + -- where @s@ is @Vertex True@, @v@ is @Vertex False@ and other + -- vertices are removed. + -- Then we check if there is an edge from @True@ to @False@ + where hasEdge' g = case foldg e v o c g of (_, _, r) -> r where e = (False , False , False ) - v (x,y) = (x , y , False ) + v x = (x , not x , False ) o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) induce' = foldg Empty - (\x -> let l = x == s - r = x == t - in if l || r then Vertex (l,r) else Empty - ) + (\x -> if x == s then Vertex True else if x == t then Vertex False else Empty) (k Overlay) (k Connect) where diff --git a/src/Algebra/Graph/NonEmpty.hs b/src/Algebra/Graph/NonEmpty.hs index b39e93598..b6a0419e4 100644 --- a/src/Algebra/Graph/NonEmpty.hs +++ b/src/Algebra/Graph/NonEmpty.hs @@ -378,7 +378,13 @@ hasVertex v = foldg1 (==v) (||) (||) -- hasEdge x y == 'elem' (x,y) . 'edgeList' -- @ hasEdge :: Eq a => a -> a -> NonEmptyGraph a -> Bool -hasEdge s t = maybe False hasEdge' . induce' +hasEdge s t = + if s == t -- We test if we search for a loop + then hasSelfLoop s + else maybe False hasEdge' . induce' -- if not, we convert the supplied @Graph a@ to a @Graph Bool@ + -- where @s@ is @Vertex True@, @v@ is @Vertex False@ and other + -- vertices are removed. + -- Then we check if there is an edge from @True@ to @False@ where hasEdge' g = case foldg1 v o c g of (_, _, r) -> r where From 922126e746d0727d0d93f2f95756a3acf8c5e021 Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Thu, 5 Jul 2018 20:14:15 +0200 Subject: [PATCH 7/8] Add optimizations for NonEmptyGraph --- src/Algebra/Graph/NonEmpty.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Algebra/Graph/NonEmpty.hs b/src/Algebra/Graph/NonEmpty.hs index b6a0419e4..2e51a17f1 100644 --- a/src/Algebra/Graph/NonEmpty.hs +++ b/src/Algebra/Graph/NonEmpty.hs @@ -388,20 +388,19 @@ hasEdge s t = where hasEdge' g = case foldg1 v o c g of (_, _, r) -> r where - v (x,y) = (x , y , False ) + v x = (x , not x , False ) o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) - induce' = foldg1 (\x -> let l = x == s - r = x == t - in if l || r then Just (Vertex (l,r)) else Nothing - ) - (k Overlay) - (k Connect) + induce' = foldg1 (\x -> if x == s then Just (Vertex True) + else if x == t + then Just (Vertex False) + else Nothing) + (k Overlay) + (k Connect) where k _ x Nothing = x -- Constant folding to get rid of Empty leaves k _ Nothing y = y k f (Just x) (Just y) = Just $ f x y - -- | Check if a graph contains a given loop. -- Complexity: /O(s)/ time. -- From c20977c3e1bd8d8157969680014ca69b20bef6bb Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Thu, 19 Jul 2018 16:38:30 +0200 Subject: [PATCH 8/8] Better hasEdge for Fold --- src/Algebra/Graph/Fold.hs | 41 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 39 insertions(+), 2 deletions(-) diff --git a/src/Algebra/Graph/Fold.hs b/src/Algebra/Graph/Fold.hs index 5cb239ead..868bb4422 100644 --- a/src/Algebra/Graph/Fold.hs +++ b/src/Algebra/Graph/Fold.hs @@ -191,6 +191,8 @@ instance Traversable Fold where instance ToGraph (Fold a) where type ToVertex (Fold a) = a foldg = foldg + hasEdge = hasEdge + hasSelfLoop = hasSelfLoop -- | Construct the /empty graph/. -- Complexity: /O(1)/ time, memory and size. @@ -408,7 +410,27 @@ hasVertex = T.hasVertex -- hasEdge x y == 'elem' (x,y) . 'edgeList' -- @ hasEdge :: Eq a => a -> a -> Fold a -> Bool -hasEdge = T.hasEdge +hasEdge s t = if s == t -- We test if we search for a loop + then hasSelfLoop s + else maybe False hasEdge' . induce' -- if not, we convert the supplied @Graph a@ to a @Graph Bool@ + -- where @s@ is @Vertex True@, @v@ is @Vertex False@ and other + -- vertices are removed. + -- Then we check if there is an edge from @True@ to @False@ + where + hasEdge' g = case foldg e v o c g of (_, _, r) -> r + where + e = (False , False , False ) + v x = (x , not x , False ) + o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) + c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) + induce' = foldg Nothing + (\x -> if x == s then Just (vertex True) else if x == t then Just (vertex False) else Nothing) + (k overlay) + (k connect) + where + k _ x Nothing = x -- Constant folding to get rid of Empty leaves + k _ Nothing y = y + k f (Just x) (Just y) = Just $ f x y -- | Check if a graph contains a given loop. -- Complexity: /O(s)/ time. @@ -422,7 +444,22 @@ hasEdge = T.hasEdge -- hasSelfLoop x == 'elem' (x,x) . 'edgeList' -- @ hasSelfLoop :: Eq a => a -> Fold a -> Bool -hasSelfLoop = T.hasSelfLoop +hasSelfLoop t = maybe False hasEdge' . induce' + where + hasEdge' g = case foldg e v o c g of (_, _, r) -> r + where + e = (False , False , False ) + v x = (x , x , False ) + o (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xst || yst) + c (xs, xt, xst) (ys, yt, yst) = (xs || ys, xt || yt, xs && yt || xst || yst) + induce' = foldg Nothing + (\x -> if x==t then Just (vertex True) else Nothing) + (k overlay) + (k connect) + where + k _ x Nothing = x -- Constant folding to get rid of Empty leaves + k _ Nothing y = y + k f (Just x) (Just y) = Just $ f x y -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time.