diff options
Diffstat (limited to 'Library/GraphPart.hs')
| -rw-r--r-- | Library/GraphPart.hs | 161 |
1 files changed, 0 insertions, 161 deletions
diff --git a/Library/GraphPart.hs b/Library/GraphPart.hs deleted file mode 100644 index 02a95c0..0000000 --- a/Library/GraphPart.hs +++ /dev/null @@ -1,161 +0,0 @@ -module Library.GraphPart ( - GraphPart, - - graphPart, - makeGraphPart, - - nodes, - edges, - inputNode, - outputNode, - inputLab, - outputLab, - - graphAdd, - graphAddList, - graphDel, - size, - addedSize, - overlap, - join - ) 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 -import Library.ProofGraph - - -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 :: PGraph -> 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) - - - -graphAddImp :: GraphPart -> Maybe (Node,Int) -> [(Node,Int)] -> PGraph -> PGraph -graphAddImp 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 (o == [] || isNothing (getOutput gpart)) - then inputAdded - else let outEdge = map (\(x,y) -> (x, fromJust (Map.lookup (fst . fromJust . getOutput $ gpart) dict), - (y, snd . fromJust . getOutput $ gpart))) o - in Graph.insEdges outEdge inputAdded - - graph' = outputAdded - in graph' - - - -graphAdd :: GraphPart -> Maybe (Node,Int) -> [(Node,Int)] -> PGraph -> PGraph -graphAdd gpart i o graph = - let graph' = graphAddImp gpart i o graph - in checkDupe graph' - - - -graphAddList :: [(GraphPart, Maybe (Node,Int), [(Node,Int)])] -> PGraph -> PGraph -graphAddList partList graph = - let graph' = foldl' (\g (x,y,z) -> graphAddImp x y z g) graph partList - in checkDupe graph' - - - -graphDel :: GraphPart -> PGraph -> PGraph -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) -> [(Node,Int)] -> PGraph -> 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 added = Graph.noNodes (graphAdd one Nothing [] (getGraph two)) - total = Graph.noNodes (getGraph one) + Graph.noNodes (getGraph two) - in total - added - - - -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) - - |