summaryrefslogtreecommitdiff
path: root/GraphPart.hs
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2012-09-13 02:14:04 +1000
committerJed Barber <jjbarber@y7mail.com>2012-09-13 02:14:04 +1000
commitea3f1f7736c57747e743a5106b917d2853c62f57 (patch)
treef6aa645c04b3606694184fa9b949abd020550643 /GraphPart.hs
parentec95ea382132f0702e5046a721e4d8ea4cdc82e3 (diff)
Cleaner directory structure, addition of make clean, grouping of library modules into a single package
Diffstat (limited to 'GraphPart.hs')
-rw-r--r--GraphPart.hs186
1 files changed, 0 insertions, 186 deletions
diff --git a/GraphPart.hs b/GraphPart.hs
deleted file mode 100644
index bea4f72..0000000
--- a/GraphPart.hs
+++ /dev/null
@@ -1,186 +0,0 @@
-module GraphPart (
- graphPart,
- makeGraphPart,
-
- nodes,
- edges,
- inputNode,
- outputNode,
- inputLab,
- outputLab,
-
- graphAdd,
- graphDel,
- size,
- addedSize,
- overlap,
- join,
-
- checkDupe,
- nodeEquals,
- resolveNodeClash
- ) where
-
-
-
-import Data.Maybe
-import Data.List
-import Data.Map( Map )
-import qualified Data.Map as Map
-import Data.Graph.Inductive.Graph( Node, LNode, Edge, LEdge )
-import qualified Data.Graph.Inductive.Graph as Graph
-import Data.Graph.Inductive.Tree
-
-
-data GraphPart = GraphPart { getGraph :: Gr String (Int,Int)
- , getInput :: Maybe (Node,Int)
- , getOutput :: Maybe (Node,Int) }
-
-
-graphPart :: [LNode String] -> [LEdge (Int,Int)] -> Maybe (Node,Int) -> Maybe (Node,Int) -> GraphPart
-graphPart nodes edges =
- let graph = checkDupe (Graph.mkGraph nodes edges)
- in GraphPart graph
-
-
-makeGraphPart :: Gr String (Int,Int) -> Maybe (Node,Int) -> Maybe (Node,Int) -> GraphPart
-makeGraphPart = GraphPart
-
-
-nodes :: GraphPart -> [LNode String]
-nodes = Graph.labNodes . getGraph
-
-
-edges :: GraphPart -> [LEdge (Int,Int)]
-edges = Graph.labEdges . getGraph
-
-
-inputNode :: GraphPart -> Maybe Node
-inputNode gpart = do
- input <- getInput gpart
- return (fst input)
-
-
-outputNode :: GraphPart -> Maybe Node
-outputNode gpart = do
- output <- getOutput gpart
- return (fst output)
-
-
-inputLab :: GraphPart -> Maybe Int
-inputLab gpart = do
- input <- getInput gpart
- return (snd input)
-
-
-outputLab :: GraphPart -> Maybe Int
-outputLab gpart = do
- output <- getOutput gpart
- return (snd output)
-
-
-
-graphAdd :: GraphPart -> Maybe (Node,Int) -> Maybe (Node,Int) -> Gr String (Int,Int) -> Gr String (Int,Int)
-graphAdd gpart i o graph =
- let (resolved, dict) = resolveNodeClash graph (getGraph gpart)
- base = (Graph.insEdges (Graph.labEdges resolved)) . (Graph.insNodes (Graph.labNodes resolved)) $ graph
-
- inputAdded = if (isNothing i || isNothing (getInput gpart))
- then base
- else Graph.insEdge (fromJust (Map.lookup (fst . fromJust . getInput $ gpart) dict),
- fst . fromJust $ i,
- (snd . fromJust . getInput $ gpart, snd . fromJust $ i)) base
- outputAdded = if (isNothing o || isNothing (getOutput gpart))
- then inputAdded
- else Graph.insEdge (fst . fromJust $ o,
- fromJust (Map.lookup (fst . fromJust . getOutput $ gpart) dict),
- (snd . fromJust $ o, snd . fromJust . getOutput $ gpart)) inputAdded
-
- graph' = outputAdded
-
- in checkDupe graph'
-
-
-
-graphDel :: GraphPart -> Gr String (Int,Int) -> Gr String (Int,Int)
-graphDel gpart graph =
- let n = map fst . nodes $ gpart
- e = map (\(a,b,_) -> (a,b)) . edges $ gpart
- in (Graph.delNodes n) . (Graph.delEdges e) $ graph
-
-
-
-size :: GraphPart -> Int
-size = Graph.noNodes . getGraph
-
-
-
-addedSize :: GraphPart -> Maybe (Node,Int) -> Maybe (Node,Int) -> Gr String (Int,Int) -> Int
-addedSize gpart i o graph =
- let oldSize = Graph.noNodes graph
- newSize = Graph.noNodes (graphAdd gpart i o graph)
- in newSize - oldSize
-
-
-
-overlap :: GraphPart -> GraphPart -> Int
-overlap one two =
- let addedSize = Graph.noNodes (graphAdd one Nothing Nothing (getGraph two))
- totalSize = Graph.noNodes (getGraph one) + Graph.noNodes (getGraph two)
- in totalSize - addedSize
-
-
-
-join :: GraphPart -> GraphPart -> GraphPart
-join one two | (isJust (getOutput one) && isJust (getInput two)) =
- let (resolved, dict) = resolveNodeClash (getGraph one) (getGraph two)
- base = (Graph.insEdges (Graph.labEdges resolved)) . (Graph.insNodes (Graph.labNodes resolved)) . getGraph $ one
-
- from = (\(x,y) -> (fromJust (Map.lookup x dict), y)) . fromJust . getInput $ two
- to = fromJust . getOutput $ one
- ioEdge = (fst from, fst to, (snd from, snd to))
-
- newOutput = (\(x,y) -> (fromJust (Map.lookup x dict), y)) . fromJust . getOutput $ two
-
- in makeGraphPart (checkDupe (Graph.insEdge ioEdge base)) (getInput one) (Just newOutput)
-
-
-
-checkDupe :: Gr String (Int,Int) -> Gr String (Int,Int)
-checkDupe graph =
- let f = (\g n ->
- let list = filter (\x -> (x /= n) && (nodeEquals g n x)) (Graph.nodes g)
- in if (list == []) then g else merge g n (head list))
-
- merge =
- (\g n r ->
- let edgesFixed = map (\(a,b,c) -> (a,r,c)) (Graph.inn g n)
- in (Graph.insEdges edgesFixed) . (Graph.delNode n) $ g)
-
- in foldl' f graph (Graph.nodes graph)
-
-
-
-nodeEquals :: Gr String (Int,Int) -> Node -> Node -> Bool
-nodeEquals graph one two =
- let edgesOne = sortBy sortFunc (Graph.out graph one)
- edgesTwo = sortBy sortFunc (Graph.out graph two)
- sortFunc = (\(_,_,x) (_,_,y) -> compare x y)
- paired = zip (map (\(_,x,_) -> x) edgesOne) (map (\(_,x,_) -> x) edgesTwo)
-
- in (Graph.gelem one graph) &&
- (Graph.gelem two graph) &&
- (Graph.lab graph one == Graph.lab graph two) &&
- (length edgesOne == length edgesTwo) &&
- (all (\x -> nodeEquals graph (fst x) (snd x)) paired)
-
-
-
-resolveNodeClash :: Gr String (Int,Int) -> Gr String (Int,Int) -> (Gr String (Int,Int), Map Int Int)
-resolveNodeClash ref graph =
- let dict = Map.fromList (zip (Graph.nodes graph) (Graph.newNodes (Graph.noNodes graph) ref))
- nodeList = map (\(x,y) -> (fromJust (Map.lookup x dict), y)) (Graph.labNodes graph)
- edgeList = map (\(x,y,z) -> (fromJust (Map.lookup x dict),
- fromJust (Map.lookup y dict), z)) (Graph.labEdges graph)
- in (Graph.mkGraph nodeList edgeList, dict)
-