Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

NonEmpty graphs optimizations #94

Merged
merged 10 commits into from
Jul 17, 2018
Merged

NonEmpty graphs optimizations #94

Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
2e957ae
Start specialisation
nobrakal Jul 15, 2018
a906ff9
Add previous improvements
nobrakal Jul 16, 2018
b4341fa
Fix imports
nobrakal Jul 16, 2018
d4d8ee6
Merge branch 'master' of https://github.com/snowleopard/alga into Non…
nobrakal Jul 16, 2018
38a079d
Prepare PR
nobrakal Jul 16, 2018
2b67483
Allow ghc optimization for edgeCount
nobrakal Jul 16, 2018
1345d59
drop edgeTuple
nobrakal Jul 17, 2018
92921a9
Use ToGraph for "classic" edgeList
nobrakal Jul 17, 2018
fe0d04d
Remove now unecessary import
nobrakal Jul 17, 2018
5d82119
redefine default instances
nobrakal Jul 17, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
93 changes: 80 additions & 13 deletions src/Algebra/Graph/NonEmpty.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,12 +57,13 @@ import Control.DeepSeq (NFData (..))
import Control.Monad.Compat
import Data.List.NonEmpty (NonEmpty (..))

import qualified Algebra.Graph as G
import qualified Algebra.Graph.ToGraph as T
import qualified Data.IntSet as IntSet
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Set as Set
import qualified Data.Tree as Tree
import qualified Algebra.Graph as G
import qualified Algebra.Graph.AdjacencyIntMap as AIM
import qualified Algebra.Graph.ToGraph as T
import qualified Data.IntSet as IntSet
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Set as Set
import qualified Data.Tree as Tree

{-| The 'NonEmptyGraph' data type is a deep embedding of the core graph
construction primitives 'vertex', 'overlay' and 'connect'. As one can guess from
Expand Down Expand Up @@ -139,7 +140,9 @@ instance NFData a => NFData (NonEmptyGraph a) where

instance T.ToGraph (NonEmptyGraph a) where
type ToVertex (NonEmptyGraph a) = a
foldg _ = foldg1
foldg _ = foldg1
hasEdge = hasEdge
hasSelfLoop = hasSelfLoop

instance Num a => Num (NonEmptyGraph a) where
fromInteger = Vertex . fromInteger
Expand All @@ -150,7 +153,18 @@ instance Num a => Num (NonEmptyGraph a) where
negate = id

instance Ord a => Eq (NonEmptyGraph a) where
x == y = T.adjacencyMap x == T.adjacencyMap y
(==) = equals

-- TODO: Find a more efficient equality check.
-- | Compare two graphs by converting them to their adjacency maps.
{-# NOINLINE [1] equals #-}
{-# RULES "equalsInt" equals = equalsInt #-}
equals :: Ord a => NonEmptyGraph a -> NonEmptyGraph a -> Bool
equals x y = T.adjacencyMap x == T.adjacencyMap y

-- | Like 'equals' but specialised for graphs with vertices of type 'Int'.
equalsInt :: NonEmptyGraph Int -> NonEmptyGraph Int -> Bool
equalsInt x y = T.adjacencyIntMap x == T.adjacencyIntMap y

instance Applicative NonEmptyGraph where
pure = Vertex
Expand Down Expand Up @@ -263,7 +277,7 @@ connect = Connect
-- 'vertexSet' . vertices1 == Set.'Set.fromList' . 'Data.List.NonEmpty.toList'
-- @
vertices1 :: NonEmpty a -> NonEmptyGraph a
vertices1 = overlays1 . fmap vertex
vertices1 (x :| xs) = foldr (Overlay . vertex) (vertex x) xs

-- | Construct the graph from a list of edges.
-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the
Expand All @@ -274,7 +288,7 @@ vertices1 = overlays1 . fmap vertex
-- 'edgeCount' . edges1 == 'Data.List.NonEmpty.length' . 'Data.List.NonEmpty.nub'
-- @
edges1 :: NonEmpty (a, a) -> NonEmptyGraph a
edges1 = overlays1 . fmap (uncurry edge)
edges1 (x :| xs) = foldr (Overlay . uncurry edge) (uncurry edge x) xs

-- | Overlay a given list of graphs.
-- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length
Expand Down Expand Up @@ -325,6 +339,7 @@ foldg1 v o c = go
-- isSubgraphOf ('overlay' x y) ('connect' x y) == True
-- isSubgraphOf ('path1' xs) ('circuit1' xs) == True
-- @
{-# SPECIALISE isSubgraphOf :: NonEmptyGraph Int -> NonEmptyGraph Int -> Bool #-}
isSubgraphOf :: Ord a => NonEmptyGraph a -> NonEmptyGraph a -> Bool
isSubgraphOf x y = overlay x y == y

Expand All @@ -337,6 +352,7 @@ isSubgraphOf x y = overlay x y == y
-- 1 + 2 === 2 + 1 == False
-- x + y === x * y == False
-- @
{-# SPECIALISE (===) :: NonEmptyGraph Int -> NonEmptyGraph Int -> Bool #-}
(===) :: Eq a => NonEmptyGraph a -> NonEmptyGraph a -> Bool
(Vertex x1 ) === (Vertex x2 ) = x1 == x2
(Overlay x1 y1) === (Overlay x2 y2) = x1 === x2 && y1 === y2
Expand Down Expand Up @@ -365,6 +381,7 @@ size = foldg1 (const 1) (+) (+)
-- hasVertex x ('vertex' x) == True
-- hasVertex 1 ('vertex' 2) == False
-- @
{-# SPECIALISE hasVertex :: Int -> NonEmptyGraph Int -> Bool #-}
hasVertex :: Eq a => a -> NonEmptyGraph a -> Bool
hasVertex v = foldg1 (==v) (||) (||)

Expand All @@ -377,8 +394,31 @@ hasVertex v = foldg1 (==v) (||) (||)
-- hasEdge x y . 'removeEdge' x y == const False
-- hasEdge x y == 'elem' (x,y) . 'edgeList'
-- @
{-# SPECIALISE hasEdge :: Int -> Int -> NonEmptyGraph Int -> Bool #-}
hasEdge :: Eq a => a -> a -> NonEmptyGraph a -> Bool
hasEdge = T.hasEdge
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since you now provide much faster implementations compared to the default ones in ToGraph, you should use them in the instance ToGraph declaration.

Copy link
Contributor Author

@nobrakal nobrakal Jul 17, 2018 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Writing this improvement in the ToGraph instance drop a the performances:
Alga is the improvement moved in the ToGraph instance, and AlgaOld is the current state of this PR.

Mesh

100
Alga 6.383 μs
AlgaOld 5.100 μs

Clique

100
Alga 716.0 μs
AlgaOld 170.4 μs

I am not sure why...

I think this is because I can't use NonEmpty graphs in ToGraph, so I can 't use Algebra.Graph.NonEmpty.Vertex but only Algebra.Graph.Vertex, and thus, in the final step, I can only use foldg instead of foldg1.

Also, because we are not sure that induce is removing empty leaves, we loose the fast hasSelfLoop (because it was defined in ToGraph as hasSelfLoop x = hasEdge x x

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@nobrakal I meant this:

instance ToGraph NonEmpty where
    ...
    hasEdge = hasEdge -- use faster implementation instead of the default one

Surely this can't reduce the performace of hasEdge itself!

Copy link
Owner

@snowleopard snowleopard Jul 17, 2018 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

But users of the typeclass might get the benefit.

So, the rule is: if you use the default implementation, i.e. x = T.x then the instance declaration uses default methods. But otherwise you need to redefine default instance methods, i.e. add x = x to the instance.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh yes, it is done now :)

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
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 -> 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.
Expand All @@ -389,6 +429,7 @@ hasEdge = T.hasEdge
-- hasSelfLoop x == 'hasEdge' x x
-- hasSelfLoop x . 'removeEdge' x x == const False
-- @
{-# SPECIALISE hasSelfLoop :: Int -> NonEmptyGraph Int -> Bool #-}
hasSelfLoop :: Eq a => a -> NonEmptyGraph a -> Bool
hasSelfLoop l = maybe False hasSelfLoop' . induce1 (==l)
where
Expand All @@ -404,9 +445,15 @@ hasSelfLoop l = maybe False hasSelfLoop' . induce1 (==l)
-- vertexCount x >= 1
-- vertexCount == 'length' . 'vertexList1'
-- @
{-# RULES "vertexCount/Int" vertexCount = vertexIntCount #-}
{-# INLINE[1] vertexCount #-}
vertexCount :: Ord a => NonEmptyGraph a -> Int
vertexCount = T.vertexCount

-- | Like 'vertexCount' but specialised for NonEmptyGraph with vertices of type 'Int'.
vertexIntCount :: NonEmptyGraph Int -> Int
vertexIntCount = IntSet.size . vertexIntSet

-- | The number of edges in a graph.
-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a
-- graph can be quadratic with respect to the expression size /s/.
Expand All @@ -416,8 +463,9 @@ vertexCount = T.vertexCount
-- edgeCount ('edge' x y) == 1
-- edgeCount == 'length' . 'edgeList'
-- @
{-# SPECIALISE edgeCount :: NonEmptyGraph Int -> Int #-}
edgeCount :: Ord a => NonEmptyGraph a -> Int
edgeCount = T.edgeCount
edgeCount = length . edgeList

-- | The sorted list of vertices of a given graph.
-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
Expand All @@ -426,8 +474,14 @@ edgeCount = T.edgeCount
-- vertexList1 ('vertex' x) == x ':|' []
-- vertexList1 . 'vertices1' == 'Data.List.NonEmpty.nub' . 'Data.List.NonEmpty.sort'
-- @
{-# RULES "vertexList1/Int" vertexList1 = vertexIntList1 #-}
{-# INLINE[1] vertexList1 #-}
vertexList1 :: Ord a => NonEmptyGraph a -> NonEmpty a
vertexList1 = NonEmpty.fromList . T.vertexList
vertexList1 = NonEmpty.fromList . Set.toAscList . vertexSet

-- | Like 'vertexList1' but specialised for NonEmptyGraph with vertices of type 'Int'.
vertexIntList1 :: NonEmptyGraph Int -> NonEmpty Int
vertexIntList1 = NonEmpty.fromList . IntSet.toAscList . vertexIntSet

-- | The sorted list of edges of a graph.
-- Complexity: /O(s + m * log(m))/ time and /O(m)/ memory. Note that the number of
Expand All @@ -440,9 +494,15 @@ vertexList1 = NonEmpty.fromList . T.vertexList
-- edgeList . 'edges1' == 'Data.List.nub' . 'Data.List.sort' . 'Data.List.NonEmpty.toList'
-- edgeList . 'transpose' == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList
-- @
{-# RULES "edgeList/Int" edgeList = edgeIntList #-}
{-# INLINE[1] edgeList #-}
edgeList :: Ord a => NonEmptyGraph a -> [(a, a)]
edgeList = T.edgeList

-- | Like 'edgeList' but specialised for NonEmptyGraph with vertices of type 'Int'.
edgeIntList :: NonEmptyGraph Int -> [(Int,Int)]
edgeIntList = AIM.edgeList . foldg1 AIM.vertex AIM.overlay AIM.connect

-- | The set of vertices of a given graph.
-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
--
Expand Down Expand Up @@ -608,6 +668,7 @@ torus1 xs ys = circuit1 xs `box` circuit1 ys
-- removeVertex1 1 ('edge' 1 2) == Just ('vertex' 2)
-- removeVertex1 x '>=>' removeVertex1 x == removeVertex1 x
-- @
{-# SPECIALISE removeVertex1 :: Int -> NonEmptyGraph Int -> Maybe (NonEmptyGraph Int) #-}
removeVertex1 :: Eq a => a -> NonEmptyGraph a -> Maybe (NonEmptyGraph a)
removeVertex1 x = induce1 (/= x)

Expand All @@ -621,10 +682,12 @@ removeVertex1 x = induce1 (/= x)
-- removeEdge 1 2 (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2
-- 'size' (removeEdge x y z) <= 3 * 'size' z
-- @
{-# SPECIALISE removeEdge :: Int -> Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-}
removeEdge :: Eq a => a -> a -> NonEmptyGraph a -> NonEmptyGraph a
removeEdge s t = filterContext s (/=s) (/=t)

-- TODO: Export
{-# SPECIALISE filterContext :: Int -> (Int -> Bool) -> (Int -> Bool) -> NonEmptyGraph Int -> NonEmptyGraph Int #-}
filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> NonEmptyGraph a -> NonEmptyGraph a
filterContext s i o g = maybe g go $ G.context (==s) (T.toGraph g)
where
Expand All @@ -640,6 +703,7 @@ filterContext s i o g = maybe g go $ G.context (==s) (T.toGraph g)
-- replaceVertex x y ('vertex' x) == 'vertex' y
-- replaceVertex x y == 'mergeVertices' (== x) y
-- @
{-# SPECIALISE replaceVertex :: Int -> Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-}
replaceVertex :: Eq a => a -> a -> NonEmptyGraph a -> NonEmptyGraph a
replaceVertex u v = fmap $ \w -> if w == u then v else w

Expand All @@ -666,6 +730,7 @@ mergeVertices p v = fmap $ \w -> if p w then v else w
-- splitVertex1 x (y ':|' [] ) == 'replaceVertex' x y
-- splitVertex1 1 (0 ':|' [1]) $ 1 * (2 + 3) == (0 + 1) * (2 + 3)
-- @
{-# SPECIALISE splitVertex1 :: Int -> NonEmpty Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-}
splitVertex1 :: Eq a => a -> NonEmpty a -> NonEmptyGraph a -> NonEmptyGraph a
splitVertex1 v us g = g >>= \w -> if w == v then vertices1 us else vertex w

Expand Down Expand Up @@ -719,9 +784,11 @@ induce1 p = foldg1
-- simplify (1 + 2 + 1) '===' 1 + 2
-- simplify (1 * 1 * 1) '===' 1 * 1
-- @
{-# SPECIALISE simplify :: NonEmptyGraph Int -> NonEmptyGraph Int #-}
simplify :: Ord a => NonEmptyGraph a -> NonEmptyGraph a
simplify = foldg1 Vertex (simple Overlay) (simple Connect)

{-# SPECIALISE simple :: (NonEmptyGraph Int -> NonEmptyGraph Int -> NonEmptyGraph Int) -> NonEmptyGraph Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-}
simple :: Eq g => (g -> g -> g) -> g -> g -> g
simple op x y
| x == z = x
Expand Down