packages feed

fgl (empty) → 5.3

raw patch · 31 files changed

+3577/−0 lines, 31 filesdep +basedep +mtlbuild-type:Customsetup-changed

Dependencies added: base, mtl

Files

+ Data/Graph/Inductive.hs view
@@ -0,0 +1,33 @@+------------------------------------------------------------------------------+--  +--  Inductive.hs -- Functional Graph Library  +--+--  (c) 1999-2006 by Martin Erwig [see file COPYRIGHT]+--+------------------------------------------------------------------------------++module Data.Graph.Inductive(+    module Data.Graph.Inductive.Graph,+    module Data.Graph.Inductive.Tree,+    module Data.Graph.Inductive.Basic,+    module Data.Graph.Inductive.Monad,+    module Data.Graph.Inductive.Monad.IOArray,+    module Data.Graph.Inductive.Query,+    module Data.Graph.Inductive.Graphviz,+    module Data.Graph.Inductive.NodeMap,+    -- * Version Information+    version+) where++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.Basic+import Data.Graph.Inductive.Monad+import Data.Graph.Inductive.Monad.IOArray+import Data.Graph.Inductive.Query+import Data.Graph.Inductive.Graphviz+import Data.Graph.Inductive.NodeMap++-- | Version info+version :: IO ()+version = putStrLn "\nFGL - Functional Graph Library, June 2006"
+ Data/Graph/Inductive/Basic.hs view
@@ -0,0 +1,126 @@+-- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT]+-- | Basic Graph Algorithms+module Data.Graph.Inductive.Basic+(+    -- * Graph Operations+    grev,+    undir,unlab,+    gsel, gfold,+    -- * Filter Operations+    efilter,elfilter,+    -- * Predicates and Classifications+    hasLoop,isSimple,+    -- * Tree Operations+    postorder, postorderF, preorder, preorderF+) +where+++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Internal.Thread (threadMaybe,threadList)++import Data.List (nub)+import Data.Tree++-- | Reverse the direction of all edges.+grev :: DynGraph gr => gr a b -> gr a b +grev = gmap (\(p,v,l,s)->(s,v,l,p))++-- | Make the graph undirected, i.e. for every edge from A to B, there+-- exists an edge from B to A.+undir :: (Eq b,DynGraph gr) => gr a b -> gr a b+undir = gmap (\(p,v,l,s)->let ps = nub (p++s) in (ps,v,l,ps))+-- this version of undir considers edge lables and keeps edges with+-- different labels, an alternative is the definition below:+--   undir = gmap (\(p,v,l,s)->+--           let ps = nubBy (\x y->snd x==snd y) (p++s) in (ps,v,l,ps))++-- | Remove all labels.+unlab :: DynGraph gr => gr a b -> gr () ()+unlab = gmap (\(p,v,_,s)->(unlabAdj p,v,(),unlabAdj s))+        where unlabAdj = map (\(_,v)->((),v))+-- alternative:+--    unlab = nmap (\_->()) . emap (\_->())++-- | Return all 'Context's for which the given function returns 'True'.+gsel :: Graph gr => (Context a b -> Bool) -> gr a b -> [Context a b]+gsel p = ufold (\c cs->if p c then c:cs else cs) []+++-- filter operations+--+-- efilter  : filter based on edge property+-- elfilter : filter based on edge label property+--++-- | Filter based on edge property.+efilter :: DynGraph gr => (LEdge b -> Bool) -> gr a b -> gr a b+efilter f = ufold cfilter empty+            where cfilter (p,v,l,s) g = (p',v,l,s') & g+                   where p' = filter (\(b,u)->f (u,v,b)) p+                         s' = filter (\(b,w)->f (v,w,b)) s++-- | Filter based on edge label property.+elfilter :: DynGraph gr => (b -> Bool) -> gr a b -> gr a b+elfilter f = efilter (\(_,_,b)->f b)+++-- some predicates and classifications+--++-- | 'True' if the graph has any edges of the form (A, A).+hasLoop :: Graph gr => gr a b -> Bool+hasLoop = not . null . (gsel (\c->(node' c `elem` suc' c)))++-- | The inverse of 'hasLoop'.+isSimple :: Graph gr => gr a b -> Bool+isSimple = not . hasLoop+++threadGraph f c = threadMaybe f c match++-- gfold1 f d b u = threadGraph (\c->d (labNode' c)) (\c->gfoldn f d b u (f c))+gfold1 f d b = threadGraph d (\c->gfoldn f d b (f c))+gfoldn f d b = threadList b (gfold1 f d b)++-- gfold :: ((Context a b) -> [Node]) -> ((Node,a) -> c -> d) -> +--          (Maybe d -> c -> c) -> c -> [Node] -> Graph a b -> c+-- gfold f d b u l g = fst (gfoldn f d b u l g)++-- type Dir a b    = (Context a b) -> [Node]  -- direction of fold+-- type Dagg a b c = (Node,a) -> b -> c       -- depth aggregation+-- type Bagg a b   = (Maybe a -> b -> b,b)    -- breadth/level aggregation+-- +-- gfold :: (Dir a b) -> (Dagg a c d) -> (Bagg d c) -> [Node] -> Graph a b -> c+-- gfold f d (b,u) l g = fst (gfoldn f d b u l g)++-- | Directed graph fold.+gfold :: Graph gr =>   ((Context a b) -> [Node])    -- ^ direction of fold+		    -> ((Context a b) -> c -> d)    -- ^ depth aggregation+		    -> (Maybe d -> c -> c, c)	    -- ^ breadth\/level aggregation+		    -> [Node]+		    -> gr a b+		    -> c+gfold f d b l g = fst (gfoldn f d b l g)++-- not finished yet ...+--+-- undirBy :: (b -> b -> b) -> Graph a b -> Graph a b+-- undirBy = gmap (\(p,v,l,s)->let ps = nub (p++s) in (ps,v,l,ps))++-- | Flatten a 'Tree', returning the elements in post-order.+postorder :: Tree a -> [a]+postorder (Node v ts) = postorderF ts ++ [v]++-- | Flatten multiple 'Tree's in post-order.+postorderF :: [Tree a] -> [a]+postorderF = concatMap postorder++-- | Flatten a 'Tree', returning the elements in pre-order.  Equivalent to+--'flatten' in 'Data.Tree'.+preorder :: Tree a -> [a]+preorder = flatten++-- | Flatten multiple 'Tree's in pre-order.+preorderF :: [Tree a] -> [a]+preorderF = concatMap preorder
+ Data/Graph/Inductive/Example.hs view
@@ -0,0 +1,187 @@+-- | Example Graphs+module Data.Graph.Inductive.Example(+    -- * Auxiliary Functions+    genUNodes, genLNodes, labUEdges, noEdges,+    -- * Small Dynamic Graphs+    a, b, c, e, loop, ab, abb, dag3, e3, cyc3, g3, g3b, dag4, d1, d3,+    -- * Small Static Graphs+    a', b', c', e', loop', ab', abb', dag3', e3', dag4', d1', d3',+    -- * Functions to Create (Regular) Graphs+    ucycle, star, ucycleM, starM,+    -- * More Graphs+    -- | clr : Cormen\/Leiserson\/Rivest++    -- | kin : Kingston++    -- ** Dynamic Versions+    clr479, clr489, clr486, clr508, clr528, clr595, gr1, kin248, vor,+    -- ** Static Versions+    clr479', clr489', clr486', clr508', clr528', kin248', vor'+)where+++import Data.Graph.Inductive+import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.Monad+import Data.Graph.Inductive.Monad.IOArray++-- | generate list of unlabeled nodes+genUNodes :: Int -> [UNode]+genUNodes n = zip [1..n] (repeat ())++-- | generate list of labeled nodes+genLNodes :: Enum a => a -> Int -> [LNode a]+genLNodes q i = take i (zip [1..] [q..])++-- | denote unlabeled edges+labUEdges :: [Edge] -> [UEdge]+labUEdges = map (\(i,j) -> (i,j,()))++-- | empty (unlabeled) edge list+noEdges :: [UEdge]+noEdges = [] +++a,b,c,e,loop,ab,abb,dag3   :: Gr Char ()+e3                         :: Gr () String+cyc3,g3,g3b                :: Gr Char String+dag4                       :: Gr Int ()+d1,d3                      :: Gr Int Int++a    = ([],1,'a',[]) & empty                  -- just a node+b    = mkGraph (zip [1..2] "ab") noEdges      -- just two nodes+c    = mkGraph (zip [1..3] "abc") noEdges     -- just three nodes+e    = ([((),1)],2,'b',[]) & a                -- just one edge a-->b+e3   = mkGraph (genUNodes 2) +       [(1,2,"a"),(1,2,"b"),(1,2,"a")]        -- three edges (two labels) a-->b+loop = ([],1,'a',[((),1)]) & empty            -- loop on single node+ab   = ([((),1)],2,'b',[((),1)]) & a          -- cycle of two nodes:  a<-->b+abb  = mkGraph (zip [1..2] "ab") (labUEdges [(2,2)]) -- a and loop on b++cyc3 = buildGr                                -- cycle of three nodes+       [([("ca",3)],1,'a',[("ab",2)]),+                ([],2,'b',[("bc",3)]),+                ([],3,'c',[])]++dag3 = mkGraph (zip [1..3] "abc") (labUEdges [(1,3)])+dag4 = mkGraph (genLNodes 1 4) (labUEdges [(1,2),(1,4),(2,3),(2,4),(4,3)])++d1   = mkGraph (genLNodes 1 2) [(1,2,1)]+d3   = mkGraph (genLNodes 1 3) [(1,2,1),(1,3,4),(2,3,2)] ++g3 = ([("left",2),("up",3)],1,'a',[("right",2)]) & (+                        ([],2,'b',[("down",3)])  & (+                        ([],3,'c',[])            & empty ))+g3b = ([("down",2)], 3,'c',[("up",1)])   & (+      ([("right",1)],2,'b',[("left",1)]) & (+                 ([],1,'a',[])           & empty ))+++a',b',c',e',loop',ab',abb',dag3' :: IO (SGr Char ())+e3'                              :: IO (SGr () String)+dag4'                            :: IO (SGr Int ())+d1',d3'                          :: IO (SGr Int Int)++a'    = mkGraphM [(1,'a')] noEdges              -- just a node+b'    = mkGraphM (zip [1..2] "ab") noEdges      -- just two nodes+c'    = mkGraphM (zip [1..3] "abc") noEdges     -- just three nodes+e'    = mkGraphM (zip [1..2] "ab") [(1,2,())]   -- just one edge a-->b+e3'   = mkGraphM (genUNodes 2) +          [(1,2,"a"),(1,2,"b"),(1,2,"a")]       -- three edges (two labels) a-->b+loop' = mkGraphM [(1,'a')] [(1,1,())]           -- loop on single node+ab'   = mkGraphM (zip [1..2] "ab") +          [(1,2,()),(2,1,())]                   -- cycle of two nodes:  a<-->b+abb'  = mkGraphM (zip [1..2] "ab") (labUEdges [(2,2)]) -- a and loop on b++dag3' = mkGraphM (zip [1..3] "abc") (labUEdges [(1,3)])+dag4' = mkGraphM (genLNodes 1 4) (labUEdges [(1,2),(1,4),(2,3),(2,4),(4,3)])++d1'   = mkGraphM (genLNodes 1 2) [(1,2,1)]+d3'   = mkGraphM (genLNodes 1 3) [(1,2,1),(1,3,4),(2,3,2)] ++ucycle :: Graph gr => Int -> gr () ()+ucycle n = mkUGraph vs (map (\v->(v,v `mod` n+1)) vs)+           where vs = [1..n]++star :: Graph gr => Int -> gr () ()+star n = mkUGraph [1..n] (map (\v->(1,v)) [2..n])++ucycleM :: GraphM m gr => Int -> m (gr () ())+ucycleM n = mkUGraphM vs (map (\v->(v,v `mod` n+1)) vs)+            where vs = [1..n]++starM :: GraphM m gr => Int -> m (gr () ())+starM n = mkUGraphM [1..n] (map (\v->(1,v)) [2..n])+++clr479,clr489    :: Gr Char ()+clr486           :: Gr String ()+clr508,clr528    :: Gr Char Int+clr595,gr1       :: Gr Int Int+kin248           :: Gr Int ()+vor              :: Gr String Int++clr479 = mkGraph (genLNodes 'u' 6) +         (labUEdges [(1,2),(1,4),(2,5),(3,5),(3,6),(4,2),(5,4),(6,6)])+clr486 = mkGraph (zip [1..9] ["shorts","socks","watch","pants","shoes",+                              "shirt","belt","tie","jacket"])+                 (labUEdges [(1,4),(1,5),(2,5),(4,5),(4,7),(6,7),(6,8),(7,9),(8,9)])+clr489 = mkGraph (genLNodes 'a' 8)+                 (labUEdges [(1,2),(2,3),(2,5),(2,6),(3,4),(3,7),(4,3),(4,8),+                         (5,1),(5,6),(6,7),(7,6),(7,8),(8,8)])+clr508 = mkGraph (genLNodes 'a' 9)+                 [(1,2,4),(1,8,8),(2,3,8),(2,8,11),(3,4,7),(3,6,4),(3,9,2),+                  (4,5,9),(4,6,14),(5,6,10),(6,7,2),(7,8,1),(7,9,6),(8,9,7)]+clr528 = mkGraph [(1,'s'),(2,'u'),(3,'v'),(4,'x'),(5,'y')]+                 [(1,2,10),(1,4,5),(2,3,1),(2,4,2),(3,5,4),+                  (4,2,3),(4,3,9),(4,5,2),(5,1,7),(5,3,6)]+clr595 = mkGraph (zip [1..6] [1..6]) +                 [(1,2,16),(1,3,13),(2,3,10),(2,4,12),(3,2,4),+                  (3,5,14),(4,3,9),(4,6,20),(5,4,7),(5,6,4)]+gr1    = mkGraph (zip [1..10] [1..10]) +                 [(1,2,12),(1,3,1),(1,4,2),(2,3,1),(2,5,7),(2,6,5),(3,6,1),+                  (3,7,7),(4,3,3),(4,6,2),(4,7,5),(5,3,2),(5,6,3),(5,8,3),+                  (6,7,2),(6,8,3),(6,9,1),(7,9,9),(8,9,1),(8,10,4),(9,10,11)]+kin248 = mkGraph (genLNodes 1 10)+                 (labUEdges [(1,2),(1,4),(1,7),(2,4),(2,5),(3,4),(3,10),+                         (4,5),(4,8),(5,2),(5,3),(6,7),(7,6),(7,8),+                         (8,10),(9,9),(9,10),(10,8),(10,9)])+         -- this is the inverse graph shown on the bottom of the page++vor = mkGraph (zip [1..8] ["A","B","C","H1","H2","D","E","F"])+              [(1,4,3),(2,3,3),(2,4,3),(4,2,4),(4,6,2),+               (5,2,5),(5,3,6),(5,7,5),(5,8,6),+               (6,5,3),(6,7,2),(7,8,3),(8,7,3)]+++clr479',clr489'  :: IO (SGr Char ())+clr486'          :: IO (SGr String ())+clr508',clr528'  :: IO (SGr Char Int)+kin248'          :: IO (SGr Int ())+vor'             :: IO (SGr String Int)++clr479' = mkGraphM (genLNodes 'u' 6) +          (labUEdges [(1,2),(1,4),(2,5),(3,5),(3,6),(4,2),(5,4),(6,6)])+clr486' = mkGraphM (zip [1..9] ["shorts","socks","watch","pants","shoes",+                                "shirt","belt","tie","jacket"])+                   (labUEdges [(1,4),(1,5),(2,5),(4,5),(4,7),(6,7),(6,8),(7,9),(8,9)])+clr489' = mkGraphM (genLNodes 'a' 8)+                   (labUEdges [(1,2),(2,3),(2,5),(2,6),(3,4),(3,7),(4,3),(4,8),+                           (5,1),(5,6),(6,7),(7,6),(7,8),(8,8)])+clr508' = mkGraphM (genLNodes 'a' 9)+                   [(1,2,4),(1,8,8),(2,3,8),(2,8,11),(3,4,7),(3,6,4),(3,9,2),+                   (4,5,9),(4,6,14),(5,6,10),(6,7,2),(7,8,1),(7,9,6),(8,9,7)]+clr528' = mkGraphM [(1,'s'),(2,'u'),(3,'v'),(4,'x'),(5,'y')]+                   [(1,2,10),(1,4,5),(2,3,1),(2,4,2),(3,5,4),+                    (4,2,3),(4,3,9),(4,5,2),(5,1,7),(5,3,6)]+kin248' = mkGraphM (genLNodes 1 10)+                   (labUEdges [(1,2),(1,4),(1,7),(2,4),(2,5),(3,4),(3,10),+                           (4,5),(4,8),(5,2),(5,3),(6,7),(7,6),(7,8),+                           (8,10),(9,9),(9,10),(10,8),(10,9)])+         -- this is the inverse graph shown on the bottom of the page++vor' = mkGraphM (zip [1..8] ["A","B","C","H1","H2","D","E","F"])+                [(1,4,3),(2,3,3),(2,4,3),(4,2,4),(4,6,2),+                 (5,2,5),(5,3,6),(5,7,5),(5,8,6),+                 (6,5,3),(6,7,2),(7,8,3),(8,7,3)]+
+ Data/Graph/Inductive/Graph.hs view
@@ -0,0 +1,476 @@+-- (c) 1999-2005 by Martin Erwig [see file COPYRIGHT]+-- | Static and Dynamic Inductive Graphs  +module Data.Graph.Inductive.Graph (+    -- * General Type Defintions+    -- ** Node and Edge Types+    Node,LNode,UNode,+    Edge,LEdge,UEdge,+    -- ** Types Supporting Inductive Graph View+    Adj,Context,MContext,Decomp,GDecomp,UDecomp,+    Path,LPath(..),UPath,+    -- * Graph Type Classes+    -- | We define two graph classes:+    --+    --   Graph: static, decomposable graphs.+    --		Static means that a graph itself cannot be changed+    --             +    --   DynGraph: dynamic, extensible graphs.+    --             Dynamic graphs inherit all operations from static graphs+    --             but also offer operations to extend and change graphs.+    --+    -- Each class contains in addition to its essential operations those+    -- derived operations that might be overwritten by a more efficient+    -- implementation in an instance definition.+    -- +    -- Note that labNodes is essentially needed because the default definition+    -- for matchAny is based on it: we need some node from the graph to define+    -- matchAny in terms of match. Alternatively, we could have made matchAny +    -- essential and have labNodes defined in terms of ufold and matchAny. +    -- However, in general, labNodes seems to be (at least) as easy to define +    -- as matchAny. We have chosen labNodes instead of the function nodes since +    -- nodes can be easily derived from labNodes, but not vice versa.+    Graph(..), +    DynGraph(..),+    -- * Operations+    -- ** Graph Folds and Maps+    ufold,gmap,nmap,emap,+    -- ** Graph Projection+    nodes,edges,newNodes,gelem,+    -- ** Graph Construction and Destruction+    insNode,insEdge,delNode,delEdge,delLEdge,+    insNodes,insEdges,delNodes,delEdges,+    buildGr,mkUGraph,+    -- ** Graph Inspection+    context,lab,neighbors,+    suc,pre,lsuc,lpre,+    out,inn,outdeg,indeg,deg,+    equal,+    -- ** Context Inspection+    node',lab',labNode',neighbors',+    suc',pre',lpre',lsuc',+    out',inn',outdeg',indeg',deg',+) where+++import Data.List (sortBy)+++{- Signatures:++-- basic operations+empty      ::    Graph gr => gr a b+isEmpty    ::    Graph gr => gr a b -> Bool+match      ::    Graph gr => Node -> gr a b -> Decomp gr a b+mkGraph    ::    Graph gr => [LNode a] -> [LEdge b] -> gr a b+(&)        :: DynGraph gr => Context a b -> gr a b -> gr a b++-- graph folds and maps+ufold      :: Graph gr => ((Context a b) -> c -> c) -> c -> gr a b -> c+gmap       :: Graph gr => (Context a b -> Context c d) -> gr a b -> gr c d+nmap       :: Graph gr => (a -> c) -> gr a b -> gr c b+emap       :: Graph gr => (b -> c) -> gr a b -> gr a c++-- graph projection+matchAny   :: Graph gr => gr a b -> GDecomp g a b+nodes      :: Graph gr => gr a b -> [Node]+edges      :: Graph gr => gr a b -> [Edge]+labNodes   :: Graph gr => gr a b -> [LNode a]+labEdges   :: Graph gr => gr a b -> [LEdge b]+newNodes   :: Graph gr => Int -> gr a b -> [Node]+noNodes    :: Graph gr => gr a b -> Int+nodeRange  :: Graph gr => gr a b -> (Node,Node)+gelem      :: Graph gr => Node -> gr a b -> Bool++-- graph construction & destruction+insNode    :: DynGraph gr => LNode a   -> gr a b -> gr a b+insEdge    :: DynGraph gr => LEdge b   -> gr a b -> gr a b+delNode    ::    Graph gr => Node      -> gr a b -> gr a b+delEdge    :: DynGraph gr => Edge      -> gr a b -> gr a b+delLEdge   :: (DynGraph gr, Eq b) =>+                             LEdge b   -> gr a b -> gr a b+insNodes   :: DynGraph gr => [LNode a] -> gr a b -> gr a b+insEdges   :: DynGraph gr => [LEdge b] -> gr a b -> gr a b+delNodes   ::    Graph gr => [Node]    -> gr a b -> gr a b+delEdges   :: DynGraph gr => [Edge]    -> gr a b -> gr a b+buildGr    :: DynGraph gr => [Context a b] -> gr a b+mkUGraph   :: DynGraph gr => [Node] -> [Edge] -> gr () ()++-- graph inspection+context    :: Graph gr => gr a b -> Node -> Context a b+lab        :: Graph gr => gr a b -> Node -> Maybe a+neighbors  :: Graph gr => gr a b -> Node -> [Node] +suc        :: Graph gr => gr a b -> Node -> [Node]+pre        :: Graph gr => gr a b -> Node -> [Node] +lsuc       :: Graph gr => gr a b -> Node -> [(Node,b)]+lpre       :: Graph gr => gr a b -> Node -> [(Node,b)] +out        :: Graph gr => gr a b -> Node -> [LEdge b] +inn        :: Graph gr => gr a b -> Node -> [LEdge b] +outdeg     :: Graph gr => gr a b -> Node -> Int+indeg      :: Graph gr => gr a b -> Node -> Int+deg        :: Graph gr => gr a b -> Node -> Int++-- context inspection+node'      :: Context a b -> Node+lab'       :: Context a b -> a+labNode'   :: Context a b -> LNode a+neighbors' :: Context a b -> [Node] +suc'       :: Context a b -> [Node]+pre'       :: Context a b -> [Node] +lpre'      :: Context a b -> [(Node,b)] +lsuc'      :: Context a b -> [(Node,b)]+out'       :: Context a b -> [LEdge b] +inn'       :: Context a b -> [LEdge b] +outdeg'    :: Context a b -> Int+indeg'     :: Context a b -> Int+deg'       :: Context a b -> Int++-}++-- | Unlabeled node+type  Node   = Int		+-- | Labeled node+type LNode a = (Node,a)		+-- | Quasi-unlabeled node+type UNode   = LNode ()		++-- | Unlabeled edge+type  Edge   = (Node,Node)	+-- | Labeled edge+type LEdge b = (Node,Node,b)	+-- | Quasi-unlabeled edge+type UEdge   = LEdge ()		++-- | Unlabeled path+type Path    = [Node]		+-- | Labeled path+newtype LPath a = LP [LNode a]++instance Show a => Show (LPath a) where+  show (LP xs) = show xs++-- | Quasi-unlabeled path+type UPath   = [UNode]		++-- | Labeled links to or from a 'Node'.+type Adj b        = [(b,Node)]+-- | Links to the 'Node', the 'Node' itself, a label, links from the 'Node'.+type Context a b  = (Adj b,Node,a,Adj b) -- Context a b "=" Context' a b "+" Node+type MContext a b = Maybe (Context a b)+-- | 'Graph' decomposition - the context removed from a 'Graph', and the rest+-- of the 'Graph'.+type Decomp g a b = (MContext a b,g a b)+-- | The same as 'Decomp', only more sure of itself.+type GDecomp g a b  = (Context a b,g a b)++-- | Unlabeled context.+type UContext     = ([Node],Node,[Node])+-- | Unlabeled decomposition.+type UDecomp g    = (Maybe UContext,g)++-- | Minimum implementation: 'empty', 'isEmpty', 'match', 'mkGraph', 'labNodes'+class Graph gr where+  -- essential operations+  -- | An empty 'Graph'.+  empty     :: gr a b+  -- | True if the given 'Graph' is empty.+  isEmpty   :: gr a b -> Bool+  -- | Decompose a 'Graph' into the 'MContext' found for the given node and the+  -- remaining 'Graph'.+  match     :: Node -> gr a b -> Decomp gr a b+  -- | Create a 'Graph' from the list of 'LNode's and 'LEdge's.+  mkGraph   :: [LNode a] -> [LEdge b] -> gr a b+  -- | A list of all 'LNode's in the 'Graph'.+  labNodes  :: gr a b -> [LNode a]+  -- derived operations+  -- | Decompose a graph into the 'Context' for an arbitrarily-chosen 'Node'+  -- and the remaining 'Graph'.+  matchAny  :: gr a b -> GDecomp gr a b+  -- | The number of 'Node's in a 'Graph'.+  noNodes   :: gr a b -> Int+  -- | The minimum and maximum 'Node' in a 'Graph'.+  nodeRange :: gr a b -> (Node,Node)+  -- | A list of all 'LEdge's in the 'Graph'.+  labEdges  :: gr a b -> [LEdge b]+  -- default implementation of derived operations+  matchAny g = case labNodes g of+                 []      -> error "Match Exception, Empty Graph"+                 (v,_):_ -> (c,g') where (Just c,g') = match v g +  noNodes = length . labNodes +  nodeRange g = (minimum vs,maximum vs) where vs = map fst (labNodes g)+  labEdges = ufold (\(_,v,_,s)->((map (\(l,w)->(v,w,l)) s)++)) []+++class Graph gr => DynGraph gr where+  -- | Merge the 'Context' into the 'DynGraph'.+  (&) :: Context a b -> gr a b -> gr a b+++-- | Fold a function over the graph.+ufold :: Graph gr => ((Context a b) -> c -> c) -> c -> gr a b -> c+ufold f u g | isEmpty g = u+            | otherwise = f c (ufold f u g') +            where (c,g') = matchAny g++-- | Map a function over the graph.+gmap :: DynGraph gr => (Context a b -> Context c d) -> gr a b -> gr c d+gmap f = ufold (\c->(f c&)) empty++-- | Map a function over the 'Node' labels in a graph.+nmap :: DynGraph gr => (a -> c) -> gr a b -> gr c b+nmap f = gmap (\(p,v,l,s)->(p,v,f l,s))++-- | Map a function over the 'Edge' labels in a graph.+emap :: DynGraph gr => (b -> c) -> gr a b -> gr a c+emap f = gmap (\(p,v,l,s)->(map1 f p,v,l,map1 f s))+         where map1 g = map (\(l,v)->(g l,v))++-- | List all 'Node's in the 'Graph'.+nodes :: Graph gr => gr a b -> [Node]+nodes = map fst . labNodes++-- | List all 'Edge's in the 'Graph'.+edges :: Graph gr => gr a b -> [Edge]+edges = map (\(v,w,_)->(v,w)) . labEdges++-- | List N available 'Node's, i.e. 'Node's that are not used in the 'Graph'.+newNodes :: Graph gr => Int -> gr a b -> [Node]+newNodes i g = [n+1..n+i] where (_,n) = nodeRange g++-- | 'True' if the 'Node' is present in the 'Graph'.+gelem :: Graph gr => Node -> gr a b -> Bool+gelem v g = case match v g of {(Just _,_) -> True; _ -> False}++-- | Insert a 'LNode' into the 'Graph'.+insNode :: DynGraph gr => LNode a -> gr a b -> gr a b+insNode (v,l) = (([],v,l,[])&)++-- | Insert a 'LEdge' into the 'Graph'.+insEdge :: DynGraph gr => LEdge b -> gr a b -> gr a b+insEdge (v,w,l) g = (pr,v,la,(l,w):su) & g'+                    where (Just (pr,_,la,su),g') = match v g++-- | Remove a 'Node' from the 'Graph'.+delNode :: Graph gr => Node -> gr a b -> gr a b+delNode v = delNodes [v]++-- | Remove an 'Edge' from the 'Graph'.+delEdge :: DynGraph gr => Edge -> gr a b -> gr a b+delEdge (v,w) g = case match v g of+                  (Nothing,_)        -> g+                  (Just (p,v',l,s),g') -> (p,v',l,filter ((/=w).snd) s) & g'++-- | Remove an 'LEdge' from the 'Graph'.+delLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b+delLEdge (v,w,b) g = case match v g of+                  (Nothing,_)        -> g+                  (Just (p,v',l,s),g') -> (p,v',l,filter (\(x,n) -> x /= b || n /= w) s) & g'++-- | Insert multiple 'LNode's into the 'Graph'.+insNodes   :: DynGraph gr => [LNode a] -> gr a b -> gr a b+insNodes vs g = foldr insNode g vs++-- | Insert multiple 'LEdge's into the 'Graph'.+insEdges :: DynGraph gr => [LEdge b] -> gr a b -> gr a b+insEdges es g = foldr insEdge g es++-- | Remove multiple 'Node's from the 'Graph'.+delNodes :: Graph gr => [Node] -> gr a b -> gr a b+delNodes []     g = g+delNodes (v:vs) g = delNodes vs (snd (match v g))  ++-- | Remove multiple 'Edge's from the 'Graph'.+delEdges :: DynGraph gr => [Edge]    -> gr a b -> gr a b+delEdges es g = foldr delEdge g es++-- | Build a 'Graph' from a list of 'Context's.+buildGr :: DynGraph gr => [Context a b] -> gr a b+buildGr = foldr (&) empty++-- mkGraph :: DynGraph gr => [LNode a] -> [LEdge b] -> gr a b+-- mkGraph vs es = (insEdges es . insNodes vs) empty++-- | Build a quasi-unlabeled 'Graph'.+mkUGraph :: Graph gr => [Node] -> [Edge] -> gr () ()+mkUGraph vs es = mkGraph (labUNodes vs) (labUEdges es) ++labUEdges = map (\(v,w)->(v,w,()))+labUNodes = map (\v->(v,()))+ +-- | Find the context for the given 'Node'.  Causes an error if the 'Node' is+-- not present in the 'Graph'.+context :: Graph gr => gr a b -> Node -> Context a b+context g v = case match v g of+                (Nothing,_) -> error ("Match Exception, Node: "++show v)+                (Just c,_)  -> c ++-- | Find the label for a 'Node'.+lab :: Graph gr => gr a b -> Node -> Maybe a+lab g v = fst (match v g) >>= return.lab' ++-- | Find the neighbors for a 'Node'.+neighbors :: Graph gr => gr a b -> Node -> [Node] +neighbors = (\(p,_,_,s) -> map snd (p++s)) .: context++-- | Find all 'Node's that have a link from the given 'Node'.+suc :: Graph gr => gr a b -> Node -> [Node]+suc = map snd .: context4++-- | Find all 'Node's that link to to the given 'Node'.+pre :: Graph gr => gr a b -> Node -> [Node] +pre = map snd .: context1++-- | Find all 'Node's that are linked from the given 'Node' and the label of+-- each link.+lsuc :: Graph gr => gr a b -> Node -> [(Node,b)]+lsuc = map flip2 .: context4++-- | Find all 'Node's that link to the given 'Node' and the label of each link.+lpre :: Graph gr => gr a b -> Node -> [(Node,b)] +lpre = map flip2 .: context1++-- | Find all outward-bound 'LEdge's for the given 'Node'.+out :: Graph gr => gr a b -> Node -> [LEdge b] +out g v = map (\(l,w)->(v,w,l)) (context4 g v)++-- | Find all inward-bound 'LEdge's for the given 'Node'.+inn :: Graph gr => gr a b -> Node -> [LEdge b] +inn g v = map (\(l,w)->(w,v,l)) (context1 g v)++-- | The outward-bound degree of the 'Node'.+outdeg :: Graph gr => gr a b -> Node -> Int+outdeg = length .: context4++-- | The inward-bound degree of the 'Node'.+indeg :: Graph gr => gr a b -> Node -> Int+indeg  = length .: context1++-- | The degree of the 'Node'.+deg :: Graph gr => gr a b -> Node -> Int+deg = (\(p,_,_,s) -> length p+length s) .: context++-- | The 'Node' in a 'Context'.+node' :: Context a b -> Node+node' (_,v,_,_) = v++-- | The label in a 'Context'.+lab' :: Context a b -> a+lab' (_,_,l,_) = l++-- | The 'LNode' from a 'Context'.+labNode' :: Context a b -> LNode a+labNode' (_,v,l,_) = (v,l)++-- | All 'Node's linked to or from in a 'Context'.+neighbors' :: Context a b -> [Node] +neighbors' (p,_,_,s) = map snd p++map snd s++-- | All 'Node's linked to in a 'Context'.+suc' :: Context a b -> [Node]+suc' (_,_,_,s) = map snd s++-- | All 'Node's linked from in a 'Context'.+pre' :: Context a b -> [Node] +pre' (p,_,_,_) = map snd p++-- | All 'Node's linked from in a 'Context', and the label of the links.+lpre' :: Context a b -> [(Node,b)] +lpre' (p,_,_,_) = map flip2 p++-- | All 'Node's linked from in a 'Context', and the label of the links.+lsuc' :: Context a b -> [(Node,b)]+lsuc' (_,_,_,s) = map flip2 s++-- | All outward-directed 'LEdge's in a 'Context'.+out' :: Context a b -> [LEdge b] +out' (_,v,_,s) = map (\(l,w)->(v,w,l)) s++-- | All inward-directed 'LEdge's in a 'Context'.+inn' :: Context a b -> [LEdge b] +inn' (p,v,_,_) = map (\(l,w)->(w,v,l)) p++-- | The outward degree of a 'Context'.+outdeg' :: Context a b -> Int+outdeg' (_,_,_,s) = length s++-- | The inward degree of a 'Context'.+indeg' :: Context a b -> Int+indeg' (p,_,_,_) = length p++-- | The degree of a 'Context'.+deg' :: Context a b -> Int+deg' (p,_,_,s) = length p+length s+++-- graph equality+--+nodeComp :: Eq b => LNode b -> LNode b -> Ordering+nodeComp n@(v,_) n'@(w,_) | n == n'   = EQ+                          | v<w       = LT+                          | otherwise = GT++slabNodes :: (Eq a,Graph gr) => gr a b -> [LNode a]+slabNodes = sortBy nodeComp . labNodes++edgeComp :: Eq b => LEdge b -> LEdge b -> Ordering+edgeComp e@(v,w,_) e'@(x,y,_) | e == e'              = EQ+                              | v<x || (v==x && w<y) = LT+                              | otherwise            = GT++slabEdges :: (Eq b,Graph gr) => gr a b -> [LEdge b]+slabEdges = sortBy edgeComp . labEdges++-- instance (Eq a,Eq b,Graph gr) => Eq (gr a b) where+--   g == g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g'++equal :: (Eq a,Eq b,Graph gr) => gr a b -> gr a b -> Bool+equal g g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g'+++----------------------------------------------------------------------+-- UTILITIES+----------------------------------------------------------------------+++-- auxiliary functions used in the implementation of the +-- derived class members+-- +(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)+-- f .: g = \x y->f (g x y)+-- f .: g = (f .) . g+-- (.:) f = ((f .) .)+-- (.:) = (.) (.) (.)+(.:) = (.) . (.)++fst4 (x,_,_,_) = x+{- not used+snd4 (_,x,_,_) = x+thd4 (_,_,x,_) = x+-}+fth4 (_,_,_,x) = x++{- not used+fst3 (x,_,_) = x+snd3 (_,x,_) = x+thd3 (_,_,x) = x+-}++flip2 (x,y) = (y,x)+++-- projecting on context elements+--+-- context1 g v = fst4 (contextP g v)+context1 :: Graph gr => gr a b -> Node -> Adj b+{- not used+context2 :: Graph gr => gr a b -> Node -> Node+context3 :: Graph gr => gr a b -> Node -> a+-}+context4 :: Graph gr => gr a b -> Node -> Adj b++context1 = fst4 .: context+{- not used+context2 = snd4 .: context+context3 = thd4 .: context+-}+context4 = fth4 .: context+
+ Data/Graph/Inductive/Graphviz.hs view
@@ -0,0 +1,69 @@+-- | Simple graphviz output.+module Data.Graph.Inductive.Graphviz(+    Orient(..),+    graphviz, graphviz'+) where++import Data.Graph.Inductive.Graph++data Orient = Portrait | Landscape deriving (Eq, Show)++o2s :: Orient -> String+o2s Portrait = "\trotate = \"0\"\n"+o2s Landscape = "\trotate = \"90\"\n"++-- | Formats a graph for use in graphviz.+graphviz :: (Graph g, Show a, Show b) =>    g a b   -- ^ The graph to format+					 -> String  -- ^ The title of the graph+					 -> (Double, Double)	-- ^ The size+								-- of the page+					 -> (Int, Int)	-- ^ The width and+							-- height of the page+							-- grid+					 -> Orient  -- ^ The orientation of+						    -- the graph.+					 -> String++i2d :: Int -> Double+i2d = fromInteger . toInteger++graphviz g t (w, h) p@(pw', ph') o =+    let n = labNodes g+	e = labEdges g+	ns = concatMap sn n+	es = concatMap se e+	sz w' h' = if o == Portrait then show w'++","++show h' else show h'++","++show w'+	ps = show w++","++show h+	(pw, ph) = if o == Portrait then p else (ph', pw')+	--gs = show ((w*(i2d pw))-m)++","++show ((h*(i2d ph))-m)+	gs = sz (w*(i2d pw)) (h*(i2d ph))+    in "digraph "++t++" {\n"+	    ++"\tmargin = \"0\"\n"+	    ++"\tpage = \""++ps++"\"\n"+	    ++"\tsize = \""++gs++"\"\n"+	    ++o2s o+	    ++"\tratio = \"fill\"\n"+	    ++ns+	    ++es+	++"}"+    where sn (n, a) | sa == ""	= ""+		    | otherwise	= '\t':(show n ++ sa ++ "\n")+	    where sa = sl a+	  se (n1, n2, b) = '\t':(show n1 ++ " -> " ++ show n2 ++ sl b ++ "\n")++-- | Format a graph for graphviz with reasonable defaults: title of \"fgl\",+-- 8.5x11 pages, one page, landscape orientation+graphviz' :: (Graph g, Show a, Show b) => g a b -> String+graphviz' g = graphviz g "fgl" (8.5,11.0) (1,1) Landscape++sq :: String -> String+sq ('"':s) | last s == '"'  = init s+	   | otherwise	    = s+sq ('\'':s) | last s == '\''	= init s+	    | otherwise		= s+sq s = s++sl :: (Show a) => a -> String+sl a =+    let l = sq (show a)+    in if (l /= "()") then (" [label = \""++l++"\"]") else ""
+ Data/Graph/Inductive/Internal/FiniteMap.hs view
@@ -0,0 +1,209 @@+-- | Simple Finite Maps.+-- This implementation provides several useful methods that Data.FiniteMap+-- does not.++module Data.Graph.Inductive.Internal.FiniteMap(+    -- * Type+    FiniteMap(..),+    -- * Operations+    emptyFM,addToFM,delFromFM,+    updFM,+    accumFM,+    splitFM,+    isEmptyFM,sizeFM,lookupFM,elemFM,+    rangeFM,+    minFM,maxFM,predFM,succFM,+    splitMinFM,+    fmToList+) where++import Data.Maybe (isJust)              ++data Ord a => FiniteMap a b =+    Empty | Node Int (FiniteMap a b) (a,b) (FiniteMap a b)+    deriving (Eq)+++----------------------------------------------------------------------+-- UTILITIES+----------------------------------------------------------------------+++-- pretty printing+--+showsMap :: (Show a,Show b,Ord a) => FiniteMap a b -> ShowS+showsMap Empty            = id+showsMap (Node _ l (i,x) r) = showsMap l . (' ':) . +                              shows i . ("->"++) . shows x . showsMap r+                +instance (Show a,Show b,Ord a) => Show (FiniteMap a b) where+  showsPrec _ m = showsMap m+++-- other+--+splitMax :: Ord a => FiniteMap a b -> (FiniteMap a b,(a,b))+splitMax (Node _ l x Empty) = (l,x)+splitMax (Node _ l x r)     = (avlBalance l x m,y) where (m,y) = splitMax r+splitMax Empty		    = error "splitMax on empty FiniteMap"++merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b+merge l Empty = l+merge Empty r = r+merge l r     = avlBalance l' x r where (l',x) = splitMax l+++----------------------------------------------------------------------+-- MAIN FUNCTIONS+----------------------------------------------------------------------++emptyFM :: Ord a => FiniteMap a b+emptyFM  = Empty++addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b+addToFM Empty            i x              =  node Empty (i,x) Empty+addToFM (Node h l (j,y) r) i x+    | i<j        =  avlBalance (addToFM l i x) (j,y) r+    | i>j        =  avlBalance l (j,y) (addToFM r i x) +    | otherwise  =  Node h l (j,x) r  ++-- | applies function to stored entry+updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b+updFM Empty              _ _              =  Empty+updFM (Node h l (j,x) r) i f +           | i<j        =  let l' = updFM l i f in l' `seq` Node h l' (j,x) r+           | i>j        =  let r' = updFM r i f in r' `seq` Node h l (j,x) r'+           | otherwise  =  Node h l (j,f x) r  ++-- | defines or aggregates entries+accumFM :: Ord a => FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b+accumFM Empty              i _ x              =  node Empty (i,x) Empty+accumFM (Node h l (j,y) r) i f x +    | i<j        =  avlBalance (accumFM l i f x) (j,y) r+    | i>j        =  avlBalance l (j,y) (accumFM r i f x) +    | otherwise  =  Node h l (j,f x y) r  ++delFromFM :: Ord a => FiniteMap a b -> a -> FiniteMap a b+delFromFM Empty              _              =  Empty+delFromFM (Node _ l (j,x) r) i+    | i<j        =  avlBalance (delFromFM l i) (j,x) r+    | i>j        =  avlBalance l (j,x) (delFromFM r i) +    | otherwise  =  merge l r  ++isEmptyFM :: FiniteMap a b -> Bool+isEmptyFM Empty = True+isEmptyFM _     = False++sizeFM :: Ord a => FiniteMap a b -> Int+sizeFM Empty          = 0+sizeFM (Node _ l _ r) = sizeFM l + 1 + sizeFM r++lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b+lookupFM Empty _ = Nothing+lookupFM (Node _ l (j,x) r) i | i<j        =  lookupFM l i+                              | i>j        =  lookupFM r i +                              | otherwise  =  Just x++-- | applies lookup to an interval+rangeFM :: Ord a => FiniteMap a b -> a -> a -> [b]+rangeFM m i j = rangeFMa m i j []+--+rangeFMa Empty _ _ a = a+rangeFMa (Node _ l (k,x) r) i j a+    | k<i       = rangeFMa r i j a+    | k>j       = rangeFMa l i j a+    | otherwise = rangeFMa l i j (x:rangeFMa r i j a)++minFM :: Ord a => FiniteMap a b -> Maybe (a,b)+minFM Empty              = Nothing+minFM (Node _ Empty x _) = Just x+minFM (Node _ l     _ _) = minFM l++maxFM :: Ord a => FiniteMap a b -> Maybe (a,b)+maxFM Empty              = Nothing+maxFM (Node _ _ x Empty) = Just x+maxFM (Node _ _ _ r)     = maxFM r++predFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b)+predFM m i = predFM' m i Nothing+--+predFM' Empty              _ p              =  p+predFM' (Node _ l (j,x) r) i p | i<j        =  predFM' l i p+                               | i>j        =  predFM' r i (Just (j,x))+                               | isJust ml  =  ml +                               | otherwise  =  p+                                 where ml = maxFM l+                           +succFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b)+succFM m i = succFM' m i Nothing+--+succFM' Empty              _ p              =  p+succFM' (Node _ l (j,x) r) i p | i<j        =  succFM' l i (Just (j,x))+                               | i>j        =  succFM' r i p+                               | isJust mr  =  mr +                               | otherwise  =  p+                                 where mr = minFM r++elemFM :: Ord a => FiniteMap a b -> a -> Bool+elemFM m i = case lookupFM m i of {Nothing -> False; _ -> True}++-- | combines delFrom and lookup+splitFM :: Ord a => FiniteMap a b -> a -> Maybe (FiniteMap a b,(a,b))+splitFM Empty              _ =  Nothing+splitFM (Node _ l (j,x) r) i =+        if i<j then+           case splitFM l i of+                Just (l',y) -> Just (avlBalance l' (j,x) r,y)+                Nothing     -> Nothing  else+        if i>j then+           case splitFM r i of+                Just (r',y) -> Just (avlBalance l (j,x) r',y) +                Nothing     -> Nothing  +        else {- i==j -}        Just (merge l r,(j,x))  ++-- | combines splitFM and minFM+splitMinFM :: Ord a => FiniteMap a b -> Maybe (FiniteMap a b,(a,b))+splitMinFM Empty              =  Nothing+splitMinFM (Node _ Empty x r) = Just (r,x)+splitMinFM (Node _ l x r)     = Just (avlBalance l' x r,y) +                                where Just (l',y) = splitMinFM l++fmToList :: Ord a => FiniteMap a b -> [(a,b)]+fmToList m = scan m []+             where scan Empty xs = xs+                   scan (Node _ l x r) xs = scan l (x:(scan r xs))++----------------------------------------------------------------------+-- AVL tree helper functions+----------------------------------------------------------------------++height :: Ord a => FiniteMap a b -> Int+height Empty          = 0+height (Node h _ _ _) = h++node :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b+node l val r = Node h l val r+    where h=1+(height l `max` height r)++avlBalance :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b+avlBalance l (i,x) r+    | (hr + 1 < hl) && (bias l < 0) = rotr (node (rotl l) (i,x) r)+    | (hr + 1 < hl)                 = rotr (node l (i,x) r)+    | (hl + 1 < hr) && (0 < bias r) = rotl (node l (i,x) (rotr r))+    | (hl + 1 < hr)                 = rotl (node l (i,x) r)+    | otherwise                     = node l (i,x) r+    where hl=height l; hr=height r++bias :: Ord a => FiniteMap a b -> Int+bias (Node _ l _ r) = height l - height r+bias Empty	    = 0++rotr :: Ord a => FiniteMap a b -> FiniteMap a b+rotr Empty			      = Empty+rotr (Node _ (Node _ l1 v1 r1) v2 r2) = node l1 v1 (node r1 v2 r2)+rotr (Node _ Empty _ _)		      = error "rotr on invalid FiniteMap"++rotl :: Ord a => FiniteMap a b -> FiniteMap a b+rotl Empty			      = Empty+rotl (Node _ l1 v1 (Node _ l2 v2 r2)) = node (node l1 v1 l2) v2 r2+rotl (Node _ _ _ Empty)		      = error "rotl on invalid FiniteMap"
+ Data/Graph/Inductive/Internal/Heap.hs view
@@ -0,0 +1,91 @@+-- | Pairing heap implementation of dictionary+module Data.Graph.Inductive.Internal.Heap(+    -- * Type+    Heap(..),+    -- * Operations+    empty,unit,insert,merge,mergeAll,+    isEmpty,findMin,deleteMin,splitMin,+    build, toList, heapsort+) where+++data Ord a => Heap a b = Empty | Node a b [Heap a b]+     deriving Eq++showsHeap :: (Show a,Ord a,Show b) => Heap a b -> ShowS+showsHeap Empty             = id+showsHeap (Node key val []) = shows key . (": "++) . shows val+showsHeap (Node key val hs) = shows key . (": "++) . shows val .  (' ':) . shows hs+                +instance (Show a,Ord a,Show b) => Show (Heap a b) where+  showsPrec _ d = showsHeap d+++----------------------------------------------------------------------+-- MAIN FUNCTIONS+----------------------------------------------------------------------++empty :: Ord a => Heap a b+empty = Empty++unit :: Ord a => a -> b -> Heap a b+unit key val = Node key val []++insert :: Ord a => (a, b) -> Heap a b -> Heap a b+insert (key, val) h = merge (unit key val) h++merge :: Ord a => Heap a b -> Heap a b -> Heap a b+merge h Empty = h+merge Empty h = h+merge h@(Node key1 val1 hs) h'@(Node key2 val2 hs')+    | key1<key2 = Node key1 val1 (h':hs)+    | otherwise = Node key2 val2 (h:hs')++mergeAll:: Ord a => [Heap a b] -> Heap a b+mergeAll []        = Empty+mergeAll [h]       = h+mergeAll (h:h':hs) = merge (merge h h') (mergeAll hs)++isEmpty :: Ord a => Heap a b -> Bool+isEmpty Empty = True+isEmpty _     = False+          +findMin :: Ord a => Heap a b -> (a, b)+findMin Empty      = error "Heap.findMin: empty heap"+findMin (Node key val _) = (key, val)++deleteMin :: Ord a => Heap a b -> Heap a b+deleteMin Empty             = Empty+deleteMin (Node _ _ hs) = mergeAll hs++splitMin :: Ord a => Heap a b -> (a,b,Heap a b)+splitMin Empty             = error "Heap.splitMin: empty heap"+splitMin (Node key val hs) = (key,val,mergeAll hs)+++----------------------------------------------------------------------+-- APPLICATION FUNCTIONS, EXAMPLES+----------------------------------------------------------------------+++build :: Ord a => [(a,b)] -> Heap a b+build = foldr insert Empty++toList :: Ord a => Heap a b -> [(a,b)]+toList Empty = []+toList h = x:toList r+           where (x,r) = (findMin h,deleteMin h)++heapsort :: Ord a => [a] -> [a]+heapsort = (map fst) . toList . build . map (\x->(x,x))+{-+l :: (Num a) => [a]+l  = [6,9,2,13,6,8,14,9,10,7,5]+l' = reverse l++h1  = build $ map (\x->(x,x)) l+h1' = build $ map (\x->(x,x)) l'++s1  = heapsort l+s1' = heapsort l'+-}
+ Data/Graph/Inductive/Internal/Queue.hs view
@@ -0,0 +1,26 @@+module Data.Graph.Inductive.Internal.Queue(+    -- * Type+    Queue(..),+    -- * Operations+    mkQueue, queuePut, queuePutList, queueGet, queueEmpty+) where+++data Queue a = MkQueue [a] [a]++mkQueue :: Queue a+mkQueue = MkQueue [] []++queuePut :: a -> Queue a -> Queue a+queuePut item (MkQueue ins outs) = MkQueue (item:ins) outs++queuePutList :: [a] -> Queue a -> Queue a+queuePutList [] q     = q+queuePutList (x:xs) q = queuePutList xs (queuePut x q)++queueGet :: Queue a -> (a, Queue a)+queueGet (MkQueue ins (item:rest)) = (item, MkQueue ins rest)+queueGet (MkQueue ins []) = queueGet (MkQueue [] (reverse ins))++queueEmpty :: Queue a -> Bool+queueEmpty (MkQueue ins outs) = (null ins) && (null outs)
+ Data/Graph/Inductive/Internal/RootPath.hs view
@@ -0,0 +1,51 @@+-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]+-- | Inward directed trees as lists of paths.+module Data.Graph.Inductive.Internal.RootPath (+    -- * Types+    RTree,LRTree,+    -- * Operations+    getPath,getLPath,+    getDistance,+    getLPathNodes+) where++import Data.Graph.Inductive.Graph+++instance Eq a => Eq (LPath a) where+  (LP [])        == (LP [])        = True+  (LP ((_,x):_)) == (LP ((_,y):_)) = x==y+  (LP _)         == (LP _)         = False++instance Ord a => Ord (LPath a) where+  compare (LP [])        (LP [])        = EQ+  compare (LP ((_,x):_)) (LP ((_,y):_)) = compare x y+  compare _ _ = error "LPath: cannot compare to empty paths"+++type LRTree a = [LPath a]+type RTree = [Path]++first :: ([a] -> Bool) -> [[a]] -> [a]+first p xss  = case filter p xss of+                 []   -> []+                 x:_  -> x++-- | Find the first path in a tree that starts with the given node+findP :: Node -> LRTree a -> [LNode a]+findP _ []                                  = []+findP v ((LP []):ps)                        = findP v ps+findP v ((LP (p@((w,_):_))):ps) | v==w      = p+                                | otherwise = findP v ps++getPath :: Node -> RTree -> Path+getPath v = reverse . first (\(w:_)->w==v) ++getLPath :: Node -> LRTree a -> LPath a+getLPath v = LP . reverse . findP v++getDistance :: Node -> LRTree a -> a+getDistance v = snd . head . findP v++getLPathNodes :: Node -> LRTree a -> Path+getLPathNodes v = (\(LP p)->map fst p) . getLPath v
+ Data/Graph/Inductive/Internal/Thread.hs view
@@ -0,0 +1,149 @@+-- (c) 1999 by Martin Erwig+-- | Threading Combinators.+module Data.Graph.Inductive.Internal.Thread(+    -- * Types+    Split, SplitM, Thread, Collect,+    -- * Operations+    threadList', threadList, threadMaybe', threadMaybe, splitPar, splitParM+) where++-- import Graph+-- import GraphData+-- import qualified Diet as D++-- import ADT++----------------------------------------------------------------------+-- CLASSES AND TYPES+----------------------------------------------------------------------++{-+class Thread t a b where+  split :: a -> t -> (b,t)+  +  +instance Thread (Graph a b) Node (MContext a b) where+  split = match+  +instance D.Discrete a => Thread (D.Diet a) a a where+  split x s = (x,D.delete x s)+-}++{-+   Make clear different notions:+   +   "thread" = data structure + split operation+   ...      = threadable data structure+   ...      = split operation+   +-}+++----------------------------------------------------------------------+-- THREAD COMBINATORS+----------------------------------------------------------------------+++-- (A) split along a list of indexes and thread data structure+--+-- there are different ways to consume the returned elements:++{-+--  (1) simple collect in a list+-- +foldT1' ys []     d = ys+foldT1' ys (x:xs) d = foldT1' (y:ys) xs d'  where (y,d') = split x d+foldT1 xs d = foldT1' [] xs d++--  (2) combine by a function+-- +foldT2' f ys []     d = ys+foldT2' f ys (x:xs) d = foldT2' f (f y ys) xs d'  where (y,d') = split x d+foldT2 f u xs d = foldT2' f u xs d+-}+++-- Mnemonics:+--+--  t : thread type+--  i : index type+--  r : result type+--  c : collection type+--+type Split t i r  = i -> t -> (r,t)+type Thread t i r = (t,Split t i r)+type Collect r c  = (r -> c -> c,c)++--  (3) abstract from split+-- +threadList' :: (Collect r c) -> (Split t i r) -> [i] -> t -> (c,t)+threadList' (_,c) _ []	       t = (c,t)+threadList' (f,c) split (i:is) t = threadList' (f,f r c) split is t'+                                   where (r,t') = split i t++{-  +   Note: threadList' works top-down (or, from left),+         whereas dfs,gfold,... have been defined bottom-up (or from right).+ +   ==> therefore, we define a correpsonding operator for folding+       bottom-up/from right.+-}+threadList :: (Collect r c) -> (Split t i r) -> [i] -> t -> (c,t)+threadList (_,c) _ []     t	= (c,t)+threadList (f,c) split (i:is) t = (f r c',t'')+                                  where (r,t')   = split i t+                                        (c',t'') = threadList (f,c) split is t'++++-- (B) thread "maybes", ie, apply f to Just-values and continue+--     threading with "continuation" c, and ignore Nothing-values, ie,+--     stop threading and return current data structure.+--+-- threadMaybe' :: (r -> b) -> (Split t i r) -> (e -> f -> (Maybe i,t)) +--                 -> e -> f -> (Maybe b,t)++type SplitM t i r = Split t i (Maybe r)++threadMaybe' :: (r->a)->Split t i r->Split t j (Maybe i)->Split t j (Maybe a)+threadMaybe' f cont split j t = +      case mi of Just i  -> (Just (f r),t'') where (r,t'') = cont i t'+                 Nothing -> (Nothing,t')+      where (mi,t') = split j t++-- extension:  grant f access also to y, the result of split.+--+-- threadMaybe :: (a -> b -> c) -> (a -> d -> (b,d)) -> (e -> f -> (Maybe a,d))+--                -> e -> f -> (Maybe c,d)+-- threadMaybe :: (i->r->a)->Split t i r->Split t j (Maybe i)->Split t j (Maybe a)+threadMaybe :: (i -> r -> a) -> Split t i r -> SplitM t j i -> SplitM t j a+threadMaybe f cont split j t = +      case mi of Just i  -> (Just (f i r),t'') where (r,t'') = cont i t'+                 Nothing -> (Nothing,t')+      where (mi,t') = split j t+++-- (C) compose splits in parallel (is a kind of generalized zip)+--+-- splitPar :: (a -> b -> (c,d)) -> (e -> f -> (g,h)) +--             -> (a,e) -> (b,f) -> ((c,g),(d,h))+splitPar :: Split t i r -> Split u j s -> Split (t,u) (i,j) (r,s)+splitPar split split' (i,j) (t,u) = ((r,s),(t',u'))+                                    where (r,t') = split i t+                                          (s,u') = split' j u++splitParM :: SplitM t i r -> Split u j s -> SplitM (t,u) (i,j) (r,s)+splitParM splitm split (i,j) (t,u) =+          case mr of Just r  -> (Just (r,s),(t',u'))+                     Nothing -> (Nothing,(t',u))   -- ignore 2nd split +          where (mr,t') = splitm i t+                (s,u')  = split j u+++-- (D) merge a thread with/into a computation+--+{- +   Example: assign consecutive numbers to the nodes of a tree+ +   Input: type d, thread (t,split), fold operation on d+-}
+ Data/Graph/Inductive/Monad.hs view
@@ -0,0 +1,227 @@+-- (c) 2002 by Martin Erwig [see file COPYRIGHT]+-- | Monadic Graphs+module Data.Graph.Inductive.Monad(+    -- * Classes+    GraphM(..), +    -- * Operations+    -- ** Graph Folds and Maps+    ufoldM,+    -- ** Graph Projection+    nodesM,edgesM,newNodesM,+    -- ** Graph Construction and Destruction+    delNodeM,delNodesM,+    mkUGraphM,+    -- ** Graph Inspection+    contextM,labM+) where+++import Data.Graph.Inductive.Graph+++----------------------------------------------------------------------+-- MONADIC GRAPH CLASS+----------------------------------------------------------------------++-- +-- Currently, we define just one monadic graph class:+--+--   GraphM:    static, decomposable graphs+--              static means that a graph itself cannot be changed+--             +-- Later we might also define DynGraphM for dynamic, extensible graphs+-- ++++-- Monadic Graph+-- +class Monad m => GraphM m gr where+  -- essential operations+  emptyM     :: m (gr a b)+  isEmptyM   :: m (gr a b) -> m Bool+  matchM     :: Node -> m (gr a b) -> m (Decomp gr a b)+  mkGraphM   :: [LNode a] -> [LEdge b] -> m (gr a b)+  labNodesM  :: m (gr a b) -> m [LNode a]+  -- derived operations+  matchAnyM  :: m (gr a b) -> m (GDecomp gr a b)+  noNodesM   :: m (gr a b) -> m Int+  nodeRangeM :: m (gr a b) -> m (Node,Node)+  labEdgesM  :: m (gr a b) -> m [LEdge b]+  -- default implementation of derived operations+  matchAnyM g = do vs <- labNodesM g +                   case vs of+                     []      -> error "Match Exception, Empty Graph"+                     (v,_):_ -> do (Just c,g') <- matchM v g+                                   return (c,g')  +  noNodesM = labNodesM >>. length+  nodeRangeM g = do vs <- labNodesM g+                    let vs' = map fst vs +                    return (minimum vs',maximum vs') +  labEdgesM = ufoldM (\(p,v,_,s)->(((map (i v) p)++(map (o v) s))++)) []+              where o v = \(l,w)->(v,w,l)+                    i v = \(l,w)->(w,v,l)+++-- composing a monadic function with a non-monadic one+--+(>>.) :: Monad m => (m a -> m b) -> (b -> c) -> (m a -> m c)+f >>. g = (>>= return . g) . f +++----------------------------------------------------------------------+-- DERIVED GRAPH OPERATIONS+----------------------------------------------------------------------++-- graph folds and maps+-- ++-- | graph fold+ufoldM :: GraphM m gr => ((Context a b) -> c -> c) -> c -> m (gr a b) -> m c+ufoldM f u g = do b <- isEmptyM g+                  if b then return u+                       else do (c,g') <- matchAnyM g+                               x <- ufoldM f u (return g')+                               return (f c x)+++-- (additional) graph projection+-- [noNodes, nodeRange, labNodes, labEdges are defined in class Graph]+-- +nodesM :: GraphM m gr => m (gr a b) -> m [Node]+nodesM = labNodesM >>. map fst++edgesM :: GraphM m gr => m (gr a b) -> m [Edge]+edgesM =  labEdgesM >>. map (\(v,w,_)->(v,w))++newNodesM :: GraphM m gr => Int -> m (gr a b) -> m [Node]+newNodesM i g = do (_,n) <- nodeRangeM g+                   return [n+1..n+i]+++-- graph construction & destruction+-- +delNodeM :: GraphM m gr => Node -> m (gr a b) -> m (gr a b)+delNodeM v = delNodesM [v]++delNodesM :: GraphM m gr => [Node] -> m (gr a b) -> m (gr a b)+delNodesM []     g = g+delNodesM (v:vs) g = do (_,g') <- matchM v g +                        delNodesM vs (return g')  ++mkUGraphM :: GraphM m gr => [Node] -> [Edge] -> m (gr () ())+mkUGraphM vs es = mkGraphM (labUNodes vs) (labUEdges es) ++labUEdges = map (\(v,w)->(v,w,()))+labUNodes = map (\v->(v,()))+++-- graph inspection (for a particular node)+-- +onMatch :: GraphM m gr => (Context a b -> c) -> c -> m (gr a b) -> Node -> m c+onMatch f u g v = do (x,_) <- matchM v g+                     return (case x of {Nothing -> u; Just c -> f c})++contextM :: GraphM m gr => m (gr a b) -> Node -> m (Context a b)+contextM g v = onMatch id (error ("Match Exception, Node: "++show v)) g v++labM :: GraphM m gr => m (gr a b) -> Node -> m (Maybe a)+labM = onMatch (Just . lab') Nothing++{-+neighbors :: GraphM m gr => m (gr a b) -> Node -> [Node] +neighbors = (\(p,_,_,s) -> map snd (p++s)) .: context++suc :: GraphM m gr => m (gr a b) -> Node -> [Node]+suc = map snd .: context4++pre :: GraphM m gr => m (gr a b) -> Node -> [Node] +pre = map snd .: context1++lsuc :: GraphM m gr => m (gr a b) -> Node -> [(Node,b)]+lsuc = map flip2 .: context4++lpre :: GraphM m gr => m (gr a b) -> Node -> [(Node,b)] +lpre = map flip2 .: context1++out :: GraphM m gr => m (gr a b) -> Node -> [LEdge b] +out g v = map (\(l,w)->(v,w,l)) (context4 g v)++inn :: GraphM m gr => m (gr a b) -> Node -> [LEdge b] +inn g v = map (\(l,w)->(w,v,l)) (context1 g v)++outdeg :: GraphM m gr => m (gr a b) -> Node -> Int+outdeg = length .: context4++indeg :: GraphM m gr => m (gr a b) -> Node -> Int+indeg  = length .: context1++deg :: GraphM m gr => m (gr a b) -> Node -> Int+deg = (\(p,_,_,s) -> length p+length s) .: context+-- ++-- -- context inspection+-- -- +-- node' :: Context a b -> Node+-- node' (_,v,_,_) = v+-- +-- lab' :: Context a b -> a+-- lab' (_,_,l,_) = l+-- +-- labNode' :: Context a b -> LNode a+-- labNode' (_,v,l,_) = (v,l)+-- +-- neighbors' :: Context a b -> [Node] +-- neighbors' (p,_,_,s) = map snd p++map snd s+-- +-- suc' :: Context a b -> [Node]+-- suc' (_,_,_,s) = map snd s+-- +-- pre' :: Context a b -> [Node] +-- pre' (p,_,_,_) = map snd p+-- +-- lpre' :: Context a b -> [(Node,b)] +-- lpre' (p,_,_,_) = map flip2 p+-- +-- lsuc' :: Context a b -> [(Node,b)]+-- lsuc' (_,_,_,s) = map flip2 s+-- +-- out' :: Context a b -> [LEdge b] +-- out' (_,v,_,s) = map (\(l,w)->(v,w,l)) s+-- +-- inn' :: Context a b -> [LEdge b] +-- inn' (p,v,_,_) = map (\(l,w)->(w,v,l)) p+-- +-- outdeg' :: Context a b -> Int+-- outdeg' (_,_,_,s) = length s+-- +-- indeg' :: Context a b -> Int+-- indeg' (p,_,_,_) = length p+-- +-- deg' :: Context a b -> Int+-- deg' (p,_,_,s) = length p+length s+++-- graph equality+--+nodeComp :: Eq b => LNode b -> LNode b -> Ordering+nodeComp n@(v,a) n'@(w,b) | n == n'   = EQ+                          | v<w       = LT+                          | otherwise = GT++slabNodes :: (Eq a,Graph gr) => m (gr a b) -> [LNode a]+slabNodes = sortBy nodeComp . labNodes++edgeComp :: Eq b => LEdge b -> LEdge b -> Ordering+edgeComp e@(v,w,a) e'@(x,y,b) | e == e'              = EQ+                              | v<x || (v==x && w<y) = LT+                              | otherwise            = GT++slabEdges :: (Eq b,Graph gr) => m (gr a b) -> [LEdge b]+slabEdges = sortBy edgeComp . labEdges++instance (Eq a,Eq b,Graph gr) => Eq (m (gr a b)) where+  g == g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g'+++-}
+ Data/Graph/Inductive/Monad/IOArray.hs view
@@ -0,0 +1,112 @@+-- (c) 2002 by Martin Erwig [see file COPYRIGHT]+-- | Static IOArray-based Graphs  +module Data.Graph.Inductive.Monad.IOArray(+    -- * Graph Representation+    SGr(..), GraphRep, Context', USGr,+    defaultGraphSize, emptyN,+    -- * Utilities+    removeDel,+) where++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Monad++import Control.Monad+import Data.Array+import Data.Array.IO+import System.IO.Unsafe+import Data.Maybe+++----------------------------------------------------------------------+-- GRAPH REPRESENTATION+----------------------------------------------------------------------++data SGr a b = SGr (GraphRep a b)++type GraphRep a b = (Int,Array Node (Context' a b),IOArray Node Bool)+type Context' a b = Maybe (Adj b,a,Adj b)++type USGr = SGr () ()+++----------------------------------------------------------------------+-- CLASS INSTANCES+----------------------------------------------------------------------++-- Show+--+showGraph :: (Show a,Show b) => GraphRep a b -> String+showGraph (_,a,m) = concatMap showAdj (indices a)+    where showAdj v | unsafePerformIO (readArray m v) = ""+                    | otherwise = case a!v of+                        Nothing      -> ""+                        Just (_,l,s) -> '\n':show v++":"++show l++"->"++show s'+                          where s' = unsafePerformIO (removeDel m s)+               +instance (Show a,Show b) => Show (SGr a b) where+  show (SGr g) = showGraph g++instance (Show a,Show b) => Show (IO (SGr a b)) where+  show g = unsafePerformIO (do {(SGr g') <- g; return (showGraph g')})++{-+run :: Show (IO a) => IO a -> IO ()+run x = seq x (print x)+-}++-- GraphM+-- +instance GraphM IO SGr where+  emptyM = emptyN defaultGraphSize+  isEmptyM g = do {SGr (n,_,_) <- g; return (n==0)}+  matchM v g = do g'@(SGr (n,a,m)) <- g+                  case a!v of +                    Nothing -> return (Nothing,g')+                    Just (pr,l,su) -> +                       do b <- readArray m v+                          if b then return (Nothing,g') else+                             do s  <- removeDel m su+                                p' <- removeDel m pr+                                let p = filter ((/=v).snd) p'+                                writeArray m v True+                                return (Just (p,v,l,s),SGr (n-1,a,m))+  mkGraphM vs es = do m <- newArray (1,n) False+                      return (SGr (n,pr,m))+          where nod  = array bnds (map (\(v,l)->(v,Just ([],l,[]))) vs)+                su   = accum addSuc nod (map (\(v,w,l)->(v,(l,w))) es)+                pr   = accum addPre su (map (\(v,w,l)->(w,(l,v))) es)+                bnds = (minimum vs',maximum vs')+                vs'  = map fst vs+                n    = length vs+                addSuc (Just (p,l',s)) (l,w) = Just (p,l',(l,w):s)+		addSuc Nothing _ = error "mkGraphM (SGr): addSuc Nothing"+                addPre (Just (p,l',s)) (l,w) = Just ((l,w):p,l',s)+		addPre Nothing _ = error "mkGraphM (SGr): addPre Nothing"+  labNodesM g = do (SGr (_,a,m)) <- g+                   let getLNode vs (_,Nothing)      = return vs+                       getLNode vs (v,Just (_,l,_)) = +                           do b <- readArray m v +                              return (if b then vs else (v,l):vs)+                   foldM getLNode [] (assocs a)+  +defaultGraphSize :: Int+defaultGraphSize = 100++emptyN :: Int -> IO (SGr a b) +emptyN n = do m <- newArray (1,n) False+              return (SGr (0,array (1,n) [(i,Nothing) | i <- [1..n]],m))++----------------------------------------------------------------------+-- UTILITIES+----------------------------------------------------------------------++++-- | filter list (of successors\/predecessors) through a boolean ST array+-- representing deleted marks+removeDel :: IOArray Node Bool -> Adj b -> IO (Adj b)+removeDel m = filterM (\(_,v)->do {b<-readArray m v;return (not b)})+++
+ Data/Graph/Inductive/NodeMap.hs view
@@ -0,0 +1,248 @@+-- | Utility methods to automatically generate and keep track of a mapping+-- between node labels and 'Node's.+module Data.Graph.Inductive.NodeMap(+    -- * Functional Construction+    NodeMap,+    -- ** Map Construction+    new, fromGraph, mkNode, mkNode_, mkNodes, mkNodes_, mkEdge, mkEdges,+    -- ** Graph Construction+    -- | These functions mirror the construction and destruction functions in+    -- 'Data.Graph.Inductive.Graph', but use the given 'NodeMap' to look up+    -- the appropriate 'Node's.  Note that the 'insMapNode' family of functions+    -- will create new nodes as needed, but the other functions will not.+    insMapNode, insMapNode_, insMapEdge, delMapNode, delMapEdge, insMapNodes,+    insMapNodes_, insMapEdges, delMapNodes, delMapEdges, mkMapGraph,+    -- * Monadic Construction+    NodeMapM,+    -- | The following mirror the functional construction functions, but handle passing+    -- 'NodeMap's and 'Graph's behind the scenes.++    -- ** Map Construction+    run, run_, mkNodeM, mkNodesM, mkEdgeM, mkEdgesM,+    -- ** Graph Construction+    insMapNodeM, insMapEdgeM, delMapNodeM, delMapEdgeM, insMapNodesM,+    insMapEdgesM, delMapNodesM, delMapEdgesM+) where++import Prelude hiding (map)+import qualified Prelude as P (map)+import Control.Monad.State+import Data.Graph.Inductive.Graph+--import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.Internal.FiniteMap++data (Ord a) => NodeMap a =+    NodeMap { map :: FiniteMap a Node,+	      key :: Int }+    deriving Show++-- | Create a new, empty mapping.+new :: (Ord a) => NodeMap a+new = NodeMap { map = emptyFM, key = 0 }++-- LNode = (Node, a)++-- | Generate a mapping containing the nodes in the given graph.+fromGraph :: (Ord a, Graph g) => g a b -> NodeMap a+fromGraph g =+    let ns = labNodes g+	aux (n, a) (m', k') = (addToFM m' a n, max n k')+	(m, k) = foldr aux (emptyFM, 0) ns+    in NodeMap { map = m, key = k+1 }++-- | Generate a labelled node from the given label.  Will return the same node+-- for the same label.+mkNode :: (Ord a) => NodeMap a -> a -> (LNode a, NodeMap a)+mkNode m@(NodeMap mp k) a =+    case lookupFM mp a of+	Just i	-> ((i, a), m)+	Nothing	->+	    let m' = NodeMap { map = addToFM mp a k, key = k+1 }+	    in ((k, a), m')++-- | Generate a labelled node and throw away the modified 'NodeMap'.+mkNode_ :: (Ord a) => NodeMap a -> a -> LNode a+mkNode_ m a = fst $ mkNode m a++-- | Generate a 'LEdge' from the node labels.+mkEdge :: (Ord a) => NodeMap a -> (a, a, b) -> Maybe (LEdge b)+mkEdge (NodeMap m _) (a1, a2, b) =+    do n1 <- lookupFM m a1+       n2 <- lookupFM m a2+       return (n1, n2, b)++-- | Generates a list of 'LEdge's.+mkEdges :: (Ord a) => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]+mkEdges m es = mapM (mkEdge m) es++-- | Construct a list of nodes.+mkNodes :: (Ord a) => NodeMap a -> [a] -> ([LNode a], NodeMap a)+mkNodes = map' mkNode++map' :: (a -> b -> (c, a)) -> a -> [b] -> ([c], a)+map' _ a [] = ([], a)+map' f a (b:bs) =+    let (c, a') = f a b+	(cs, a'') = map' f a' bs+    in (c:cs, a'')++-- | Construct a list of nodes and throw away the modified 'NodeMap'.+mkNodes_ :: (Ord a) => NodeMap a -> [a] -> [LNode a]+mkNodes_ m as = fst $ mkNodes m as++insMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> (g a b, NodeMap a, LNode a)+insMapNode m a g =+    let (n, m') = mkNode m a+    in (insNode n g, m', n)++insMapNode_ :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b+insMapNode_ m a g =+    let (g', _, _) = insMapNode m a g+    in g'++insMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a, b) -> g a b -> g a b+insMapEdge m e g =+    let (Just e') = mkEdge m e+    in insEdge e' g++delMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b+delMapNode m a g =+    let (n, _) = mkNode_ m a+    in delNode n g++delMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a) -> g a b -> g a b+delMapEdge m (n1, n2) g =+    let Just (n1', n2', _) = mkEdge m (n1, n2, ())+    in delEdge (n1', n2') g++insMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a])+insMapNodes m as g =+    let (ns, m') = mkNodes m as+    in (insNodes ns g, m', ns)++insMapNodes_ :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b+insMapNodes_ m as g =+    let (g', _, _) = insMapNodes m as g+    in g'++insMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a, b)] -> g a b -> g a b+insMapEdges m es g =+    let Just es' = mkEdges m es+    in insEdges es' g++delMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b+delMapNodes m as g =+    let ns = P.map fst $ mkNodes_ m as+    in delNodes ns g++delMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a)] -> g a b -> g a b+delMapEdges m ns g =+    let Just ns' =  mkEdges m $ P.map (\(a, b) -> (a, b, ())) ns+	ns'' = P.map (\(a, b, _) -> (a, b)) ns'+    in delEdges ns'' g++mkMapGraph :: (Ord a, DynGraph g) => [a] -> [(a, a, b)] -> (g a b, NodeMap a)+mkMapGraph ns es =+    let (ns', m') = mkNodes new ns+	Just es' = mkEdges m' es+    in (mkGraph ns' es', m')++-- | Graph construction monad; handles passing both the 'NodeMap' and the+-- 'Graph'.+type NodeMapM a b g r = State (NodeMap a, g a b) r++-- | Run a construction; return the value of the computation, the modified+-- 'NodeMap', and the modified 'Graph'.+run :: (DynGraph g, Ord a) => g a b -> NodeMapM a b g r -> (r, (NodeMap a, g a b))+run g m = runState m (fromGraph g, g)++-- | Run a construction and only return the 'Graph'.+run_ :: (DynGraph g, Ord a) => g a b -> NodeMapM a b g r -> g a b+run_ g m = snd . snd $ run g m++{- not used+liftN1 :: (Ord a, DynGraph g) => (NodeMap a -> (c, NodeMap a)) -> NodeMapM a b g c+liftN1 f =+    do (m, g) <- get+       let (r, m') = f m+       put (m', g)+       return r++liftN1' :: (Ord a, DynGraph g) => (NodeMap a -> c) -> NodeMapM a b g c+liftN1' f =+    do (m, g) <- get+       return $ f m+-}+liftN2 :: (Ord a, DynGraph g) => (NodeMap a -> c -> (d, NodeMap a)) -> c -> NodeMapM a b g d+liftN2 f c =+    do (m, g) <- get+       let (r, m') = f m c+       put (m', g)+       return r++liftN2' :: (Ord a, DynGraph g) => (NodeMap a -> c -> d) -> c -> NodeMapM a b g d+liftN2' f c =+    do (m, _) <- get+       return $ f m c+{- not used+liftN3 :: (Ord a, DynGraph g) => (NodeMap a -> c -> d -> (e, NodeMap a)) -> c -> d -> NodeMapM a b g e+liftN3 f c d =+    do (m, g) <- get+       let (r, m') = f m c d+       put (m', g)+       return r++liftN3' :: (Ord a, DynGraph g) => (NodeMap a -> c -> d -> e) -> c -> d -> NodeMapM a b g e+liftN3' f c d =+    do (m, g) <- get+       return $ f m c d+-}+liftM1 :: (Ord a, DynGraph g) => (NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()+liftM1 f c =+    do (m, g) <- get+       let g' = f m c g+       put (m, g')++liftM1' :: (Ord a, DynGraph g) => (NodeMap a -> c -> g a b -> (g a b, NodeMap a, d)) -> c -> NodeMapM a b g d+liftM1' f c =+    do (m, g) <- get+       let (g', m', r) = f m c g+       put (m', g')+       return r++-- | Monadic node construction.+mkNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a)+mkNodeM = liftN2 mkNode++mkNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g [LNode a]+mkNodesM = liftN2 mkNodes++mkEdgeM :: (Ord a, DynGraph g) => (a, a, b) -> NodeMapM a b g (Maybe (LEdge b))+mkEdgeM = liftN2' mkEdge++mkEdgesM :: (Ord a, DynGraph g) => [(a, a, b)] -> NodeMapM a b g (Maybe [LEdge b])+mkEdgesM = liftN2' mkEdges++insMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a)+insMapNodeM = liftM1' insMapNode++insMapEdgeM :: (Ord a, DynGraph g) => (a, a, b) -> NodeMapM a b g ()+insMapEdgeM = liftM1 insMapEdge++delMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g ()+delMapNodeM = liftM1 delMapNode++delMapEdgeM :: (Ord a, DynGraph g) => (a, a) -> NodeMapM a b g ()+delMapEdgeM = liftM1 delMapEdge++insMapNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g [LNode a]+insMapNodesM = liftM1' insMapNodes++insMapEdgesM :: (Ord a, DynGraph g) => [(a, a, b)] -> NodeMapM a b g ()+insMapEdgesM = liftM1 insMapEdges++delMapNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g ()+delMapNodesM = liftM1 delMapNodes++delMapEdgesM :: (Ord a, DynGraph g) => [(a, a)] -> NodeMapM a b g ()+delMapEdgesM = liftM1 delMapEdges
+ Data/Graph/Inductive/Query.hs view
@@ -0,0 +1,29 @@+module Data.Graph.Inductive.Query(+    module Data.Graph.Inductive.Query.DFS,+    module Data.Graph.Inductive.Query.BFS,+    module Data.Graph.Inductive.Query.SP,+    module Data.Graph.Inductive.Query.GVD,+    module Data.Graph.Inductive.Query.MST,+    module Data.Graph.Inductive.Query.Indep,+    module Data.Graph.Inductive.Query.MaxFlow,+    module Data.Graph.Inductive.Query.MaxFlow2,+    module Data.Graph.Inductive.Query.ArtPoint,+    module Data.Graph.Inductive.Query.BCC,+    module Data.Graph.Inductive.Query.Dominators,+    module Data.Graph.Inductive.Query.TransClos,+    module Data.Graph.Inductive.Query.Monad,+) where++import Data.Graph.Inductive.Query.DFS+import Data.Graph.Inductive.Query.BFS+import Data.Graph.Inductive.Query.SP+import Data.Graph.Inductive.Query.GVD+import Data.Graph.Inductive.Query.MST+import Data.Graph.Inductive.Query.Indep+import Data.Graph.Inductive.Query.MaxFlow+import Data.Graph.Inductive.Query.MaxFlow2+import Data.Graph.Inductive.Query.ArtPoint+import Data.Graph.Inductive.Query.BCC+import Data.Graph.Inductive.Query.Dominators+import Data.Graph.Inductive.Query.TransClos+import Data.Graph.Inductive.Query.Monad
+ Data/Graph/Inductive/Query/ArtPoint.hs view
@@ -0,0 +1,122 @@+module Data.Graph.Inductive.Query.ArtPoint(+    ap+) where++import Data.Graph.Inductive.Graph+++------------------------------------------------------------------------------+-- Tree for storing the DFS numbers and back edges for each node in the graph.+-- Each node in this tree is of the form (v,n,b) where v is the vertex number,+-- n is its DFS number and b is the list of nodes (and their DFS numbers) that+-- lead to back back edges for that vertex v.+------------------------------------------------------------------------------+data DFSTree a = B (a,a,[(a,a)]) [DFSTree a]+     deriving (Eq)++------------------------------------------------------------------------------+-- Tree for storing the DFS and low numbers for each node in the graph.+-- Each node in this tree is of the form (v,n,l) where v is the vertex number,+-- n is its DFS number and l is its low number.+------------------------------------------------------------------------------+data LOWTree a = Brc (a,a,a) [LOWTree a]+     deriving (Eq)++------------------------------------------------------------------------------+-- Finds the back edges for a given node.+------------------------------------------------------------------------------+getBackEdges :: Node -> [[(Node,Int)]] -> [(Node,Int)]+getBackEdges _ [] = []+getBackEdges v ls   = map head (filter (elem (v,0)) (tail ls))++------------------------------------------------------------------------------+-- Builds a DFS tree for a given graph. Each element (v,n,b) in the tree+-- contains: the node number v, the DFS number n, and a list of backedges b.+------------------------------------------------------------------------------+dfsTree :: Graph gr => Int -> Node -> [Node] -> [[(Node,Int)]] -> +                       gr a b -> ([DFSTree Int],gr a b,Int)+dfsTree n _ []      _ g             = ([],g,n)+dfsTree n _ _       _ g | isEmpty g = ([],g,n)+dfsTree n u (v:vs) ls g = case match v g of+                            (Nothing, g1) -> dfsTree n u vs ls g1+                            (Just c , g1) -> (B (v,n+1,bck) ts:ts', g3, k)+                             where  bck        = getBackEdges v ls+                                    (ts, g2,m) = dfsTree (n+1) v sc ls' g1+                                    (ts',g3,k) = dfsTree m v vs ls g2+                                    ls'        = ((v,n+1):sc'):ls+                                    sc'        = map (\x->(x,0)) sc+                                    sc         = suc' c++------------------------------------------------------------------------------+-- Finds the minimum between a dfs number and a list of back edges' dfs+-- numbers.+------------------------------------------------------------------------------+minbckEdge :: Int -> [(Node,Int)] -> Int+minbckEdge n [] = n+minbckEdge n bs = min n (minimum (map snd bs))++------------------------------------------------------------------------------+-- Returns the low number for a node in a subtree.+------------------------------------------------------------------------------+getLow :: LOWTree Int -> Int+getLow (Brc (_,_,l) _) = l++------------------------------------------------------------------------------+-- Builds a low tree from a DFS tree. Each element (v,n,low) in the tree+-- contains: the node number v, the DFS number n, and the low number low.+------------------------------------------------------------------------------+lowTree :: DFSTree Int -> LOWTree Int+lowTree (B (v,n,[]  ) [] ) = Brc (v,n,n) [] +lowTree (B (v,n,bcks) [] ) = Brc (v,n,minbckEdge n bcks) [] +lowTree (B (v,n,bcks) trs) = Brc (v,n,lowv) ts+                             where lowv     = min (minbckEdge n bcks) lowChild+                                   lowChild = minimum (map getLow ts)+                                   ts       = map lowTree trs++------------------------------------------------------------------------------+-- Builds a low tree for a given graph. Each element (v,n,low) in the tree+-- contains: the node number v, the DFS number n, and the low number low.+------------------------------------------------------------------------------+getLowTree :: Graph gr => gr a b -> Node -> LOWTree Int+getLowTree g v = lowTree (head dfsf)+                  where (dfsf, _, _) = dfsTree 0 0 [v] [] g++------------------------------------------------------------------------------+-- Tests if a node in a subtree is an articulation point. An non-root node v+-- is an articulation point iff there exists at least one child w of v such+-- that lowNumber(w) >= dfsNumber(v). The root node is an articulation point+-- iff it has two or more children.+------------------------------------------------------------------------------+isap :: LOWTree Int -> Bool+isap (Brc (_,_,_) []) = False+isap (Brc (_,1,_) ts) = length ts > 1+isap (Brc (_,n,_) ts) = length ch >= 1+                        where ch = filter ( >=n) (map getLow ts)++------------------------------------------------------------------------------+-- Finds the articulation points by traversing the low tree.+------------------------------------------------------------------------------+arp :: LOWTree Int -> [Node]+arp (Brc (v,1,_) ts) | length ts > 1         = v:concatMap arp ts+                     | otherwise             =   concatMap arp ts+arp (Brc (v,n,l) ts) | isap (Brc (v,n,l) ts) = v:concatMap arp ts+                     | otherwise             =   concatMap arp ts++------------------------------------------------------------------------------+-- Finds the articulation points of a graph starting at a given node.+------------------------------------------------------------------------------+artpoints :: Graph gr => gr a b -> Node -> [Node]+artpoints g v = arp (getLowTree g v)++{-|+   Finds the articulation points for a connected undirected graph,+   by using the low numbers criteria:++   a) The root node is an articulation point iff it has two or more children.++   b) An non-root node v is an articulation point iff there exists at least+      one child w of v such that lowNumber(w) >= dfsNumber(v).+-}+ap :: Graph gr => gr a b -> [Node]+ap g = artpoints g v where ((_,v,_,_),_) = matchAny g+
+ Data/Graph/Inductive/Query/BCC.hs view
@@ -0,0 +1,75 @@+module Data.Graph.Inductive.Query.BCC(+    bcc+) where+++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Query.DFS+import Data.Graph.Inductive.Query.ArtPoint+++------------------------------------------------------------------------------+-- Given a graph g, this function computes the subgraphs which are+-- g's connected components.+------------------------------------------------------------------------------+gComponents :: DynGraph gr => gr a b -> [gr a b]+gComponents g = map (\(x,y)-> mkGraph x y) (zip ln le)+            where ln         = map (\x->[(u,l)|(u,l)<-vs,elem u x]) cc+                  le         = map (\x->[(u,v,l)|(u,v,l)<-es,elem u x]) cc+                  (vs,es,cc) = (labNodes g,labEdges g,components g)+++embedContexts :: DynGraph gr => Context a b -> [gr a b] -> [gr a b]+embedContexts (_,v,l,s) gs = map (\(x,y)-> x & y) (zip lc gs)+                  where lc = map (\e->(e,v,l,e)) lc'+                        lc'= map (\g->[ e | e <- s, gelem (snd e) g]) gs++------------------------------------------------------------------------------+-- Given a node v and a list of graphs, this functions returns the graph which+-- v belongs to.+------------------------------------------------------------------------------+findGraph :: DynGraph gr => Node -> [gr a b] -> Decomp gr a b+findGraph _ [] = error "findGraph: empty graph list"+findGraph v (g:gs) = case match v g of+                          (Nothing,  _) -> findGraph v gs+                          (Just c,  g') -> (Just c, g')++------------------------------------------------------------------------------+-- Given a graph g and its articulation points, this function disconnects g+-- for each articulation point and returns the connected components of the+-- resulting disconnected graph.+------------------------------------------------------------------------------+splitGraphs :: DynGraph gr => [gr a b] -> [Node] -> [gr a b]+splitGraphs gs     []     = gs+splitGraphs []	   _	  = error "splitGraphs: empty graph list"+splitGraphs (g:gs) (v:vs) = splitGraphs (gs''++gs) vs +                            where gs''        = embedContexts c gs'+                                  gs'         = gComponents g'+                                  (Just c,g') = findGraph v (g:gs)++{-|+Finds the bi-connected components of an undirected connected graph.+It first finds the articulation points of the graph. Then it disconnects the+graph on each articulation point and computes the connected components.+-}+bcc :: DynGraph gr => gr a b -> [gr a b]+bcc g = splitGraphs [g] (ap g)+++++++++                                                ++++++++++
+ Data/Graph/Inductive/Query/BFS.hs view
@@ -0,0 +1,131 @@+-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]+-- | Breadth-First Search Algorithms++module Data.Graph.Inductive.Query.BFS(+    -- * BFS Node List+    bfs,bfsn,bfsWith,bfsnWith,+    -- * Node List With Depth Info+    level,leveln,+    -- * BFS Edges+    bfe,bfen,+    -- * BFS Tree+    bft,lbft,+    -- * Shortest Path (Number of Edges)+    esp,lesp+) where+++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Internal.Queue+import Data.Graph.Inductive.Internal.RootPath++-- bfs (node list ordered by distance)+--+bfsnInternal :: Graph gr => (Context a b -> c) -> Queue Node -> gr a b -> [c]+bfsnInternal f q g | queueEmpty q || isEmpty g = []+                   | otherwise                 =+       case match v g of+        (Just c, g')  -> f c:bfsnInternal f (queuePutList (suc' c) q') g'+        (Nothing, g') -> bfsnInternal f q' g'+        where (v,q') = queueGet q++bfsnWith :: Graph gr => (Context a b -> c) -> [Node] -> gr a b -> [c]+bfsnWith f vs = bfsnInternal f (queuePutList vs mkQueue)++bfsn :: Graph gr => [Node] -> gr a b -> [Node]+bfsn = bfsnWith node'++bfsWith :: Graph gr => (Context a b -> c) -> Node -> gr a b -> [c]+bfsWith f v = bfsnInternal f (queuePut v mkQueue)++bfs :: Graph gr => Node -> gr a b -> [Node]+bfs = bfsWith node'+++-- level (extension of bfs giving the depth of each node)+--+level :: Graph gr => Node -> gr a b -> [(Node,Int)]+level v = leveln [(v,0)]++suci c i = zip (suc' c) (repeat i)++leveln :: Graph gr => [(Node,Int)] -> gr a b -> [(Node,Int)]+leveln []         _             = []+leveln _          g | isEmpty g = []+leveln ((v,j):vs) g = case match v g of+                        (Just c,g')  -> (v,j):leveln (vs++suci c (j+1)) g'+                        (Nothing,g') -> leveln vs g'  +++-- bfe (breadth first edges)+-- remembers predecessor information+--+bfenInternal :: Graph gr => Queue Edge -> gr a b -> [Edge]+bfenInternal q g | queueEmpty q || isEmpty g = []+                 | otherwise                 = +      case match v g of+        (Just c, g')  -> (u,v):bfenInternal (queuePutList (outU c) q') g'+        (Nothing, g') -> bfenInternal q' g'+        where ((u,v),q') = queueGet q++bfen :: Graph gr => [Edge] -> gr a b -> [Edge]+bfen vs g = bfenInternal (queuePutList vs mkQueue) g++bfe :: Graph gr => Node -> gr a b -> [Edge]+bfe v = bfen [(v,v)]++outU c = map (\(v,w,_)->(v,w)) (out' c)+++-- bft (breadth first search tree)+-- here: with inward directed trees+--+-- bft :: Node -> gr a b -> IT.InTree Node+-- bft v g = IT.build $ map swap $ bfe v g+--           where swap (x,y) = (y,x)+-- +-- sp (shortest path wrt to number of edges)+--+-- sp :: Node -> Node -> gr a b -> [Node]+-- sp s t g = reverse $ IT.rootPath (bft s g) t+++-- faster shortest paths +-- here: with root path trees+-- +bft :: Graph gr => Node -> gr a b -> RTree+bft v = bf (queuePut [v] mkQueue)++bf :: Graph gr => Queue Path -> gr a b -> RTree+bf q g | queueEmpty q || isEmpty g = []+       | otherwise                 =+       case match v g of+         (Just c, g')  -> p:bf (queuePutList (map (:p) (suc' c)) q') g'+         (Nothing, g') -> bf q' g'+         where (p@(v:_),q') = queueGet q++esp :: Graph gr => Node -> Node -> gr a b -> Path+esp s t = getPath t . bft s+++-- lesp is a version of esp that returns labeled paths+-- Note that the label of the first node in a returned path is meaningless;+-- all other nodes are paired with the label of their incoming edge. +--+lbft :: Graph gr => Node -> gr a b -> LRTree b+lbft v g = case (out g v) of +             []         -> [LP []]+             (v',_,l):_ -> lbf (queuePut (LP [(v',l)]) mkQueue) g++lbf :: Graph gr => Queue (LPath b) -> gr a b -> LRTree b+lbf q g | queueEmpty q || isEmpty g = []+        | otherwise                 =+       case match v g of+         (Just c, g') ->+             LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g'+         (Nothing, g') -> lbf q' g'+         where ((LP (p@((v,_):_))),q') = queueGet q++lesp :: Graph gr => Node -> Node -> gr a b -> LPath b+lesp s t = getLPath t . lbft s+
+ Data/Graph/Inductive/Query/DFS.hs view
@@ -0,0 +1,222 @@+-- (c) 2000 - 2005 by Martin Erwig [see file COPYRIGHT]+-- | Depth-First Search  ++module Data.Graph.Inductive.Query.DFS(+    CFun,+    dfs,dfs',dff,dff',+    dfsWith, dfsWith',dffWith,dffWith',+    -- * Undirected DFS+    udfs,udfs',udff,udff',+    -- * Reverse DFS+    rdff,rdff',rdfs,rdfs',+    -- * Applications of DFS\/DFF+    topsort,topsort',scc,reachable,+    -- * Applications of UDFS\/UDFF+    components,noComponents,isConnected+) where++import Data.Tree+import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Basic++----------------------------------------------------------------------+-- DFS AND FRIENDS+----------------------------------------------------------------------++{-++  Classification of all 32 dfs functions:++    dfs-function ::= [direction]"df"structure["With"]["'"]+    direction  -->  "x" | "u" | "r"+    structure  -->  "s" | "f"++              |   structure+   direction  |   "s"   "f"+   ------------------------   + optional With + optional '+      "x"     | xdfs  xdff   +      " "     |  dfs   dff+      "u"     | udfs  udff+      "r"     | rdfs  rdff+   ------------------------++  Direction Parameter+  -------------------+   x : parameterized by a function that specifies which nodes +       to be visited next++  " ": the "normal case: just follow successors+ +   u : undirected, ie, follow predecesors and successors+   +   r : reverse, ie, follow predecesors+++  Structure Parameter+  -------------------+   s : result is a list of +        (a) objects computed from visited contexts  ("With"-version)+        (b) nodes                                   (normal version)++   f : result is a tree/forest of +        (a) objects computed from visited contexts  ("With"-version)+        (b) nodes                                   (normal version)++  Optional Suffixes+  -----------------+   With : objects to be put into list/tree are given by a function+          on contexts, default for non-"With" versions: nodes++   '    : parameter node list is given implicitly by the nodes of the +          graph to be traversed, default for non-"'" versions: nodes+          must be provided explicitly+++  Defined are only the following 18 most important function versions:++    xdfsWith+     dfsWith,dfsWith',dfs,dfs'+     udfs,udfs'+     rdfs,rdfs'+    xdffWith+     dffWith,dffWith',dff,dff'+     udff,udff'+     rdff,rdff'+    +  Others can be added quite easily if needed.+  +-}++-- fixNodes fixes the nodes of the graph as a parameter+--+fixNodes :: Graph gr => ([Node] -> gr a b -> c) -> gr a b -> c+fixNodes f g = f (nodes g) g+++-- generalized depth-first search+--  (could also be simply defined as applying preorderF to the +--   result of xdffWith)+--   +type CFun a b c = Context a b -> c++xdfsWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]+xdfsWith _ _ []     _             = []+xdfsWith _ _ _      g | isEmpty g = []+xdfsWith d f (v:vs) g = case match v g of+                         (Just c,g')  -> f c:xdfsWith d f (d c++vs) g'+                         (Nothing,g') -> xdfsWith d f vs g'  +++-- dfs+--+dfsWith :: Graph gr => CFun a b c -> [Node] -> gr a b -> [c]+dfsWith = xdfsWith suc'++dfsWith' :: Graph gr => CFun a b c -> gr a b -> [c]+dfsWith' f = fixNodes (dfsWith f)++dfs :: Graph gr => [Node] -> gr a b -> [Node]+dfs = dfsWith node'++dfs' :: Graph gr => gr a b -> [Node]+dfs' = dfsWith' node'+++-- undirected dfs, ie, ignore edge directions+--+udfs :: Graph gr => [Node] -> gr a b -> [Node]+udfs = xdfsWith neighbors' node'  ++udfs' :: Graph gr => gr a b -> [Node]+udfs' = fixNodes udfs+++-- reverse dfs, ie, follow predecessors+--+rdfs :: Graph gr => [Node] -> gr a b -> [Node]+rdfs = xdfsWith pre' node'  ++rdfs' :: Graph gr => gr a b -> [Node]+rdfs' = fixNodes rdfs+++-- generalized depth-first forest+-- +xdfWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> ([Tree c],gr a b)+xdfWith _ _ []     g             = ([],g)+xdfWith _ _ _      g | isEmpty g = ([],g)+xdfWith d f (v:vs) g = case match v g of+                        (Nothing,g1) -> xdfWith d f vs g1 +                        (Just c,g1)  -> (Node (f c) ts:ts',g3) +                                 where (ts,g2)  = xdfWith d f (d c) g1+                                       (ts',g3) = xdfWith d f vs g2 ++xdffWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]+xdffWith d f vs g = fst (xdfWith d f vs g)+++-- dff+--+dffWith :: Graph gr => CFun a b c -> [Node] -> gr a b -> [Tree c]+dffWith = xdffWith suc'++dffWith' :: Graph gr => CFun a b c -> gr a b -> [Tree c]+dffWith' f = fixNodes (dffWith f)++dff :: Graph gr => [Node] -> gr a b -> [Tree Node]+dff = dffWith node'++dff' :: Graph gr => gr a b -> [Tree Node]+dff' = dffWith' node'+++-- undirected dff+--+udff :: Graph gr => [Node] -> gr a b -> [Tree Node]+udff = xdffWith neighbors' node'++udff' :: Graph gr => gr a b -> [Tree Node]+udff' = fixNodes udff+++-- reverse dff, ie, following predecessors+--+rdff :: Graph gr => [Node] -> gr a b -> [Tree Node]+rdff = xdffWith pre' node'++rdff' :: Graph gr => gr a b -> [Tree Node]+rdff' = fixNodes rdff+++----------------------------------------------------------------------+-- ALGORITHMS BASED ON DFS+----------------------------------------------------------------------++components :: Graph gr => gr a b -> [[Node]]+components = (map preorder) . udff'++noComponents :: Graph gr => gr a b -> Int+noComponents = length . components++isConnected :: Graph gr => gr a b -> Bool+isConnected = (==1) . noComponents++postflatten :: Tree a -> [a]+postflatten (Node v ts) = postflattenF ts ++ [v]++postflattenF :: [Tree a] -> [a]+postflattenF = concatMap postflatten++topsort :: Graph gr => gr a b -> [Node]+topsort = reverse . postflattenF . dff'++topsort' :: Graph gr => gr a b -> [a]+topsort' = reverse . postorderF . (dffWith' lab')++scc :: Graph gr => gr a b -> [[Node]]+scc g = map preorder (rdff (topsort g) g)            -- optimized, using rdff+-- sccOrig g = map preorder (dff (topsort g) (grev g))  -- original by Sharir++reachable :: Graph gr => Node -> gr a b -> [Node]+reachable v g = preorderF (dff [v] g)+
+ Data/Graph/Inductive/Query/Dominators.hs view
@@ -0,0 +1,40 @@+module Data.Graph.Inductive.Query.Dominators(+    dom+) where++import Data.List+import Data.Graph.Inductive.Graph+++type DomSets = [(Node,[Node],[Node])]+++intersection :: [[Node]] -> [Node]+intersection cs = foldr intersect (head cs) cs++getdomv :: [Node] -> DomSets -> [[Node]]+getdomv vs  ds = [z|(w,_,z)<-ds,v<-vs,v==w]++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++domr :: DomSets -> [Node] -> DomSets+domr ds vs|xs == ds  = ds+          |otherwise = builddoms xs vs+           where xs = (builddoms ds vs)++{-|+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++
+ Data/Graph/Inductive/Query/GVD.hs view
@@ -0,0 +1,51 @@+-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]+-- | Graph Voronoi Diagram ++module Data.Graph.Inductive.Query.GVD (+    Voronoi,+    gvdIn,gvdOut,+    voronoiSet,nearestNode,nearestDist,nearestPath,+--    vd,nn,ns,+--    vdO,nnO,nsO+) where++import Data.Maybe (listToMaybe)+import Data.List (nub)++import qualified Data.Graph.Inductive.Internal.Heap as H++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Query.SP (dijkstra)+import Data.Graph.Inductive.Internal.RootPath+import Data.Graph.Inductive.Basic++type Voronoi a = LRTree a++gvdIn :: (DynGraph gr, Real b) => [Node] -> gr a b -> Voronoi b+gvdIn vs g = gvdOut vs (grev g)++gvdOut :: (Graph gr, Real b) => [Node] -> gr a b -> Voronoi b+gvdOut vs = dijkstra (H.build (zip (repeat 0) (map (\v->LP [(v,0)]) vs)))++voronoiSet :: Real b => Node -> Voronoi b -> [Node]+voronoiSet v = nub . concat . filter (\p->last p==v) . map (\(LP p)->map fst p)++maybePath :: Real b => Node -> Voronoi b -> Maybe (LPath b)+maybePath v = listToMaybe . filter (\(LP ((w,_):_))->w==v)++nearestNode :: Real b => Node -> Voronoi b -> Maybe Node+nearestNode v = fmap (\(LP ((w,_):_))->w) . maybePath v++nearestDist :: Real b => Node -> Voronoi b -> Maybe b+nearestDist v = fmap (\(LP ((_,l):_))->l) . maybePath v++nearestPath :: Real b => Node -> Voronoi b -> Maybe Path+nearestPath v = fmap (\(LP p)->map fst p) . maybePath v+++-- vd = gvdIn [4,5] vor+-- vdO = gvdOut [4,5] vor+-- nn = map (flip nearestNode vd) [1..8]+-- nnO = map (flip nearestNode vdO) [1..8]+-- ns = map (flip voronoiSet vd) [1..8]+-- nsO = map (flip voronoiSet vdO) [1..8]
+ Data/Graph/Inductive/Query/Indep.hs view
@@ -0,0 +1,24 @@+-- (c) 2000 - 2002 by Martin Erwig [see file COPYRIGHT]+-- | Maximum Independent Node Sets++module Data.Graph.Inductive.Query.Indep (+    indep+) where+++import Data.Graph.Inductive.Graph+++first :: (a -> Bool) -> [a] -> a+first p = head . filter p++indep :: DynGraph gr => gr a b -> [Node]+indep g | isEmpty g = []+indep g = if length i1>length i2 then i1 else i2+          where vs          = nodes g +                m           = maximum (map (deg g) vs) +                v           = first (\v'->deg g v'==m) vs +                (Just c,g') = match v g +                i1          = indep g'+                i2          = v:indep (delNodes (neighbors' c) g')+
+ Data/Graph/Inductive/Query/MST.hs view
@@ -0,0 +1,41 @@+-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]+-- | Minimum-Spanning-Tree Algorithms ++module Data.Graph.Inductive.Query.MST (+    msTreeAt,msTree,+    -- * Path in MST+    msPath+) where++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Internal.RootPath+import qualified Data.Graph.Inductive.Internal.Heap as H+++newEdges :: Ord b => LPath b -> Context a b -> [H.Heap b (LPath b)]+newEdges (LP p) (_,_,_,s) = map (\(l,v)->H.unit l (LP ((v,l):p))) s++prim :: (Graph gr,Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b+prim h g | H.isEmpty h || isEmpty g = []+prim h g =+    case match v g of+         (Just c,g')  -> p:prim (H.mergeAll (h':newEdges p c)) g'+         (Nothing,g') -> prim h' g'  +    where (_,p@(LP ((v,_):_)),h') = H.splitMin h++msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b+msTreeAt v g = prim (H.unit 0 (LP [(v,0)])) g++msTree :: (Graph gr,Real b) => gr a b -> LRTree b+msTree g = msTreeAt v g where ((_,v,_,_),_) = matchAny g++msPath :: Real b => LRTree b -> Node -> Node -> Path+msPath t a b = joinPaths (getLPathNodes a t) (getLPathNodes b t)+            +joinPaths :: Path -> Path -> Path +joinPaths p q = joinAt (head p) p q++joinAt :: Node -> Path -> Path -> Path+joinAt _ (v:vs) (w:ws) | v==w = joinAt v vs ws+joinAt x p      q             = reverse p++(x:q)+
+ Data/Graph/Inductive/Query/MaxFlow.hs view
@@ -0,0 +1,127 @@+-- | Maximum Flow algorithm+-- We are given a flow network G=(V,E) with source s and sink t where each+-- edge (u,v) in E has a nonnegative capacity c(u,v)>=0, and we wish to+-- find a flow of maximum value from s to t.+-- +-- A flow in G=(V,E) is a real-valued function f:VxV->R that satisfies:+--+-- @+-- For all u,v in V, f(u,v)\<=c(u,v)+-- For all u,v in V, f(u,v)=-f(v,u)+-- For all u in V-{s,t}, Sum{f(u,v):v in V } = 0+-- @+--+-- The value of a flow f is defined as |f|=Sum {f(s,v)|v in V}, i.e.,+-- the total net flow out of the source.+--+-- In this module we implement the Edmonds-Karp algorithm, which is the+-- Ford-Fulkerson method but using the shortest path from s to t as the+-- augmenting path along which the flow is incremented.++module Data.Graph.Inductive.Query.MaxFlow(+    getRevEdges, augmentGraph, updAdjList, updateFlow, mfmg, mf, maxFlowgraph,+    maxFlow+) where+++import Data.List++import Data.Graph.Inductive.Basic+import Data.Graph.Inductive.Graph+--import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.Query.BFS++-- |+-- @+--                 i                                 0+-- For each edge a--->b this function returns edge b--->a .+--          i+-- Edges a\<--->b are ignored+--          j+-- @+getRevEdges :: (Num b,Ord b) => [(Node,Node)] -> [(Node,Node,b)]+getRevEdges [] = []+getRevEdges ((u,v):es) | notElem (v,u) es = (v,u,0):getRevEdges es+                       | otherwise        = getRevEdges (delete (v,u) es)++-- |+-- @+--                 i                                  0+-- For each edge a--->b insert into graph the edge a\<---b . Then change the+--                            i         (i,0,i)+-- label of every edge from a---->b to a------->b+-- @+-- +-- where label (x,y,z)=(Max Capacity, Current flow, Residual capacity)+augmentGraph :: (DynGraph gr,Num b,Ord b) => gr a b -> gr a (b,b,b)+augmentGraph g = emap (\i->(i,0,i)) (insEdges (getRevEdges (edges g)) g)+                                                +-- | Given a successor or predecessor list for node u and given node v, find+-- the label corresponding to edge (u,v) and update the flow and residual+-- capacity of that edge's label. Then return the updated list.+updAdjList::(Num b,Ord b) => [((b,b,b),Node)]->Node->b->Bool->[((b,b,b),Node)]+updAdjList s v cf fwd | fwd == True = ((x,y+cf,z-cf),w):rs+                      | otherwise   = ((x,y-cf,z+cf),w):rs+                        where ((x,y,z),w) = head (filter (\(_,w')->v==w') s)+                              rs          = filter (\(_,w')->v/=w') s++-- | Update flow and residual capacity along augmenting path from s to t in+-- graph G. For a path [u,v,w,...] find the node u in G and its successor and+-- predecessor list, then update the corresponding edges (u,v) and (v,u) on+-- those lists by using the minimum residual capacity of the path.+updateFlow :: (DynGraph gr,Num b,Ord b) => Path -> b -> gr a (b,b,b) -> gr a (b,b,b)+updateFlow []	     _ g = g+updateFlow [_]       _ g = g+updateFlow (u:v:vs) cf g = case match u g of+                             (Nothing,g')        -> g'+                             (Just (p,u',l,s),g') -> (p',u',l,s') & g2+                                where g2 = updateFlow (v:vs) cf g'+                                      s' = updAdjList s v cf True+                                      p' = updAdjList p v cf False++-- | Compute the flow from s to t on a graph whose edges are labeled with+-- (x,y,z)=(max capacity,current flow,residual capacity) and all edges+-- are of the form a\<---->b. First compute the residual graph, that is,+-- delete those edges whose residual capacity is zero. Then compute the+-- shortest augmenting path from s to t, and finally update the flow and+-- residual capacity along that path by using the minimum capacity of+-- that path. Repeat this process until no shortest path from s to t exist.+mfmg :: (DynGraph gr,Num b,Ord b) => gr a (b,b,b) -> Node -> Node -> gr a (b,b,b)+mfmg g s t | augPath == [] = g+           | otherwise     = mfmg (updateFlow augPath minC g) s t+             where minC        = minimum (map ((\(_,_,z)->z).snd)(tail augLPath))+                   augPath     = map fst augLPath+                   LP augLPath = lesp s t gf+                   gf          = elfilter (\(_,_,z)->z/=0) g++-- | Compute the flow from s to t on a graph whose edges are labeled with+-- x, which is the max capacity and where not all edges need to be of the+-- form a\<---->b. Return the flow as a grap whose edges are labeled with+-- (x,y,z)=(max capacity,current flow,residual capacity) and all edges+-- are of the form a\<---->b+mf :: (DynGraph gr,Num b,Ord b) => gr a b -> Node -> Node -> gr a (b,b,b)+mf g s t = mfmg (augmentGraph g) s t++-- | Compute the maximum flow from s to t on a graph whose edges are labeled+-- with x, which is the max capacity and where not all edges need to be of+-- the form a\<---->b. Return the flow as a grap whose edges are labeled with+-- (y,x) = (current flow, max capacity).+maxFlowgraph :: (DynGraph gr,Num b,Ord b) => gr a b -> Node -> Node -> gr a (b,b)+maxFlowgraph g s t = emap (\(u,v,_)->(v,u)) g2+                           where g2 = elfilter (\(x,_,_)->x/=0) g1+                                 g1 = mf g s t++-- | Compute the value of a maximumflow+maxFlow :: (DynGraph gr,Num b,Ord b) => gr a b -> Node -> Node -> b+maxFlow g s t = foldr (+) 0 (map (\(_,_,(x,_))->x)(out (maxFlowgraph g s t) s))++------------------------------------------------------------------------------+-- Some test cases: clr595 is from the CLR textbook, page 595. The value of+-- the maximum flow for s=1 and t=6 (23) coincides with the example but the +-- flow itself is slightly different since the textbook does not compute the +-- shortest augmenting path from s to t, but just any path. However remember +-- that for a given flow graph the maximum flow is not unique.+-- (gr595 is defined in GraphData.hs)+------------------------------------------------------------------------------++
+ Data/Graph/Inductive/Query/MaxFlow2.hs view
@@ -0,0 +1,263 @@+-- | Alternative Maximum Flow+module Data.Graph.Inductive.Query.MaxFlow2(+    Network,+    ekSimple, ekFused, ekList,+) where++--   ekSimple, ekFused, ekList) where++import Data.List+import Data.Maybe++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.Internal.FiniteMap+import Data.Graph.Inductive.Internal.Queue+import Data.Graph.Inductive.Query.BFS (bft)+++------------------------------------------------------------------------------+-- Data types++-- Network data type+type Network = Gr () (Double, Double)++-- Data type for direction in which an edge is traversed+data Direction = Forward | Backward+    deriving (Eq, Show)++-- Data type for edge with direction of traversal+type DirEdge b = (Node, Node, b, Direction)++type DirPath=[(Node, Direction)]+type DirRTree=[DirPath]++pathFromDirPath = map (\(n,_)->n)++------------------------------------------------------------------------------+-- Example networks++-- Example number 1+-- This network has a maximum flow of 2000+{-+exampleNetwork1 :: Network+exampleNetwork1=mkGraph [ (1,()), (2,()), (3,()), (4,()) ]+    [ (1,2,(1000,0)), (1,3,(1000,0)),+    (2,3,(1,0)), (2,4,(1000,0)), (3,4,(1000,0)) ]++-- Example number 2+-- Taken from "Introduction to Algorithms" (Cormen, Leiserson, Rivest)+-- This network has a maximum flow of 23+exampleNetwork2 :: Network+-- Names of nodes in "Introduction to Algorithms":+-- 1: s+-- 2: v1+-- 3: v2+-- 4: v3+-- 5: v4+-- 6: t+exampleNetwork2=mkGraph [ (1,()), (2,()), (3,()), (4,()), (5,()), (6,()) ]+    [ (1, 2, (16, 0)),+    (1, 3, (13, 0)),+    (2, 3, (10, 0)),+    (3, 2, (4, 0)),+    (2, 4, (12, 0)),+    (3, 5, (14, 0)),+    (4, 3, (9, 0)),+    (5, 4, (7, 0)),+    (4, 6, (20, 0)),+    (5, 6, (4, 0)) ]+-}+------------------------------------------------------------------------------+-- Implementation of Edmonds-Karp algorithm++-- EXTRACT fglEdmondsFused.txt+-- Compute an augmenting path+augPathFused :: Network -> Node -> Node -> Maybe DirPath+augPathFused g s t = listToMaybe $ map reverse $ +    filter (\((u,_):_) -> u==t) tree+    where tree = bftForEK s g++-- Breadth First Search wrapper function+bftForEK :: Node -> Network -> DirRTree+bftForEK v = bfForEK (queuePut [(v,Forward)] mkQueue)++-- Breadth First Search, tailored for Edmonds & Karp+bfForEK :: Queue DirPath -> Network -> DirRTree+bfForEK q g+    | queueEmpty q || isEmpty g = []+    | otherwise                 = case match v g of+        (Nothing, g')                     -> bfForEK q1 g'+        (Just (preAdj, _, _, sucAdj), g') -> p:bfForEK q2 g'+            where+                -- Insert successor nodes (with path to root) into queue+                q2   = queuePutList suc1 $ queuePutList suc2 q1+                -- Traverse edges in reverse if flow positive+                suc1 = [ (preNode, Backward):p+                    | ((_, f), preNode) <- preAdj, f>0]+                -- Traverse edges forwards if flow less than capacity+                suc2 = [ (sucNode,Forward):p+                    | ((c, f), sucNode) <- sucAdj, c>f]+    where (p@((v,_):_), q1)=queueGet q++-- Extract augmenting path from network; return path as a sequence of +-- edges with direction of traversal, and new network with augmenting +-- path removed.+extractPathFused :: Network -> DirPath +    -> ([DirEdge (Double,Double)], Network)+extractPathFused g []  = ([], g)+extractPathFused g [(_,_)] = ([], g)+extractPathFused g ((u,_):rest@((v,Forward):_)) =+    ((u, v, l, Forward):tailedges, newerg)+        where (tailedges, newerg) = extractPathFused newg rest+              Just (l, newg)    = extractEdge g u v (\(c,f)->(c>f))+extractPathFused g ((u,_):rest@((v,Backward):_)) =+    ((v, u, l, Backward):tailedges, newerg)+        where (tailedges, newerg) = extractPathFused newg rest+              Just (l, newg)    = extractEdge g v u (\(_,f)->(f>0))++-- ekFusedStep :: EKStepFunc+ekFusedStep g s t = case maybePath of+        Just _	  -> +            Just ((insEdges (integrateDelta es delta) newg), delta)+        Nothing   -> Nothing+    where maybePath     = augPathFused g s t+          (es, newg) = extractPathFused g (fromJust maybePath)+          delta         = minimum $ getPathDeltas es++ekFused :: Network -> Node -> Node -> (Network, Double)+ekFused = ekWith ekFusedStep+-- ENDEXTRACT++-----------------------------------------------------------------------------+-- Alternative implementation: Use an explicit residual graph++-- EXTRACT fglEdmondsSimple.txt+residualGraph :: Network -> Gr () Double+residualGraph g = +    mkGraph (labNodes g) +        ([(u, v, c-f) | (u, v, (c,f)) <- labEdges g, c>f ] ++ +         [(v, u, f) | (u,v,(_,f)) <- labEdges g, f>0])++augPath :: Network -> Node -> Node -> Maybe Path+augPath g s t = listToMaybe $ map reverse $ filter (\(u:_) -> u==t) tree+    where tree = bft s (residualGraph g)++-- Extract augmenting path from network; return path as a sequence of+-- edges with direction of traversal, and new network with augmenting +-- path removed.+extractPath :: Network -> Path -> ([DirEdge (Double,Double)], Network)+extractPath g []  = ([], g)+extractPath g [_] = ([], g)+extractPath g (u:v:ws) =+    case fwdExtract of+        Just (l, newg) -> ((u, v, l, Forward):tailedges, newerg)+            where (tailedges, newerg) = extractPath newg (v:ws)+        Nothing          ->+            case revExtract of+                Just (l, newg) -> +                    ((v, u, l, Backward):tailedges, newerg)+                    where (tailedges, newerg) = extractPath newg (v:ws)+		Nothing	       -> error "extractPath: revExtract == Nothing"+    where fwdExtract = extractEdge g u v (\(c,f)->(c>f))+          revExtract = extractEdge g v u (\(_,f)->(f>0))++-- Extract an edge from the graph that satisfies a given predicate+-- Return the label on the edge and the graph without the edge+extractEdge :: Gr a b -> Node -> Node -> (b->Bool) -> Maybe (b, Gr a b)+extractEdge g u v p =+    case adj of+        Just (el, _) -> Just (el, (p', node, l, rest) & newg)+        Nothing      -> Nothing+    where (Just (p', node, l, s), newg) = match u g+          (adj, rest)=extractAdj s +              (\(l', dest) -> (dest==v) && (p l'))++-- Extract an item from an adjacency list that satisfies a given +-- predicate. Return the item and the rest of the adjacency list+extractAdj :: Adj b -> ((b,Node)->Bool) -> (Maybe (b,Node), Adj b)+extractAdj []         _ = (Nothing, [])+extractAdj (adj:adjs) p+    | p adj     = (Just adj, adjs)+    | otherwise = (theone, adj:rest) +        where (theone, rest)=extractAdj adjs p++getPathDeltas :: [DirEdge (Double,Double)] -> [Double]+getPathDeltas []     = []+getPathDeltas (e:es) = case e of+    (_, _, (c,f), Forward)  -> (c-f) : (getPathDeltas es)+    (_, _, (_,f), Backward) -> f : (getPathDeltas es)++integrateDelta :: [DirEdge (Double,Double)] -> Double +    -> [LEdge (Double, Double)]+integrateDelta []	  _ = []+integrateDelta (e:es) delta = case e of+    (u, v, (c, f), Forward) -> +        (u, v, (c, f+delta)) : (integrateDelta es delta)+    (u, v, (c, f), Backward) -> +        (u, v, (c, f-delta)) : (integrateDelta es delta)++type EKStepFunc = Network -> Node -> Node -> Maybe (Network, Double)++ekSimpleStep :: EKStepFunc+ekSimpleStep g s t = case maybePath of+        Just _ -> +            Just ((insEdges (integrateDelta es delta) newg), delta)+        Nothing   -> Nothing+    where maybePath  = augPath g s t+          (es, newg) = extractPath g (fromJust maybePath)+          delta      = minimum $ getPathDeltas es++ekWith :: EKStepFunc -> Network -> Node -> Node -> (Network, Double)+ekWith stepfunc g s t = case stepfunc g s t of+    Just (newg, delta) -> (finalg, capacity+delta)+        where (finalg, capacity) = (ekWith stepfunc newg s t)+    Nothing            -> (g, 0)++ekSimple :: Network -> Node -> Node -> (Network, Double)+ekSimple = ekWith ekSimpleStep+-- ENDEXTRACT++-----------------------------------------------------------------------------+-- Alternative implementation: Process list of edges to extract path instead+-- of operating on graph structure++-- EXTRACT fglEdmondsList.txt+setFromList :: Ord a => [a] -> FiniteMap a ()+setFromList [] = emptyFM+setFromList (x:xs) = addToFM (setFromList xs) x ()++setContains :: Ord a => FiniteMap a () -> a -> Bool+setContains m i = case (lookupFM m i) of+    Nothing -> False+    Just () -> True++extractPathList :: [LEdge (Double, Double)] -> FiniteMap (Node,Node) () +    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])+extractPathList []                 _ = ([], [])+extractPathList (edge@(u,v,l@(c,f)):es) set+    | (c>f) && (setContains set (u,v)) = +        let (pathrest, notrest)=extractPathList es (delFromFM set (u,v))+            in ((u,v,l,Forward):pathrest, notrest)+    | (f>0) && (setContains set (v,u)) =+        let (pathrest, notrest)=extractPathList es (delFromFM set (u,v))+            in ((u,v,l,Backward):pathrest, notrest)+    | otherwise                        =+        let (pathrest, notrest)=extractPathList es set in+            (pathrest, edge:notrest)++ekStepList :: EKStepFunc+ekStepList g s t = case maybePath of+        Just _  -> Just (mkGraph (labNodes g) newEdges, delta)+        Nothing -> Nothing+    where newEdges      = (integrateDelta es delta) ++ otheredges+          maybePath     = augPathFused g s t+          (es, otheredges) = extractPathList (labEdges g) +              (setFromList (zip justPath (tail justPath)))+          delta         = minimum $ getPathDeltas es+          justPath      = pathFromDirPath (fromJust maybePath)++ekList :: Network -> Node -> Node -> (Network, Double)+ekList = ekWith ekStepList+-- ENDEXTRACT+
+ Data/Graph/Inductive/Query/Monad.hs view
@@ -0,0 +1,227 @@+-- (c) 2002 by Martin Erwig [see file COPYRIGHT]+-- | Monadic Graph Algorithms++module Data.Graph.Inductive.Query.Monad(+    -- * Additional Graph Utilities+    mapFst, mapSnd, (><), orP,+    -- * Graph Transformer Monad+    GT(..), apply, apply', applyWith, applyWith', runGT, condMGT', recMGT',+    condMGT, recMGT,+    -- * Graph Computations Based on Graph Monads+    -- ** Monadic Graph Accessing Functions+    getNode, getContext, getNodes', getNodes, sucGT, sucM,+    -- ** Derived Graph Recursion Operators+    graphRec, graphRec', graphUFold,+    -- * Examples: Graph Algorithms as Instances of Recursion Operators+    -- ** Instances of graphRec+    graphNodesM0, graphNodesM, graphNodes, graphFilterM, graphFilter,+    -- * Example: Monadic DFS Algorithm(s)+    dfsGT, dfsM, dfsM', dffM, graphDff, graphDff',+) where+++-- Why all this?+--+-- graph monad ensures single-threaded access +--  ==> we can safely use imperative updates in the graph implementation+--++import Data.Tree+--import Control.Monad (liftM)++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Monad++-- some additional (graph) utilities+--+mapFst :: (a -> b) -> (a, c) -> (b, c)+mapFst f (x,y) = (f x,y)+mapSnd :: (a -> b) -> (c, a) -> (c, b)+mapSnd f (x,y) = (x,f y)++infixr 8 ><+(><) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)+(f >< g) (x,y) = (f x,g y)++orP :: (a -> Bool) -> (b -> Bool) -> (a,b) -> Bool+orP p q (x,y) = p x || q y++----------------------------------------------------------------------+-- "wrapped" state transformer monad   ==+-- monadic graph transformer monad+----------------------------------------------------------------------++data GT m g a = MGT (m g -> m (a,g))++apply :: GT m g a -> m g -> m (a,g)+apply (MGT f) mg = f mg++apply' :: Monad m => GT m g a -> g -> m (a,g)+apply' gt = apply gt . return++applyWith :: Monad m => (a -> b) -> GT m g a -> m g -> m (b,g)+applyWith h (MGT f) gm = do {(x,g) <- f gm; return (h x,g)}++applyWith' :: Monad m => (a -> b) -> GT m g a -> g -> m (b,g)+applyWith' h gt = applyWith h gt . return++runGT :: Monad m => GT m g a -> m g -> m a+runGT gt mg = do {(x,_) <- apply gt mg; return x}+++instance Monad m => Monad (GT m g) where+  return x = MGT (\mg->do {g<-mg; return (x,g)})+  f >>= h  = MGT (\mg->do {(x,g)<-apply f mg; apply' (h x) g})++condMGT' :: Monad m => (s -> Bool) -> GT m s a -> GT m s a -> GT m s a+condMGT' p f g = MGT (\mg->do {h<-mg; if p h then apply f mg else apply g mg})+ +recMGT' :: Monad m => (s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b+recMGT' p mg f u = condMGT' p (return u) +                            (do {x<-mg;y<-recMGT' p mg f u;return (f x y)})++condMGT :: Monad m => (m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a+condMGT p f g = MGT (\mg->do {b<-p mg; if b then apply f mg else apply g mg})++recMGT :: Monad m => (m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b+recMGT p mg f u = condMGT p (return u) +                          (do {x<-mg;y<-recMGT p mg f u;return (f x y)})+++----------------------------------------------------------------------+-- graph computations based on state monads/graph monads+----------------------------------------------------------------------+++-- some monadic graph accessing functions+-- +getNode :: GraphM m gr => GT m (gr a b) Node+getNode = MGT (\mg->do {((_,v,_,_),g) <- matchAnyM mg; return (v,g)})++getContext :: GraphM m gr => GT m (gr a b) (Context a b)+getContext = MGT matchAnyM++-- some functions defined by using the do-notation explicitly+-- Note: most of these can be expressed as an instance of graphRec+-- +getNodes' :: (Graph gr,GraphM m gr) => GT m (gr a b) [Node]+getNodes' = condMGT' isEmpty (return [])+                             (do v  <- getNode+                                 vs <- getNodes+                                 return (v:vs))++getNodes :: GraphM m gr => GT m (gr a b) [Node]+getNodes = condMGT isEmptyM (return [])+                            (do v  <- getNode+                                vs <- getNodes+                                return (v:vs))++sucGT :: GraphM m gr => Node -> GT m (gr a b) (Maybe [Node])+sucGT v = MGT (\mg->do (c,g) <- matchM v mg+                       case c of+                         Just (_,_,_,s) -> return (Just (map snd s),g)+                         Nothing        -> return (Nothing,g)+              )++sucM :: GraphM m gr => Node -> m (gr a b) -> m (Maybe [Node])+sucM v = runGT (sucGT v)++++----------------------------------------------------------------------+-- some derived graph recursion operators+----------------------------------------------------------------------++-- +-- graphRec :: GraphMonad a b c -> (c -> d -> d) -> d -> GraphMonad a b d+-- graphRec f g u = cond isEmpty (return u) +--                               (do x <- f+--                                   y <- graphRec f g u+--                                   return (g x y))++-- | encapsulates a simple recursion schema on graphs+graphRec :: GraphM m gr => GT m (gr a b) c -> +                           (c -> d -> d) -> d -> GT m (gr a b) d+graphRec = recMGT isEmptyM++graphRec' :: (Graph gr,GraphM m gr) => GT m (gr a b) c -> +                           (c -> d -> d) -> d -> GT m (gr a b) d+graphRec' = recMGT' isEmpty++graphUFold :: GraphM m gr => (Context a b -> c -> c) -> c -> GT m (gr a b) c+graphUFold = graphRec getContext++++----------------------------------------------------------------------+-- Examples: graph algorithms as instances of recursion operators+----------------------------------------------------------------------++-- instances of graphRec+-- +graphNodesM0 :: GraphM m gr => GT m (gr a b) [Node]+graphNodesM0 = graphRec getNode (:) []++graphNodesM :: GraphM m gr => GT m (gr a b) [Node]+graphNodesM = graphUFold (\(_,v,_,_)->(v:)) []++graphNodes :: GraphM m gr => m (gr a b) -> m [Node]+graphNodes = runGT graphNodesM++graphFilterM :: GraphM m gr => (Context a b -> Bool) ->+                              GT m (gr a b) [Context a b]+graphFilterM p = graphUFold (\c cs->if p c then c:cs else cs) []++graphFilter :: GraphM m gr => (Context a b -> Bool) -> m (gr a b) -> m [Context a b]+graphFilter p = runGT (graphFilterM p)+++++----------------------------------------------------------------------+-- Example: monadic dfs algorithm(s)+----------------------------------------------------------------------++-- | Monadic graph algorithms are defined in two steps:+--+--  (1) define the (possibly parameterized) graph transformer (e.g., dfsGT)+--  (2) run the graph transformer (applied to arguments) (e.g., dfsM)+--++dfsGT :: GraphM m gr => [Node] -> GT m (gr a b) [Node]+dfsGT []     = return []+dfsGT (v:vs) = MGT (\mg->+               do (mc,g') <- matchM v mg+                  case mc of+                    Just (_,_,_,s) -> applyWith' (v:) (dfsGT (map snd s++vs)) g'+                    Nothing        -> apply' (dfsGT vs) g'  )++-- | depth-first search yielding number of nodes+dfsM :: GraphM m gr => [Node] -> m (gr a b) -> m [Node]+dfsM vs = runGT (dfsGT vs)++dfsM' :: GraphM m gr => m (gr a b) -> m [Node]+dfsM' mg = do {vs <- nodesM mg; runGT (dfsGT vs) mg}+++-- | depth-first search yielding dfs forest+dffM :: GraphM m gr => [Node] -> GT m (gr a b) [Tree Node]+dffM vs = MGT (\mg->+          do g<-mg+             b<-isEmptyM mg+             if b||null vs then return ([],g) else +                let (v:vs') = vs in+                do (mc,g1) <- matchM v mg+                   case mc of+                     Nothing -> apply (dffM vs') (return g1)+                     Just c  -> do (ts, g2) <- apply (dffM (suc' c)) (return g1)+                                   (ts',g3) <- apply (dffM vs') (return g2)+                                   return (Node (node' c) ts:ts',g3)+          )++graphDff :: GraphM m gr => [Node] -> m (gr a b) -> m [Tree Node]+graphDff vs = runGT (dffM vs)++graphDff' :: GraphM m gr => m (gr a b) -> m [Tree Node]+graphDff' mg = do {vs <- nodesM mg; runGT (dffM vs) mg}+
+ Data/Graph/Inductive/Query/SP.hs view
@@ -0,0 +1,32 @@+-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]++module Data.Graph.Inductive.Query.SP(+    spTree,spLength,sp,+    dijkstra+) where++import qualified Data.Graph.Inductive.Internal.Heap as H++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Internal.RootPath++expand :: Real b => b -> LPath b -> Context a b -> [H.Heap b (LPath b)]+expand d (LP p) (_,_,_,s) = map (\(l,v)->H.unit (l+d) (LP ((v,l+d):p))) s++-- | Implementation of Dijkstra's shortest path algorithm  +dijkstra :: (Graph gr, Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b+dijkstra h g | H.isEmpty h || isEmpty g = []+dijkstra h g =+    case match v g of+         (Just c,g')  -> p:dijkstra (H.mergeAll (h':expand d p c)) g'+         (Nothing,g') -> dijkstra h' g'  +    where (_,p@(LP ((v,d):_)),h') = H.splitMin h+        +spTree :: (Graph gr, Real b) => Node -> gr a b -> LRTree b+spTree v = dijkstra (H.unit 0 (LP [(v,0)]))++spLength :: (Graph gr, Real b) => Node -> Node -> gr a b -> b+spLength s t = getDistance t . spTree s++sp :: (Graph gr, Real b) => Node -> Node -> gr a b -> Path+sp s t = getLPathNodes t . spTree s
+ Data/Graph/Inductive/Query/TransClos.hs view
@@ -0,0 +1,21 @@+module Data.Graph.Inductive.Query.TransClos(+    trc+) where++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Query.DFS (reachable)+++getNewEdges :: DynGraph gr => [LNode a] -> gr a b -> [LEdge ()]+getNewEdges vs g = concatMap (\(u,_)->r u g) vs+                   where r = \u g' -> map (\v->(u,v,())) (reachable u g')++{-|+Finds the transitive closure of a directed graph.+Given a graph G=(V,E), its transitive closure is the graph:+G* = (V,E*) where E*={(i,j): i,j in V and there is a path from i to j in G}+-}+trc :: DynGraph gr => gr a b -> gr a ()+trc g = insEdges (getNewEdges ln g) (insNodes ln empty)+        where ln = labNodes g+
+ Data/Graph/Inductive/Tree.hs view
@@ -0,0 +1,99 @@+-- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT]+-- | Tree-based implementation of 'Graph' and 'DynGraph'++module Data.Graph.Inductive.Tree (Gr,UGr) where++import Data.List        (foldl')++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Internal.FiniteMap++import Data.Maybe (fromJust)+++----------------------------------------------------------------------+-- GRAPH REPRESENTATION+----------------------------------------------------------------------++data Gr a b = Gr (GraphRep a b)++type GraphRep a b = FiniteMap Node (Context' a b)+type Context' a b = (Adj b,a,Adj b)++type UGr = Gr () ()+++----------------------------------------------------------------------+-- CLASS INSTANCES+----------------------------------------------------------------------+++-- Show+--+showsGraph :: (Show a,Show b) => GraphRep a b -> ShowS+showsGraph Empty = id+showsGraph (Node _ l (v,(_,l',s)) r) = showsGraph l . ('\n':) . +     shows v . (':':) . shows l' . ("->"++) . shows s . showsGraph r+                +instance (Show a,Show b) => Show (Gr a b) where+  showsPrec _ (Gr g) = showsGraph g+++-- Graph+-- +instance Graph Gr where+  empty           = Gr emptyFM+  isEmpty (Gr g)  = case g of {Empty -> True; _ -> False}+  match           = matchGr+  mkGraph vs es   = (insEdges' . insNodes vs) empty+        where+          insEdges' g = foldl' (flip insEdge) g es++  labNodes (Gr g) = map (\(v,(_,l,_))->(v,l)) (fmToList g)+  -- more efficient versions of derived class members+  --+  matchAny (Gr Empty)                = error "Match Exception, Empty Graph"+  matchAny g@(Gr (Node _ _ (v,_) _)) = (c,g') where (Just c,g') = matchGr v g+  noNodes   (Gr g) = sizeFM g+  nodeRange (Gr Empty) = (0,0)+  nodeRange (Gr g)     = (ix (minFM g),ix (maxFM g)) where ix = fst.fromJust+  labEdges  (Gr g) = concatMap (\(v,(_,_,s))->map (\(l,w)->(v,w,l)) s) (fmToList g)+++matchGr v (Gr g) = +      case splitFM g v of +           Nothing -> (Nothing,Gr g)+           Just (g',(_,(p,l,s))) -> (Just (p',v,l,s),Gr g2)+                where s'   = filter ((/=v).snd) s+                      p'   = filter ((/=v).snd) p+                      g1   = updAdj g' s' (clearPred v)+                      g2   = updAdj g1 p' (clearSucc v)+++-- DynGraph+-- +instance DynGraph Gr where+  (p,v,l,s) & (Gr g) | elemFM g v = error ("Node Exception, Node: "++show v)+                     | otherwise  = Gr g3+      where g1 = addToFM g v (p,l,s)+            g2 = updAdj g1 p (addSucc v)+            g3 = updAdj g2 s (addPred v)+++----------------------------------------------------------------------+-- UTILITIES+----------------------------------------------------------------------++addSucc v l (p,l',s) = (p,l',(l,v):s)+addPred v l (p,l',s) = ((l,v):p,l',s)++clearSucc v _ (p,l,s) = (p,l,filter ((/=v).snd) s)+clearPred v _ (p,l,s) = (filter ((/=v).snd) p,l,s)++updAdj :: GraphRep a b -> Adj b -> (b -> Context' a b -> Context' a b) -> GraphRep a b+updAdj g []         _              = g+updAdj g ((l,v):vs) f | elemFM g v = updAdj (updFM g v (f l)) vs f+                      | otherwise  = error ("Edge Exception, Node: "++show v)+++
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 1999-2004, Martin Erwig+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+   used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fgl.cabal view
@@ -0,0 +1,39 @@+name:		fgl+version:	5.3+license:	BSD3+license-file:	LICENSE+maintainer:	Martin Erwig+homepage:	http://web.engr.oregonstate.edu/~erwig/fgl/haskell+category:	Data Structures+synopsis:	Martin Erwig's Functional Graph Library+exposed-modules:+	Data.Graph.Inductive.Internal.FiniteMap,+	Data.Graph.Inductive.Internal.Heap,+	Data.Graph.Inductive.Internal.Queue,+	Data.Graph.Inductive.Internal.RootPath,+	Data.Graph.Inductive.Internal.Thread,+	Data.Graph.Inductive.Basic,+	Data.Graph.Inductive.Example,+	Data.Graph.Inductive.Graph,+	Data.Graph.Inductive.Graphviz,+	Data.Graph.Inductive.Monad,+	Data.Graph.Inductive.NodeMap,+	Data.Graph.Inductive.Query,+	Data.Graph.Inductive.Tree,+	Data.Graph.Inductive.Monad.IOArray,+	Data.Graph.Inductive.Query.ArtPoint,+	Data.Graph.Inductive.Query.BCC,+	Data.Graph.Inductive.Query.BFS,+	Data.Graph.Inductive.Query.DFS,+	Data.Graph.Inductive.Query.Dominators,+	Data.Graph.Inductive.Query.GVD,+	Data.Graph.Inductive.Query.Indep,+	Data.Graph.Inductive.Query.MST,+	Data.Graph.Inductive.Query.MaxFlow,+	Data.Graph.Inductive.Query.MaxFlow2,+	Data.Graph.Inductive.Query.Monad,+	Data.Graph.Inductive.Query.SP,+	Data.Graph.Inductive.Query.TransClos,+	Data.Graph.Inductive+build-depends:	base, mtl+extensions: MultiParamTypeClasses, OverlappingInstances