Hello community,
here is the log from the commit of package ghc-fgl for openSUSE:Factory checked
in at 2016-08-24 10:08:11
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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 2016-07-21
08:12:40.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-fgl.new/ghc-fgl.changes 2016-08-24
10:08:13.000000000 +0200
@@ -1,0 +2,5 @@
+Fri Jul 22 06:07:23 UTC 2016 - psim...@suse.com
+
+- Update to version 5.5.3.0 revision 0 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
fgl-5.5.2.3.tar.gz
New:
----
fgl-5.5.3.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-fgl.spec ++++++
--- /var/tmp/diff_new_pack.FEmz78/_old 2016-08-24 10:08:14.000000000 +0200
+++ /var/tmp/diff_new_pack.FEmz78/_new 2016-08-24 10:08:14.000000000 +0200
@@ -19,7 +19,7 @@
%global pkg_name fgl
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 5.5.2.3
+Version: 5.5.3.0
Release: 0
Summary: Martin Erwig's Functional Graph Library
License: BSD-3-Clause
@@ -27,7 +27,6 @@
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-array-devel
BuildRequires: ghc-containers-devel
BuildRequires: ghc-deepseq-devel
@@ -38,7 +37,6 @@
BuildRequires: ghc-QuickCheck-devel
BuildRequires: ghc-hspec-devel
%endif
-# End cabal-rpm deps
%description
An inductive representation of manipulating graph data structures.
@@ -70,9 +68,7 @@
%check
-%if %{with tests}
-%{cabal} test
-%endif
+%cabal_test
%post devel
++++++ fgl-5.5.2.3.tar.gz -> fgl-5.5.3.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/ChangeLog new/fgl-5.5.3.0/ChangeLog
--- old/fgl-5.5.2.3/ChangeLog 2015-09-08 15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/ChangeLog 2016-07-15 08:40:25.000000000 +0200
@@ -1,3 +1,19 @@
+5.5.3.0
+-------
+
+* Additional closure functions by Matthew Danish.
+
+* `Bifunctor` instances for base >= 4.8.0.0.
+
+* An `ST`-based `GraphM` instance.
+
+* Addition of `order` and `size` functions for finding the number of
+ nodes and edges respectively in a graph (the former is an alias for
+ the existing `noNodes` function).
+
+* The rules for faster implementations of `insNode` and `insEdge` for
+ `PatriciaTree` should fire more often now.
+
5.5.2.3
-------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/Graph.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/Graph.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/Graph.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/Graph.hs 2016-07-15
08:40:25.000000000 +0200
@@ -34,6 +34,8 @@
Graph(..),
DynGraph(..),
-- * Operations
+ order,
+ size,
-- ** Graph Folds and Maps
ufold,gmap,nmap,emap,nemap,
-- ** Graph Projection
@@ -173,8 +175,29 @@
class (Graph gr) => DynGraph gr where
-- | Merge the 'Context' into the 'DynGraph'.
+ --
+ -- Contexts should only refer to either a Node already in a graph
+ -- or the node in the Context itself (for loops).
(&) :: Context a b -> gr a b -> gr a b
+
+-- | The number of nodes in the graph. An alias for 'noNodes'.
+order :: (Graph gr) => gr a b -> Int
+order = noNodes
+
+-- | The number of edges in the graph.
+--
+-- Note that this counts every edge found, so if you are
+-- representing an unordered graph by having each edge mirrored this
+-- will be incorrect.
+--
+-- If you created an unordered graph by either mirroring every edge
+-- (including loops!) or using the @undir@ function in
+-- "Data.Graph.Inductive.Basic" then you can safely halve the value
+-- returned by this.
+size :: (Graph gr) => gr a b -> Int
+size = length . labEdges
+
-- | Fold a function over the graph.
ufold :: (Graph gr) => (Context a b -> c -> c) -> c -> gr a b -> c
ufold f u g
@@ -252,6 +275,7 @@
(pr,_,la,su) = fromMaybe
(error ("insEdge: cannot add edge from non-existent
vertex " ++ show v))
mcxt
+{-# NOINLINE [0] insEdge #-}
-- | Remove a 'Node' from the 'Graph'.
delNode :: (Graph gr) => Node -> gr a b -> gr a b
@@ -272,7 +296,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 'delAllLedges'.
+-- edges, please use 'delAllLedge'.
delLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b
delLEdge = delLEdgeBy delete
@@ -289,10 +313,12 @@
-- | Insert multiple 'LNode's into the 'Graph'.
insNodes :: (DynGraph gr) => [LNode a] -> gr a b -> gr a b
insNodes vs g = foldl' (flip insNode) g vs
+{-# INLINABLE insNodes #-}
-- | Insert multiple 'LEdge's into the 'Graph'.
insEdges :: (DynGraph gr) => [LEdge b] -> gr a b -> gr a b
insEdges es g = foldl' (flip insEdge) g es
+{-# INLINABLE insEdges #-}
-- | Remove multiple 'Node's from the 'Graph'.
delNodes :: (Graph gr) => [Node] -> gr a b -> gr a b
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/Monad/IOArray.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/Monad/IOArray.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/Monad/IOArray.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/Monad/IOArray.hs 2016-07-15
08:40:25.000000000 +0200
@@ -46,9 +46,11 @@
Just (_,l,s) -> '\n':show v++":"++show l++"->"++show s'
where s' = unsafePerformIO (removeDel m s)
+-- | Please not that this instance is unsafe.
instance (Show a,Show b) => Show (SGr a b) where
show (SGr g) = showGraph g
+-- | Please not that this instance is unsafe.
instance (Show a,Show b) => Show (IO (SGr a b)) where
show g = unsafePerformIO (do {(SGr g') <- g; return (showGraph g')})
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/Monad/STArray.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/Monad/STArray.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/Monad/STArray.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/Monad/STArray.hs 2016-07-15
08:40:25.000000000 +0200
@@ -0,0 +1,113 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
+
+-- (c) 2002 by Martin Erwig [see file COPYRIGHT]
+-- | Static IOArray-based Graphs
+module Data.Graph.Inductive.Monad.STArray(
+ -- * Graph Representation
+ SGr(..), GraphRep, Context', USGr,
+ defaultGraphSize, emptyN,
+ -- * Utilities
+ removeDel,
+) where
+
+import Data.Graph.Inductive.Graph
+import Data.Graph.Inductive.Monad
+
+import Control.Monad
+import Control.Monad.ST
+import Data.Array
+import Data.Array.ST
+import System.IO.Unsafe
+
+
+
+----------------------------------------------------------------------
+-- GRAPH REPRESENTATION
+----------------------------------------------------------------------
+
+newtype SGr s a b = SGr (GraphRep s a b)
+
+type GraphRep s a b = (Int,Array Node (Context' a b),STArray s Node Bool)
+type Context' a b = Maybe (Adj b,a,Adj b)
+
+type USGr s = SGr s () ()
+
+
+----------------------------------------------------------------------
+-- CLASS INSTANCES
+----------------------------------------------------------------------
+
+-- Show
+--
+showGraph :: (Show a,Show b) => GraphRep RealWorld a b -> String
+showGraph (_,a,m) = concatMap showAdj (indices a)
+ where showAdj v | unsafeST (readArray m v) = ""
+ | otherwise = case a!v of
+ Nothing -> ""
+ Just (_,l,s) -> '\n':show v++":"++show l++"->"++show s'
+ where s' = unsafeST (removeDel m s)
+
+unsafeST :: ST RealWorld a -> a
+unsafeST = unsafePerformIO . stToIO
+
+-- | Please not that this instance is unsafe.
+instance (Show a,Show b) => Show (SGr RealWorld a b) where
+ show (SGr g) = showGraph g
+
+{-
+run :: Show (IO a) => IO a -> IO ()
+run x = seq x (print x)
+-}
+
+-- GraphM
+--
+instance GraphM (ST s) (SGr s) 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
+ Nothing -> return (Nothing,g')
+ Just (pr,l,su) ->
+ do b <- readArray m v
+ if b then return (Nothing,g') else
+ do s <- removeDel m su
+ p' <- removeDel m pr
+ let p = filter ((/=v).snd) p'
+ writeArray m v True
+ return (Just (p,v,l,s),SGr (n-1,a,m))
+ mkGraphM vs es = do m <- newArray (1,n) False
+ return (SGr (n,pr,m))
+ where nod = array bnds (map (\(v,l)->(v,Just ([],l,[]))) vs)
+ su = accum addSuc nod (map (\(v,w,l)->(v,(l,w))) es)
+ pr = accum addPre su (map (\(v,w,l)->(w,(l,v))) es)
+ bnds = (minimum vs',maximum vs')
+ vs' = map fst vs
+ n = length vs
+ addSuc (Just (p,l',s)) (l,w) = Just (p,l',(l,w):s)
+ addSuc Nothing _ = error "mkGraphM (SGr): addSuc Nothing"
+ addPre (Just (p,l',s)) (l,w) = Just ((l,w):p,l',s)
+ 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
+ return (if b then vs else (v,l):vs)
+ foldM getLNode [] (assocs a)
+
+defaultGraphSize :: Int
+defaultGraphSize = 100
+
+emptyN :: Int -> ST s (SGr s a b)
+emptyN n = do m <- newArray (1,n) False
+ return (SGr (0,array (1,n) [(i,Nothing) | i <- [1..n]],m))
+
+----------------------------------------------------------------------
+-- UTILITIES
+----------------------------------------------------------------------
+
+
+
+-- | filter list (of successors\/predecessors) through a boolean ST array
+-- representing deleted marks
+removeDel :: STArray s Node Bool -> Adj b -> ST s (Adj b)
+removeDel m = filterM (\(_,v)->do {b<-readArray m v;return (not b)})
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/NodeMap.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/NodeMap.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/NodeMap.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/NodeMap.hs 2016-07-15
08:40:25.000000000 +0200
@@ -223,16 +223,16 @@
return r
-- | Monadic node construction.
-mkNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a)
+mkNodeM :: (Ord a) => a -> NodeMapM a b g (LNode a)
mkNodeM = liftN2 mkNode
-mkNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g [LNode a]
+mkNodesM :: (Ord a) => [a] -> NodeMapM a b g [LNode a]
mkNodesM = liftN2 mkNodes
-mkEdgeM :: (Ord a, DynGraph g) => (a, a, b) -> NodeMapM a b g (Maybe (LEdge b))
+mkEdgeM :: (Ord a) => (a, a, b) -> NodeMapM a b g (Maybe (LEdge b))
mkEdgeM = liftN2' mkEdge
-mkEdgesM :: (Ord a, DynGraph g) => [(a, a, b)] -> NodeMapM a b g (Maybe [LEdge
b])
+mkEdgesM :: (Ord a) => [(a, a, b)] -> NodeMapM a b g (Maybe [LEdge b])
mkEdgesM = liftN2' mkEdges
insMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/PatriciaTree.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/PatriciaTree.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/PatriciaTree.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/PatriciaTree.hs 2016-07-15
08:40:25.000000000 +0200
@@ -28,7 +28,6 @@
import Data.Graph.Inductive.Graph
import Control.Applicative (liftA2)
-import Control.Arrow (second)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.List (sort)
@@ -42,6 +41,12 @@
import GHC.Generics (Generic)
#endif
+#if MIN_VERSION_base (4,8,0)
+import Data.Bifunctor
+#else
+import Control.Arrow (second)
+#endif
+
----------------------------------------------------------------------
-- GRAPH REPRESENTATION
----------------------------------------------------------------------
@@ -120,6 +125,15 @@
rnf (Gr g) = rnf g
#endif
+#if MIN_VERSION_base (4,8,0)
+instance Bifunctor Gr where
+ bimap = fastNEMap
+
+ first = fastNMap
+
+ second = fastEMap
+#endif
+
matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr node (Gr g)
= case IM.lookup node g of
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/Query/GVD.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/Query/GVD.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/Query/GVD.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/Query/GVD.hs 2016-07-15
08:40:25.000000000 +0200
@@ -50,7 +50,7 @@
-- | Try to determine the nearest root node to the one specified in the
-- shortest path forest.
-nearestNode :: (Real b) => Node -> Voronoi b -> Maybe Node
+nearestNode :: Node -> Voronoi b -> Maybe Node
nearestNode v = fmap (fst . last . unLPath) . maybePath v
-- | The distance to the 'nearestNode' (if there is one) in the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/Query/TransClos.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/Query/TransClos.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/Query/TransClos.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/Query/TransClos.hs 2016-07-15
08:40:25.000000000 +0200
@@ -1,21 +1,40 @@
module Data.Graph.Inductive.Query.TransClos(
- trc
+ trc, rc, tc
) where
import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.Query.DFS (reachable)
-
-
-getNewEdges :: (DynGraph gr) => [LNode a] -> gr a b -> [LEdge ()]
-getNewEdges vs g = map (`toLEdge` ())
- . concatMap (\u -> map ((,) u) (reachable u g))
- $ map fst vs
+import Data.Graph.Inductive.Query.BFS (bfen)
{-|
Finds the transitive closure of a directed graph.
Given a graph G=(V,E), its transitive closure is the graph:
G* = (V,E*) where E*={(i,j): i,j in V and there is a path from i to j in G}
-}
+tc :: (DynGraph gr) => gr a b -> gr a ()
+tc g = newEdges `insEdges` insNodes ln empty
+ where
+ ln = labNodes g
+ newEdges = [ (u, v, ()) | (u, _) <- ln, (_, v) <- bfen (outU g u) g ]
+ 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:
+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 ()
-trc g = insEdges (getNewEdges ln g) (insNodes ln empty)
- where ln = labNodes g
+trc g = newEdges `insEdges` insNodes ln empty
+ where
+ ln = labNodes g
+ newEdges = [ (u, v, ()) | (u, _) <- ln, (_, v) <- bfen [(u, u)] g ]
+
+{-|
+Finds the reflexive closure of a directed graph.
+Given a graph G=(V,E), its transitive 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
+ where
+ ln = labNodes g
+ newEdges = [ (u, u, ()) | (u, _) <- ln ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/Data/Graph/Inductive/Tree.hs
new/fgl-5.5.3.0/Data/Graph/Inductive/Tree.hs
--- old/fgl-5.5.2.3/Data/Graph/Inductive/Tree.hs 2015-09-08
15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/Data/Graph/Inductive/Tree.hs 2016-07-15
08:40:25.000000000 +0200
@@ -14,7 +14,6 @@
import Data.Graph.Inductive.Graph
import Control.Applicative (liftA2)
-import Control.Arrow (first, second)
import Data.List (foldl', sort)
import Data.Map (Map)
import qualified Data.Map as M
@@ -28,6 +27,12 @@
import GHC.Generics (Generic)
#endif
+#if MIN_VERSION_base (4,8,0)
+import Data.Bifunctor
+#else
+import Control.Arrow (first, second)
+#endif
+
----------------------------------------------------------------------
-- GRAPH REPRESENTATION
----------------------------------------------------------------------
@@ -130,6 +135,15 @@
rnf (Gr g) = rnf g
#endif
+#if MIN_VERSION_base (4,8,0)
+instance Bifunctor Gr where
+ bimap = nemap
+
+ first = nmap
+
+ second = emap
+#endif
+
----------------------------------------------------------------------
-- UTILITIES
----------------------------------------------------------------------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/fgl.cabal new/fgl-5.5.3.0/fgl.cabal
--- old/fgl-5.5.2.3/fgl.cabal 2015-09-08 15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/fgl.cabal 2016-07-15 08:40:25.000000000 +0200
@@ -1,5 +1,5 @@
name: fgl
-version: 5.5.2.3
+version: 5.5.3.0
license: BSD3
license-file: LICENSE
author: Martin Erwig, Ivan Lazar Miljenovic
@@ -18,7 +18,7 @@
ChangeLog
tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3,
- GHC == 7.8.4, GHC == 7.10.2, GHC == 7.11.*
+ GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1, GHC == 8.1.*
source-repository head
type: git
@@ -46,6 +46,7 @@
Data.Graph.Inductive.Query,
Data.Graph.Inductive.Tree,
Data.Graph.Inductive.Monad.IOArray,
+ Data.Graph.Inductive.Monad.STArray,
Data.Graph.Inductive.Query.ArtPoint,
Data.Graph.Inductive.Query.BCC,
Data.Graph.Inductive.Query.BFS,
@@ -89,7 +90,7 @@
build-depends: fgl
, base
- , QuickCheck >= 2.8 && < 2.9
+ , QuickCheck >= 2.8 && < 2.10
, hspec >= 2.1 && < 2.3
, containers
@@ -105,5 +106,4 @@
ghc-options: -Wall
- ghc-prof-options: -prof -auto
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/fgl-5.5.2.3/test/Data/Graph/Inductive/Query/Properties.hs
new/fgl-5.5.3.0/test/Data/Graph/Inductive/Query/Properties.hs
--- old/fgl-5.5.2.3/test/Data/Graph/Inductive/Query/Properties.hs
2015-09-08 15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/test/Data/Graph/Inductive/Query/Properties.hs
2016-07-15 08:40:25.000000000 +0200
@@ -26,7 +26,7 @@
import Test.QuickCheck
import Control.Arrow (second)
-import Data.List (delete, sort, unfoldr)
+import Data.List (delete, sort, unfoldr, group, (\\))
import qualified Data.Set as S
#if __GLASGOW_HASKELL__ < 710
@@ -327,18 +327,41 @@
--
-----------------------------------------------------------------------------
-- TransClos
-test_trc :: (ArbGraph gr, Eq (BaseGraph gr a ())) => Proxy (gr a b)
- -> UConnected (SimpleGraph
gr) a ()
- -> Bool
-test_trc _ cg = gReach == trc g
+-- | The transitive, reflexive closure of a graph means that every
+-- node is a successor of itself, and also that if (a, b) is an edge,
+-- and (b, c) is an edge, then (a, c) must also be an edge.
+test_trc :: DynGraph gr => Proxy (gr a b) -> (NoMultipleEdges gr) a b -> Bool
+test_trc _ nme = all valid $ nodes gTrans
+ where
+ g = emap (const ()) (nmeGraph nme)
+ gTrans = trc g
+ valid n =
+ -- For each node n, check that:
+ -- the successors for n in gTrans are a superset of the successors for
n in g.
+ null (suc g n \\ suc gTrans n) &&
+ -- the successors for n in gTrans are exactly equal to the reachable
nodes for n in g, plus n.
+ sort (suc gTrans n) == map head (group (sort (n:[ v | u <- suc g n, v <-
reachable u g ])))
+
+-- | The transitive closure of a graph means that if (a, b) is an
+-- edge, and (b, c) is an edge, then (a, c) must also be an edge.
+test_tc :: DynGraph gr => Proxy (gr a b) -> (NoMultipleEdges gr) a b -> Bool
+test_tc _ nme = all valid $ nodes gTrans
+ where
+ g = nmeGraph nme
+ gTrans = tc g
+ valid n =
+ -- For each node n, check that:
+ -- the successors for n in gTrans are a superset of the successors for
n in g.
+ null (suc g n \\ suc gTrans n) &&
+ -- the successors for n in gTrans are exactly equal to the reachable
nodes for n in g.
+ sort (suc gTrans n) == map head (group (sort [ v | u <- suc g n, v <-
reachable u g ]))
+
+-- | The reflexive closure of a graph means that all nodes are a
+-- successor of themselves.
+test_rc :: DynGraph gr => Proxy (gr a b) -> gr a b -> Bool
+test_rc _ g = and [ n `elem` suc gRefl n | n <- nodes gRefl ]
where
- g = connGraph cg
-
- lns = labNodes g
-
- gReach = (`asTypeOf` g)
- . insEdges [(v,w,()) | (v,_) <- lns, (w,_) <- lns]
- $ mkGraph lns []
+ gRefl = rc g
--
-----------------------------------------------------------------------------
-- Utility functions
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/fgl-5.5.2.3/test/TestSuite.hs
new/fgl-5.5.3.0/test/TestSuite.hs
--- old/fgl-5.5.2.3/test/TestSuite.hs 2015-09-08 15:50:30.000000000 +0200
+++ new/fgl-5.5.3.0/test/TestSuite.hs 2016-07-15 08:40:25.000000000 +0200
@@ -117,9 +117,11 @@
test_maxFlow
propP "msTree" test_msTree
propP "sp" test_sp
- keepSmall $
+ keepSmall $ do
-- Just producing the sample graph to compare against is O(|V|^2)
propP "trc" test_trc
+ propP "tc" test_tc
+ propP "rc" test_rc
where
propP str = prop str . ($p)
