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.

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

Remove foldable #121

Merged
merged 15 commits into from
Oct 6, 2018
4 changes: 4 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,9 @@
# Change log

## 0.2.1

* #121: Drop `Foldable` and `Traversable` instances

## 0.2

* #117: Add `sparsify`.
Expand Down
27 changes: 7 additions & 20 deletions src/Algebra/Graph.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE DeriveFunctor #-}
-----------------------------------------------------------------------------
-- |
-- Module : Algebra.Graph
Expand Down Expand Up @@ -132,19 +132,7 @@ be computed as follows:
m == 'edgeCount' g
s == 'size' g@

Note that 'size' is slightly different from the 'length' method of the
'Foldable' type class, as the latter does not count 'empty' leaves of the
expression:

@'length' 'empty' == 0
'size' 'empty' == 1
'length' ('vertex' x) == 1
'size' ('vertex' x) == 1
'length' ('empty' + 'empty') == 0
'size' ('empty' + 'empty') == 2@

The 'size' of any graph is positive, and the difference @('size' g - 'length' g)@
corresponds to the number of occurrences of 'empty' in an expression @g@.
Note that 'size' count all leaves of the expression.
Copy link
Owner

Choose a reason for hiding this comment

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

"count" -> "counts"

Also, I think we can keep size-related examples above, and replace length examples by vertexCount examples.


Converting a 'Graph' to the corresponding 'AM.AdjacencyMap' takes /O(s + m * log(m))/
time and /O(s + m)/ memory. This is also the complexity of the graph equality test,
Expand All @@ -155,7 +143,7 @@ data Graph a = Empty
| Vertex a
| Overlay (Graph a) (Graph a)
| Connect (Graph a) (Graph a)
deriving (Foldable, Functor, Show, Traversable)
deriving (Functor, Show)

instance NFData a => NFData (Graph a) where
rnf Empty = ()
Expand Down Expand Up @@ -356,10 +344,9 @@ concatg combine = fromMaybe empty . foldr1Safe combine
-- @
-- foldg 'empty' 'vertex' 'overlay' 'connect' == id
-- foldg 'empty' 'vertex' 'overlay' (flip 'connect') == 'transpose'
-- foldg [] return (++) (++) == 'Data.Foldable.toList'
-- foldg 0 (const 1) (+) (+) == 'Data.Foldable.length'
-- foldg 1 (const 1) (+) (+) == 'size'
-- foldg True (const False) (&&) (&&) == 'isEmpty'
-- foldg False ((==) v) (||) (||) == 'hasVertex v'
Copy link
Owner

Choose a reason for hiding this comment

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

Let's switch to foldg False (==x) (||) (||) == hasVertex x to match the testsuite as well as actual hasVertex implementation.

-- @
foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Graph a -> b
foldg e v o c = go
Expand Down Expand Up @@ -844,7 +831,6 @@ removeVertex v = induce (/= v)
removeEdge :: Eq a => a -> a -> Graph a -> Graph a
removeEdge s t = filterContext s (/=s) (/=t)


-- TODO: Export
-- | Filter vertices in a subgraph context.
{-# SPECIALISE filterContext :: Int -> (Int -> Bool) -> (Int -> Bool) -> Graph Int -> Graph Int #-}
Expand Down Expand Up @@ -1000,8 +986,9 @@ simple op x y
box :: Graph a -> Graph b -> Graph (a, b)
box x y = overlays $ xs ++ ys
where
xs = map (\b -> fmap (,b) x) $ toList y
ys = map (\a -> fmap (a,) y) $ toList x
xs = map (\b -> fmap (,b) x) $ toListGr y
ys = map (\a -> fmap (a,) y) $ toListGr x
toListGr = foldg [] pure (++) (++)
Copy link
Owner

Choose a reason for hiding this comment

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

I suggest to use the name toList since the function is equivalent to the standard toList.

By the way, are you sure this is fast enough? Do we need to worry about potential quadratic list concatenation?

You might want to use Algebra.Graph.Internal.List instead to achieve constant-time list concatenation.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

Indeed, it is better !


-- | 'Focus' on a specified subgraph.
focus :: (a -> Bool) -> Graph a -> Focus a
Expand Down
25 changes: 3 additions & 22 deletions src/Algebra/Graph/Fold.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ module Algebra.Graph.Fold (
import Prelude ()
import Prelude.Compat

import Control.Applicative (Alternative, liftA2)
import Control.Applicative (Alternative)
import Control.Monad.Compat (MonadPlus (..), ap)
import Data.Function

Expand Down Expand Up @@ -125,19 +125,7 @@ computed as follows:
m == 'edgeCount' g
s == 'size' g@

Note that 'size' is slightly different from the 'length' method of the
'Foldable' type class, as the latter does not count 'empty' leaves of the
expression:

@'length' 'empty' == 0
'size' 'empty' == 1
'length' ('vertex' x) == 1
'size' ('vertex' x) == 1
'length' ('empty' + 'empty') == 0
'size' ('empty' + 'empty') == 2@

The 'size' of any graph is positive, and the difference @('size' g - 'length' g)@
corresponds to the number of occurrences of 'empty' in an expression @g@.
Note that 'size' count all leaves of the expression.
Copy link
Owner

Choose a reason for hiding this comment

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


Converting a 'Fold' to the corresponding 'AM.AdjacencyMap' takes /O(s + m * log(m))/
time and /O(s + m)/ memory. This is also the complexity of the graph equality test,
Expand Down Expand Up @@ -182,12 +170,6 @@ instance Monad Fold where
return = vertex
g >>=f = foldg empty f overlay connect g

instance Foldable Fold where
foldMap f = foldg mempty f mappend mappend

instance Traversable Fold where
traverse f = foldg (pure empty) (fmap vertex . f) (liftA2 overlay) (liftA2 connect)

instance ToGraph (Fold a) where
type ToVertex (Fold a) = a
foldg = foldg
Expand Down Expand Up @@ -341,10 +323,9 @@ connects = foldr connect empty
-- @
-- foldg 'empty' 'vertex' 'overlay' 'connect' == id
-- foldg 'empty' 'vertex' 'overlay' (flip 'connect') == 'transpose'
-- foldg [] return (++) (++) == 'Data.Foldable.toList'
-- foldg 0 (const 1) (+) (+) == 'Data.Foldable.length'
-- foldg 1 (const 1) (+) (+) == 'size'
-- foldg True (const False) (&&) (&&) == 'isEmpty'
-- foldg False ((==) v) (||) (||) == 'hasVertex v'
Copy link
Owner

Choose a reason for hiding this comment

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

-- @
foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Fold a -> b
foldg e v o c g = runFold g e v o c
Expand Down
155 changes: 40 additions & 115 deletions src/Algebra/Graph/HigherKinded/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,31 +43,25 @@ module Algebra.Graph.HigherKinded.Class (
isSubgraphOf,

-- * Graph properties
isEmpty, hasVertex, hasEdge, vertexCount, vertexList, vertexSet, vertexIntSet,
hasEdge,

-- * Standard families of graphs
path, circuit, clique, biclique, star, starTranspose, tree, forest, mesh,
torus, deBruijn,
path, circuit, clique, biclique, star, stars, starTranspose, tree, forest,
mesh, torus, deBruijn,

-- * Graph transformation
removeVertex, replaceVertex, mergeVertices, splitVertex, induce,

-- * Graph composition
box
removeVertex, replaceVertex, mergeVertices, splitVertex, induce
) where

import Prelude ()
import Prelude.Compat

import Control.Applicative (Alternative(empty, (<|>)))
import Control.Monad.Compat (MonadPlus, msum, mfilter)
import Data.Foldable (toList)
import Control.Monad.Compat (MonadPlus, mfilter)
import Data.Tree

import qualified Algebra.Graph as G
import qualified Algebra.Graph.Fold as F
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set

{-|
The core type class for constructing algebraic graphs is defined by introducing
Expand Down Expand Up @@ -128,7 +122,7 @@ denote the number of vertices in the graph, /m/ will denote the number of
edges in the graph, and /s/ will denote the /size/ of the corresponding
'Graph' expression.
-}
class (Traversable g,
class (
#if !MIN_VERSION_base(4,8,0)
Alternative g,
#endif
Expand Down Expand Up @@ -282,30 +276,6 @@ connects (x:xs) = x `connect` connects xs
isSubgraphOf :: (Graph g, Eq (g a)) => g a -> g a -> Bool
isSubgraphOf x y = overlay x y == y

-- | Check if a graph is empty. A convenient alias for 'null'.
-- Complexity: /O(s)/ time.
--
-- @
-- isEmpty 'empty' == True
-- isEmpty ('overlay' 'empty' 'empty') == True
-- isEmpty ('vertex' x) == False
-- isEmpty ('removeVertex' x $ 'vertex' x) == True
-- @
isEmpty :: Graph g => g a -> Bool
isEmpty = null

-- | Check if a graph contains a given vertex. A convenient alias for `elem`.
-- Complexity: /O(s)/ time.
--
-- @
-- hasVertex x 'empty' == False
-- hasVertex x ('vertex' x) == True
-- hasVertex 1 ('vertex' 2) == False
-- hasVertex x . 'removeVertex' x == const False
-- @
hasVertex :: (Eq a, Graph g) => a -> g a -> Bool
hasVertex = elem

-- | Check if a graph contains a given edge.
-- Complexity: /O(s)/ time.
--
Expand All @@ -318,53 +288,6 @@ hasVertex = elem
hasEdge :: (Eq (g a), Graph g, Ord a) => a -> a -> g a -> Bool
hasEdge u v = (edge u v `isSubgraphOf`) . induce (`elem` [u, v])

-- | The number of vertices in a graph.
-- Complexity: /O(s * log(n))/ time.
--
-- @
-- vertexCount 'empty' == 0
-- vertexCount ('vertex' x) == 1
-- vertexCount == 'length' . 'vertexList'
-- @
vertexCount :: (Ord a, Graph g) => g a -> Int
vertexCount = length . vertexList

-- | The sorted list of vertices of a given graph.
-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
--
-- @
-- vertexList 'empty' == []
-- vertexList ('vertex' x) == [x]
-- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'
-- @
vertexList :: (Ord a, Graph g) => g a -> [a]
vertexList = Set.toAscList . vertexSet

-- | The set of vertices of a given graph.
-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
--
-- @
-- vertexSet 'empty' == Set.'Set.empty'
-- vertexSet . 'vertex' == Set.'Set.singleton'
-- vertexSet . 'vertices' == Set.'Set.fromList'
-- vertexSet . 'clique' == Set.'Set.fromList'
-- @
vertexSet :: (Ord a, Graph g) => g a -> Set.Set a
vertexSet = foldr Set.insert Set.empty

-- | The set of vertices of a given graph. Like 'vertexSet' but specialised for
-- graphs with vertices of type 'Int'.
-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
--
-- @
-- vertexIntSet 'empty' == IntSet.'IntSet.empty'
-- vertexIntSet . 'vertex' == IntSet.'IntSet.singleton'
-- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'
-- vertexIntSet . 'clique' == IntSet.'IntSet.fromList'
-- @
vertexIntSet :: Graph g => g Int -> IntSet.IntSet
vertexIntSet = foldr IntSet.insert IntSet.empty

-- | The /path/ on a list of vertices.
-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the
-- given list.
Expand Down Expand Up @@ -436,6 +359,23 @@ star :: Graph g => a -> [a] -> g a
star x [] = vertex x
star x ys = connect (vertex x) (vertices ys)

-- | The /stars/ formed by overlaying a list of 'star's. An inverse of
-- 'adjacencyList'.
-- Complexity: /O(L)/ time, memory and size, where /L/ is the total size of the
-- input.
--
-- @
-- stars [] == 'empty'
-- stars [(x, [])] == 'vertex' x
-- stars [(x, [y])] == 'edge' x y
-- stars [(x, ys)] == 'star' x ys
-- stars == 'overlays' . map (uncurry 'star')
-- stars . 'adjacencyList' == id
-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)
-- @
stars :: Graph g => [(a, [a])] -> g a
stars = overlays . map (uncurry star)
Copy link
Owner

Choose a reason for hiding this comment

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

Does it also make sense to switch to your better overlays implementation based on foldr1Safe?

Copy link
Contributor Author

Choose a reason for hiding this comment

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

I don't know, I think yes ! I will do some benchs tomorrow

Copy link
Contributor Author

Choose a reason for hiding this comment

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

Mmhh, I spoke too quickly, the concatg solution seems to not work, at least not out-of-the-box...
It will certainly require further work, maybe this is linked with the same problem in Algebra.Graph.Fold


-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.
-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the
-- given list.
Expand Down Expand Up @@ -492,7 +432,17 @@ forest = overlays . map tree
-- , ((2,\'a\'),(3,\'a\')), ((2,\'b\'),(3,\'b\')), ((3,\'a\'),(3,\'b\')) ]
-- @
mesh :: Graph g => [a] -> [b] -> g (a, b)
mesh xs ys = path xs `box` path ys
mesh [] _ = empty
mesh _ [] = empty
mesh [x] [y] = vertex (x, y)
mesh xs ys = stars $ [ ((a1, b1), [(a1, b2), (a2, b1)]) | (a1, a2) <- ipxs, (b1, b2) <- ipys ]
++ [ ((lx,y1), [(lx,y2)]) | (y1,y2) <- ipys]
++ [ ((x1,ly), [(x2,ly)]) | (x1,x2) <- ipxs]
where
lx = last xs
ly = last ys
ipxs = init (pairs xs)
ipys = init (pairs ys)

-- | Construct a /torus graph/ from two lists of vertices.
-- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the
Expand All @@ -507,7 +457,12 @@ mesh xs ys = path xs `box` path ys
-- , ((2,\'a\'),(1,\'a\')), ((2,\'a\'),(2,\'b\')), ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ]
-- @
torus :: Graph g => [a] -> [b] -> g (a, b)
torus xs ys = circuit xs `box` circuit ys
torus xs ys = stars [ ((a1, b1), [(a1, b2), (a2, b1)]) | (a1, a2) <- pairs xs, (b1, b2) <- pairs ys ]

-- | Auxiliary function for 'mesh' and 'torus'
pairs :: [a] -> [(a, a)]
pairs [] = []
pairs as@(x:xs) = zip as (xs ++ [x])

-- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols
-- from a given alphabet.
Expand Down Expand Up @@ -599,33 +554,3 @@ mergeVertices p v = fmap $ \w -> if p w then v else w
-- @
splitVertex :: (Eq a, Graph g) => a -> [a] -> g a -> g a
splitVertex v us g = g >>= \w -> if w == v then vertices us else vertex w

-- | Compute the /Cartesian product/ of graphs.
-- Complexity: /O(s1 * s2)/ time, memory and size, where /s1/ and /s2/ are the
-- sizes of the given graphs.
--
-- @
-- box ('path' [0,1]) ('path' "ab") == 'edges' [ ((0,\'a\'), (0,\'b\'))
-- , ((0,\'a\'), (1,\'a\'))
-- , ((0,\'b\'), (1,\'b\'))
-- , ((1,\'a\'), (1,\'b\')) ]
-- @
-- Up to an isomorphism between the resulting vertex types, this operation
-- is /commutative/, /associative/, /distributes/ over 'overlay', has singleton
-- graphs as /identities/ and 'empty' as the /annihilating zero/. Below @~~@
-- stands for the equality up to an isomorphism, e.g. @(x, ()) ~~ x@.
--
-- @
-- box x y ~~ box y x
-- box x (box y z) ~~ box (box x y) z
-- box x ('overlay' y z) == 'overlay' (box x y) (box x z)
-- box x ('vertex' ()) ~~ x
-- box x 'empty' ~~ 'empty'
-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y
-- 'edgeCount' (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y
-- @
box :: Graph g => g a -> g b -> g (a, b)
box x y = msum $ xs ++ ys
where
xs = map (\b -> fmap (,b) x) $ toList y
ys = map (\a -> fmap (a,) y) $ toList x
Loading