Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

back to type families

  • Loading branch information...
commit 98378fc3939225929bb9ab2e7cd726c7ffa1d310 1 parent 7b44abc
@ekmett authored
View
14 Data/Graph/Adjacency/List.hs → Data/Graph/AdjacencyList.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Adjacency.List
@@ -7,11 +7,11 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
-module Data.Graph.Adjacency.List
+module Data.Graph.AdjacencyList
( AdjacencyList(..)
, ask
) where
@@ -21,7 +21,7 @@ import Data.Ix
import Data.Array
import Data.Graph.PropertyMap
import Data.Graph.Class
-import Data.Graph.Class.Adjacency.List
+import Data.Graph.Class.AdjacencyList
newtype AdjacencyList i a = AdjacencyList { runAdjacencyList :: Array i [i] -> a }
@@ -40,11 +40,13 @@ instance Monad (AdjacencyList i) where
return = AdjacencyList . const
AdjacencyList f >>= k = AdjacencyList $ \t -> runAdjacencyList (k (f t)) t
-instance Ord i => Graph (AdjacencyList i) i (i, i) where
+instance Ord i => Graph (AdjacencyList i) where
+ type Vertex (AdjacencyList i) = i
+ type Edge (AdjacencyList i) = (i, i)
vertexMap = pure . propertyMap
edgeMap = pure . propertyMap
-instance Ix i => AdjacencyListGraph (AdjacencyList i) i (i, i) where
+instance Ix i => AdjacencyListGraph (AdjacencyList i) where
adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v
then g ! v
else []
View
14 Data/Graph/Adjacency/Matrix.hs → Data/Graph/AdjacencyMatrix.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Adjacency.Matrix
@@ -7,11 +7,11 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
-module Data.Graph.Adjacency.Matrix
+module Data.Graph.AdjacencyMatrix
( AdjacencyMatrix(..)
, ask
) where
@@ -22,7 +22,7 @@ import Data.Functor
import Data.Array.IArray
import Data.Graph.PropertyMap
import Data.Graph.Class
-import Data.Graph.Class.Adjacency.Matrix
+import Data.Graph.Class.AdjacencyMatrix
newtype AdjacencyMatrix arr i a = AdjacencyMatrix { runAdjacencyMatrix :: arr (i,i) Bool -> a }
@@ -41,11 +41,13 @@ instance Monad (AdjacencyMatrix arr i) where
return = AdjacencyMatrix . const
AdjacencyMatrix f >>= k = AdjacencyMatrix $ \t -> runAdjacencyMatrix (k (f t)) t
-instance Ord i => Graph (AdjacencyMatrix arr i) i (i, i) where
+instance Ord i => Graph (AdjacencyMatrix arr i) where
+ type Vertex (AdjacencyMatrix arr i) = i
+ type Edge (AdjacencyMatrix arr i) = (i, i)
vertexMap = pure . propertyMap
edgeMap = pure . propertyMap
-instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) i (i, i) where
+instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where
edge i j = AdjacencyMatrix $ \a ->
if inRange (bounds a) ix && (a ! ix)
then Just ix
View
92 Data/Graph/Algorithm/BreadthFirstSearch.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveFunctor #-}
+{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Algorithm.BreadthFirstSearch
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MTPCs, fundeps, type families
+-- Portability : type families
--
-- Breadth-first search
----------------------------------------------------------------------------
@@ -16,32 +16,62 @@ module Data.Graph.Algorithm.BreadthFirstSearch
( bfs, Bfs(..)
) where
-import Data.Default
-import Data.Foldable
+import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
+import Data.Default
+import Data.Foldable
import Data.Monoid
+import Data.Sequence
+
import Data.Graph.Class
-import Data.Graph.Class.Adjacency.List
+import Data.Graph.Class.AdjacencyList
import Data.Graph.PropertyMap
-import Data.Sequence
+import Data.Graph.Internal.Color
+
+-- | Breadth first search visitor
+data Bfs g m = Bfs
+ { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered
+ , grayTarget :: Edge g -> g m -- called when we encounter a back edge to a vertex we're still processing
+ , exitVertex :: Vertex g -> g m -- called once we have processed all descendants of a vertex
+ , blackTarget :: Edge g -> g m -- called when we encounter a cross edge to a vertex we've already finished
+ }
+
+instance Graph g => Functor (Bfs g) where
+ fmap f (Bfs a b c d) = Bfs
+ (liftM f . a)
+ (liftM f . b)
+ (liftM f . c)
+ (liftM f . d)
+
+instance Graph g => Applicative (Bfs g) where
+ pure a = Bfs
+ (const (return a))
+ (const (return a))
+ (const (return a))
+ (const (return a))
+
+ m <*> n = Bfs
+ (\v -> enterVertex m v `ap` enterVertex n v)
+ (\e -> grayTarget m e `ap` grayTarget n e)
+ (\v -> exitVertex m v `ap` exitVertex n v)
+ (\e -> blackTarget m e `ap` blackTarget n e)
-data Color = White | Gray | Black deriving (Eq,Ord,Show,Read)
+instance Graph g => Monad (Bfs g) where
+ return = pure
+ m >>= f = Bfs
+ (\v -> enterVertex m v >>= ($ v) . enterVertex . f)
+ (\e -> grayTarget m e >>= ($ e) . grayTarget . f)
+ (\v -> exitVertex m v >>= ($ v) . exitVertex . f)
+ (\e -> blackTarget m e >>= ($ e) . blackTarget . f)
-data Bfs v e m = Bfs
- { enterVertex :: v -> m -- called the first time a vertex is discovered
- , grayTarget :: e -> m -- called when we encounter a back edge to a vertex we're still processing
- , exitVertex :: v -> m -- called once we have processed all descendants of a vertex
- , blackTarget :: e -> m -- called when we encounter a cross edge to a vertex we've already finished
- } deriving (Functor)
+instance (Graph g, Monoid m) => Default (Bfs g m) where
+ def = return mempty
-instance Monoid m => Default (Bfs v e m) where
- def = Bfs
- (const mempty)
- (const mempty)
- (const mempty)
- (const mempty)
+instance (Graph g, Monoid m) => Monoid (Bfs g m) where
+ mempty = return mempty
+ mappend = liftM2 mappend
getS :: Monad g => k -> StateT (Seq v, PropertyMap g k Color) g Color
getS k = do
@@ -54,22 +84,24 @@ putS k v = do
m' <- lift $ putP m k v
modify $ \(q,_) -> (q, m')
-enqueue :: Monad g => Bfs v e m -> v -> StateT (Seq v, PropertyMap g v Color) g m
+enqueue :: Graph g
+ => Bfs g m
+ -> Vertex g
+ -> StateT (Seq (Vertex g), PropertyMap g (Vertex g) Color) g m
enqueue vis v = do
m <- gets snd
- m' <- lift $ putP m v Gray
+ m' <- lift $ putP m v Grey
modify $ \(q,_) -> (q |> v, m')
- return $ enterVertex vis v
+ lift $ enterVertex vis v
dequeue :: Monad g => StateT (Seq v, s) g r -> (v -> StateT (Seq v, s) g r) -> StateT (Seq v, s) g r
dequeue ke ks = do
(q, m) <- get
case viewl q of
- EmptyL -> ke
+ EmptyL -> ke
(a :< q') -> put (q', m) >> ks a
--- TODO: CPS transform?
-bfs :: (AdjacencyListGraph g v e, Monoid m) => Bfs v e m -> v -> g m
+bfs :: (AdjacencyListGraph g, Monoid m) => Bfs g m -> Vertex g -> g m
bfs vis v0 = do
m <- vertexMap White
evalStateT (enqueue vis v0 >>= pump) (mempty, m)
@@ -82,9 +114,9 @@ bfs vis v0 = do
color <- getS v'
liftM (`mappend` m) $ case color of
White -> enqueue vis v'
- Gray -> return $ grayTarget vis e
- Black -> return $ blackTarget vis e)
- mempty
- adjs
+ Grey -> lift $ grayTarget vis e
+ Black -> lift $ blackTarget vis e
+ ) mempty adjs
putS v Black
- pump $ lhs `mappend` children `mappend` exitVertex vis v
+ rhs <- lift $ exitVertex vis v
+ pump $ lhs `mappend` children `mappend` rhs
View
77 Data/Graph/Algorithm/DepthFirstSearch.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveFunctor #-}
+{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Algorithm.DepthFirstSearch
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MTPCs, fundeps, type families
+-- Portability : type families
--
-- Depth-first search
----------------------------------------------------------------------------
@@ -16,31 +16,60 @@ module Data.Graph.Algorithm.DepthFirstSearch
( dfs, Dfs(..)
) where
-import Data.Default
-import Data.Foldable
+import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
+import Data.Default
+import Data.Foldable
import Data.Monoid
+
import Data.Graph.Class
-import Data.Graph.Class.Adjacency.List
+import Data.Graph.Class.AdjacencyList
import Data.Graph.PropertyMap
+import Data.Graph.Internal.Color
+
+data Dfs g m = Dfs
+ { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered
+ , grayTarget :: Edge g -> g m -- called when we encounter a back edge to a vertex we're still processing
+ , exitVertex :: Vertex g -> g m -- called once we have processed all descendants of a vertex
+ , blackTarget :: Edge g -> g m -- called when we encounter a cross edge to a vertex we've already finished
+ }
+
+instance Graph g => Functor (Dfs g) where
+ fmap f (Dfs a b c d) = Dfs
+ (liftM f . a)
+ (liftM f . b)
+ (liftM f . c)
+ (liftM f . d)
+
+instance Graph g => Applicative (Dfs g) where
+ pure a = Dfs
+ (const (return a))
+ (const (return a))
+ (const (return a))
+ (const (return a))
+
+ m <*> n = Dfs
+ (\v -> enterVertex m v `ap` enterVertex n v)
+ (\e -> grayTarget m e `ap` grayTarget n e)
+ (\v -> exitVertex m v `ap` exitVertex n v)
+ (\e -> blackTarget m e `ap` blackTarget n e)
-data Color = White | Gray | Black deriving (Eq,Ord,Show,Read)
+instance Graph g => Monad (Dfs g) where
+ return = pure
+ m >>= f = Dfs
+ (\v -> enterVertex m v >>= ($ v) . enterVertex . f)
+ (\e -> grayTarget m e >>= ($ e) . grayTarget . f)
+ (\v -> exitVertex m v >>= ($ v) . exitVertex . f)
+ (\e -> blackTarget m e >>= ($ e) . blackTarget . f)
-data Dfs v e m = Dfs
- { enterVertex :: v -> m -- called the first time a vertex is discovered
- , backEdge :: e -> m -- called when we encounter a back edge to a vertex we're still processing
- , exitVertex :: v -> m -- called once we have processed all descendants of a vertex
- , crossEdge :: e -> m -- called when we encounter a cross edge to a vertex we've already finished
- } deriving (Functor)
+instance (Graph g, Monoid m) => Default (Dfs g m) where
+ def = return mempty
-instance Monoid m => Default (Dfs v e m) where
- def = Dfs
- (const mempty)
- (const mempty)
- (const mempty)
- (const mempty)
+instance (Graph g, Monoid m) => Monoid (Dfs g m) where
+ mempty = return mempty
+ mappend = liftM2 mappend
getS :: Monad g => k -> StateT (PropertyMap g k v) g v
getS k = do
@@ -54,12 +83,13 @@ putS k v = do
put m'
-- TODO: CPS transform?
-dfs :: (AdjacencyListGraph g v e, Monoid m) => Dfs v e m -> v -> g m
+dfs :: (AdjacencyListGraph g, Monoid m) => Dfs g m -> Vertex g -> g m
dfs vis v0 = do
m <- vertexMap White
evalStateT (go v0) m where
go v = do
- putS v Gray
+ putS v Grey
+ lhs <- lift $ enterVertex vis v
adjs <- lift $ outEdges v
result <- foldrM
(\e m -> do
@@ -67,10 +97,11 @@ dfs vis v0 = do
color <- getS v'
liftM (`mappend` m) $ case color of
White -> go v'
- Gray -> return $ backEdge vis e
- Black -> return $ crossEdge vis e
+ Grey -> lift $ grayTarget vis e
+ Black -> lift $ blackTarget vis e
)
mempty
adjs
putS v Black
- return $ enterVertex vis v `mappend` result `mappend` exitVertex vis v
+ rhs <- lift $ exitVertex vis v
+ return $ lhs `mappend` result `mappend` rhs
View
28 Data/Graph/Class.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Class
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
@@ -24,22 +24,32 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.PropertyMap
-class (Monad g, Eq v, Eq e) => Graph g v e | g -> v e where
- vertexMap :: a -> g (PropertyMap g v a)
- edgeMap :: a -> g (PropertyMap g e a)
+class (Monad g, Eq (Vertex g), Eq (Edge g)) => Graph g where
+ type Vertex g :: *
+ type Edge g :: *
+ vertexMap :: a -> g (PropertyMap g (Vertex g) a)
+ edgeMap :: a -> g (PropertyMap g (Edge g) a)
-instance Graph g v e => Graph (Strict.StateT s g) v e where
+instance Graph g => Graph (Strict.StateT s g) where
+ type Vertex (Strict.StateT s g) = Vertex g
+ type Edge (Strict.StateT s g) = Edge g
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
-instance Graph g v e => Graph (Lazy.StateT s g) v e where
+instance Graph g => Graph (Lazy.StateT s g) where
+ type Vertex (Lazy.StateT s g) = Vertex g
+ type Edge (Lazy.StateT s g) = Edge g
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
-instance (Graph g v e, Monoid m) => Graph (Strict.WriterT m g) v e where
+instance (Graph g, Monoid m) => Graph (Strict.WriterT m g) where
+ type Vertex (Strict.WriterT m g) = Vertex g
+ type Edge (Strict.WriterT m g) = Edge g
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
-instance (Graph g v e, Monoid m) => Graph (Lazy.WriterT m g) v e where
+instance (Graph g, Monoid m) => Graph (Lazy.WriterT m g) where
+ type Vertex (Lazy.WriterT m g) = Vertex g
+ type Edge (Lazy.WriterT m g) = Edge g
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
View
31 Data/Graph/Class/Adjacency/List.hs → Data/Graph/Class/AdjacencyList.hs
@@ -1,17 +1,17 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
--- Module : Data.Graph.Class.Adjacency.List
+-- Module : Data.Graph.Class.AdjacencyList
-- Copyright : (C) 2011 Edward Kmett
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
-module Data.Graph.Class.Adjacency.List
+module Data.Graph.Class.AdjacencyList
( AdjacencyListGraph(..)
, defaultOutEdges
, module Data.Graph.Class
@@ -26,49 +26,50 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.Class
-defaultOutEdges :: AdjacencyListGraph g v e => v -> g [(v, v)]
+defaultOutEdges :: AdjacencyListGraph g => Vertex g -> g [(Vertex g, Vertex g)]
defaultOutEdges v = liftM (map ((,) v)) (adjacentVertices v)
-- | Minimal definition: 'source', 'target', and either 'adjacentVertices' with @'outEdges' = 'defaultOutEdges'@ or 'outEdges'
-class Graph g v e => AdjacencyListGraph g v e | g -> v e where
+class Graph g => AdjacencyListGraph g where
-- /O(1)/
- source :: e -> g v
+ source :: Edge g -> g (Vertex g)
-- /O(1)/
- target :: e -> g v
+ target :: Edge g -> g (Vertex g)
-- /O(e)/ in the number of out edges
- outEdges :: v -> g [e]
+ outEdges :: Vertex g -> g [Edge g]
-- /O(e)/
- outDegree :: v -> g Int
+ outDegree :: Vertex g -> g Int
outDegree v = liftM length (outEdges v)
- adjacentVertices :: v -> g [v]
+ adjacentVertices :: Vertex g -> g [Vertex g]
adjacentVertices = outEdges >=> mapM target
-instance AdjacencyListGraph g v e => AdjacencyListGraph (Strict.StateT s g) v e where
+instance AdjacencyListGraph g => AdjacencyListGraph (Strict.StateT s g) where
adjacentVertices = lift . adjacentVertices
source = lift . source
target = lift . target
outEdges = lift . outEdges
outDegree = lift . outDegree
-instance AdjacencyListGraph g v e => AdjacencyListGraph (Lazy.StateT s g) v e where
+instance AdjacencyListGraph g => AdjacencyListGraph (Lazy.StateT s g) where
adjacentVertices = lift . adjacentVertices
source = lift . source
target = lift . target
outEdges = lift . outEdges
outDegree = lift . outDegree
-instance (AdjacencyListGraph g v e, Monoid m) => AdjacencyListGraph (Strict.WriterT m g) v e where
+instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Strict.WriterT m g) where
adjacentVertices = lift . adjacentVertices
source = lift . source
target = lift . target
outEdges = lift . outEdges
outDegree = lift . outDegree
-instance (AdjacencyListGraph g v e, Monoid m) => AdjacencyListGraph (Lazy.WriterT m g) v e where
+instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Lazy.WriterT m g) where
adjacentVertices = lift . adjacentVertices
source = lift . source
target = lift . target
outEdges = lift . outEdges
outDegree = lift . outDegree
+
View
21 Data/Graph/Class/Adjacency/Matrix.hs → Data/Graph/Class/AdjacencyMatrix.hs
@@ -1,17 +1,17 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
--- Module : Data.Graph.Class.Adjacency.Matrix
+-- Module : Data.Graph.Class.AdjacencyMatrix
-- Copyright : (C) 2011 Edward Kmett
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
-module Data.Graph.Class.Adjacency.Matrix
+module Data.Graph.Class.AdjacencyMatrix
( AdjacencyMatrixGraph(..)
, module Data.Graph.Class
) where
@@ -24,17 +24,18 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.Class
-class Graph g v e => AdjacencyMatrixGraph g v e | g -> v e where
- edge :: v -> v -> g (Maybe e)
+class Graph g => AdjacencyMatrixGraph g where
+ edge :: Vertex g -> Vertex g -> g (Maybe (Edge g))
-instance AdjacencyMatrixGraph g v e => AdjacencyMatrixGraph (Strict.StateT s g) v e where
+instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Strict.StateT s g) where
edge a b = lift (edge a b)
-instance AdjacencyMatrixGraph g v e => AdjacencyMatrixGraph (Lazy.StateT s g) v e where
+instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Lazy.StateT s g) where
edge a b = lift (edge a b)
-instance (AdjacencyMatrixGraph g v e, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) v e where
+instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) where
edge a b = lift (edge a b)
-instance (AdjacencyMatrixGraph g v e, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) v e where
+instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) where
edge a b = lift (edge a b)
+
View
26 Data/Graph/Class/Bidirectional.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Class.Bidirectional
@@ -7,13 +7,13 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
module Data.Graph.Class.Bidirectional
( BidirectionalGraph(..)
- , module Data.Graph.Class.Adjacency.List
+ , module Data.Graph.Class.AdjacencyList
) where
import Control.Monad
@@ -23,40 +23,40 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Class
import Data.Monoid
-import Data.Graph.Class.Adjacency.List
+import Data.Graph.Class.AdjacencyList
-class AdjacencyListGraph g v e => BidirectionalGraph g v e | g -> v e where
+class AdjacencyListGraph g => BidirectionalGraph g where
-- /O(e)/
- inEdges :: v -> g [e]
+ inEdges :: Vertex g -> g [Edge g]
-- /O(e)/
- inDegree :: v -> g Int
+ inDegree :: Vertex g -> g Int
inDegree v = length `liftM` inEdges v
- incidentEdges :: v -> g [e]
+ incidentEdges :: Vertex g -> g [Edge g]
incidentEdges v = liftM2 (++) (inEdges v) (outEdges v)
- degree :: v -> g Int
+ degree :: Vertex g -> g Int
degree v = liftM2 (+) (inDegree v) (outDegree v)
-instance BidirectionalGraph g v e => BidirectionalGraph (Strict.StateT s g) v e where
+instance BidirectionalGraph g => BidirectionalGraph (Strict.StateT s g) where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
degree = lift . degree
-instance BidirectionalGraph g v e => BidirectionalGraph (Lazy.StateT s g) v e where
+instance BidirectionalGraph g => BidirectionalGraph (Lazy.StateT s g) where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
degree = lift . degree
-instance (BidirectionalGraph g v e, Monoid m) => BidirectionalGraph (Strict.WriterT m g) v e where
+instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.WriterT m g) where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
degree = lift . degree
-instance (BidirectionalGraph g v e, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) v e where
+instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
View
41 Data/Graph/Class/EdgeEnumerable.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Graph.Class.EdgeEnumerable
+-- Copyright : (C) 2011 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : Edward Kmett <ekmett@gmail.com>
+-- Stability : experimental
+-- Portability : type families
+--
+----------------------------------------------------------------------------
+
+module Data.Graph.Class.EdgeEnumerable
+ ( EdgeEnumerableGraph(..)
+ , module Data.Graph.Class
+ ) where
+
+import qualified Control.Monad.Trans.State.Strict as Strict
+import qualified Control.Monad.Trans.State.Lazy as Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy
+import Control.Monad.Trans.Class
+import Data.Monoid
+import Data.Graph.Class
+
+class Graph g => EdgeEnumerableGraph g where
+ -- | /O(e)/
+ edges :: g [Edge g]
+
+instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Strict.StateT s g) where
+ edges = lift edges
+
+instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Lazy.StateT s g) where
+ edges = lift edges
+
+instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Strict.WriterT m g) where
+ edges = lift edges
+
+instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Lazy.WriterT m g) where
+ edges = lift edges
View
42 Data/Graph/Class/VertexEnumerable.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Graph.Class.VertexEnumerable
+-- Copyright : (C) 2011 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : Edward Kmett <ekmett@gmail.com>
+-- Stability : experimental
+-- Portability : type families
+--
+----------------------------------------------------------------------------
+
+module Data.Graph.Class.VertexEnumerable
+ ( VertexEnumerableGraph(..)
+ , module Data.Graph.Class
+ ) where
+
+import qualified Control.Monad.Trans.State.Strict as Strict
+import qualified Control.Monad.Trans.State.Lazy as Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy
+import Control.Monad.Trans.Class
+import Data.Monoid
+import Data.Graph.Class
+
+class Graph g => VertexEnumerableGraph g where
+ -- | /O(v)/
+ vertices :: g [Vertex g]
+
+instance VertexEnumerableGraph g => VertexEnumerableGraph (Strict.StateT s g) where
+ vertices = lift vertices
+
+instance VertexEnumerableGraph g => VertexEnumerableGraph (Lazy.StateT s g) where
+ vertices = lift vertices
+
+instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Strict.WriterT m g) where
+ vertices = lift vertices
+
+instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Lazy.WriterT m g) where
+ vertices = lift vertices
+
View
25 Data/Graph/Dual.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Dual
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
@@ -19,7 +19,10 @@ import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Data.Graph.PropertyMap
-import Data.Graph.Class.Adjacency.Matrix
+import Data.Graph.Class.AdjacencyList
+import Data.Graph.Class.AdjacencyMatrix
+import Data.Graph.Class.EdgeEnumerable
+import Data.Graph.Class.VertexEnumerable
import Data.Graph.Class.Bidirectional
newtype Dual g a = Dual { runDual :: g a }
@@ -42,21 +45,29 @@ instance Monad g => Monad (Dual g) where
Dual g >>= k = Dual (g >>= runDual . k)
Dual g >> Dual h = Dual (g >> h)
-instance Graph g v e => Graph (Dual g) v e where
+instance Graph g => Graph (Dual g) where
+ type Vertex (Dual g) = Vertex g
+ type Edge (Dual g) = Edge g
vertexMap = Dual . liftM liftPropertyMap . vertexMap
edgeMap = Dual . liftM liftPropertyMap . edgeMap
-instance AdjacencyMatrixGraph g v e => AdjacencyMatrixGraph (Dual g) v e where
+instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Dual g) where
edge l r = Dual (edge r l)
-instance BidirectionalGraph g v e => AdjacencyListGraph (Dual g) v e where
+instance BidirectionalGraph g => AdjacencyListGraph (Dual g) where
source = Dual . target
target = Dual . source
outEdges = Dual . inEdges
outDegree = Dual . inDegree
-instance BidirectionalGraph g v e => BidirectionalGraph (Dual g) v e where
+instance BidirectionalGraph g => BidirectionalGraph (Dual g) where
inEdges = Dual . outEdges
inDegree = Dual . inDegree
incidentEdges = Dual . incidentEdges
degree = Dual . degree
+
+instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Dual g) where
+ edges = Dual edges
+
+instance VertexEnumerableGraph g => VertexEnumerableGraph (Dual g) where
+ vertices = Dual vertices
View
25 Data/Graph/Empty.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Empty
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : MPTCs, fundeps
+-- Portability : type families
--
----------------------------------------------------------------------------
@@ -19,7 +19,10 @@ import Control.Applicative
import Control.Monad
import Data.Void
import Data.Graph.PropertyMap
-import Data.Graph.Class.Adjacency.Matrix
+import Data.Graph.Class.AdjacencyList
+import Data.Graph.Class.AdjacencyMatrix
+import Data.Graph.Class.VertexEnumerable
+import Data.Graph.Class.EdgeEnumerable
import Data.Graph.Class.Bidirectional
newtype Empty a = Empty { runEmpty :: a }
@@ -42,21 +45,29 @@ instance Monad Empty where
voidMap :: PropertyMap Empty Void a
voidMap = PropertyMap (Empty . void) $ \_ _ -> Empty voidMap
-instance Graph Empty Void Void where
+instance Graph Empty where
+ type Vertex Empty = Void
+ type Edge Empty = Void
vertexMap _ = Empty voidMap
edgeMap _ = Empty voidMap
-instance AdjacencyMatrixGraph Empty Void Void where
+instance AdjacencyMatrixGraph Empty where
edge _ _ = Empty Nothing
-instance AdjacencyListGraph Empty Void Void where
+instance AdjacencyListGraph Empty where
source = Empty
target = Empty
outEdges _ = Empty []
outDegree _ = Empty 0
-instance BidirectionalGraph Empty Void Void where
+instance BidirectionalGraph Empty where
inEdges _ = Empty []
inDegree _ = Empty 0
incidentEdges _ = Empty []
degree _ = Empty 0
+
+instance EdgeEnumerableGraph Empty where
+ edges = return []
+
+instance VertexEnumerableGraph Empty where
+ vertices = return []
View
3  Data/Graph/Internal/Color.hs
@@ -0,0 +1,3 @@
+module Data.Graph.Internal.Color where
+
+data Color = White | Grey | Black deriving (Eq,Ord,Show,Read)
View
14 graphs.cabal
@@ -24,20 +24,24 @@ library
data-default >= 0.2 && < 0.3,
transformers >= 0.2.2 && < 0.3,
containers >= 0.3 && < 0.5,
- void >= 0.1 && < 0.2,
+ void >= 0.3 && < 0.4,
heaps >= 0.2 && < 0.3
exposed-modules:
- Data.Graph.Adjacency.List
- Data.Graph.Adjacency.Matrix
+ Data.Graph.AdjacencyList
+ Data.Graph.AdjacencyMatrix
Data.Graph.Algorithm.DepthFirstSearch
Data.Graph.Algorithm.BreadthFirstSearch
Data.Graph.Class
- Data.Graph.Class.Adjacency.List
- Data.Graph.Class.Adjacency.Matrix
+ Data.Graph.Class.AdjacencyList
+ Data.Graph.Class.AdjacencyMatrix
+ Data.Graph.Class.EdgeEnumerable
Data.Graph.Class.Bidirectional
+ Data.Graph.Class.VertexEnumerable
Data.Graph.Dual
Data.Graph.Empty
Data.Graph.PropertyMap
+ other-modules
+ Data.Graph.Internal.Color
ghc-options: -Wall
Please sign in to comment.
Something went wrong with that request. Please try again.