fgl 5.5.3.1 → 5.5.4.0

raw patch · 8 files changed

+110/−23 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog +12/−0
• Data/Graph/Inductive/Internal/RootPath.hs +10/−3
• Data/Graph/Inductive/Monad/IOArray.hs +2/−2
• Data/Graph/Inductive/PatriciaTree.hs +16/−6
• Data/Graph/Inductive/Query/SP.hs +25/−5
• fgl.cabal +7/−2
• test/Data/Graph/Inductive/Query/Properties.hs +34/−4
• test/TestSuite.hs +4/−1

@@ -1,3 +1,15 @@+5.5.4.0+-------++* Improved type safety of shortest-path functions (in+  `Data.Graph.Inductive.Query.SP`) thanks to Nathan Collins.++    - `getDistance`, `spLength` and `sp` now return `Maybe` values.++* Fixed building on GHC < 7.4; previously uncaught due to+  cabal-install doing the wrong thing on Travis-CI.++ 5.5.3.1 ------- 

@@ -19,7 +19,9 @@                  []   -> []                  x:_  -> x --- | Find the first path in a tree that starts with the given node+-- | Find the first path in a tree that starts with the given node.+--+--   Returns an empty list if there is no such path. findP :: Node -> LRTree a -> [LNode a] findP _ []                                = [] findP v (LP []:ps)                        = findP v ps@@ -32,8 +34,13 @@ getLPath :: Node -> LRTree a -> LPath a getLPath v = LP . reverse . findP v -getDistance :: Node -> LRTree a -> a-getDistance v = snd . head . findP v+-- | Return the distance to the given node in the given tree.+--+--   Returns 'Nothing' if the given node is not reachable.+getDistance :: Node -> LRTree a -> Maybe a+getDistance v t = case findP v t of+  []      -> Nothing+  (_,d):_ -> Just d  getLPathNodes :: Node -> LRTree a -> Path getLPathNodes v = (\(LP p)->map fst p) . getLPath v

@@ -46,11 +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.+-- | Please note 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.+-- | Please note 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')}) 

@@ -273,30 +273,40 @@  addSucc :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b addSucc g0 v numAdd xs-  | numAdd < bulkThreshold = IM.foldlWithKey' go g0 xs+  | numAdd < bulkThreshold = foldlWithKey' go g0 xs   where     go :: GraphRep a b -> Node -> [b] -> GraphRep a b     go g p l = IMS.adjust f p g-      where f (ps, l', ss) = let !ss' = IM.insertWith (++) v l ss+      where f (ps, l', ss) = let !ss' = IM.insertWith addLists v l ss                              in (ps, l', ss') addSucc g v _ xs = IMS.differenceWith go g xs   where     go :: Context' a b -> [b] -> Maybe (Context' a b)-    go (ps, l', ss) l = let !ss' = IM.insertWith (++) v l ss+    go (ps, l', ss) l = let !ss' = IM.insertWith addLists v l ss                         in Just (ps, l', ss') +foldlWithKey' :: (a -> IM.Key -> b -> a) -> a -> IntMap b -> a+foldlWithKey' =+#if MIN_VERSION_containers (0,4,2)+  IM.foldlWithKey'+#else+  IM.foldWithKey . adjustFunc+  where+    adjustFunc f k b a = f a k b+#endif+ addPred :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b addPred g0 v numAdd xs-  | numAdd < bulkThreshold = IM.foldlWithKey' go g0 xs+  | numAdd < bulkThreshold = foldlWithKey' go g0 xs   where     go :: GraphRep a b -> Node -> [b] -> GraphRep a b     go g p l = IMS.adjust f p g-      where f (ps, l', ss) = let !ps' = IM.insertWith (++) v l ps+      where f (ps, l', ss) = let !ps' = IM.insertWith addLists v l ps                              in (ps', l', ss) addPred g v _ xs = IMS.differenceWith go g xs   where     go :: Context' a b -> [b] -> Maybe (Context' a b)-    go (ps, l', ss) l = let !ps' = IM.insertWith (++) v l ps+    go (ps, l', ss) l = let !ps' = IM.insertWith addLists v l ps                         in Just (ps', l', ss)  clearSucc :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b

@@ -19,6 +19,9 @@ expand d (LP p) (_,_,_,s) = map (\(l,v)->H.unit (l+d) (LP ((v,l+d):p))) s  -- | Dijkstra's shortest path algorithm.+--+--   The edge labels of type @b@ are the edge weights; negative edge+--   weights are not supported. dijkstra :: (Graph gr, Real b)     => H.Heap b (LPath b) -- ^ Initial heap of known paths and their lengths.     -> gr a b@@ -35,24 +38,41 @@ -- --   Corresponds to 'dijkstra' applied to a heap in which the only known node is --   the starting node, with a path of length 0 leading to it.+--+--   The edge labels of type @b@ are the edge weights; negative edge+--   weights are not supported. spTree :: (Graph gr, Real b)     => Node     -> gr a b     -> LRTree b spTree v = dijkstra (H.unit 0 (LP [(v,0)])) --- | Length of the shortest path between two nodes.+-- | Length of the shortest path between two nodes, if any.+--+--   Returns 'Nothing' if there is no path, and @'Just' <path length>@+--   otherwise.+--+--   The edge labels of type @b@ are the edge weights; negative edge+--   weights are not supported. spLength :: (Graph gr, Real b)     => Node -- ^ Start     -> Node -- ^ Destination     -> gr a b-    -> b+    -> Maybe b spLength s t = getDistance t . spTree s --- | Shortest path between two nodes.+-- | Shortest path between two nodes, if any.+--+--   Returns 'Nothing' if the destination is not reachable from the+--   start node, and @'Just' <path>@ otherwise.+--+--   The edge labels of type @b@ are the edge weights; negative edge+--   weights are not supported. sp :: (Graph gr, Real b)     => Node -- ^ Start     -> Node -- ^ Destination     -> gr a b-    -> Path-sp s t = getLPathNodes t . spTree s+    -> Maybe Path+sp s t g = case getLPathNodes t (spTree s g) of+  [] -> Nothing+  p  -> Just p

@@ -1,5 +1,5 @@ name:          fgl-version:       5.5.3.1+version:       5.5.4.0 license:       BSD3 license-file:  LICENSE author:        Martin Erwig, Ivan Lazar Miljenovic@@ -22,7 +22,7 @@  source-repository head     type:         git-    location:     git://github.com/haskell/fgl.git+    location:     https://github.com/haskell/fgl.git  flag containers042 {     manual:  False@@ -109,6 +109,11 @@ }  benchmark fgl-benchmark {+    if flag(containers042)+        buildable:    True+    else+        buildable:    False+     default-language: Haskell98      type:             exitcode-stdio-1.0

@@ -27,6 +27,7 @@  import           Control.Arrow (second) import           Data.List     (delete, sort, unfoldr, group, (\\))+import           Data.Maybe    (fromJust, isJust, isNothing) import qualified Data.Set      as S  #if __GLASGOW_HASKELL__ < 710@@ -310,19 +311,48 @@ test_sp _ cg = all test_p (map unLPath (msTree g))   where     -- Use Positive to avoid problems with distances containing-    -- negative lengths.+    -- negative lengths. The shortest path algorithm is Dijkstra's,+    -- which doesn't support negative weights.     g = emap getPositive (connGraph cg)      gCon = emap (const 1) g `asTypeOf` g -    test_p p = length p >= len_gCon                 -- Length-based test+               -- Length-based test+    test_p p = length p >= len_gCon                && length (esp v w gCon) == len_gCon-               && sum (map snd p) >= spLength v w g -- Weighting-based test+               -- Weighting-based test+               && sum (map snd p) >= fromJust (spLength v w g)       where         v = fst (head p)         w = fst (last p) -        len_gCon = length (sp v w gCon)+        len_gCon = length (fromJust $ sp v w gCon)++-- | Test that 'spLength' and 'sp' return a length and an connecting+--   path when destination is reachable from source.+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++-- | 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)  -- ----------------------------------------------------------------------------- -- TransClos

@@ -116,7 +116,10 @@   test_maxFlow2   test_maxFlow   propP "msTree"       test_msTree-  propP "sp"           test_sp+  describe "SP" $ do+    propP "sp"         test_sp+    propP "sp_Just"    test_sp_Just+    propP "sp_Nothing" test_sp_Nothing   keepSmall $ do     -- Just producing the sample graph to compare against is O(|V|^2)     propP "trc"        test_trc