fgl 5.4.2.4 → 5.5.0.0
raw patch · 12 files changed
+279/−265 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Data.Graph.Inductive.Example: a', dag3', abb', ab', loop', e', c', b' :: IO (SGr Char ())
- Data.Graph.Inductive.Example: a, dag3, abb, ab, loop, e, c, b :: Gr Char ()
- Data.Graph.Inductive.Example: clr479', clr489' :: IO (SGr Char ())
- Data.Graph.Inductive.Example: clr479, clr489 :: Gr Char ()
- Data.Graph.Inductive.Example: clr508', clr528' :: IO (SGr Char Int)
- Data.Graph.Inductive.Example: clr508, clr528 :: Gr Char Int
- Data.Graph.Inductive.Example: clr595, gr1 :: Gr Int Int
- Data.Graph.Inductive.Example: cyc3, g3b, g3 :: Gr Char String
- Data.Graph.Inductive.Example: d1', d3' :: IO (SGr Int Int)
- Data.Graph.Inductive.Example: d1, d3 :: Gr Int Int
- Data.Graph.Inductive.Graph: instance [overlap ok] Show a => Show (LPath a)
- Data.Graph.Inductive.Graphviz: Landscape :: Orient
- Data.Graph.Inductive.Graphviz: Portrait :: Orient
- Data.Graph.Inductive.Graphviz: data Orient
- Data.Graph.Inductive.Graphviz: graphviz :: (Graph g, Show a, Show b) => g a b -> String -> (Double, Double) -> (Int, Int) -> Orient -> String
- Data.Graph.Inductive.Graphviz: graphviz' :: (Graph g, Show a, Show b) => g a b -> String
- Data.Graph.Inductive.Graphviz: instance [overlap ok] Eq Orient
- Data.Graph.Inductive.Graphviz: instance [overlap ok] Show Orient
- Data.Graph.Inductive.Internal.FiniteMap: instance [overlap ok] (Eq b, Ord a) => Eq (FiniteMap a b)
- Data.Graph.Inductive.Internal.FiniteMap: instance [overlap ok] (Show a, Show b, Ord a) => Show (FiniteMap a b)
- Data.Graph.Inductive.Internal.Heap: instance [overlap ok] (Eq b, Ord a) => Eq (Heap a b)
- Data.Graph.Inductive.Internal.Heap: instance [overlap ok] (Show a, Ord a, Show b) => Show (Heap a b)
- Data.Graph.Inductive.Internal.RootPath: instance [overlap ok] Eq a => Eq (LPath a)
- Data.Graph.Inductive.Internal.RootPath: instance [overlap ok] Ord a => Ord (LPath a)
- Data.Graph.Inductive.Monad.IOArray: instance [overlap ok] (Show a, Show b) => Show (IO (SGr a b))
- Data.Graph.Inductive.Monad.IOArray: instance [overlap ok] (Show a, Show b) => Show (SGr a b)
- Data.Graph.Inductive.Monad.IOArray: instance [overlap ok] GraphM IO SGr
- Data.Graph.Inductive.NodeMap: instance [overlap ok] (Ord a, Show a) => Show (NodeMap a)
- Data.Graph.Inductive.PatriciaTree: instance [overlap ok] DynGraph Gr
- Data.Graph.Inductive.PatriciaTree: instance [overlap ok] Graph Gr
- Data.Graph.Inductive.Query.ArtPoint: instance [overlap ok] Eq a => Eq (DFSTree a)
- Data.Graph.Inductive.Query.ArtPoint: instance [overlap ok] Eq a => Eq (LOWTree a)
- Data.Graph.Inductive.Query.MaxFlow2: instance [overlap ok] Eq Direction
- Data.Graph.Inductive.Query.MaxFlow2: instance [overlap ok] Show Direction
- Data.Graph.Inductive.Query.Monad: instance [overlap ok] Monad m => Monad (GT m g)
- Data.Graph.Inductive.Tree: instance [overlap ok] (Show a, Show b) => Show (Gr a b)
- Data.Graph.Inductive.Tree: instance [overlap ok] DynGraph Gr
- Data.Graph.Inductive.Tree: instance [overlap ok] Graph Gr
+ Data.Graph.Inductive.Example: a :: Gr Char ()
+ Data.Graph.Inductive.Example: a' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: ab :: Gr Char ()
+ Data.Graph.Inductive.Example: ab' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: abb :: Gr Char ()
+ Data.Graph.Inductive.Example: abb' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: b :: Gr Char ()
+ Data.Graph.Inductive.Example: b' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: c :: Gr Char ()
+ Data.Graph.Inductive.Example: c' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: clr479 :: Gr Char ()
+ Data.Graph.Inductive.Example: clr479' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: clr489 :: Gr Char ()
+ Data.Graph.Inductive.Example: clr489' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: clr508 :: Gr Char Int
+ Data.Graph.Inductive.Example: clr508' :: IO (SGr Char Int)
+ Data.Graph.Inductive.Example: clr528 :: Gr Char Int
+ Data.Graph.Inductive.Example: clr528' :: IO (SGr Char Int)
+ Data.Graph.Inductive.Example: clr595 :: Gr Int Int
+ Data.Graph.Inductive.Example: cyc3 :: Gr Char String
+ Data.Graph.Inductive.Example: d1 :: Gr Int Int
+ Data.Graph.Inductive.Example: d1' :: IO (SGr Int Int)
+ Data.Graph.Inductive.Example: d3 :: Gr Int Int
+ Data.Graph.Inductive.Example: d3' :: IO (SGr Int Int)
+ Data.Graph.Inductive.Example: dag3 :: Gr Char ()
+ Data.Graph.Inductive.Example: dag3' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: e :: Gr Char ()
+ Data.Graph.Inductive.Example: e' :: IO (SGr Char ())
+ Data.Graph.Inductive.Example: g3 :: Gr Char String
+ Data.Graph.Inductive.Example: g3b :: Gr Char String
+ Data.Graph.Inductive.Example: gr1 :: Gr Int Int
+ Data.Graph.Inductive.Example: loop :: Gr Char ()
+ Data.Graph.Inductive.Example: loop' :: IO (SGr Char ())
+ Data.Graph.Inductive.Graph: instance Show a => Show (LPath a)
+ Data.Graph.Inductive.Graph: prettify :: (DynGraph gr, Show a, Show b) => gr a b -> String
+ Data.Graph.Inductive.Graph: prettyPrint :: (DynGraph gr, Show a, Show b) => gr a b -> IO ()
+ Data.Graph.Inductive.Internal.FiniteMap: instance (Eq a, Eq b) => Eq (FiniteMap a b)
+ Data.Graph.Inductive.Internal.FiniteMap: instance (Show a, Show b, Ord a) => Show (FiniteMap a b)
+ Data.Graph.Inductive.Internal.Heap: instance (Eq b, Ord a) => Eq (Heap a b)
+ Data.Graph.Inductive.Internal.Heap: instance (Show a, Ord a, Show b) => Show (Heap a b)
+ Data.Graph.Inductive.Internal.RootPath: instance Eq a => Eq (LPath a)
+ Data.Graph.Inductive.Internal.RootPath: instance Ord a => Ord (LPath a)
+ Data.Graph.Inductive.Monad.IOArray: instance (Show a, Show b) => Show (IO (SGr a b))
+ Data.Graph.Inductive.Monad.IOArray: instance (Show a, Show b) => Show (SGr a b)
+ Data.Graph.Inductive.Monad.IOArray: instance GraphM IO SGr
+ Data.Graph.Inductive.NodeMap: instance (Ord a, Show a) => Show (NodeMap a)
+ Data.Graph.Inductive.PatriciaTree: instance (Eq a, Eq b) => Eq (Gr a b)
+ Data.Graph.Inductive.PatriciaTree: instance (Read a, Read b) => Read (Gr a b)
+ Data.Graph.Inductive.PatriciaTree: instance (Show a, Show b) => Show (Gr a b)
+ Data.Graph.Inductive.PatriciaTree: instance DynGraph Gr
+ Data.Graph.Inductive.PatriciaTree: instance Graph Gr
+ Data.Graph.Inductive.Query.ArtPoint: instance Eq a => Eq (DFSTree a)
+ Data.Graph.Inductive.Query.ArtPoint: instance Eq a => Eq (LOWTree a)
+ Data.Graph.Inductive.Query.MaxFlow2: instance Eq Direction
+ Data.Graph.Inductive.Query.MaxFlow2: instance Show Direction
+ Data.Graph.Inductive.Query.Monad: instance Monad m => Monad (GT m g)
+ Data.Graph.Inductive.Tree: instance (Eq a, Eq b) => Eq (Gr a b)
+ Data.Graph.Inductive.Tree: instance (Read a, Read b) => Read (Gr a b)
+ Data.Graph.Inductive.Tree: instance (Show a, Show b) => Show (Gr a b)
+ Data.Graph.Inductive.Tree: instance DynGraph Gr
+ Data.Graph.Inductive.Tree: instance Graph Gr
- Data.Graph.Inductive.Graph: class Graph gr
+ Data.Graph.Inductive.Graph: class Graph gr where 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) ++)) []
- Data.Graph.Inductive.Internal.FiniteMap: data Ord a => FiniteMap a b
+ Data.Graph.Inductive.Internal.FiniteMap: data FiniteMap a b
- Data.Graph.Inductive.Monad: class Monad m => GraphM m gr
+ Data.Graph.Inductive.Monad: class Monad m => GraphM m gr where 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)
Files
- ChangeLog +32/−0
- Data/Graph/Inductive.hs +11/−9
- Data/Graph/Inductive/Example.hs +14/−12
- Data/Graph/Inductive/Graph.hs +72/−49
- Data/Graph/Inductive/Graphviz.hs +0/−70
- Data/Graph/Inductive/Internal/FiniteMap.hs +27/−27
- Data/Graph/Inductive/Monad.hs +43/−41
- Data/Graph/Inductive/Monad/IOArray.hs +12/−10
- Data/Graph/Inductive/PatriciaTree.hs +17/−3
- Data/Graph/Inductive/Query/MaxFlow2.hs +22/−22
- Data/Graph/Inductive/Tree.hs +21/−18
- fgl.cabal +8/−4
+ ChangeLog view
@@ -0,0 +1,32 @@+5.5.0.0+-------++* Add proper Show, Read and Eq instances to Data.Graph.Inductive.Tree+ and Data.Graph.Inductive.PatriciaTree.++* Add pretty-printing functions to Data.Graph.Inductive.Graph. These+ are based upon the old Show implementation for+ Data.Graph.Inductive.Tree.++* Now use PatriciaTree by default rather than Tree (and recommend as+ such). IntMap has been receiving a lot of optimisation work on it,+ whereas the internal FiniteMap implementation hasn't received any+ attention.++* The `version :: IO ()` action now uses the actual Cabal version.++* Remove Data.Graph.Inductive.Graphviz; use the graphviz package+ instead.++5.4.2.4+-------++* Update to work with GHC-7.2 and Cabal-1.6.++5.4.2.3+-------++* Maintainership taken over by Ivan Miljenovic.++* Allow Data.Graph.Inductive.PatriciaTree to deal with multiple edges+ between nodes.
Data/Graph/Inductive.hs view
@@ -1,33 +1,35 @@ --------------------------------------------------------------------------------- --- Inductive.hs -- Functional Graph Library --+-- Inductive.hs -- Functional Graph Library+-- -- (c) 1999-2007 by Martin Erwig [see file COPYRIGHT] -- ------------------------------------------------------------------------------ module Data.Graph.Inductive( module Data.Graph.Inductive.Graph,- module Data.Graph.Inductive.Tree,+ module Data.Graph.Inductive.PatriciaTree, 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.Graph 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+import Data.Graph.Inductive.PatriciaTree+import Data.Graph.Inductive.Query +import Data.Version (showVersion)+import qualified Paths_fgl as Paths (version)+ -- | Version info version :: IO ()-version = putStrLn "\nFGL - Functional Graph Library, April 2007"+version = putStrLn $ "\nFGL - Functional Graph Library, version "+ ++ showVersion Paths.version
Data/Graph/Inductive/Example.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+ -- | Example Graphs module Data.Graph.Inductive.Example( -- * Auxiliary Functions@@ -19,9 +21,9 @@ clr479', clr489', clr486', clr508', clr528', kin248', vor' )where +import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.PatriciaTree -import Data.Graph.Inductive-import Data.Graph.Inductive.Tree import Data.Graph.Inductive.Monad import Data.Graph.Inductive.Monad.IOArray @@ -39,7 +41,7 @@ -- | empty (unlabeled) edge list noEdges :: [UEdge]-noEdges = [] +noEdges = [] a,b,c,e,loop,ab,abb,dag3 :: Gr Char ()@@ -52,7 +54,7 @@ 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) +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@@ -67,7 +69,7 @@ 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)] +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)]) & (@@ -86,10 +88,10 @@ 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) +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") +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 @@ -97,7 +99,7 @@ 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)] +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)@@ -121,7 +123,7 @@ kin248 :: Gr Int () vor :: Gr String Int -clr479 = mkGraph (genLNodes 'u' 6) +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"])@@ -135,10 +137,10 @@ 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]) +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]) +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)]@@ -160,7 +162,7 @@ kin248' :: IO (SGr Int ()) vor' :: IO (SGr String Int) -clr479' = mkGraphM (genLNodes 'u' 6) +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"])
Data/Graph/Inductive/Graph.hs view
@@ -1,5 +1,5 @@ -- (c) 1999-2005 by Martin Erwig [see file COPYRIGHT]--- | Static and Dynamic Inductive Graphs +-- | Static and Dynamic Inductive Graphs module Data.Graph.Inductive.Graph ( -- * General Type Defintions -- ** Node and Edge Types@@ -12,8 +12,8 @@ -- | We define two graph classes: -- -- Graph: static, decomposable graphs.- -- Static means that a graph itself cannot be changed- -- + -- 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.@@ -21,15 +21,15 @@ -- 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 + -- 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(..), + Graph(..), DynGraph(..), -- * Operations -- ** Graph Folds and Maps@@ -49,6 +49,9 @@ node',lab',labNode',neighbors', suc',pre',lpre',lsuc', out',inn',outdeg',indeg',deg',+ -- * Pretty-printing+ prettify,+ prettyPrint ) where @@ -98,13 +101,13 @@ -- 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] +neighbors :: Graph gr => gr a b -> Node -> [Node] suc :: Graph gr => gr a b -> Node -> [Node]-pre :: 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] +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@@ -113,13 +116,13 @@ node' :: Context a b -> Node lab' :: Context a b -> a labNode' :: Context a b -> LNode a-neighbors' :: Context a b -> [Node] +neighbors' :: Context a b -> [Node] suc' :: Context a b -> [Node]-pre' :: Context a b -> [Node] -lpre' :: Context a b -> [(Node,b)] +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] +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@@ -127,21 +130,21 @@ -} -- | Unlabeled node-type Node = Int +type Node = Int -- | Labeled node-type LNode a = (Node,a) +type LNode a = (Node,a) -- | Quasi-unlabeled node-type UNode = LNode () +type UNode = LNode () -- | Unlabeled edge-type Edge = (Node,Node) +type Edge = (Node,Node) -- | Labeled edge-type LEdge b = (Node,Node,b) +type LEdge b = (Node,Node,b) -- | Quasi-unlabeled edge-type UEdge = LEdge () +type UEdge = LEdge () -- | Unlabeled path-type Path = [Node] +type Path = [Node] -- | Labeled path newtype LPath a = LP [LNode a] @@ -149,7 +152,7 @@ show (LP xs) = show xs -- | Quasi-unlabeled path-type UPath = [UNode] +type UPath = [UNode] -- | Labeled links to or from a 'Node'. type Adj b = [(b,Node)]@@ -194,8 +197,8 @@ -- 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 + (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)++)) [] @@ -208,7 +211,7 @@ -- | 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') + | otherwise = f c (ufold f u g') where (c,g') = matchAny g -- | Map a function over the graph.@@ -276,7 +279,7 @@ -- | 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)) +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@@ -291,23 +294,23 @@ -- | Build a quasi-unlabeled 'Graph'. mkUGraph :: Graph gr => [Node] -> [Edge] -> gr () ()-mkUGraph vs es = mkGraph (labUNodes vs) (labUEdges es) +mkUGraph vs es = mkGraph (labUNodes vs) (labUEdges es) where 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 + (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' +lab g v = fst (match v g) >>= return.lab' -- | Find the neighbors for a 'Node'.-neighbors :: Graph gr => gr a b -> Node -> [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'.@@ -315,7 +318,7 @@ suc = map snd .: context4l -- | Find all 'Node's that link to to the given 'Node'.-pre :: Graph gr => gr a b -> Node -> [Node] +pre :: Graph gr => gr a b -> Node -> [Node] pre = map snd .: context1l -- | Find all 'Node's that are linked from the given 'Node' and the label of@@ -324,15 +327,15 @@ lsuc = map flip2 .: context4l -- | 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 :: Graph gr => gr a b -> Node -> [(Node,b)] lpre = map flip2 .: context1l -- | Find all outward-bound 'LEdge's for the given 'Node'.-out :: Graph gr => gr a b -> Node -> [LEdge b] +out :: Graph gr => gr a b -> Node -> [LEdge b] out g v = map (\(l,w)->(v,w,l)) (context4l g v) -- | Find all inward-bound 'LEdge's for the given 'Node'.-inn :: Graph gr => gr a b -> Node -> [LEdge b] +inn :: Graph gr => gr a b -> Node -> [LEdge b] inn g v = map (\(l,w)->(w,v,l)) (context1l g v) -- | The outward-bound degree of the 'Node'.@@ -360,7 +363,7 @@ labNode' (_,v,l,_) = (v,l) -- | All 'Node's linked to or from in a 'Context'.-neighbors' :: Context a b -> [Node] +neighbors' :: Context a b -> [Node] neighbors' (p,_,_,s) = map snd p++map snd s -- | All 'Node's linked to in a 'Context'.@@ -368,7 +371,7 @@ suc' = map snd . context4l' -- | All 'Node's linked from in a 'Context'.-pre' :: Context a b -> [Node] +pre' :: Context a b -> [Node] pre' = map snd . context1l' -- | All 'Node's linked from in a 'Context', and the label of the links.@@ -376,15 +379,15 @@ lsuc' = map flip2 . context4l' -- | All 'Node's linked from in a 'Context', and the label of the links.-lpre' :: Context a b -> [(Node,b)] +lpre' :: Context a b -> [(Node,b)] lpre' = map flip2 . context1l' -- | All outward-directed 'LEdge's in a 'Context'.-out' :: Context a b -> [LEdge b] +out' :: Context a b -> [LEdge b] out' c@(_,v,_,_) = map (\(l,w)->(v,w,l)) (context4l' c) -- | All inward-directed 'LEdge's in a 'Context'.-inn' :: Context a b -> [LEdge b] +inn' :: Context a b -> [LEdge b] inn' c@(_,v,_,_) = map (\(l,w)->(w,v,l)) (context1l' c) -- | The outward degree of a 'Context'.@@ -430,9 +433,9 @@ ---------------------------------------------------------------------- --- auxiliary functions used in the implementation of the +-- 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@@ -451,8 +454,28 @@ context4l :: Graph gr => gr a b -> Node -> Adj b context4l = context4l' .: context -context1l' :: Context a b -> Adj b +context1l' :: Context a b -> Adj b context1l' (p,v,_,s) = p++filter ((==v).snd) s -context4l' :: Context a b -> Adj b +context4l' :: Context a b -> Adj b context4l' (p,v,_,s) = s++filter ((==v).snd) p++----------------------------------------------------------------------+-- PRETTY PRINTING+----------------------------------------------------------------------++-- ufold :: Graph gr => (Context a b -> c -> c) -> c -> gr a b -> c++-- | Pretty-print the graph. Note that this loses a lot of+-- information, such as edge inverses, etc.+prettify :: (DynGraph gr, Show a, Show b) => gr a b -> String+prettify g = ufold showsContext id g ""+ where+ showsContext (_,n,l,s) sg = shows n . (':':) . shows l+ . showString "->" . shows s+ . ('\n':) . sg++-- | Pretty-print the graph to stdout.+prettyPrint :: (DynGraph gr, Show a, Show b) => gr a b -> IO ()+prettyPrint = putStr . prettify+
− Data/Graph/Inductive/Graphviz.hs
@@ -1,70 +0,0 @@--- | 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@[c] = s-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
@@ -17,9 +17,9 @@ fmToList ) where -import Data.Maybe (isJust) +import Data.Maybe (isJust) -data Ord a => FiniteMap a b =+data FiniteMap a b = Empty | Node Int (FiniteMap a b) (a,b) (FiniteMap a b) deriving (Eq) @@ -33,9 +33,9 @@ -- showsMap :: (Show a,Show b,Ord a) => FiniteMap a b -> ShowS showsMap Empty = id-showsMap (Node _ l (i,x) r) = showsMap l . (' ':) . +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 @@ -45,7 +45,7 @@ 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"+splitMax Empty = error "splitMax on empty FiniteMap" merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b merge l Empty = l@@ -64,31 +64,31 @@ 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 + | 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 +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 + | 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 +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 + | 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 + | i>j = avlBalance l (j,x) (delFromFM r i)+ | otherwise = merge l r isEmptyFM :: FiniteMap a b -> Bool isEmptyFM Empty = True@@ -101,7 +101,7 @@ 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 + | i>j = lookupFM r i | otherwise = Just x -- | applies lookup to an interval@@ -130,17 +130,17 @@ 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 + | 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 + | isJust mr = mr | otherwise = p where mr = minFM r @@ -157,15 +157,15 @@ 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)) + 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) +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)]@@ -196,14 +196,14 @@ bias :: Ord a => FiniteMap a b -> Int bias (Node _ l _ r) = height l - height r-bias Empty = 0+bias Empty = 0 rotr :: Ord a => FiniteMap a b -> FiniteMap a b-rotr Empty = Empty+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"+rotr (Node _ Empty _ _) = error "rotr on invalid FiniteMap" rotl :: Ord a => FiniteMap a b -> FiniteMap a b-rotl Empty = Empty+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"+rotl (Node _ _ _ Empty) = error "rotl on invalid FiniteMap"
Data/Graph/Inductive/Monad.hs view
@@ -1,8 +1,10 @@+{-# LANGUAGE MultiParamTypeClasses #-}+ -- (c) 2002 by Martin Erwig [see file COPYRIGHT] -- | Monadic Graphs module Data.Graph.Inductive.Monad( -- * Classes- GraphM(..), + GraphM(..), -- * Operations -- ** Graph Folds and Maps ufoldM,@@ -23,19 +25,19 @@ -- 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)@@ -49,15 +51,15 @@ 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 + 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') + return (c,g') noNodesM = labNodesM >>. length nodeRangeM g = do vs <- labNodesM g- let vs' = map fst vs - return (minimum vs',maximum vs') + 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)@@ -66,7 +68,7 @@ -- 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 +f >>. g = (>>= return . g) . f ----------------------------------------------------------------------@@ -74,7 +76,7 @@ ---------------------------------------------------------------------- -- graph folds and maps--- +-- -- | graph fold ufoldM :: GraphM m gr => ((Context a b) -> c -> c) -> c -> m (gr a b) -> m c@@ -87,7 +89,7 @@ -- (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 @@ -100,24 +102,24 @@ -- 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') +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) +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})@@ -129,25 +131,25 @@ labM = onMatch (Just . lab') Nothing {--neighbors :: GraphM m gr => m (gr a b) -> Node -> [Node] +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 :: 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 :: 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 :: 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 :: 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@@ -158,46 +160,46 @@ 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' :: 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' :: Context a b -> [Node] -- pre' (p,_,_,_) = map snd p--- --- lpre' :: Context a b -> [(Node,b)] +--+-- 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' :: Context a b -> [LEdge b] -- out' (_,v,_,s) = map (\(l,w)->(v,w,l)) s--- --- inn' :: Context a b -> [LEdge b] +--+-- 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
Data/Graph/Inductive/Monad/IOArray.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+ -- (c) 2002 by Martin Erwig [see file COPYRIGHT]--- | Static IOArray-based Graphs +-- | Static IOArray-based Graphs module Data.Graph.Inductive.Monad.IOArray( -- * Graph Representation SGr(..), GraphRep, Context', USGr,@@ -15,9 +17,9 @@ import Data.Array import Data.Array.IO import System.IO.Unsafe-import Data.Maybe + ---------------------------------------------------------------------- -- GRAPH REPRESENTATION ----------------------------------------------------------------------@@ -43,7 +45,7 @@ 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 @@ -56,14 +58,14 @@ -} -- 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 + case a!v of Nothing -> return (Nothing,g')- Just (pr,l,su) -> + Just (pr,l,su) -> do b <- readArray m v if b then return (Nothing,g') else do s <- removeDel m su@@ -85,15 +87,15 @@ 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 + 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 :: 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))
Data/Graph/Inductive/PatriciaTree.hs view
@@ -22,21 +22,35 @@ ) where +import Control.Arrow (second) import Data.Graph.Inductive.Graph-import Data.IntMap (IntMap)-import qualified Data.IntMap as IM+import Data.IntMap (IntMap)+import qualified Data.IntMap as IM import Data.List import Data.Maybe-import Control.Arrow(second) newtype Gr a b = Gr (GraphRep a b)+ deriving (Eq) type GraphRep a b = IntMap (Context' a b) type Context' a b = (IntMap [b], a, IntMap [b]) type UGr = Gr () () +instance (Show a, Show b) => Show (Gr a b) where+ showsPrec d g = showParen (d > 10) $+ showString "mkGraph "+ . shows (labNodes g)+ . showString " "+ . shows (labEdges g)++instance (Read a, Read b) => Read (Gr a b) where+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("mkGraph", s) <- lex r+ (ns,t) <- reads s+ (es,u) <- reads t+ return (mkGraph ns es, u) instance Graph Gr where -- required members
Data/Graph/Inductive/Query/MaxFlow2.hs view
@@ -6,11 +6,11 @@ -- ekSimple, ekFused, ekList) where -import Data.List+ import Data.Maybe import Data.Graph.Inductive.Graph-import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.PatriciaTree import Data.Graph.Inductive.Internal.FiniteMap import Data.Graph.Inductive.Internal.Queue import Data.Graph.Inductive.Query.BFS (bft)@@ -74,7 +74,7 @@ -- EXTRACT fglEdmondsFused.txt -- Compute an augmenting path augPathFused :: Network -> Node -> Node -> Maybe DirPath-augPathFused g s t = listToMaybe $ map reverse $ +augPathFused g s t = listToMaybe $ map reverse $ filter (\((u,_):_) -> u==t) tree where tree = bftForEK s g @@ -100,10 +100,10 @@ | ((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 +-- 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 +extractPathFused :: Network -> DirPath -> ([DirEdge (Double,Double)], Network) extractPathFused g [] = ([], g) extractPathFused g [(_,_)] = ([], g)@@ -118,7 +118,7 @@ -- ekFusedStep :: EKStepFunc ekFusedStep g s t = case maybePath of- Just _ -> + Just _ -> Just ((insEdges (integrateDelta es delta) newg), delta) Nothing -> Nothing where maybePath = augPathFused g s t@@ -134,9 +134,9 @@ -- EXTRACT fglEdmondsSimple.txt residualGraph :: Network -> Gr () Double-residualGraph g = - mkGraph (labNodes g) - ([(u, v, c-f) | (u, v, (c,f)) <- labEdges g, c>f ] ++ +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@@ -144,7 +144,7 @@ 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 +-- edges with direction of traversal, and new network with augmenting -- path removed. extractPath :: Network -> Path -> ([DirEdge (Double,Double)], Network) extractPath g [] = ([], g)@@ -155,7 +155,7 @@ where (tailedges, newerg) = extractPath newg (v:ws) Nothing -> case revExtract of- Just (l, newg) -> + Just (l, newg) -> ((v, u, l, Backward):tailedges, newerg) where (tailedges, newerg) = extractPath newg (v:ws) Nothing -> error "extractPath: revExtract == Nothing"@@ -170,16 +170,16 @@ 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 + (adj, rest)=extractAdj s (\(l', dest) -> (dest==v) && (p l')) --- Extract an item from an adjacency list that satisfies a given +-- 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) + | otherwise = (theone, adj:rest) where (theone, rest)=extractAdj adjs p getPathDeltas :: [DirEdge (Double,Double)] -> [Double]@@ -188,20 +188,20 @@ (_, _, (c,f), Forward) -> (c-f) : (getPathDeltas es) (_, _, (_,f), Backward) -> f : (getPathDeltas es) -integrateDelta :: [DirEdge (Double,Double)] -> Double +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), Forward) -> (u, v, (c, f+delta)) : (integrateDelta es delta)- (u, v, (c, f), Backward) -> + (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 _ -> Just ((insEdges (integrateDelta es delta) newg), delta) Nothing -> Nothing where maybePath = augPath g s t@@ -232,11 +232,11 @@ Nothing -> False Just () -> True -extractPathList :: [LEdge (Double, Double)] -> FiniteMap (Node,Node) () +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)) = + | (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)) =@@ -252,7 +252,7 @@ Nothing -> Nothing where newEdges = (integrateDelta es delta) ++ otheredges maybePath = augPathFused g s t- (es, otheredges) = extractPathList (labEdges g) + (es, otheredges) = extractPathList (labEdges g) (setFromList (zip justPath (tail justPath))) delta = minimum $ getPathDeltas es justPath = pathFromDirPath (fromJust maybePath)
Data/Graph/Inductive/Tree.hs view
@@ -1,46 +1,49 @@ -- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT] -- | Tree-based implementation of 'Graph' and 'DynGraph'+--+-- You will probably have better performance using the+-- "Data.Graph.Inductive.PatriciaTree" implementation instead. 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.List (foldl') import Data.Maybe (fromJust) - ---------------------------------------------------------------------- -- GRAPH REPRESENTATION ---------------------------------------------------------------------- data Gr a b = Gr (GraphRep a b)+ deriving (Eq) 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+instance (Show a, Show b) => Show (Gr a b) where+ showsPrec d g = showParen (d > 10) $+ showString "mkGraph "+ . shows (labNodes g)+ . showString " "+ . shows (labEdges g) +instance (Read a, Read b) => Read (Gr a b) where+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("mkGraph", s) <- lex r+ (ns,t) <- reads s+ (es,u) <- reads t+ return (mkGraph ns es, u) -- Graph--- +-- instance Graph Gr where empty = Gr emptyFM isEmpty (Gr g) = case g of {Empty -> True; _ -> False}@@ -60,8 +63,8 @@ labEdges (Gr g) = concatMap (\(v,(_,_,s))->map (\(l,w)->(v,w,l)) s) (fmToList g) -matchGr v (Gr g) = - case splitFM g v of +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@@ -71,7 +74,7 @@ -- DynGraph--- +-- instance DynGraph Gr where (p,v,l,s) & (Gr g) | elemFM g v = error ("Node Exception, Node: "++show v) | otherwise = Gr g3
fgl.cabal view
@@ -1,14 +1,16 @@ name: fgl-version: 5.4.2.4+version: 5.5.0.0 license: BSD3 license-file: LICENSE author: Martin Erwig, Ivan Lazar Miljenovic-maintainer: Ivan.Miljenovic@gmail.com, tomberek@gmail.com+maintainer: Ivan.Miljenovic@gmail.com homepage: http://web.engr.oregonstate.edu/~erwig/fgl/haskell category: Data Structures, Graphs synopsis: Martin Erwig's Functional Graph Library cabal-version: >= 1.6 build-type: Simple+extra-source-files:+ ChangeLog source-repository head type: darcs@@ -24,7 +26,6 @@ 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.PatriciaTree,@@ -45,6 +46,9 @@ Data.Graph.Inductive.Query.SP, Data.Graph.Inductive.Query.TransClos, Data.Graph.Inductive++ other-modules:+ Paths_fgl+ build-depends: base < 5, mtl, containers, array- extensions: MultiParamTypeClasses, OverlappingInstances, FlexibleInstances, ScopedTypeVariables }