Remove Foldable and Traversable instances (#121)

See #95.

* Remove `Foldable` and `Traversable` instances, and associated comments.
* Drop `isEmpty`, `hasVertex`, `vertexCount`, `vertexList`, `vertexSet`, `vertexIntSet` and `box` from `Algebra.Graph.HigherKinded.Class` because of the removal of the `Foldable` superclass; `mesh` and `torus` were rewritten without `box`.
* Add a comment explaining why the `Foldable` instance is problematic.

CHANGES.md

@@ -1,5 +1,9 @@
 # Change log
 
+## 0.2.1
+
+* #121: Drop `Foldable` and `Traversable` instances
+
 ## 0.2
 
 * #117: Add `sparsify`.

src/Algebra/Graph.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# LANGUAGE DeriveFunctor #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Algebra.Graph
@@ -52,13 +52,14 @@ module Algebra.Graph (
   ) where
 
 import Prelude ()
-import Prelude.Compat
+import Prelude.Compat hiding ((<>))
 
 import Control.Applicative (Alternative)
 import Control.DeepSeq (NFData (..))
 import Control.Monad.Compat
 import Control.Monad.State (runState, get, put)
 import Data.Foldable (toList)
+import Data.Monoid ((<>))
 import Data.Maybe (fromMaybe)
 import Data.Tree
 
@@ -132,19 +133,14 @@ 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:
+Note that 'size' counts all 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@.
+@'vertexCount' 'empty'           == 0
+'size'        'empty'           == 1
+'vertexCount' ('vertex' x)      == 1
+'size'        ('vertex' x)      == 1
+'vertexCount' ('empty' + 'empty') == 0
+'size'        ('empty' + 'empty') == 2@
 
 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,
@@ -155,7 +151,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         = ()
@@ -356,10 +352,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 ((==) x)      (||)    (||)           == 'hasVertex x'
 -- @
 foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Graph a -> b
 foldg e v o c = go
@@ -844,7 +839,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 #-}
@@ -1000,8 +994,10 @@ 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) $ toList $ toListGr y
+    ys = map (\a -> fmap (a,) y) $ toList $ toListGr x
+    toListGr :: Graph a -> List a
+    toListGr = foldg mempty pure (<>) (<>)
 
 -- | 'Focus' on a specified subgraph.
 focus :: (a -> Bool) -> Graph a -> Focus a

src/Algebra/Graph/Fold.hs

@@ -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
 
@@ -125,19 +125,14 @@ 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:
+Note that 'size' counts all 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@.
+@'vertexCount' 'empty'           == 0
+'size'        'empty'           == 1
+'vertexCount' ('vertex' x)      == 1
+'size'        ('vertex' x)      == 1
+'vertexCount' ('empty' + 'empty') == 0
+'size'        ('empty' + 'empty') == 2@
 
 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,
@@ -182,12 +177,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
@@ -341,10 +330,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 ((==) x)      (||)    (||)           == 'hasVertex x'
 -- @
 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

src/Algebra/Graph/HigherKinded/Class.hs

@@ -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
@@ -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
@@ -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.
 --
@@ -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.
@@ -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)
+
 -- | 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.
@@ -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
@@ -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.
@@ -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