# Changes between Initial Version and Version 1 of CodeDraft

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

--

Unmodified
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)
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
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}}}