Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-fgl for openSUSE:Factory checked
in at 2023-11-23 21:40:33
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-fgl (Old)
and /work/SRC/openSUSE:Factory/.ghc-fgl.new.25432 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-fgl"
Thu Nov 23 21:40:33 2023 rev:9 rq:1128071 version:5.8.2.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-fgl/ghc-fgl.changes 2023-06-30
19:59:10.957754237 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-fgl.new.25432/ghc-fgl.changes
2023-11-23 21:41:53.498239367 +0100
@@ -1,0 +2,28 @@
+Wed Oct 18 08:42:49 UTC 2023 - Peter Simons <psim...@suse.com>
+
+- Update fgl to version 5.8.2.0.
+ 5.8.2.0
+ -------
+
+ * Data.Graph.Inductive.Graph now only requires Graph, not DynGraph
+ (issue #100).
+
+ * Documented that some functions are partial (issue #98).
+
+ * Add `insert` function as synonym for `&` (issue #90).
+
+ 5.8.1.1
+ -------
+
+ * Data.Graph.Inductive.Query.Dominators.{dom,iDom} could fail for some
+ graphs (issue #109, regression in 5.8.1.0).
+
+ 5.8.1.0
+ -------
+
+ * Data.Graph.Inductive.PatriciaTree.Gr and
+ Data.Graph.Inductive.Tree.Gr now have Functor instances.
+
+ * 'Gr a' is now an instance of Functor.
+
+-------------------------------------------------------------------
Old:
----
fgl-5.8.0.0.tar.gz
fgl.cabal
New:
----
fgl-5.8.2.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-fgl.spec ++++++
--- /var/tmp/diff_new_pack.wiAoZL/_old 2023-11-23 21:41:54.446274286 +0100
+++ /var/tmp/diff_new_pack.wiAoZL/_new 2023-11-23 21:41:54.446274286 +0100
@@ -20,13 +20,12 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 5.8.0.0
+Version: 5.8.2.0
Release: 0
Summary: Martin Erwig's Functional Graph Library
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-array-devel
BuildRequires: ghc-array-prof
@@ -81,7 +80,6 @@
%prep
%autosetup -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ fgl-5.8.0.0.tar.gz -> fgl-5.8.2.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/ChangeLog new/fgl-5.8.2.0/ChangeLog
--- old/fgl-5.8.0.0/ChangeLog 2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/ChangeLog 2001-09-09 03:46:40.000000000 +0200
@@ -1,3 +1,27 @@
+5.8.2.0
+-------
+
+* Data.Graph.Inductive.Graph now only requires Graph, not DynGraph
+ (issue #100).
+
+* Documented that some functions are partial (issue #98).
+
+* Add `insert` function as synonym for `&` (issue #90).
+
+5.8.1.1
+-------
+
+* Data.Graph.Inductive.Query.Dominators.{dom,iDom} could fail for some
+ graphs (issue #109, regression in 5.8.1.0).
+
+5.8.1.0
+-------
+
+* Data.Graph.Inductive.PatriciaTree.Gr and
+ Data.Graph.Inductive.Tree.Gr now have Functor instances.
+
+* 'Gr a' is now an instance of Functor.
+
5.8.0.0
-------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Graph.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Graph.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Graph.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Graph.hs 2001-09-09
03:46:40.000000000 +0200
@@ -34,6 +34,7 @@
Graph(..),
DynGraph(..),
-- * Operations
+ insert,
order,
size,
-- ** Graph Folds and Maps
@@ -156,9 +157,10 @@
matchAny :: gr a b -> GDecomp gr a b
matchAny g = case labNodes g of
[] -> error "Match Exception, Empty Graph"
- (v,_):_ -> (c,g')
- where
- (Just c,g') = match v g
+ (v,_):_ ->
+ case match v g of
+ (Just c,g') -> (c,g')
+ _ -> error "Match Exception, cannot extract node"
-- | The number of 'Node's in a 'Graph'.
noNodes :: gr a b -> Int
@@ -186,6 +188,10 @@
-- in the graph.
(&) :: Context a b -> gr a b -> gr a b
+-- | A synonym for '&', to avoid conflicts with the similarly named
+-- operator in "Data.Function".
+insert :: DynGraph gr => Context a b -> gr a b -> gr a b
+insert = (&)
-- | The number of nodes in the graph. An alias for 'noNodes'.
order :: (Graph gr) => gr a b -> Int
@@ -302,7 +308,7 @@
--
-- NOTE: in the case of multiple edges with the same label, this
-- will only delete the /first/ such edge. To delete all such
--- edges, please use 'delAllLedge'.
+-- edges, please use 'delAllLEdge'.
delLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b
delLEdge = delLEdgeBy delete
@@ -577,7 +583,7 @@
-- | 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 :: (Graph gr, Show a, Show b) => gr a b -> String
prettify g = foldr (showsContext . context g) id (nodes g) ""
where
showsContext (_,n,l,s) sg = shows n . (':':) . shows l
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/fgl-5.8.0.0/Data/Graph/Inductive/Internal/RootPath.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Internal/RootPath.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Internal/RootPath.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Internal/RootPath.hs 2001-09-09
03:46:40.000000000 +0200
@@ -29,7 +29,7 @@
| otherwise = findP v ps
getPath :: Node -> RTree -> Path
-getPath v = reverse . first (\(w:_)->w==v)
+getPath v = reverse . first ((==v) . head)
getLPath :: Node -> LRTree a -> LPath a
getLPath v = LP . reverse . findP v
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Monad.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Monad.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Monad.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Monad.hs 2001-09-09
03:46:40.000000000 +0200
@@ -56,8 +56,10 @@
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')
+ (v,_):_ -> do r <- matchM v g
+ case r of
+ (Just c,g') -> return (c,g')
+ _ -> error "Match Exception, cannot
extract node"
noNodesM :: m (gr a b) -> m Int
noNodesM = labNodesM >>. length
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/NodeMap.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/NodeMap.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/NodeMap.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/NodeMap.hs 2001-09-09
03:46:40.000000000 +0200
@@ -112,20 +112,22 @@
let (g', _, _) = insMapNode m a g
in g'
+-- | Partial function: raises exception if passed nodes that are not in the
graph.
insMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a, b) -> g a b -> g a b
insMapEdge m e g =
- let (Just e') = mkEdge m e
- in insEdge e' g
+ case mkEdge m e of Just e' -> insEdge e' g
+ Nothing -> error "insMapEdge: invalid edge"
delMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b
delMapNode m a g =
let (n, _) = mkNode_ m a
in delNode n g
+-- | Partial function: raises exception if passed nodes that are not in the
graph.
delMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a) -> g a b -> g a b
delMapEdge m (n1, n2) g =
- let Just (n1', n2', _) = mkEdge m (n1, n2, ())
- in delEdge (n1', n2') g
+ case mkEdge m (n1, n2, ()) of Just (n1', n2', _) -> delEdge (n1', n2') g
+ Nothing -> error "delMapEdge: invalid edge"
insMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> (g a b,
NodeMap a, [LNode a])
insMapNodes m as g =
@@ -137,27 +139,33 @@
let (g', _, _) = insMapNodes m as g
in g'
+-- | Partial function: raises exception if passed nodes that are not in the
graph.
insMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a, b)] -> g a b -> g a
b
insMapEdges m es g =
- let Just es' = mkEdges m es
- in insEdges es' g
+ case mkEdges m es of Just es' -> insEdges es' g
+ Nothing -> error "insMapEdges: invalid edge"
delMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b
delMapNodes m as g =
let ns = P.map fst $ mkNodes_ m as
in delNodes ns g
+-- | Partial function: raises exception if passed nodes that are not in the
graph.
delMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a)] -> g a b -> g a b
delMapEdges m ns g =
- let Just ns' = mkEdges m $ P.map (\(a, b) -> (a, b, ())) ns
- ns'' = P.map (\(a, b, _) -> (a, b)) ns'
- in delEdges ns'' g
+ case mkEdges m $ P.map (\(a, b) -> (a, b, ())) ns of
+ Nothing -> error "delMapEdges: invalid edges"
+ Just ns' ->
+ let ns'' = P.map (\(a, b, _) -> (a, b)) ns'
+ in delEdges ns'' g
+-- | Partial function: raises exception if passed a node that is not in the
graph.
mkMapGraph :: (Ord a, DynGraph g) => [a] -> [(a, a, b)] -> (g a b, NodeMap a)
mkMapGraph ns es =
let (ns', m') = mkNodes new ns
- Just es' = mkEdges m' es
- in (mkGraph ns' es', m')
+ in case mkEdges m' es of
+ Just es' -> (mkGraph ns' es', m')
+ Nothing -> error "mkMapGraph: invalid edges"
-- | Graph construction monad; handles passing both the 'NodeMap' and the
-- 'Graph'.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/PatriciaTree.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/PatriciaTree.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/PatriciaTree.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/PatriciaTree.hs 2001-09-09
03:46:40.000000000 +0200
@@ -134,6 +134,9 @@
rnf (Gr g) = rnf g
#endif
+instance Functor (Gr a) where
+ fmap = fastEMap
+
#if MIN_VERSION_base (4,8,0)
instance Bifunctor Gr where
bimap = fastNEMap
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/BCC.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/BCC.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/BCC.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/BCC.hs 2001-09-09
03:46:40.000000000 +0200
@@ -43,10 +43,11 @@
splitGraphs :: (DynGraph gr) => [gr a b] -> [Node] -> [gr a b]
splitGraphs gs [] = gs
splitGraphs [] _ = error "splitGraphs: empty graph list"
-splitGraphs gs (v:vs) = splitGraphs (gs''++gs''') vs
- where gs'' = embedContexts c gs'
- gs' = gComponents g'
- ((Just c,g'), gs''') = findGraph v gs
+splitGraphs gs (v:vs) = case findGraph v gs of
+ ((Nothing, _), _) -> error "splitGraphs: invalid
node"
+ ((Just c,g'), gs''') -> splitGraphs (gs''++gs''') vs
+ where gs'' = embedContexts c gs'
+ gs' = gComponents g'
{-|
Finds the bi-connected components of an undirected connected graph.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/BFS.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/BFS.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/BFS.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/BFS.hs 2001-09-09
03:46:40.000000000 +0200
@@ -107,10 +107,12 @@
bf :: (Graph gr) => Queue Path -> gr a b -> RTree
bf q g | queueEmpty q || isEmpty g = []
| otherwise =
- case match v g of
- (Just c, g') -> p:bf (queuePutList (map (:p) (suc' c)) q') g'
- (Nothing, g') -> bf q' g'
- where (p@(v:_),q') = queueGet q
+ case queueGet q of
+ ([], _) -> []
+ (p@(v:_),q') ->
+ case match v g of
+ (Just c, g') -> p:bf (queuePutList (map (:p) (suc' c)) q') g'
+ (Nothing, g') -> bf q' g'
esp :: (Graph gr) => Node -> Node -> gr a b -> Path
esp s t = getPath t . bft s
@@ -128,11 +130,13 @@
lbf :: (Graph gr) => Queue (LPath b) -> gr a b -> LRTree b
lbf q g | queueEmpty q || isEmpty g = []
| otherwise =
- case match v g of
- (Just c, g') ->
- LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g'
- (Nothing, g') -> lbf q' g'
- where (LP (p@((v,_):_)),q') = queueGet q
+ case queueGet q of
+ (LP [], _) -> []
+ (LP (p@((v,_):_)),q') ->
+ case match v g of
+ (Just c, g') ->
+ LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q')
g'
+ (Nothing, g') -> lbf q' g'
lesp :: (Graph gr) => Node -> Node -> gr a b -> LPath b
lesp s t = getLPath t . lbft s
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/Dominators.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/Dominators.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/Dominators.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/Dominators.hs 2001-09-09
03:46:40.000000000 +0200
@@ -17,16 +17,17 @@
import Data.Graph.Inductive.Query.DFS
import Data.IntMap (IntMap)
import qualified Data.IntMap as I
+import Data.Maybe (mapMaybe)
import Data.Tree (Tree (..))
import qualified Data.Tree as T
{-# ANN iDom "HLint: ignore Use ***" #-}
--- | return immediate dominators for each node of a graph, given a root
+-- | return immediate dominators for each reachable node of a graph, given a
root
iDom :: (Graph gr) => gr a b -> Node -> [(Node,Node)]
iDom g root = let (result, toNode, _) = idomWork g root
in map (\(a, b) -> (toNode ! a, toNode ! b)) (assocs result)
--- | return the set of dominators of the nodes of a graph, given a root
+-- | return the set of dominators of the reachable nodes of a graph, given a
root
dom :: (Graph gr) => gr a b -> Node -> [(Node,[Node])]
dom g root = let
(iD, toNode, fromNode) = idomWork g root
@@ -50,24 +51,26 @@
type FromNode = IntMap Node'
idomWork :: (Graph gr) => gr a b -> Node -> (IDom, ToNode, FromNode)
-idomWork g root = let
- -- use depth first tree from root do build the first approximation
- trees@(~[tree]) = dff [root] g
- -- relabel the tree so that paths from the root have increasing nodes
- (s, ntree) = numberTree 0 tree
- -- the approximation iDom0 just maps each node to its parent
- iD0 = array (1, s-1) (tail $ treeEdges (-1) ntree)
- -- fromNode translates graph nodes to relabeled (internal) nodes
- fromNode = I.unionWith const (I.fromList (zip (T.flatten tree) (T.flatten
ntree))) (I.fromList (zip (nodes g) (repeat (-1))))
- -- toNode translates internal nodes to graph nodes
- toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree))
- preds = array (1, s-1) [(i, filter (/= -1) (map (fromNode I.!)
- (pre g (toNode ! i)))) | i <- [1..s-1]]
- -- iteratively improve the approximation to find iDom.
- iD = fixEq (refineIDom preds) iD0
- in
- if null trees then error "Dominators.idomWork: root not in graph"
- else (iD, toNode, fromNode)
+idomWork g root =
+ case dff [root] g of
+ [] -> error "Dominators.idomWork: root not in graph"
+ tree : _ ->
+ let
+ nds = reachable root g
+ -- use depth first tree from root do build the first approximation
+ -- relabel the tree so that paths from the root have increasing nodes
+ (s, ntree) = numberTree 0 tree
+ -- the approximation iDom0 just maps each node to its parent
+ iD0 = array (1, s-1) (tail $ treeEdges (-1) ntree)
+ -- fromNode translates graph nodes to relabeled (internal) nodes
+ fromNode = I.unionWith const (I.fromList (zip (T.flatten tree)
(T.flatten ntree))) (I.fromList (zip nds (repeat (-1))))
+ -- toNode translates internal nodes to graph nodes
+ toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree))
+ preds = array (1, s-1) [(i, filter (/= -1) (mapMaybe (`I.lookup`
fromNode)
+ (pre g (toNode ! i)))) | i <- [1..s-1]]
+ -- iteratively improve the approximation to find iDom.
+ iD = fixEq (refineIDom preds) iD0
+ in (iD, toNode, fromNode)
-- for each node in iDom, find the intersection of all its predecessor's
-- dominating sets, and update iDom accordingly.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/Indep.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/Indep.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/Indep.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/Indep.hs 2001-09-09
03:46:40.000000000 +0200
@@ -22,12 +22,14 @@
indepSize :: (DynGraph gr) => gr a b -> ([Node], Int)
indepSize g
| isEmpty g = ([], 0)
- | l1 > l2 = il1
- | otherwise = il2
+ | otherwise =
+ case match v g of
+ (Nothing,_) -> error "indepSize: unexpected invalid node"
+ (Just c,g') ->
+ let il1@(_,l1) = indepSize g'
+ il2@(_,l2) = ((v:) *** (+1)) $ indepSize (delNodes (neighbors'
c) g')
+ in if l1 > l2 then il1 else il2
where
vs = nodes g
v = snd . maximumBy (compare `on` fst)
. map ((,) =<< deg g) $ vs
- (Just c,g') = match v g
- il1@(_,l1) = indepSize g'
- il2@(_,l2) = ((v:) *** (+1)) $ indepSize (delNodes (neighbors' c) g')
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/MST.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/MST.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/MST.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/MST.hs 2001-09-09
03:46:40.000000000 +0200
@@ -20,10 +20,12 @@
prim :: (Graph gr,Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b
prim h g | H.isEmpty h || isEmpty g = []
prim h g =
- case match v g of
- (Just c,g') -> p:prim (H.mergeAll (h':newEdges p c)) g'
- (Nothing,g') -> prim h' g'
- where (_,p@(LP ((v,_):_)),h') = H.splitMin h
+ case H.splitMin h of
+ (_,p@(LP ((v,_):_)),h') ->
+ case match v g of
+ (Just c,g') -> p:prim (H.mergeAll (h':newEdges p c)) g'
+ (Nothing,g') -> prim h' g'
+ _ -> []
msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b
msTreeAt v = prim (H.unit 0 (LP [(v,0)]))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/MaxFlow.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/MaxFlow.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/MaxFlow.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/MaxFlow.hs 2001-09-09
03:46:40.000000000 +0200
@@ -64,10 +64,11 @@
-- residual capacity of that edge's label. Then return the updated
-- list.
updAdjList::(Num b) => Adj (b,b,b) -> Node -> b -> Bool -> Adj (b,b,b)
-updAdjList s v cf fwd = rs ++ ((x,y+cf',z-cf'),w) : rs'
+updAdjList s v cf fwd =
+ case break ((v==) . snd) s of
+ (rs, ((x,y,z),w):rs') -> rs ++ ((x,y+cf',z-cf'),w) : rs'
+ _ -> error "updAdjList: invalid node"
where
- (rs, ((x,y,z),w):rs') = break ((v==) . snd) s
-
cf' = if fwd
then cf
else negate cf
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/MaxFlow2.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/MaxFlow2.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/MaxFlow2.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/MaxFlow2.hs 2001-09-09
03:46:40.000000000 +0200
@@ -77,7 +77,7 @@
-- Compute an augmenting path
augPathFused :: Network -> Node -> Node -> Maybe DirPath
augPathFused g s t = listToMaybe $ map reverse $
- filter (\((u,_):_) -> u==t) tree
+ filter ((==t) . fst . head) tree
where tree = bftForEK s g
-- Breadth First Search wrapper function
@@ -87,8 +87,12 @@
-- Breadth First Search, tailored for Edmonds & Karp
bfForEK :: Queue DirPath -> Network -> DirRTree
bfForEK q g
- | queueEmpty q || isEmpty g = []
- | otherwise = case match v g of
+ | queueEmpty q || isEmpty g = []
+ | otherwise =
+ case queueGet q of
+ ([], _) -> []
+ (p@((v,_):_), q1) ->
+ case match v g of
(Nothing, g') -> bfForEK q1 g'
(Just (preAdj, _, _, sucAdj), g') -> p:bfForEK q2 g'
where
@@ -100,7 +104,6 @@
-- Traverse edges forwards if flow less than capacity
suc2 = [ (sucNode,Forward):p
| ((c, f), sucNode) <- sucAdj, c>f]
- where (p@((v,_):_), q1)=queueGet q
-- Extract augmenting path from network; return path as a sequence of
-- edges with direction of traversal, and new network with augmenting
@@ -110,13 +113,17 @@
extractPathFused g [] = ([], g)
extractPathFused g [(_,_)] = ([], g)
extractPathFused g ((u,_):rest@((v,Forward):_)) =
- ((u, v, l, Forward):tailedges, newerg)
- where (tailedges, newerg) = extractPathFused newg rest
- Just (l, newg) = extractEdge g u v (uncurry (>))
+ case extractEdge g u v (uncurry (>)) of
+ Just (l, newg) ->
+ let (tailedges, newerg) = extractPathFused newg rest
+ in ((u, v, l, Forward):tailedges, newerg)
+ Nothing -> error "extractPathFused Forward: invalid edge"
extractPathFused g ((u,_):rest@((v,Backward):_)) =
- ((v, u, l, Backward):tailedges, newerg)
- where (tailedges, newerg) = extractPathFused newg rest
- Just (l, newg) = extractEdge g v u (\(_,f)->(f>0))
+ case extractEdge g v u (\(_,f)->(f>0)) of
+ Just (l, newg) ->
+ let (tailedges, newerg) = extractPathFused newg rest
+ in ((v, u, l, Backward):tailedges, newerg)
+ Nothing -> error "extractPathFused Backward: invalid edge"
ekFusedStep :: EKStepFunc
ekFusedStep g s t = case maybePath of
@@ -142,7 +149,7 @@
[(v, u, f) | (u,v,(_,f)) <- labEdges g, f>0])
augPath :: Network -> Node -> Node -> Maybe Path
-augPath g s t = listToMaybe $ map reverse $ filter (\(u:_) -> u==t) tree
+augPath g s t = listToMaybe $ map reverse $ filter ((==t) . head) tree
where tree = bft s (residualGraph g)
-- Extract augmenting path from network; return path as a sequence of
@@ -168,12 +175,12 @@
-- Return the label on the edge and the graph without the edge
extractEdge :: Gr a b -> Node -> Node -> (b->Bool) -> Maybe (b, Gr a b)
extractEdge g u v p =
- case adj of
- Just (el, _) -> Just (el, (p', node, l, rest) & newg)
- Nothing -> Nothing
- where (Just (p', node, l, s), newg) = match u g
- (adj, rest)=extractAdj s
- (\(l', dest) -> dest==v && p l')
+ case match u g of
+ ((Just (p', node, l, s), newg)) ->
+ let (adj, rest)=extractAdj s (\(l', dest) -> dest==v && p l')
+ in do (el, _) <- adj
+ Just (el, (p', node, l, rest) & newg)
+ _ -> Nothing
-- Extract an item from an adjacency list that satisfies a given
-- predicate. Return the item and the rest of the adjacency list
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/Monad.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/Monad.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/Monad.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/Monad.hs 2001-09-09
03:46:40.000000000 +0200
@@ -78,11 +78,11 @@
fmap = liftM
instance (Monad m) => Applicative (GT m g) where
- pure = return
+ pure x = MGT (\mg->do {g<-mg; return (x,g)})
(<*>) = ap
instance (Monad m) => Monad (GT m g) where
- return x = MGT (\mg->do {g<-mg; return (x,g)})
+ return = pure
f >>= h = MGT (\mg->do {(x,g)<-apply f mg; apply' (h x) g})
condMGT' :: (Monad m) => (s -> Bool) -> GT m s a -> GT m s a -> GT m s a
@@ -218,14 +218,15 @@
dffM vs = MGT (\mg->
do g<-mg
b<-isEmptyM mg
- if b||null vs then return ([],g) else
- let (v:vs') = vs in
- do (mc,g1) <- matchM v mg
+ case (b, vs) of
+ (False, v:vs') -> do
+ (mc,g1) <- matchM v mg
case mc of
Nothing -> apply (dffM vs') (return g1)
Just c -> do (ts, g2) <- apply (dffM (suc' c)) (return
g1)
(ts',g3) <- apply (dffM vs') (return g2)
return (Node (node' c) ts:ts',g3)
+ _ -> return ([],g)
)
graphDff :: (GraphM m gr) => [Node] -> m (gr a b) -> m [Tree Node]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/SP.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/SP.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/SP.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/SP.hs 2001-09-09
03:46:40.000000000 +0200
@@ -28,10 +28,12 @@
-> LRTree b
dijkstra h g | H.isEmpty h || isEmpty g = []
dijkstra h g =
- case match v g of
- (Just c,g') -> p:dijkstra (H.mergeAll (h':expand d p c)) g'
- (Nothing,g') -> dijkstra h' g'
- where (_,p@(LP ((v,d):_)),h') = H.splitMin h
+ case H.splitMin h of
+ (_,p@(LP ((v,d):_)),h') ->
+ case match v g of
+ (Just c,g') -> p:dijkstra (H.mergeAll (h':expand d p c)) g'
+ (Nothing,g') -> dijkstra h' g'
+ _ -> []
-- | Tree of shortest paths from a certain node to the rest of the
-- (reachable) nodes.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Query/TransClos.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Query/TransClos.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Query/TransClos.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Query/TransClos.hs 2001-09-09
03:46:40.000000000 +0200
@@ -18,8 +18,8 @@
outU gr = map toEdge . out gr
{-|
-Finds the transitive, reflexive closure of a directed graph.
-Given a graph G=(V,E), its transitive closure is the graph:
+Finds the reflexive-transitive closure of a directed graph.
+Given a graph G=(V,E), its reflexive-transitive closure is the graph:
G* = (V,E*) where E*={(i,j): i,j in V and either i = j or there is a path from
i to j in G}
-}
trc :: (DynGraph gr) => gr a b -> gr a ()
@@ -30,11 +30,12 @@
{-|
Finds the reflexive closure of a directed graph.
-Given a graph G=(V,E), its transitive closure is the graph:
+Given a graph G=(V,E), its reflexive closure is the graph:
G* = (V,Er union E) where Er = {(i,i): i in V}
-}
rc :: (DynGraph gr) => gr a b -> gr a ()
-rc g = newEdges `insEdges` insNodes ln empty
+rc g = (newEdges ++ oldEdges) `insEdges` insNodes ln empty
where
ln = labNodes g
newEdges = [ (u, u, ()) | (u, _) <- ln ]
+ oldEdges = [ (u, v, ()) | (u, v, _) <- labEdges g ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/Data/Graph/Inductive/Tree.hs
new/fgl-5.8.2.0/Data/Graph/Inductive/Tree.hs
--- old/fgl-5.8.0.0/Data/Graph/Inductive/Tree.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/Data/Graph/Inductive/Tree.hs 2001-09-09
03:46:40.000000000 +0200
@@ -135,6 +135,9 @@
rnf (Gr g) = rnf g
#endif
+instance Functor (Gr a) where
+ fmap = emap
+
#if MIN_VERSION_base (4,8,0)
instance Bifunctor Gr where
bimap = nemap
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/LICENSE new/fgl-5.8.2.0/LICENSE
--- old/fgl-5.8.0.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
@@ -1,5 +1,6 @@
Copyright (c) 1999-2008, Martin Erwig
2010, Ivan Lazar Miljenovic
+ 2023, Troels Henriksen
All rights reserved.
Redistribution and use in source and binary forms, with or without
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/fgl-5.8.0.0/fgl-arbitrary/Data/Graph/Inductive/Arbitrary.hs
new/fgl-5.8.2.0/fgl-arbitrary/Data/Graph/Inductive/Arbitrary.hs
--- old/fgl-5.8.0.0/fgl-arbitrary/Data/Graph/Inductive/Arbitrary.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/fgl-arbitrary/Data/Graph/Inductive/Arbitrary.hs
2001-09-09 03:46:40.000000000 +0200
@@ -321,23 +321,24 @@
toConnGraph :: forall ag a b. (ArbGraph ag, Arbitrary a, Arbitrary b)
=> ag a b -> Gen (Connected ag a b)
-toConnGraph ag = do a <- arbitrary
- ces <- concat <$> mapM mkE ws
- return $ CG { connNode = v
- , connArbGraph = fromBaseGraph
- . insEdges ces
- . insNode (v,a)
- $ g
- }
+toConnGraph ag = case newNodes 1 g of
+ [] -> error "toConnGraph: cannot make node"
+ v:_ -> do
+ a <- arbitrary
+ ces <- concat <$> mapM (mkE v) ws
+ return $ CG { connNode = v
+ , connArbGraph = fromBaseGraph
+ . insEdges ces
+ . insNode (v,a)
+ $ g
+ }
where
g = toBaseGraph ag
- [v] = newNodes 1 g
-
ws = nodes g
- mkE w = do b <- arbitrary
- return (edgeF p [(v,w,b)])
+ mkE v w = do b <- arbitrary
+ return (edgeF p [(v,w,b)])
p :: GrProxy ag
p = GrProxy
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/fgl.cabal new/fgl-5.8.2.0/fgl.cabal
--- old/fgl-5.8.0.0/fgl.cabal 2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/fgl.cabal 2001-09-09 03:46:40.000000000 +0200
@@ -1,9 +1,9 @@
name: fgl
-version: 5.8.0.0
+version: 5.8.2.0
license: BSD3
license-file: LICENSE
author: Martin Erwig, Ivan Lazar Miljenovic
-maintainer: ivan.miljeno...@gmail.com
+maintainer: at...@sigkill.dk
category: Data Structures, Graphs
synopsis: Martin Erwig's Functional Graph Library
@@ -20,7 +20,7 @@
tested-with: GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4,
GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3,
GHC == 8.6.2, GHC == 8.8.2, GHC == 8.10.7, GHC == 9.0.2,
- GHC == 9.2.3, GHC == 9.4.2
+ GHC == 9.2.4, GHC == 9.4.4, GHC == 9.6.3, GHC == 9.8.1
source-repository head
type: git
@@ -73,7 +73,7 @@
if flag(containers042)
build-depends: containers >= 0.4.2
- , deepseq >= 1.1.0.0 && < 1.5
+ , deepseq >= 1.1.0.0 && < 1.6
else
build-depends: containers < 0.4.2
@@ -93,7 +93,7 @@
build-depends: fgl
, base
, QuickCheck >= 2.8 && < 2.15
- , hspec >= 2.1 && < 2.11
+ , hspec >= 2.1 && < 2.12
, containers
hs-source-dirs: test
@@ -107,6 +107,8 @@
, Data.Graph.Inductive.Query.Properties
ghc-options: -Wall
+ if impl(ghc >= 8.0)
+ ghc-options: -Wall -Wno-star-is-type
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/fgl-5.8.0.0/test/Data/Graph/Inductive/Graph/Properties.hs
new/fgl-5.8.2.0/test/Data/Graph/Inductive/Graph/Properties.hs
--- old/fgl-5.8.0.0/test/Data/Graph/Inductive/Graph/Properties.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/test/Data/Graph/Inductive/Graph/Properties.hs
2001-09-09 03:46:40.000000000 +0200
@@ -194,18 +194,17 @@
-- current behaviour is to throw an error if an existing node is
-- used.
valid_insNode :: (DynGraph gr, Ord a, Ord b) => gr a b -> a -> Bool
-valid_insNode g l = gelem v g'
- && sort (labNodes g') == sort (vl : labNodes g)
- && sort (labEdges g') == sort (labEdges g)
- -- Note: not testing whether this changes
- -- nodeRange because newNodes /might/ return
- -- unused nodes in the middle.
- where
- [v] = newNodes 1 g
-
- vl = (v,l)
-
- g' = insNode vl g
+valid_insNode g l =
+ case newNodes 1 g of
+ [v] -> let vl = (v,l)
+ g' = insNode vl g
+ in gelem v g'
+ && sort (labNodes g') == sort (vl : labNodes g)
+ && sort (labEdges g') == sort (labEdges g)
+ -- Note: not testing whether this changes
+ -- nodeRange because newNodes /might/ return
+ -- unused nodes in the middle.
+ _ -> False
-- | Insert a node for every label in the list, but don't add any new
-- edges.
@@ -329,12 +328,13 @@
-- adding the specified number to the graph and then deleting them.
valid_delAllLEdge :: (DynGraph gr, Eq a, Eq b) => gr a b -> NonNegative Int
-> a -> a -> b -> Bool
-valid_delAllLEdge g (NonNegative c) a1 a2 b = equal g' (delAllLEdge le g'')
- where
- [v,w] = newNodes 2 g
- g' = insNodes [(v,a1),(w,a2)] g
- le = (v,w,b)
- g'' = insEdges (replicate c le) g'
+valid_delAllLEdge g (NonNegative c) a1 a2 b =
+ case newNodes 2 g of
+ [v,w] -> let g' = insNodes [(v,a1),(w,a2)] g
+ le = (v,w,b)
+ g'' = insEdges (replicate c le) g'
+ in equal g' (delAllLEdge le g'')
+ _ -> False
-- | There is a version of 'mkGraph' in its documentation that uses
-- 'DynGraph' (hence why it isn't used by default). This ensures
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/fgl-5.8.0.0/test/Data/Graph/Inductive/Query/Properties.hs
new/fgl-5.8.2.0/test/Data/Graph/Inductive/Query/Properties.hs
--- old/fgl-5.8.0.0/test/Data/Graph/Inductive/Query/Properties.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/test/Data/Graph/Inductive/Query/Properties.hs
2001-09-09 03:46:40.000000000 +0200
@@ -133,14 +133,25 @@
-- Dominators
test_dom :: Spec
-test_dom = it "dom" $
- sortIt (dom domGraph 1) `shouldMatchList` [ (1, [1])
- , (2, [1,2])
- , (3, [1,2,3])
- , (4, [1,2,4])
- , (5, [1,2,5])
- , (6, [1,2,6])
- ]
+test_dom = describe "dom" $ do
+ it "regular dom" $
+ sortIt (dom domGraph 1) `shouldMatchList` [ (1, [1])
+ , (2, [1,2])
+ , (3, [1,2,3])
+ , (4, [1,2,4])
+ , (5, [1,2,5])
+ , (6, [1,2,6])
+ ]
+ it "multiple components dom" $
+ sortIt (dom domGraph1 1) `shouldMatchList` [ (1, [1])
+ , (2, [1, 2])
+ ]
+ it "directed reachable components dom" $
+ sortIt (dom domGraph2 1) `shouldMatchList` [ (1, [1]) ]
+
+ it "unreachable nodes dom" $
+ sortIt (dom domGraph3 1) `shouldMatchList` [(1,[1]), (2,[1,2])]
+
where
sortIt = map (second sort)
@@ -160,6 +171,23 @@
, (5,2)
]
+-- This graph has two components (independent subgraphs)
+domGraph1 :: Gr () ()
+domGraph1 = mkUGraph [1..3]
+ [ (1,2)
+ ]
+
+-- This graph has no reachables from 1 (but 1 is reachable)
+domGraph2 :: Gr () ()
+domGraph2 = mkUGraph [1..3]
+ [ (2,1)
+ , (2,2)
+ ]
+
+-- From #109: 1 -> 2 <- 3
+domGraph3 :: Gr () ()
+domGraph3 = mkUGraph [1..3] [(1,2), (3,2)]
+
--
-----------------------------------------------------------------------------
-- GVD
@@ -333,26 +361,29 @@
test_sp_Just :: (ArbGraph gr, Graph gr, Real b) =>
Proxy (gr a b) -> gr a b -> Property
test_sp_Just _ g =
- (noNodes g >= 2 && v `elem` bfs u g) ==>
- isJust (spLength u v g) &&
- isJust maybePath &&
- not (null path) &&
- head path == u &&
- last path == v
- where
- [u,v] = take 2 (nodes g)
- maybePath@(Just path) = sp u v g
+ case nodes g of
+ u:v:_ ->
+ v `elem` bfs u g ==>
+ isJust (spLength u v g) &&
+ case sp u v g of
+ Nothing -> False
+ Just path ->
+ not (null path) &&
+ head path == u &&
+ last path == v
+ _ -> property True
-- | Test that 'spLength' and 'sp' return 'Nothing' when destination
-- is not reachable from source.
test_sp_Nothing :: (ArbGraph gr, Graph gr, Real b) =>
Proxy (gr a b) -> gr a b -> Property
test_sp_Nothing _ g =
- (noNodes g >= 2 && not (v `elem` bfs u g)) ==>
- isNothing (spLength u v g) &&
- isNothing (sp u v g)
- where
- [u,v] = take 2 (nodes g)
+ case nodes g of
+ u:v:_ ->
+ not (v `elem` bfs u g) ==>
+ isNothing (spLength u v g) &&
+ isNothing (sp u v g)
+ _ -> property True
--
-----------------------------------------------------------------------------
-- TransClos
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.8.0.0/test/TestSuite.hs
new/fgl-5.8.2.0/test/TestSuite.hs
--- old/fgl-5.8.0.0/test/TestSuite.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/fgl-5.8.2.0/test/TestSuite.hs 2001-09-09 03:46:40.000000000 +0200
@@ -79,7 +79,7 @@
propType "subgraph" valid_subgraph
where
- proxyProp str = prop str . ($p)
+ proxyProp str = prop str . ($ p)
propType :: (Testable pr) => String -> (GraphType gr -> pr) -> Spec
propType = prop
@@ -126,7 +126,7 @@
propP "tc" test_tc
propP "rc" test_rc
where
- propP str = prop str . ($p)
+ propP str = prop str . ($ p)
p :: PatriciaTreeP
p = Proxy
