diff options
| -rw-r--r-- | Library/GraphPart.hs | 62 | ||||
| -rw-r--r-- | Library/ProofGraph.hs | 51 |
2 files changed, 58 insertions, 55 deletions
diff --git a/Library/GraphPart.hs b/Library/GraphPart.hs index c63c2eb..744222f 100644 --- a/Library/GraphPart.hs +++ b/Library/GraphPart.hs @@ -1,4 +1,6 @@ module Library.GraphPart ( + GraphPart, + graphPart, makeGraphPart, @@ -14,11 +16,7 @@ module Library.GraphPart ( size, addedSize, overlap, - join, - - checkDupe, - nodeEquals, - resolveNodeClash + join ) where @@ -30,6 +28,7 @@ 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) @@ -43,7 +42,7 @@ graphPart nodes edges = in GraphPart graph -makeGraphPart :: Gr String (Int,Int) -> Maybe (Node,Int) -> Maybe (Node,Int) -> GraphPart +makeGraphPart :: PGraph -> Maybe (Node,Int) -> Maybe (Node,Int) -> GraphPart makeGraphPart = GraphPart @@ -80,7 +79,7 @@ outputLab gpart = do -graphAdd :: GraphPart -> Maybe (Node,Int) -> Maybe (Node,Int) -> Gr String (Int,Int) -> Gr String (Int,Int) +graphAdd :: GraphPart -> Maybe (Node,Int) -> Maybe (Node,Int) -> PGraph -> PGraph graphAdd gpart i o graph = let (resolved, dict) = resolveNodeClash graph (getGraph gpart) base = (Graph.insEdges (Graph.labEdges resolved)) . (Graph.insNodes (Graph.labNodes resolved)) $ graph @@ -102,7 +101,7 @@ graphAdd gpart i o graph = -graphDel :: GraphPart -> Gr String (Int,Int) -> Gr String (Int,Int) +graphDel :: GraphPart -> PGraph -> PGraph graphDel gpart graph = let n = map fst . nodes $ gpart e = map (\(a,b,_) -> (a,b)) . edges $ gpart @@ -115,7 +114,7 @@ size = Graph.noNodes . getGraph -addedSize :: GraphPart -> Maybe (Node,Int) -> Maybe (Node,Int) -> Gr String (Int,Int) -> Int +addedSize :: GraphPart -> Maybe (Node,Int) -> Maybe (Node,Int) -> PGraph -> Int addedSize gpart i o graph = let oldSize = Graph.noNodes graph newSize = Graph.noNodes (graphAdd gpart i o graph) @@ -125,9 +124,9 @@ addedSize gpart i o graph = 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 + let added = Graph.noNodes (graphAdd one Nothing Nothing (getGraph two)) + total = Graph.noNodes (getGraph one) + Graph.noNodes (getGraph two) + in total - added @@ -145,42 +144,3 @@ join one two | (isJust (getOutput one) && isJust (getInput 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) - diff --git a/Library/ProofGraph.hs b/Library/ProofGraph.hs index f4d956f..621b962 100644 --- a/Library/ProofGraph.hs +++ b/Library/ProofGraph.hs @@ -1,6 +1,10 @@ module Library.ProofGraph ( PGraph, - doGraphGen + doGraphGen, + + checkDupe, + nodeEquals, + resolveNodeClash ) where @@ -12,14 +16,13 @@ import qualified Data.Set as Set import Data.Map( Map, (!) ) import qualified Data.Map as Map -import Data.Graph.Inductive.Graph( LNode, LEdge, (&) ) +import Data.Graph.Inductive.Graph( Node, LNode, LEdge, (&) ) import qualified Data.Graph.Inductive.Graph as Graph import Data.Graph.Inductive.Tree import Library.Stack( Stack, at, (<:>) ) import qualified Library.Stack as Stack import Library.Parse( isNumber, isName ) -import Library.GraphPart( checkDupe ) @@ -103,7 +106,47 @@ parse gs@(graph,stack,dictionary) str = x -> let (graph', stack') = process x (argMap x) graph stack in (graph', stack', dictionary) - + + + +checkDupe :: PGraph -> PGraph +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) + doGraphGen :: [String] -> PGraph |