From d0cab364562ba696dfd5396a10b698de6a1a5f02 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Fri, 21 Nov 2014 19:04:03 +1100
Subject: Incorporated Grasp.Edge and Grasp.Node into the one Grasp.Graph
module, loosely based on Data.Graph.Inductive.Graph
---
src/Grasp/Edge.hs | 43 ---------------
src/Grasp/Graph.hs | 153 +++++++++++++++++++++++++++++++++++++++++++++++++++++
src/Grasp/Node.hs | 47 ----------------
3 files changed, 153 insertions(+), 90 deletions(-)
delete mode 100644 src/Grasp/Edge.hs
create mode 100644 src/Grasp/Graph.hs
delete mode 100644 src/Grasp/Node.hs
(limited to 'src')
diff --git a/src/Grasp/Edge.hs b/src/Grasp/Edge.hs
deleted file mode 100644
index f0e1cc3..0000000
--- a/src/Grasp/Edge.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Grasp.Edge (
- GEdge,
- GEdgeType,
-
- singleton,
- fromStringList,
- src,
- dest,
- lab
- ) where
-
-
-
-import Data.Graph.Inductive.Graph( LEdge )
-import Data.Map( Map )
-import qualified Data.Map as Map
-
-
-
-type GEdge = LEdge String
-type GEdgeType = String
-
-
-
-singleton :: Int -> Int -> String -> GEdge
-singleton f t s = (f,t,s)
-
-fromStringList :: Map String Int -> [(String,String,String)] -> [GEdge]
-fromStringList m es =
- let change x = case (Map.lookup x m) of
- Just a -> a
- Nothing -> error "Grasp.Edge.fromStringList: no value for key " ++ x
- in map (\(x,y,z) -> (change x, change y, z)) es
-
-src :: GEdge -> Int
-src (x,_,_) = x
-
-dest :: GEdge -> Int
-dest (_,x,_) = x
-
-lab :: GEdge -> String
-lab (_,_,x) = x
-
diff --git a/src/Grasp/Graph.hs b/src/Grasp/Graph.hs
new file mode 100644
index 0000000..0caaee7
--- /dev/null
+++ b/src/Grasp/Graph.hs
@@ -0,0 +1,153 @@
+module Grasp.Graph (
+ Node,
+ LNode,
+ UNode,
+
+ Edge,
+ LEdge,
+ UEdge,
+
+ Adj,
+
+ Context,
+ MContext,
+ UContext,
+
+ Decomp,
+ GDecomp,
+ UDecomp,
+
+ Path,
+ LPath,
+ UPath,
+
+ Gr,
+
+ empty,
+ isEmpty,
+ match,
+ mkGraph,
+ labNodes,
+ noNodes,
+ labEdges,
+ nodes
+ ) where
+
+
+
+
+import Data.List
+import qualified Data.Maybe as Maybe
+
+
+
+
+type Node = String
+
+type LNode a = (Node, a)
+
+type UNode = LNode ()
+
+type Edge = (Node, Node)
+
+type LEdge a = (Node, Node, a)
+
+type UEdge = LEdge ()
+
+type Adj b = [(b, Node)]
+
+type Context a b = (Adj b, Node, a, Adj b)
+
+type MContext a b = Maybe (Context a b)
+
+type UContext = ([Node], Node, [Node])
+
+type Decomp a b = (MContext a b, Gr a b)
+
+type GDecomp a b = (Context a b, Gr a b)
+
+type UDecomp = (Maybe UContext, Gr () ())
+
+type Path = [Node]
+
+newtype LPath a = LP [LNode a]
+
+type UPath = [UNode]
+
+
+
+
+data Gr a b = Gr { labNodes :: [LNode a]
+ , labEdges :: [LEdge b] }
+ deriving (Show)
+
+
+
+
+instance (Eq a, Eq b) => Eq (Gr a b) where
+ a == b = (labNodes a == labNodes b) && (labEdges a == labEdges b)
+
+
+
+
+empty :: Gr a b
+empty = Gr [] []
+
+
+
+isEmpty :: Gr a b -> Bool
+isEmpty gr = (length (labNodes gr) == 0) && (length (labEdges gr) == 0)
+
+
+
+match :: Node -> Gr a b -> Decomp a b
+match n gr =
+ if (n `notElem` nodes gr)
+ then (Nothing, gr)
+ else (Just (to, n, label, from), gr)
+ where
+ to = map edgeToAdjTo (filter (edgeTo n) (labEdges gr))
+ label = snd . head $ (filter (\(x,y) -> x == n) (labNodes gr))
+ from = map edgeToAdjFrom (filter (edgeFrom n) (labEdges gr))
+
+
+
+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)
+
+ in if (all (`elem` nodes) edgeNodes)
+ then Gr lnodes ledges
+ else error "Edge Exception"
+
+
+
+noNodes :: Gr a b -> Int
+noNodes = length . labNodes
+
+
+
+nodes :: Gr a b -> [Node]
+nodes gr = (map fst) . labNodes $ gr
+
+
+
+edgeToAdjFrom :: LEdge a -> Adj a
+edgeToAdjFrom (x,y,z) = (z,y)
+
+
+
+edgeToAdjTo :: LEdge a -> Adj a
+edgeToAdjTo (x,y,z) = (z,x)
+
+
+
+edgeFrom :: Node -> LEdge a -> Bool
+edgeFrom n (x,y,z) = (y == n)
+
+
+
+edgeTo :: Node -> LEdge a -> Bool
+edgeTo n (x,y,z) = (x == n)
+
diff --git a/src/Grasp/Node.hs b/src/Grasp/Node.hs
deleted file mode 100644
index ce84163..0000000
--- a/src/Grasp/Node.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-module Grasp.Node (
- GNode,
- GNodeType,
-
- singleton,
- uSingleton,
- fromStringList,
- lab,
- inst,
- idNo
- ) where
-
-
-
-import Data.Graph.Inductive.Graph( LNode )
-import Data.Map( Map )
-import qualified Data.Map as Map
-
-
-
-type GNode = LNode (Maybe String, String)
-type GNodeType = (Maybe String, String)
-
-
-
-singleton :: Int -> String -> String -> GNode
-singleton i m s = (i,(Just m,s))
-
-uSingleton :: Int -> String -> GNode
-uSingleton i s = (i,(Nothing,s))
-
-fromStringList :: Map String Int -> [(String,String)] -> [GNode]
-fromStringList m ns =
- let change x = case (Map.lookup x m) of
- Just a -> a
- Nothing -> error "Grasp.Node.fromStringList: no value for key " ++ x
- in map (\(x,y) -> (change x, (Just x, y))) ns
-
-lab :: GNode -> Maybe String
-lab (_,(x,_)) = x
-
-inst :: GNode -> String
-inst (_,(_,x)) = x
-
-idNo :: GNode -> Int
-idNo (x,(_,_)) = x
-
--
cgit