Hello community, here is the log from the commit of package ghc-fgl for openSUSE:Factory checked in at 2014-11-26 20:54:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-fgl (Old) and /work/SRC/openSUSE:Factory/.ghc-fgl.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-fgl" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-fgl/ghc-fgl.changes 2014-08-25 11:05:52.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-fgl.new/ghc-fgl.changes 2014-11-26 20:54:41.000000000 +0100 @@ -1,0 +2,7 @@ +Tue Sep 2 08:55:52 UTC 2014 - peter.trommler@ohm-hochschule.de + +- update to 5.5.0.1 for Haskell Platform 2014.2.0.0 +* fixes for Tree and PatriciaTree classes +- regenerate spec file + +------------------------------------------------------------------- Old: ---- fgl-5.4.2.4.tar.gz New: ---- fgl-5.5.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-fgl.spec ++++++ --- /var/tmp/diff_new_pack.tGtTWF/_old 2014-11-26 20:54:42.000000000 +0100 +++ /var/tmp/diff_new_pack.tGtTWF/_new 2014-11-26 20:54:42.000000000 +0100 @@ -19,44 +19,43 @@ %global pkg_name fgl -%global common_summary Haskell functional graph library - -%global common_description Martin Erwig's functional graph library for Haskell. -#' Help syntax highlighting in EMACS. - Name: ghc-fgl -Version: 5.4.2.4 +Version: 5.5.0.1 Release: 0 -Summary: %{common_summary} +Summary: Martin Erwig's Functional Graph Library License: BSD-3-Clause Group: System/Libraries +# ' Help EMACS syntax highlighting -BuildRoot: %{_tmppath}/%{name}-%{version}-build -# BEGIN cabal2spec Url: http://hackage.haskell.org/package/%{pkg_name} Source0: http://hackage.haskell.org/packages/archive/%{pkg_name}/%{version}/%{pkg_name}-%{version}.tar.gz Source1: ghc-fgl-rpmlintrc +BuildRoot: %{_tmppath}/%{name}-%{version}-build + BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-rpm-macros +# Begin cabal-rpm deps: BuildRequires: ghc-array-devel BuildRequires: ghc-containers-devel BuildRequires: ghc-mtl-devel -BuildRequires: ghc-rpm-macros -# END cabal2spec +# End cabal-rpm deps %description -%{common_description} +Martin Erwig's Functional Graph Library for Haskell. +#' Help EMACS syntax highlighting %package devel Summary: Haskell %{pkg_name} library development files -Group: Development/Languages/Other -Requires: ghc-compiler -Requires(post): ghc-compiler -Requires(postun): ghc-compiler +Group: Development/Libraries/Other +Provides: %{name}-static = %{version}-%{release} +Requires: ghc-compiler = %{ghc_version} +Requires(post): ghc-compiler = %{ghc_version} +Requires(postun): ghc-compiler = %{ghc_version} Requires: %{name} = %{version}-%{release} %description devel -%{common_description} -This package contains the development files. +This package provides the Haskell %{pkg_name} library development files. + %prep %setup -q -n %{pkg_name}-%{version} ++++++ fgl-5.4.2.4.tar.gz -> fgl-5.5.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/ChangeLog new/fgl-5.5.0.1/ChangeLog --- old/fgl-5.4.2.4/ChangeLog 1970-01-01 01:00:00.000000000 +0100 +++ new/fgl-5.5.0.1/ChangeLog 2014-04-28 06:32:54.000000000 +0200 @@ -0,0 +1,38 @@ +5.5.0.1 +------- + +* Fix up Eq instances for Tree and PatriciaTree so that they work with + multiple edges. + +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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Example.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Example.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Example.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Example.hs 2014-04-28 06:32:54.000000000 +0200 @@ -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"]) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Graph.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Graph.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Graph.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Graph.hs 2014-04-28 06:32:54.000000000 +0200 @@ -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 + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Graphviz.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Graphviz.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Graphviz.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Graphviz.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 "" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Internal/FiniteMap.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Internal/FiniteMap.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Internal/FiniteMap.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Internal/FiniteMap.hs 2014-04-28 06:32:54.000000000 +0200 @@ -17,12 +17,15 @@ 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) +instance Functor (FiniteMap a) where + fmap _ Empty = Empty + fmap f (Node h l (i,x) r) = Node h (fmap f l) (i, f x) (fmap f r) ---------------------------------------------------------------------- -- UTILITIES @@ -33,9 +36,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 +48,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 +67,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 +104,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 +133,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 +160,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 +199,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" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Monad/IOArray.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Monad/IOArray.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Monad/IOArray.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Monad/IOArray.hs 2014-04-28 06:32:54.000000000 +0200 @@ -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,7 +17,7 @@ import Data.Array import Data.Array.IO import System.IO.Unsafe -import Data.Maybe + ---------------------------------------------------------------------- @@ -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)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Monad.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Monad.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Monad.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Monad.hs 2014-04-28 06:32:54.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/PatriciaTree.hs new/fgl-5.5.0.1/Data/Graph/Inductive/PatriciaTree.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/PatriciaTree.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/PatriciaTree.hs 2014-04-28 06:32:54.000000000 +0200 @@ -22,12 +22,12 @@ ) 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) @@ -37,6 +37,24 @@ type UGr = Gr () () +instance (Eq a, Ord b) => Eq (Gr a b) where + (Gr g1) == (Gr g2) = fmap sortAdj g1 == fmap sortAdj g2 + where + sortAdj (a1,n,a2) = (fmap sort a1,n,fmap sort a2) + +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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Query/MaxFlow2.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Query/MaxFlow2.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Query/MaxFlow2.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Query/MaxFlow2.hs 2014-04-28 06:32:54.000000000 +0200 @@ -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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive/Tree.hs new/fgl-5.5.0.1/Data/Graph/Inductive/Tree.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive/Tree.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive/Tree.hs 2014-04-28 06:32:54.000000000 +0200 @@ -1,16 +1,17 @@ -- (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', sort) import Data.Maybe (fromJust) - ---------------------------------------------------------------------- -- GRAPH REPRESENTATION ---------------------------------------------------------------------- @@ -22,25 +23,31 @@ 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 (Eq a, Ord b) => Eq (Gr a b) where + (Gr g1) == (Gr g2) = fmap sortAdj g1 == fmap sortAdj g2 + where + sortAdj (a1,n,a2) = (sort a1,n,sort a2) + +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 +67,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 +78,7 @@ -- DynGraph --- +-- instance DynGraph Gr where (p,v,l,s) & (Gr g) | elemFM g v = error ("Node Exception, Node: "++show v) | otherwise = Gr g3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/Data/Graph/Inductive.hs new/fgl-5.5.0.1/Data/Graph/Inductive.hs --- old/fgl-5.4.2.4/Data/Graph/Inductive.hs 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/Data/Graph/Inductive.hs 2014-04-28 06:32:54.000000000 +0200 @@ -1,6 +1,6 @@ ------------------------------------------------------------------------------ --- --- Inductive.hs -- Functional Graph Library +-- +-- Inductive.hs -- Functional Graph Library -- -- (c) 1999-2007 by Martin Erwig [see file COPYRIGHT] -- @@ -8,26 +8,28 @@ 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.4.2.4/fgl.cabal new/fgl-5.5.0.1/fgl.cabal --- old/fgl-5.4.2.4/fgl.cabal 2011-08-15 06:40:28.000000000 +0200 +++ new/fgl-5.5.0.1/fgl.cabal 2014-04-28 06:32:54.000000000 +0200 @@ -1,14 +1,16 @@ name: fgl -version: 5.4.2.4 +version: 5.5.0.1 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 } -- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org