fgl 5.5.2.3 → 5.5.3.0

raw patch · 12 files changed

+262/−33 lines, 12 filesdep ~QuickCheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• ChangeLog +16/−0
• Data/Graph/Inductive/Graph.hs +27/−1
• Data/Graph/Inductive/Monad/IOArray.hs +2/−0
• Data/Graph/Inductive/Monad/STArray.hs +113/−0
• Data/Graph/Inductive/NodeMap.hs +4/−4
• Data/Graph/Inductive/PatriciaTree.hs +15/−1
• Data/Graph/Inductive/Query/GVD.hs +1/−1
• Data/Graph/Inductive/Query/TransClos.hs +29/−10
• Data/Graph/Inductive/Tree.hs +15/−1
• fgl.cabal +4/−4
• test/Data/Graph/Inductive/Query/Properties.hs +33/−10
• test/TestSuite.hs +3/−1

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

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

@@ -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')}) 

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

@@ -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)

@@ -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 ----------------------------------------------------------------------@@ -118,6 +123,15 @@ #if MIN_VERSION_containers (0,4,2) instance (NFData a, NFData b) => NFData (Gr a b) where   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

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

@@ -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 ]

@@ -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 ----------------------------------------------------------------------@@ -128,6 +133,15 @@ #if MIN_VERSION_containers (0,4,2) instance (NFData a, NFData b) => NFData (Gr a b) where   rnf (Gr g) = rnf g+#endif++#if MIN_VERSION_base (4,8,0)+instance Bifunctor Gr where+  bimap = nemap++  first = nmap++  second = emap #endif  ----------------------------------------------------------------------

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

@@ -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 = connGraph cg+    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 ]))) -    lns = labNodes 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 ])) -    gReach = (`asTypeOf` g)-             . insEdges [(v,w,()) | (v,_) <- lns, (w,_) <- lns]-             $ mkGraph lns []+-- | 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+    gRefl = rc g  -- ----------------------------------------------------------------------------- -- Utility functions

@@ -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)