Graph implementation should now be complete enough

1 files changed, 250 insertions, 38 deletions

diff --git a/src/Grasp/Graph.hs b/src/Grasp/Graph.hs
index bc08bbe..2f22d2b 100644
--- a/src/Grasp/Graph.hs
+++ b/src/Grasp/Graph.hs
@@ -1,25 +1,10 @@
 module Grasp.Graph (
-	Node,
-	LNode,
-	UNode,
-	
-	Edge,
-	LEdge,
-	UEdge,
-	
+	Node, LNode, UNode,
+	Edge, LEdge, UEdge,
 	Adj,
-	
-	Context,
-	MContext,
-	UContext,
-	
-	Decomp,
-	GDecomp,
-	UDecomp,
-
-	Path,
-	LPath,
-	UPath,
+	Context, MContext, UContext,
+	Decomp, GDecomp, UDecomp,
+	Path, LPath, UPath,
 
     Gr,
 
@@ -28,20 +13,48 @@ module Grasp.Graph (
 	match,
 	mkGraph,
 	labNodes,
+	matchAny,
 	noNodes,
+	nodeRange,
 	labEdges,
-	nodes
+
+	(&),
+
+	nodes,
+	edges,
+	newNodes,
+	gelem,
+
+	insNode, insEdge,
+	delNode, delEdge, delLEdge,
+	insNodes, insEdges,
+	delNodes, delEdges,
+	buildGr,
+	mkUGraph,
+
+	context,
+	lab,
+	neighbours,
+	suc, pre, lsuc, lpre,
+	out, inn,
+	outdeg, indeg, deg,
+	equal
     ) where
 
 
 
 
-import Data.List
+import qualified Data.List as List
 import qualified Data.Maybe as Maybe
 
 
 
 
+-- this whole thing is essentially a reimplementation of Data.Graph.Inductive.Graph
+-- with String nodes instead of Int nodes, because it makes the rest of the code easier
+
+
+
 type Node = String
 
 type LNode a = (Node, a)
@@ -77,8 +90,8 @@ type UPath = [UNode]
 
 
 
-data Gr a b = Gr { labNodes :: [LNode a]
-                 , labEdges :: [LEdge b] }
+data Gr a b = Gr { getLabNodes :: [LNode a]
+                 , getLabEdges :: [LEdge b] }
     deriving (Show)
 
 
@@ -90,13 +103,17 @@ instance (Eq a, Eq b) => Eq (Gr a b) where
 
 
 
+
+-- class methods
+
+
 empty :: Gr a b
 empty = Gr [] []
 
 
 
 isEmpty :: Gr a b -> Bool
-isEmpty gr = (length (labNodes gr) == 0) && (length (labEdges gr) == 0)
+isEmpty gr = (length (labNodes gr) == 0)
 
 
 
@@ -106,48 +123,243 @@ match n gr =
     	then (Nothing, gr)
     	else (Just (to, n, label, from), gr)
     where
-    	to = edgesToAdjTo (filter (edgeTo n) (labEdges gr))
+    	to = map (\(x,y,z) -> (z,y)) (inn gr n)
     	label = snd . head $ (filter (\(x,y) -> x == n) (labNodes gr))
-    	from = edgesToAdjFrom (filter (edgeFrom n) (labEdges gr))
+    	from = map (\(x,y,z) -> (z,x)) (out gr n)
 
 
 
 mkGraph :: [LNode a] -> [LEdge b] -> Gr a b
 mkGraph lnodes ledges =
 	let nodes = map fst lnodes
-	    edgeNodes = (map (\(x,y,z) -> x) ledges) `union` (map (\(x,y,z) -> y) ledges)
-
+	    edgeNodes = (map (\(x,y,z) -> x) ledges) `List.union` (map (\(x,y,z) -> y) ledges)
 	in if (all (`elem` nodes) edgeNodes)
 		then Gr lnodes ledges
 		else error "Edge Exception"
 
 
 
+labNodes :: Gr a b -> [LNode a]
+labNodes = getLabNodes
+
+
+
+matchAny :: Gr a b -> GDecomp a b
+matchAny gr =
+	let (mcon, gr') = match (head . nodes $ gr) gr
+	in if (isEmpty gr)
+		then error "Match Exception"
+		else (Maybe.fromJust mcon, gr')
+
+
+
 noNodes :: Gr a b -> Int
 noNodes = length . labNodes
 
 
 
+nodeRange :: Gr a b -> (Node,Node)
+nodeRange gr =
+	let nodes = map fst (labNodes gr)
+	in if (length nodes == 0) then ("","") else (head nodes, last nodes)
+
+
+
+labEdges :: Gr a b -> [LEdge b]
+labEdges = getLabEdges
+
+
+
+(&) :: Context a b -> Gr a b -> Gr a b
+(to, n, lab, from) & gr =
+	let edgesTo = map (\(z,y) -> (n,y,z)) to
+	    edgesFrom = map (\(z,x) -> (x,n,z)) from
+	in (insEdges edgesTo) . (insEdges edgesFrom) . (insNode (n,lab)) $ gr
+
+
+
+
+
+-- graph projection
+
+
 nodes :: Gr a b -> [Node]
-nodes gr = (map fst) . labNodes $ gr
+nodes gr = map fst (labNodes gr)
+
+
+
+edges :: Gr a b -> [Edge]
+edges gr = map (\(x,y,z) -> (x,y)) (labEdges gr)
+
+
+
+newNodes :: Int -> Gr a b -> [Node]
+newNodes x gr = take x (filter (`notElem` (nodes gr)) (map show [1..]))
+
+
+
+gelem :: Node -> Gr a b -> Bool
+gelem n gr = n `elem` (nodes gr)
+
+
+
+
+
+-- graph construction and deconstruction
+
+
+insNode :: LNode a -> Gr a b -> Gr a b
+insNode n gr =
+	let preExisting = filter (\x -> fst x == fst n) (labNodes gr)
+	in if (length preExisting /= 0)
+		then error "Node Exception"
+		else Gr (n:(labNodes gr)) (labEdges gr)
+
+
+
+insEdge :: LEdge b -> Gr a b -> Gr a b
+insEdge (a,b,c) gr =
+	let from = filter (\x -> fst x == a) (labNodes gr)
+	    to = filter (\x -> fst x == b) (labNodes gr)
+	in if (length from == 0 || length to == 0)
+		then error "Edge Exception"
+		else Gr (labNodes gr) ((a,b,c):(labEdges gr))
+
+
+
+delNode :: Node -> Gr a b -> Gr a b
+delNode n gr =
+	let nodes' = filter (\x -> fst x /= n) (labNodes gr)
+	    edges' = filter (\(x,y,z) -> x /= n && y /= n) (labEdges gr)
+	in Gr nodes' edges'
+
+
+
+delEdge :: Edge -> Gr a b -> Gr a b
+delEdge e gr =
+	let edges' = filter (\(x,y,z) -> (x,y) /= e) (labEdges gr)
+	in Gr (labNodes gr) edges'
+
+
+
+delLEdge :: (Eq b) => LEdge b -> Gr a b -> Gr a b
+delLEdge e gr = Gr (labNodes gr) (filter (/= e) (labEdges gr))
+
+
+
+insNodes :: [LNode a] -> Gr a b -> Gr a b
+insNodes ns gr = List.foldl' (flip insNode) gr ns
+
+
+
+insEdges :: [LEdge b] -> Gr a b -> Gr a b
+insEdges es gr = List.foldl' (flip insEdge) gr es
+
+
+
+delNodes :: [Node] -> Gr a b -> Gr a b
+delNodes ns gr =
+	let nodes' = filter (\x -> fst x `notElem` ns) (labNodes gr)
+	    edges' = filter (\(x,y,z) -> x `notElem` ns && y `notElem` ns) (labEdges gr)
+	in Gr nodes' edges'
+
+
+
+delEdges :: [Edge] -> Gr a b -> Gr a b
+delEdges es gr =
+	let edges' = filter (\(x,y,z) -> (x,y) `notElem` es) (labEdges gr)
+	in Gr (labNodes gr) edges'
+
+
+
+buildGr :: [Context a b] -> Gr a b
+buildGr cs = List.foldl' (flip (&)) empty cs
+
+
+
+mkUGraph :: [Node] -> [Edge] -> Gr () ()
+mkUGraph ns es = Gr (map (\x -> (x,())) ns) (map (\(x,y) -> (x,y,())) es)
+
+
+
+
+
+-- graph inspection
+
+
+context :: Gr a b -> Node -> Context a b
+context gr n =
+	let from = map (\(x,y,z) -> (z,y)) (out gr n)
+	    to = map (\(x,y,z) -> (z,x)) (inn gr n)
+	in if (n `notElem` (nodes gr))
+		then error "Match Exception"
+		else (to, n, Maybe.fromJust (lab gr n), from)
+
+
+
+lab :: Gr a b -> Node -> Maybe a
+lab gr n =
+	let nlist = filter (\(x,y) -> x == n) (labNodes gr)
+	in if (length nlist == 0) then Nothing else Just (snd . head $ nlist)
+
+
+
+neighbours :: Gr a b -> Node -> [Node]
+neighbours gr n = (suc gr n) ++ (pre gr n)
+
+
+
+suc :: Gr a b -> Node -> [Node]
+suc gr n =
+	if (n `notElem` (nodes gr))
+		then error "Match Exception"
+		else map (\(x,y,z) -> y) (out gr n)
+
+
+
+pre :: Gr a b -> Node -> [Node]
+pre gr n =
+	if (n `notElem` (nodes gr))
+		then error "Match Exception"
+		else map (\(x,y,z) -> x) (inn gr n)
+
+
+
+lsuc :: Gr a b -> Node -> [(Node, b)]
+lsuc gr n = map (\(x,y,z) -> (y,z)) (out gr n)
+
+
+
+lpre :: Gr a b -> Node -> [(Node, b)]
+lpre gr n = map (\(x,y,z) -> (x,z)) (inn gr n)
+
+
+
+out :: Gr a b -> Node -> [LEdge b]
+out gr n = filter (\(x,y,z) -> x == n) (labEdges gr)
+
+
+
+inn :: Gr a b -> Node -> [LEdge b]
+inn gr n = filter (\(x,y,z) -> y == n) (labEdges gr)
 
 
 
-edgesToAdjFrom :: [LEdge a] -> Adj a
-edgesToAdjFrom = map (\(x,y,z) -> (z,x))
+outdeg :: Gr a b -> Node -> Int
+outdeg gr n = length (out gr n)
 
 
 
-edgesToAdjTo :: [LEdge a] -> Adj a
-edgesToAdjTo = map (\(x,y,z) -> (z,y))
+indeg :: Gr a b -> Node -> Int
+indeg gr n = length (inn gr n)
 
 
 
-edgeFrom :: Node -> LEdge a -> Bool
-edgeFrom n (x,y,z) = (x == n)
+deg :: Gr a b -> Node -> Int
+deg gr n = (outdeg gr n) + (indeg gr n)
 
 
 
-edgeTo :: Node -> LEdge a -> Bool
-edgeTo n (x,y,z) = (y == n)
+equal :: (Eq a, Eq b) => Gr a b -> Gr a b -> Bool
+equal a b = (a == b)