diff --git a/Data/Graph/Inductive/Graph.hs b/Data/Graph/Inductive/Graph.hs --- a/Data/Graph/Inductive/Graph.hs +++ b/Data/Graph/Inductive/Graph.hs @@ -381,7 +381,7 @@ -- | All outward-directed 'LEdge's in a 'Context'. out' :: Context a b -> [LEdge b] -out' c@(_,v,_,_) = map (\(l,w)->(w,v,l)) (context4l' c) +out' c@(_,v,_,_) = map (\(l,w)->(v,w,l)) (context4l' c) -- | All inward-directed 'LEdge's in a 'Context'. inn' :: Context a b -> [LEdge b] diff --git a/Data/Graph/Inductive/Query/DFS.hs b/Data/Graph/Inductive/Query/DFS.hs --- a/Data/Graph/Inductive/Query/DFS.hs +++ b/Data/Graph/Inductive/Query/DFS.hs @@ -5,6 +5,7 @@ CFun, dfs,dfs',dff,dff', dfsWith, dfsWith',dffWith,dffWith', + xdfsWith,xdfWith,xdffWith, -- * Undirected DFS udfs,udfs',udff,udff', -- * Reverse DFS diff --git a/Data/Graph/Inductive/Query/Dominators.hs b/Data/Graph/Inductive/Query/Dominators.hs --- a/Data/Graph/Inductive/Query/Dominators.hs +++ b/Data/Graph/Inductive/Query/Dominators.hs @@ -1,40 +1,120 @@ -module Data.Graph.Inductive.Query.Dominators( - dom +-- Find Dominators of a graph. +-- +-- Author: Bertram Felgenhauer +-- +-- Implementation based on +-- Keith D. Cooper, Timothy J. Harvey, Ken Kennedy, +-- "A Simple, Fast Dominance Algorithm", +-- (http://citeseer.ist.psu.edu/cooper01simple.html) + +module Data.Graph.Inductive.Query.Dominators ( + dom, + iDom ) where -import Data.List import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.Query.DFS +import Data.Tree (Tree(..)) +import qualified Data.Tree as T +import Data.Array +import Data.IntMap (IntMap) +import qualified Data.IntMap as I +-- | return immediate dominators for each node of a graph, given a root +iDom :: Graph gr => gr a b -> Node -> [(Node,Node)] +iDom g root = let (result, toNode, _) = idomWork g root + in map (\(a, b) -> (toNode ! a, toNode ! b)) (assocs result) -type DomSets = [(Node,[Node],[Node])] +-- | return the set of dominators of the nodes of a graph, given a root +dom :: Graph gr => gr a b -> Node -> [(Node,[Node])] +dom g root = let + (iDom, toNode, fromNode) = idomWork g root + dom' = getDom toNode iDom + nodes' = nodes g + rest = I.keys (I.filter (-1 ==) fromNode) + in + [(toNode ! i, dom' ! i) | i <- range (bounds dom')] ++ + [(n, nodes') | n <- rest] +-- internal node type +type Node' = Int +-- array containing the immediate dominator of each node, or an approximation +-- thereof. the dominance set of a node can be found by taking the union of +-- {node} and the dominance set of its immediate dominator. +type IDom = Array Node' Node' +-- array containing the list of predecessors of each node +type Preds = Array Node' [Node'] +-- arrays for translating internal nodes back to graph nodes and back +type ToNode = Array Node' Node +type FromNode = IntMap Node' -intersection :: [[Node]] -> [Node] -intersection cs = foldr intersect (head cs) cs +idomWork :: Graph gr => gr a b -> Node -> (IDom, ToNode, FromNode) +idomWork g root = let + -- use depth first tree from root do build the first approximation + trees@(~[tree]) = dff [root] g + -- relabel the tree so that paths from the root have increasing nodes + (s, ntree) = numberTree 0 tree + -- the approximation iDom0 just maps each node to its parent + iDom0 = array (1, s-1) (tail $ treeEdges (-1) ntree) + -- fromNode translates graph nodes to relabeled (internal) nodes + fromNode = I.unionWith const (I.fromList (zip (T.flatten tree) (T.flatten ntree))) (I.fromList (zip (nodes g) (repeat (-1)))) + -- toNode translates internal nodes to graph nodes + toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree)) + preds = array (1, s-1) [(i, filter (/= -1) (map (fromNode I.!) + (pre g (toNode ! i)))) | i <- [1..s-1]] + -- iteratively improve the approximation to find iDom. + iDom = fixEq (refineIDom preds) iDom0 + in + if null trees then error "Dominators.idomWork: root not in graph" + else (iDom, toNode, fromNode) -getdomv :: [Node] -> DomSets -> [[Node]] -getdomv vs ds = [z|(w,_,z)<-ds,v<-vs,v==w] +-- for each node in iDom, find the intersection of all its predecessor's +-- dominating sets, and update iDom accordingly. +refineIDom :: Preds -> IDom -> IDom +refineIDom preds iDom = fmap (foldl1 (intersect iDom)) preds -builddoms :: DomSets -> [Node] -> DomSets -builddoms ds [] = ds -builddoms ds (v:vs) = builddoms ((fs++[(n,p,sort(n:idv))])++(tail rs)) vs - where idv = intersection (getdomv p ds) - (n,p,_) = head rs - (fs,rs) = span (\(x,_,_)->x/=v) ds +-- find the intersection of the two given dominance sets. +intersect :: IDom -> Node' -> Node' -> Node' +intersect iDom a b = case a `compare` b of + LT -> intersect iDom a (iDom ! b) + EQ -> a + GT -> intersect iDom (iDom ! a) b -domr :: DomSets -> [Node] -> DomSets -domr ds vs|xs == ds = ds - |otherwise = builddoms xs vs - where xs = (builddoms ds vs) +-- convert an IDom to dominance sets. we translate to graph nodes here +-- because mapping later would be more expensive and lose sharing. +getDom :: ToNode -> IDom -> Array Node' [Node] +getDom toNode iDom = let + res = array (0, snd (bounds iDom)) ((0, [toNode ! 0]) : + [(i, toNode ! i : res ! (iDom ! i)) | i <- range (bounds iDom)]) + in + res -{-| -Finds the dominators relationship for a given graph and an initial -node. For each node v, it returns the list of dominators of v. --} -dom :: Graph gr => gr a b -> Node -> [(Node,[Node])] -dom g u = map (\(x,_,z)->(x,z)) (domr ld n') - where ld = (u,[],[u]):map (\v->(v,pre g v,n)) (n') - n' = n\\[u] - n = nodes g +-- relabel tree, labeling vertices with consecutive numbers in depth first order +numberTree :: Node' -> Tree a -> (Node', Tree Node') +numberTree n (Node _ ts) = let (n', ts') = numberForest (n+1) ts + in (n', Node n ts') +-- same as numberTree, for forests. +numberForest :: Node' -> [Tree a] -> (Node', [Tree Node']) +numberForest n [] = (n, []) +numberForest n (t:ts) = let (n', t') = numberTree n t + (n'', ts') = numberForest n' ts + in (n'', t':ts') +-- return the edges of the tree, with an added dummy root node. +treeEdges :: a -> Tree a -> [(a,a)] +treeEdges a (Node b ts) = (b,a) : concatMap (treeEdges b) ts + +-- find a fixed point of f, iteratively +fixEq :: Eq a => (a -> a) -> a -> a +fixEq f v | v' == v = v + | otherwise = fixEq f v' + where v' = f v + +{- +:m +Data.Graph.Inductive +let g0 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(0,3),(3,2),(4,0)]] :: Gr () () +let g1 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(2,3),(1,3),(3,4)]] :: Gr () () +let g2,g3,g4 :: Int -> Gr () (); g2 n = mkGraph [(i,()) | i <- [0..n-1]] ([(a,a+1,()) | a <- [0..n-2]] ++ [(a,a+2,()) | a <- [0..n-3]]); g3 n =mkGraph [(i,()) | i <- [0..n-1]] ([(a,a+2,()) | a <- [0..n-3]] ++ [(a,a+1,()) | a <- [0..n-2]]); g4 n =mkGraph [(i,()) | i <- [0..n-1]] ([(a+2,a,()) | a <- [0..n-3]] ++ [(a+1,a,()) | a <- [0..n-2]]) +:m -Data.Graph.Inductive +-} diff --git a/doc/CHANGES b/doc/CHANGES new file mode 100644 --- /dev/null +++ b/doc/CHANGES @@ -0,0 +1,84 @@ +CHANGES (FGL/HASKELL, Version: June 2006) +-------------------------------------------- + +June 2006 +--------- +* fixed a bug in findP (thanks to lnagy@fit.edu) +* added function delLEdge in Graph.hs (thanks to Jose Labra) +* changed implementation of updFM and mkGraph (thanks to Don Stewart) + + +February 2005 +------------- +* fixed an import error in Basic.hs +* removed Eq instance of gr because it caused overlapping instance problems. + Instead the function equal defined in Graph.hs can be used +* added some more functions to the export list of DFS.hs +* changed the definition of LPath into a newtype to avoid + overlapping instances with lists +* fixed the Makefile (for GHC and GHCi) + + +January 2004 +------------ +* bug fix for nearestNode (src/Data/Graph/Inductive/Query/GVD.hs) +Update contributed by Aetion Technologies LLC (www.aetion.com) +* Refactor into hierarchical namespace +* Build changes: + - build a standard haskell library (libHSfgl.a, HSfgl.o) + - install as ghc package (fgl), uses Auto so no -package is needed +* Automatic Node generation for labels: Data.Graph.Inductive.NodeMap +* Graphviz output: Data.Graph.Inductive.Graphviz + + +September 2002 +-------------- +* Introduction of graph classes +* Monadic graphs and graph computation monad +* Graph implementation based on balanced (AVL) trees +* Fast graph implementation based on IO arrays +* New algorithms: + - Maximum flow + - Articulation points + - biconnected components + - dominators + - transitive closure +* minor changes in utility functions + - changed signatures (swapped order of arguments) of + functions context and lab to be consistent with other graph functions + - changed function first in RootPath: not existing path is now reported + as an empty list and will not produce an error + - esp version that returns a list of labeled edges + (to find minimum label in maxflow algorithm) + - BFS uses amortized O(1) queue + - Heap stores key and value separately + - ... + + +March 2001 +---------- +* Changes to User Guide +* a couple of new functions +* some internal changes + + +April 2000 +---------- +* User Guide +* Systematic structure for all depth-first search functions +* Graph Voronoi diagram +* Several small changes and additions in utility functions + + +February 2000 +------------- +* Representation for inward-directed trees +* Breadth-first search +* Dijkstra's algorithm +* Minimum-spanning-tree algorithm + + +August 1999 +----------- +* First Haskell version + diff --git a/doc/README b/doc/README new file mode 100644 --- /dev/null +++ b/doc/README @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +FGL - Functional Graph Library, Version: January 2004 +------------------------------------------------------------------------------ + + +CONTENTS + A. CONTENTS + B. TESTING + C. CREDITS + D. CONTACT + + +------------------------------------------------------------------------------ + +A. CONTENTS + +In addition to the files doc/README, doc/COPYRIGHT, doc/CHANGES, Makefile, +package.conf.in, and prologue.txt this distribution consists of the following +28 Haskell files. + +(A) These files define inductive graphs and basic operations: + + Data/Graph/Inductive.hs - Main module + Data/Graph/Inductive/Graph.hs - Static and dynamic graph classes, + derived types & operations + Data/Graph/Inductive/Tree.hs - Dynamic graph implementation + Data/Graph/Inductive/Basic.hs - Basic graph operations (gmap, + grev, ...) + Data/Graph/Inductive/NodeMap.hs - Automatic generation of Nodes + from labels. + Data/Graph/Inductive/Graphviz.hs - Graphviz output. + Data/Graph/Inductive/Monad/Monad.hs - Monadic (static) graph class + based on balanced search trees + Data/Graph/Inductive/Monad/IOArray.hs - Static graph implementation based + on IO Arrays + + +(B) Example graphs: + + Data/Graph/Inductive/Example.hs - Example graphs + + +(C) Implementation of graph algorithms: + + Data/Graph/Inductive/Query.hs - Main query module + Data/Graph/Inductive/Query/DFS.hs - Depth-first search and + derived operations (topsort, + scc, ...) + Data/Graph/Inductive/Query/BFS.hs - Breadth-first search and + "edge" shortest paths + Data/Graph/Inductive/Query/SP.hs - Shortest paths (Dijkstra's + algorithm) + Data/Graph/Inductive/Query/GVD.hs - Graph voronoi diagram + Data/Graph/Inductive/Query/MST.hs - Minimum spanning tree (Prim's + algorithm) + Data/Graph/Inductive/Query/Indep.hs - Independent node sets + Data/Graph/Inductive/Query/MaxFlow.hs - Edmonds/Karp maximum flow + algorithm + Data/Graph/Inductive/Query/MaxFlow2.hs - Alternative implementations + of the Edmonds/Karp algorithm + Data/Graph/Inductive/Query/ArtPoint.hs - Articulation points + Data/Graph/Inductive/Query/BCC.hs - Biconnected components + Data/Graph/Inductive/Query/Dominators.hs - Dominators + Data/Graph/Inductive/Query/TransClos.hs - Transitive closure + Data/Graph/Inductive/Query/Monad.hs - Graph transformer monad and + monadic graph algorithms + + +(D) Some auxiliary modules: + + Data/Graph/Inductive/Inductive/RootPath.hs - Inward-directed trees + Data/Graph/Inductive/Inductive/Heap.hs - Pairing heaps + Data/Graph/Inductive/Inductive/Queue.hs - Amortized O(1) queue + implementation + Data/Graph/Inductive/Inductive/FiniteMap.hs - Binary-search-tree + implementation of maps + Data/Graph/Inductive/Inductive/Thread.hs - Auxiliary module used in Graph + (subject to future change) + + +------------------------------------------------------------------------------ + +B. TESTING + +B.1 GHC + + 1. Run the test program: "ghci test/test.hs" + + +B.2 Hugs + + 1. Start Hugs: "hugs -98 +o" + + 2. Load the FGL: ":l Data.Graph.Inductive.Example" + + 3. Play with it, e.g., enter: "sp 1 3 clr528" + + +------------------------------------------------------------------------------ + +C. CREDITS + +I am grateful to many people who have helped me with bug reports, questions, +comments, and implementations to improve the FGL. In particular, I would like +to thank Martin Boehme, Luis Zeron, and Hal Daume for their contributions. +Moreover, I would like to thank Abe Egnor and Isaac Jones at Aetion +Technologies who refactored the modules into the new hierarchical name space +and who have added two modules (see also the file CHANGES). + + +------------------------------------------------------------------------------ + +D. BUG REPORTS, QUESTIONS, SUGGESTIONS, ... + +Please email comments, bug reports, etc. to erwig@cs.orst.edu diff --git a/fgl.cabal b/fgl.cabal --- a/fgl.cabal +++ b/fgl.cabal @@ -1,5 +1,5 @@ name: fgl -version: 5.4.1.1 +version: 5.4.2.0 license: BSD3 license-file: LICENSE author: Martin Erwig @@ -7,6 +7,7 @@ homepage: http://web.engr.oregonstate.edu/~erwig/fgl/haskell category: Data Structures synopsis: Martin Erwig's Functional Graph Library +description: Martin Erwig's Functional Graph Library. exposed-modules: Data.Graph.Inductive.Internal.FiniteMap, Data.Graph.Inductive.Internal.Heap, @@ -36,5 +37,6 @@ Data.Graph.Inductive.Query.SP, Data.Graph.Inductive.Query.TransClos, Data.Graph.Inductive +build-type: Simple build-depends: base, mtl, containers, array extensions: MultiParamTypeClasses, OverlappingInstances, FlexibleInstances diff --git a/prologue.txt b/prologue.txt new file mode 100644 --- /dev/null +++ b/prologue.txt @@ -0,0 +1,1 @@ +Martin Erwig\'s Functional Graph Library. diff --git a/setup/Main.hi b/setup/Main.hi new file mode 100644 Binary files /dev/null and b/setup/Main.hi differ diff --git a/setup/Main.o b/setup/Main.o new file mode 100644 Binary files /dev/null and b/setup/Main.o differ diff --git a/setup/setup b/setup/setup new file mode 100644 # file too large to diff: setup/setup diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -0,0 +1,29 @@ +module Main where + +import Data.Graph.Inductive +import Data.Graph.Inductive.Example + +main :: IO () +main = return () + +m486 :: NodeMap String +m486 = fromGraph clr486 + +t1 :: Gr String () +t1 = insMapEdge m486 ("shirt", "watch", ()) clr486 + +t2 :: Gr String () +t2 = insMapEdge m486 ("watch", "pants", ()) t1 + +t3 :: Gr Char String +t3 = run_ empty $ + do insMapNodeM 'a' + insMapNodeM 'b' + insMapNodeM 'c' + insMapEdgesM [('a', 'b', "right"), + ('b', 'a', "left"), + ('b', 'c', "down"), + ('c', 'a', "up")] + +t4 :: Gr String () +t4 = run_ clr486 $ insMapEdgeM ("shirt", "watch", ())