Changes between Initial Version and Version 1 of CodeDraft

Show
Ignore:
Timestamp:
04/09/10 10:22:53 (5 years ago)
Author:
alpmestan (IP: 109.128.183.80)
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • CodeDraft

    v1 v1  
     1Thomas Bereknyei, Edward Kmett and Alp Mestanogullari started working a on a new version of HNN, which probably requires a nicer graph library. Here is a draft of the latter. 
     2 
     3{{{ 
     4{-# LANGUAGE RankNTypes #-} 
     5 
     6-- a tiny annotated graph library 
     7-- Edward Kmett 2010 
     8 
     9module Data.Graph.Annotated where 
     10 
     11import Data.Sequence as S 
     12import Data.Sequence (Sequence, ViewL(..), ViewR(..), (><)) 
     13import Data.Vector as V 
     14import Data.Ix 
     15import qualified Data.Graph as G 
     16import Data.Graph (Graph) 
     17import Control.Monad.Writer.Instances 
     18         
     19class PFunctor f where 
     20        first :: (a -> b) -> f a c -> f b c 
     21         
     22-- a simple safe graph library based on Data.Graph for prototyping 
     23-- TODO: use Vector [Int] or Rope (Vector [Int]) 
     24newtype Graph b = Graph { runGraph :: G.Graph } 
     25         
     26newtype Vertex b = Vertex { vertexId :: Int } 
     27    deriving (Enum,Ix,Eq,Ord,Show,Typeable) 
     28         
     29vertices :: Graph b -> [Vertex b] 
     30vertices = fmap Vertex . G.vertices . runGraph 
     31 
     32dfs :: Graph b -> [Vertex b] -> Forest (Vertex b) 
     33dfs g vs = fmap Vertex <$> G.dfs (runGraph g) (vertexId <$> vs) 
     34 
     35dff :: Graph b -> Forest (Vertex b) 
     36dff g = Vertex <$> G.dff (runGraph g) 
     37 
     38topSort :: Graph b -> [Vertex b] 
     39topSort g = Vertex <$> G.topSort (runGraph g) 
     40 
     41components :: Graph b -> Forest (Vertex b) 
     42components g = fmap Vertex <$> G.components (runGraph g) 
     43 
     44newtype Edge b = Edge (Vertex b, Vertex b) 
     45    deriving (Ix,Eq,Ord,Show,Typeable) 
     46                 
     47edges :: Graph b -> [Edge b] 
     48edges = fmap Edge . G.edges . runGraph 
     49 
     50newtype NodeAnn a b = NodeAnn (G.Table a) 
     51 
     52instance PFunctor NodeAnn where 
     53    first f (NodeAnn t) = NodeAnn (f <$> t) 
     54 
     55indegree :: Graph b -> NodeAnn Int b 
     56indegree = NodeAnn . G.indegree . runGraph 
     57 
     58outdegree :: Graph b -> NodeAnn Int b 
     59outdegree = NodeAnn . G.outdegree . runGraph 
     60 
     61data Degree b = Degree { indegree :: NodeAnn Int b, outDegree :: NodeAnn Int b }  
     62 
     63degree :: Graph b -> (Degree `Annotated` Graph) b 
     64degree g = (g, Degree (indegree g) (outdegree g))  
     65 
     66-- newtype NodeMap k b = NodeAnn (Map k IntSet) (IntMap [k]) 
     67-- tag :: Ord k => k -> Vertex b -> NodeMap k b -> NodeMap k b 
     68-- lookup :: NodeMap k b -> k -> [Vertex b] 
     69 
     70-- used internally, expose? 
     71class Functor w => Comonad w where 
     72    extract :: w a -> a 
     73        extend :: (w a -> b) -> w a -> w b 
     74        duplicate :: w a -> w (w a) 
     75         
     76        duplicate = extend id 
     77        extend f = fmap f . duplicate 
     78         
     79instance Comonad ((,)e) where 
     80        extract = snd 
     81        extend f ea = (fst ea, f ea) 
     82        duplicate f ea@(e,_) = (e, f ea) 
     83 
     84type Annotated f s b = (s b, f b) 
     85 
     86-- existentially wrapped annotation 
     87-- data Ann f s = forall b. Ann ((f `Annotated` s) b) 
     88 
     89-- runAnn :: Ann f s -> (forall b. (f `Annotated` s) b -> r) -> r 
     90-- runAnn (Ann a) k = k a  
     91 
     92-- a boxed up annotated structure 
     93newtype Ann f s = Ann { runAnn :: forall r. (forall b. (f `Annotated` s) b -> r) -> r }  
     94 
     95-- we can transpose node annotations easily 
     96data Transpose b 
     97 
     98class TransposableAnn f where 
     99    transposeAnn :: (f `Annotated` Graph) a -> f (Transpose a) 
     100         
     101instance TransposableAnn (NodeAnn a) where 
     102    transposeAnn (NodeAnn t) = NodeAnn t 
     103 
     104transpose :: TransposableAnn f => (f `Annotated` Graph) b -> (f `Annotated` Graph) (Transpose b) 
     105transpose g = (G.transpose (runGraph g),  transposeAnn g) 
     106 
     107}}}