packages feed

graphs (empty) → 0.1

raw patch · 16 files changed

+954/−0 lines, 16 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers, data-default, transformers, void

Files

+ Data/Graph/AdjacencyList.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Adjacency.List+-- 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.AdjacencyList+  ( AdjacencyList(..)+  , ask+  ) where++import Control.Applicative+import Data.Ix+import Data.Array+import Data.Graph.PropertyMap+import Data.Graph.Class+import Data.Graph.Class.AdjacencyList++newtype AdjacencyList i a = AdjacencyList { runAdjacencyList :: Array i [i] -> a }  ++ask :: AdjacencyList i (Array i [i])+ask = AdjacencyList id++instance Functor (AdjacencyList i) where+  fmap f (AdjacencyList g) = AdjacencyList (f . g)+  b <$ _ = pure b++instance Applicative (AdjacencyList i) where+  pure = AdjacencyList . const+  AdjacencyList f <*> AdjacencyList a = AdjacencyList $ \t -> f t (a t)++instance Monad (AdjacencyList i) where+  return = AdjacencyList . const+  AdjacencyList f >>= k = AdjacencyList $ \t -> runAdjacencyList (k (f t)) t++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) where+  adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v +                                     then g ! v +                                     else []+  source (a, _) = pure a+  target (_, b) = pure b+  outEdges = defaultOutEdges
+ Data/Graph/AdjacencyMatrix.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Adjacency.Matrix+-- 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.AdjacencyMatrix+  ( AdjacencyMatrix(..)+  , ask+  ) where++import Control.Applicative+import Data.Ix+import Data.Functor+import Data.Array.IArray+import Data.Graph.PropertyMap+import Data.Graph.Class+import Data.Graph.Class.AdjacencyMatrix++newtype AdjacencyMatrix arr i a = AdjacencyMatrix { runAdjacencyMatrix :: arr (i,i) Bool -> a } ++ask :: AdjacencyMatrix arr i (arr (i, i) Bool)+ask = AdjacencyMatrix id++instance Functor (AdjacencyMatrix arr i) where+  fmap f (AdjacencyMatrix g) = AdjacencyMatrix (f . g)+  b <$ _ = pure b++instance Applicative (AdjacencyMatrix arr i) where+  pure = AdjacencyMatrix . const+  AdjacencyMatrix f <*> AdjacencyMatrix a = AdjacencyMatrix $ \t -> f t (a t)++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) 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) where+  edge i j = AdjacencyMatrix $ \a ->+    if inRange (bounds a) ix && (a ! ix) +    then Just ix+    else Nothing+    where ix = (i, j)
+ Data/Graph/Algorithm/BreadthFirstSearch.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Algorithm.BreadthFirstSearch+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+-- Breadth-first search+----------------------------------------------------------------------------++module Data.Graph.Algorithm.BreadthFirstSearch+  ( bfs, Bfs(..)+  ) where++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.AdjacencyList+import Data.Graph.PropertyMap+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)++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)++instance (Graph g, Monoid m) => Default (Bfs g m) where+  def = return 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+  m <- gets snd +  lift (getP m k)++putS :: Monad g => k -> Color -> StateT (Seq v, PropertyMap g k Color) g ()+putS k v = do+  m <- gets snd +  m' <- lift $ putP m k v+  modify $ \(q,_) -> (q, 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 Grey+  modify $ \(q,_) -> (q |> v, m')+  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+    (a :< q') -> put (q', m) >> ks a++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) +  where+  pump lhs = dequeue (return lhs) $ \ v -> do+    adjs <- lift $ outEdges v+    children <- foldrM +      (\e m -> do+        v' <- target e+        color <- getS v'+        liftM (`mappend` m) $ case color of+          White -> enqueue vis v' +          Grey -> lift $ grayTarget vis e+          Black -> lift $ blackTarget vis e+      ) mempty adjs+    putS v Black+    rhs <- lift $ exitVertex vis v +    pump $ lhs `mappend` children `mappend` rhs
+ Data/Graph/Algorithm/DepthFirstSearch.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Algorithm.DepthFirstSearch+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+-- Depth-first search+----------------------------------------------------------------------------++module Data.Graph.Algorithm.DepthFirstSearch+  ( dfs, Dfs(..)+  ) where++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.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)++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)++instance (Graph g, Monoid m) => Default (Dfs g m) where+  def = return 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+  m <- get +  lift (getP m k)++putS :: Monad g => k -> v -> StateT (PropertyMap g k v) g ()+putS k v = do+  m <- get +  m' <- lift $ putP m k v+  put m'++-- TODO: CPS transform?+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 Grey+    lhs <- lift $ enterVertex vis v+    adjs <- lift $ outEdges v +    result <- foldrM +      (\e m -> do +        v' <- target e+        color <- getS v'+        liftM (`mappend` m) $ case color of+          White -> go v'+          Grey  -> lift $ grayTarget vis e+          Black -> lift $ blackTarget vis e+      ) +      mempty +      adjs+    putS v Black+    rhs <- lift $ exitVertex vis v+    return $ lhs `mappend` result `mappend` rhs
+ Data/Graph/Class.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class+-- 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 +  ( Graph(..)+  ) where++import Control.Monad+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.PropertyMap++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 => 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 => 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, 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, 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
+ Data/Graph/Class/AdjacencyList.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- 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 :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.AdjacencyList+  ( AdjacencyListGraph(..)+  , defaultOutEdges+  , 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+import Control.Monad.Trans.Class+import Data.Monoid+import Data.Graph.Class++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 => AdjacencyListGraph g where+  -- /O(1)/+  source :: Edge g -> g (Vertex g)+  -- /O(1)/+  target :: Edge g -> g (Vertex g)+  -- /O(e)/ in the number of out edges+  outEdges :: Vertex g -> g [Edge g]++  -- /O(e)/+  outDegree :: Vertex g -> g Int+  outDegree v = liftM length (outEdges v)++  adjacentVertices :: Vertex g -> g [Vertex g]+  adjacentVertices = outEdges >=> mapM target++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 => AdjacencyListGraph (Lazy.StateT s g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++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, Monoid m) => AdjacencyListGraph (Lazy.WriterT m g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree+
+ Data/Graph/Class/AdjacencyMatrix.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- 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 :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.AdjacencyMatrix+  ( AdjacencyMatrixGraph(..)+  , 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 => AdjacencyMatrixGraph g where+  edge :: Vertex g -> Vertex g -> g (Maybe (Edge g))++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Strict.StateT s g) where+  edge a b = lift (edge a b)++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Lazy.StateT s g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) where+  edge a b = lift (edge a b)+
+ Data/Graph/Class/Bidirectional.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class.Bidirectional+-- 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.Bidirectional +  ( BidirectionalGraph(..)+  , module Data.Graph.Class.AdjacencyList+  ) where++import Control.Monad+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.AdjacencyList++class AdjacencyListGraph g => BidirectionalGraph g where+  -- /O(e)/+  inEdges :: Vertex g -> g [Edge g]+  -- /O(e)/+  inDegree :: Vertex g -> g Int+  inDegree v = length `liftM` inEdges v+  +  incidentEdges :: Vertex g -> g [Edge g]+  incidentEdges v = liftM2 (++) (inEdges v) (outEdges v)++  degree :: Vertex g -> g Int+  degree v = liftM2 (+) (inDegree v) (outDegree v)++instance BidirectionalGraph g => BidirectionalGraph (Strict.StateT s g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance BidirectionalGraph g => BidirectionalGraph (Lazy.StateT s g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++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, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree
+ Data/Graph/Class/EdgeEnumerable.hs view
@@ -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
+ Data/Graph/Class/VertexEnumerable.hs view
@@ -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+
+ Data/Graph/Dual.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Dual+-- 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.Dual+  ( Dual(..)+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Class+import Data.Graph.PropertyMap+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 }++instance MonadTrans Dual where+  lift = Dual++instance Functor g => Functor (Dual g) where+  fmap f (Dual g) = Dual $ fmap f g+  b <$ Dual g = Dual $ b <$ g++instance Applicative g => Applicative (Dual g) where+  pure = Dual . pure+  Dual f <*> Dual a = Dual (f <*> a)+  Dual f <*  Dual a = Dual (f <*  a)+  Dual f  *> Dual a = Dual (f  *> a)++instance Monad g => Monad (Dual g) where+  return = Dual . return+  Dual g >>= k = Dual (g >>= runDual . k)+  Dual g >> Dual h = Dual (g >> h)++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 => AdjacencyMatrixGraph (Dual g) where+  edge l r = Dual (edge r l)++instance BidirectionalGraph g => AdjacencyListGraph (Dual g) where+  source = Dual . target+  target = Dual . source+  outEdges = Dual . inEdges+  outDegree = Dual . inDegree++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
+ Data/Graph/Empty.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Empty+-- 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.Empty+  ( Empty(..)+  ) where++import Control.Applicative+import Control.Monad+import Data.Void+import Data.Graph.PropertyMap+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 }++instance Functor Empty where+  fmap f (Empty g) = Empty $ f g+  b <$ _ = Empty b++instance Applicative Empty where+  pure = Empty +  Empty f <*> Empty a = Empty (f a)+  a <* _ = a+  _ *> b = b++instance Monad Empty where+  return = Empty+  Empty g >>= k = k g+  _ >> b = b++voidMap :: PropertyMap Empty Void a+voidMap = PropertyMap (Empty . void) $ \_ _ -> Empty voidMap++instance Graph Empty where+  type Vertex Empty = Void+  type Edge Empty = Void+  vertexMap _ = Empty voidMap +  edgeMap   _ = Empty voidMap++instance AdjacencyMatrixGraph Empty where+  edge _ _ = Empty Nothing++instance AdjacencyListGraph Empty where+  source = Empty+  target = Empty+  outEdges _ = Empty []+  outDegree _ = Empty 0++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 []
+ Data/Graph/PropertyMap.hs view
@@ -0,0 +1,69 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.PropertyMap+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Total transient monadic maps, used to track information about vertices+-- and edges in a graph+----------------------------------------------------------------------------++module Data.Graph.PropertyMap +  ( PropertyMap(..)+  , modifyP+  , intPropertyMap+  , propertyMap+  , liftPropertyMap+  ) where++import Control.Monad+import Control.Monad.Trans.Class+import qualified Data.IntMap as IntMap+import qualified Data.Map as Map++data PropertyMap m k v = PropertyMap+  { getP :: k -> m v+  , putP :: k -> v -> m (PropertyMap m k v)+  }++modifyP :: Monad m => PropertyMap m k v -> k -> (v -> v) -> m (PropertyMap m k v)+modifyP m k f = do+  a <- getP m k+  putP m k (f a)++-- A pure IntMap-backed vertex map+intPropertyMap :: Monad m => v -> PropertyMap m Int v+intPropertyMap v0 = go v0 IntMap.empty where+  go v m = PropertyMap +    { getP = \k -> return $ maybe v id (IntMap.lookup k m)+    , putP = \k v' -> return $ go v (IntMap.insert k v' m)+    }++-- A pure Map-backed vertex map+propertyMap :: (Monad m, Ord k) => v -> PropertyMap m k v+propertyMap v0 = go v0 Map.empty where+  go v m = PropertyMap +    { getP = \k -> return $ maybe v id (Map.lookup k m)+    , putP = \k v' -> return $ go v (Map.insert k v' m)+    }++liftPropertyMap :: (MonadTrans t, Monad m, Monad (t m)) => PropertyMap m k v -> PropertyMap (t m) k v+liftPropertyMap (PropertyMap g p) = PropertyMap (lift . g) (\k v -> liftPropertyMap `liftM` lift (p k v))++{-+-- An impure STArray-backed vertex map+stAdjVertexMap :: (DenseAdjacencyMatrix g, MonadST s g) => a -> g (PropertyMap g (Vertex g) a)+stAdjVertexMap v0 = do+  range <- vertexRange +  arr <- newSTArray range v0+  return $ go arr+  where+    go arr = r where r = VertexMap+      { getP = readSTArray arr+      , putP = \k v -> writeSTArray arr k v >> return r+      } +-}
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2011 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ graphs.cabal view
@@ -0,0 +1,46 @@+name:          graphs+category:      Data Structures+version:       0.1+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     experimental+homepage:      http://github.com/ekmett/graphs+copyright:     Copyright (C) 2011 Edward A. Kmett+synopsis:      A simple monadic graph library+description:   A simple monadic graph library+build-type:    Simple++source-repository head+  type: git+  location: git://github.com/ekmett/graphs.git++library+  build-depends: +    base >= 4 && < 4.4,+    array >= 0.3 && < 0.5,+    data-default >= 0.2 && < 0.3,+    transformers >= 0.2.2 && < 0.3,+    containers >= 0.3 && < 0.5,+    void >= 0.3 && < 0.4++  exposed-modules:+    Data.Graph.AdjacencyList+    Data.Graph.AdjacencyMatrix+    Data.Graph.Algorithm.DepthFirstSearch+    Data.Graph.Algorithm.BreadthFirstSearch+    Data.Graph.Class+    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