From 7cfbfe8cd107027dbb7533a60713050f3a974bec Mon Sep 17 00:00:00 2001 From: Alexandre Moine Date: Sat, 6 Oct 2018 13:59:35 +0200 Subject: [PATCH] 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 | 4 + src/Algebra/Graph.hs | 36 +++--- src/Algebra/Graph/Fold.hs | 30 ++--- src/Algebra/Graph/HigherKinded/Class.hs | 155 ++++++------------------ src/Algebra/Graph/NonEmpty.hs | 16 ++- src/Algebra/Graph/ToGraph.hs | 20 +++ test/Algebra/Graph/Test/API.hs | 1 - 7 files changed, 99 insertions(+), 163 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 402025e5d..7f79c765f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,9 @@ # Change log +## 0.2.1 + +* #121: Drop `Foldable` and `Traversable` instances + ## 0.2 * #117: Add `sparsify`. diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs index 3840678dd..0212779d1 100644 --- a/src/Algebra/Graph.hs +++ b/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 diff --git a/src/Algebra/Graph/Fold.hs b/src/Algebra/Graph/Fold.hs index ebd42fc73..538b97c55 100644 --- a/src/Algebra/Graph/Fold.hs +++ b/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 diff --git a/src/Algebra/Graph/HigherKinded/Class.hs b/src/Algebra/Graph/HigherKinded/Class.hs index c68bab851..054d16101 100644 --- a/src/Algebra/Graph/HigherKinded/Class.hs +++ b/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 diff --git a/src/Algebra/Graph/NonEmpty.hs b/src/Algebra/Graph/NonEmpty.hs index 9da63f79e..ec739600a 100644 --- a/src/Algebra/Graph/NonEmpty.hs +++ b/src/Algebra/Graph/NonEmpty.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE CPP, DeriveFunctor #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.NonEmpty @@ -122,9 +122,14 @@ if @g@ is a 'NonEmptyGraph' then /n/, /m/ and /s/ can be computed as follows: m == 'edgeCount' g s == 'size' g@ -The 'size' of any graph is positive and coincides with the result of 'length' -method of the 'Foldable' type class. We define 'size' only for the consistency -with the API of other graph representations, such as "Algebra.Graph". +Note that 'size' counts all leaves of the expression: + +@'vertexCount' 'empty' == 0 +'size' 'empty' == 1 +'vertexCount' ('vertex' x) == 1 +'size' ('vertex' x) == 1 +'vertexCount' ('empty' + 'empty') == 0 +'size' ('empty' + 'empty') == 2@ Converting a 'NonEmptyGraph' to the corresponding 'AM.AdjacencyMap' takes /O(s + m * log(m))/ time and /O(s + m)/ memory. This is also the complexity of @@ -134,7 +139,7 @@ expressions to canonical representations based on adjacency maps. data NonEmptyGraph a = Vertex a | Overlay (NonEmptyGraph a) (NonEmptyGraph a) | Connect (NonEmptyGraph a) (NonEmptyGraph a) - deriving (Foldable, Functor, Show, Traversable) + deriving (Functor, Show) instance NFData a => NFData (NonEmptyGraph a) where rnf (Vertex x ) = rnf x @@ -886,6 +891,5 @@ sparsify graph = res put (m + 1) overlay <$> s `x` m <*> m `y` t --- Shall we export this? I suggest to wait for Foldable1 type class instead. toNonEmpty :: NonEmptyGraph a -> NonEmpty a toNonEmpty = foldg1 (:| []) (<>) (<>) diff --git a/src/Algebra/Graph/ToGraph.hs b/src/Algebra/Graph/ToGraph.hs index bed0e96df..e2b92975e 100644 --- a/src/Algebra/Graph/ToGraph.hs +++ b/src/Algebra/Graph/ToGraph.hs @@ -17,6 +17,26 @@ -- access to many other useful methods for free. This type class is similar to -- the standard "Data.Foldable" defined for lists. -- +-- It is in fact so similar to "Data.Foldable" that one can define 'foldMap' using +-- 'foldg': +-- +-- @ +-- foldMap f = foldg mempty f (<>) (<>) +-- @ +-- +-- This allow to define a valid "Data.Foldable" instance but it leads to some +-- problems because this instance can show the internal structure of a graph. +-- For example: +-- +-- @ +-- toList (overlay (vertex 0) (vertex 0)) \/= toList (vertex 0) +-- @ +-- +-- BUT +-- +-- @ +-- overlay (vertex 0) (vertex 0) == vertex 0 +-- @ ----------------------------------------------------------------------------- module Algebra.Graph.ToGraph (ToGraph (..)) where diff --git a/test/Algebra/Graph/Test/API.hs b/test/Algebra/Graph/Test/API.hs index 92d463024..367679b01 100644 --- a/test/Algebra/Graph/Test/API.hs +++ b/test/Algebra/Graph/Test/API.hs @@ -148,7 +148,6 @@ instance Ord a => GraphAPI (Fold.Fold a) where induce = Fold.induce bind = (>>=) simplify = Fold.simplify - box = HClass.box instance Ord a => GraphAPI (Graph.Graph a) where edge = Graph.edge