packages feed

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 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 }