![](https://seccdn.libravatar.org/avatar/128a7b98d536a9cf9b4d4d5a90d63475.jpg?s=120&d=mm&r=g)
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 <psimons@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.Miljenovic@gmail.com +maintainer: athas@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