Hello community, here is the log from the commit of package ghc-fgl for openSUSE:Factory checked in at 2015-05-11 19:38:34 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 2014-11-26 20:54:41.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-fgl.new/ghc-fgl.changes 2015-05-11 19:48:49.000000000 +0200 @@ -1,0 +2,13 @@ +Mon Apr 13 14:04:37 UTC 2015 - [email protected] + +- update to 5.5.1.0 +* Support added for GHC 7.10 by Herbert Valerio Riedel. +* Additional DFS query functions added by Conrad Parker. +* Repository location changed to GitHub. +* Code cleanup: + Data.Set from the containers library. + Remove usage of data type contexts. + Use newtypes where applicable. + + +------------------------------------------------------------------- Old: ---- fgl-5.5.0.1.tar.gz New: ---- fgl-5.5.1.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-fgl.spec ++++++ --- /var/tmp/diff_new_pack.37txdI/_old 2015-05-11 19:48:49.000000000 +0200 +++ /var/tmp/diff_new_pack.37txdI/_new 2015-05-11 19:48:49.000000000 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-fgl # -# Copyright (c) 2014 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany. # Copyright (c) 2012 Peter Trommler [email protected] # # All modifications and additions to the file contributed by third parties @@ -20,7 +20,7 @@ %global pkg_name fgl Name: ghc-fgl -Version: 5.5.0.1 +Version: 5.5.1.0 Release: 0 Summary: Martin Erwig's Functional Graph Library License: BSD-3-Clause ++++++ fgl-5.5.0.1.tar.gz -> fgl-5.5.1.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/ChangeLog new/fgl-5.5.1.0/ChangeLog --- old/fgl-5.5.0.1/ChangeLog 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/ChangeLog 2015-03-09 05:38:02.000000000 +0100 @@ -1,3 +1,21 @@ +5.5.1.0 +------- + +* Support added for GHC 7.10 by Herbert Valerio Riedel. + +* Additional DFS query functions added by Conrad Parker. + +* Repository location changed to GitHub. + +* Code cleanup: + + - Replaced usage of internal FiniteMap copy with Data.Map and + Data.Set from the containers library. + + - Remove usage of data type contexts. + + - Use newtypes where applicable. + 5.5.0.1 ------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Basic.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Basic.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Basic.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Basic.hs 2015-03-09 05:38:02.000000000 +0100 @@ -12,18 +12,18 @@ hasLoop,isSimple, -- * Tree Operations postorder, postorderF, preorder, preorderF -) +) where import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.Internal.Thread (threadMaybe,threadList) +import Data.Graph.Inductive.Internal.Thread (threadList, threadMaybe) import Data.List (nub) import Data.Tree -- | Reverse the direction of all edges. -grev :: DynGraph gr => gr a b -> gr a b +grev :: DynGraph gr => gr a b -> gr a b grev = gmap (\(p,v,l,s)->(s,v,l,p)) -- | Make the graph undirected, i.e. for every edge from A to B, there @@ -83,24 +83,24 @@ gfold1 f d b = threadGraph d (\c->gfoldn f d b (f c)) gfoldn f d b = threadList b (gfold1 f d b) --- gfold :: ((Context a b) -> [Node]) -> ((Node,a) -> c -> d) -> +-- gfold :: ((Context a b) -> [Node]) -> ((Node,a) -> c -> d) -> -- (Maybe d -> c -> c) -> c -> [Node] -> Graph a b -> c -- gfold f d b u l g = fst (gfoldn f d b u l g) -- type Dir a b = (Context a b) -> [Node] -- direction of fold -- type Dagg a b c = (Node,a) -> b -> c -- depth aggregation -- type Bagg a b = (Maybe a -> b -> b,b) -- breadth/level aggregation --- +-- -- gfold :: (Dir a b) -> (Dagg a c d) -> (Bagg d c) -> [Node] -> Graph a b -> c -- gfold f d (b,u) l g = fst (gfoldn f d b u l g) -- | Directed graph fold. gfold :: Graph gr => ((Context a b) -> [Node]) -- ^ direction of fold - -> ((Context a b) -> c -> d) -- ^ depth aggregation - -> (Maybe d -> c -> c, c) -- ^ breadth\/level aggregation - -> [Node] - -> gr a b - -> c + -> ((Context a b) -> c -> d) -- ^ depth aggregation + -> (Maybe d -> c -> c, c) -- ^ breadth\/level aggregation + -> [Node] + -> gr a b + -> c gfold f d b l g = fst (gfoldn f d b l g) -- not finished yet ... diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Example.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Example.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Example.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Example.hs 2015-03-09 05:38:02.000000000 +0100 @@ -186,4 +186,3 @@ [(1,4,3),(2,3,3),(2,4,3),(4,2,4),(4,6,2), (5,2,5),(5,3,6),(5,7,5),(5,8,6), (6,5,3),(6,7,2),(7,8,3),(8,7,3)] - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Graph.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Graph.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Graph.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Graph.hs 2015-03-09 05:38:02.000000000 +0100 @@ -246,6 +246,7 @@ -- | Insert a 'LNode' into the 'Graph'. insNode :: DynGraph gr => LNode a -> gr a b -> gr a b insNode (v,l) = (([],v,l,[])&) +{-# NOINLINE [0] insNode #-} -- | Insert a 'LEdge' into the 'Graph'. insEdge :: DynGraph gr => LEdge b -> gr a b -> gr a b @@ -478,4 +479,3 @@ -- | Pretty-print the graph to stdout. prettyPrint :: (DynGraph gr, Show a, Show b) => gr a b -> IO () prettyPrint = putStr . prettify - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/FiniteMap.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/FiniteMap.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/FiniteMap.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/FiniteMap.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,212 +0,0 @@ --- | Simple Finite Maps. --- This implementation provides several useful methods that Data.FiniteMap --- does not. - -module Data.Graph.Inductive.Internal.FiniteMap( - -- * Type - FiniteMap(..), - -- * Operations - emptyFM,addToFM,delFromFM, - updFM, - accumFM, - splitFM, - isEmptyFM,sizeFM,lookupFM,elemFM, - rangeFM, - minFM,maxFM,predFM,succFM, - splitMinFM, - fmToList -) where - -import Data.Maybe (isJust) - -data FiniteMap a b = - Empty | Node Int (FiniteMap a b) (a,b) (FiniteMap a b) - deriving (Eq) - -instance Functor (FiniteMap a) where - fmap _ Empty = Empty - fmap f (Node h l (i,x) r) = Node h (fmap f l) (i, f x) (fmap f r) - ----------------------------------------------------------------------- --- UTILITIES ----------------------------------------------------------------------- - - --- pretty printing --- -showsMap :: (Show a,Show b,Ord a) => FiniteMap a b -> ShowS -showsMap Empty = id -showsMap (Node _ l (i,x) r) = showsMap l . (' ':) . - shows i . ("->"++) . shows x . showsMap r - -instance (Show a,Show b,Ord a) => Show (FiniteMap a b) where - showsPrec _ m = showsMap m - - --- other --- -splitMax :: Ord a => FiniteMap a b -> (FiniteMap a b,(a,b)) -splitMax (Node _ l x Empty) = (l,x) -splitMax (Node _ l x r) = (avlBalance l x m,y) where (m,y) = splitMax r -splitMax Empty = error "splitMax on empty FiniteMap" - -merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b -merge l Empty = l -merge Empty r = r -merge l r = avlBalance l' x r where (l',x) = splitMax l - - ----------------------------------------------------------------------- --- MAIN FUNCTIONS ----------------------------------------------------------------------- - -emptyFM :: Ord a => FiniteMap a b -emptyFM = Empty - -addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b -addToFM Empty i x = node Empty (i,x) Empty -addToFM (Node h l (j,y) r) i x - | i<j = avlBalance (addToFM l i x) (j,y) r - | i>j = avlBalance l (j,y) (addToFM r i x) - | otherwise = Node h l (j,x) r - --- | applies function to stored entry -updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b -updFM Empty _ _ = Empty -updFM (Node h l (j,x) r) i f - | i<j = let l' = updFM l i f in l' `seq` Node h l' (j,x) r - | i>j = let r' = updFM r i f in r' `seq` Node h l (j,x) r' - | otherwise = Node h l (j,f x) r - --- | defines or aggregates entries -accumFM :: Ord a => FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b -accumFM Empty i _ x = node Empty (i,x) Empty -accumFM (Node h l (j,y) r) i f x - | i<j = avlBalance (accumFM l i f x) (j,y) r - | i>j = avlBalance l (j,y) (accumFM r i f x) - | otherwise = Node h l (j,f x y) r - -delFromFM :: Ord a => FiniteMap a b -> a -> FiniteMap a b -delFromFM Empty _ = Empty -delFromFM (Node _ l (j,x) r) i - | i<j = avlBalance (delFromFM l i) (j,x) r - | i>j = avlBalance l (j,x) (delFromFM r i) - | otherwise = merge l r - -isEmptyFM :: FiniteMap a b -> Bool -isEmptyFM Empty = True -isEmptyFM _ = False - -sizeFM :: Ord a => FiniteMap a b -> Int -sizeFM Empty = 0 -sizeFM (Node _ l _ r) = sizeFM l + 1 + sizeFM r - -lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b -lookupFM Empty _ = Nothing -lookupFM (Node _ l (j,x) r) i | i<j = lookupFM l i - | i>j = lookupFM r i - | otherwise = Just x - --- | applies lookup to an interval -rangeFM :: Ord a => FiniteMap a b -> a -> a -> [b] -rangeFM m i j = rangeFMa m i j [] --- -rangeFMa Empty _ _ a = a -rangeFMa (Node _ l (k,x) r) i j a - | k<i = rangeFMa r i j a - | k>j = rangeFMa l i j a - | otherwise = rangeFMa l i j (x:rangeFMa r i j a) - -minFM :: Ord a => FiniteMap a b -> Maybe (a,b) -minFM Empty = Nothing -minFM (Node _ Empty x _) = Just x -minFM (Node _ l _ _) = minFM l - -maxFM :: Ord a => FiniteMap a b -> Maybe (a,b) -maxFM Empty = Nothing -maxFM (Node _ _ x Empty) = Just x -maxFM (Node _ _ _ r) = maxFM r - -predFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b) -predFM m i = predFM' m i Nothing --- -predFM' Empty _ p = p -predFM' (Node _ l (j,x) r) i p | i<j = predFM' l i p - | i>j = predFM' r i (Just (j,x)) - | isJust ml = ml - | otherwise = p - where ml = maxFM l - -succFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b) -succFM m i = succFM' m i Nothing --- -succFM' Empty _ p = p -succFM' (Node _ l (j,x) r) i p | i<j = succFM' l i (Just (j,x)) - | i>j = succFM' r i p - | isJust mr = mr - | otherwise = p - where mr = minFM r - -elemFM :: Ord a => FiniteMap a b -> a -> Bool -elemFM m i = case lookupFM m i of {Nothing -> False; _ -> True} - --- | combines delFrom and lookup -splitFM :: Ord a => FiniteMap a b -> a -> Maybe (FiniteMap a b,(a,b)) -splitFM Empty _ = Nothing -splitFM (Node _ l (j,x) r) i = - if i<j then - case splitFM l i of - Just (l',y) -> Just (avlBalance l' (j,x) r,y) - Nothing -> Nothing else - if i>j then - case splitFM r i of - Just (r',y) -> Just (avlBalance l (j,x) r',y) - Nothing -> Nothing - else {- i==j -} Just (merge l r,(j,x)) - --- | combines splitFM and minFM -splitMinFM :: Ord a => FiniteMap a b -> Maybe (FiniteMap a b,(a,b)) -splitMinFM Empty = Nothing -splitMinFM (Node _ Empty x r) = Just (r,x) -splitMinFM (Node _ l x r) = Just (avlBalance l' x r,y) - where Just (l',y) = splitMinFM l - -fmToList :: Ord a => FiniteMap a b -> [(a,b)] -fmToList m = scan m [] - where scan Empty xs = xs - scan (Node _ l x r) xs = scan l (x:(scan r xs)) - ----------------------------------------------------------------------- --- AVL tree helper functions ----------------------------------------------------------------------- - -height :: Ord a => FiniteMap a b -> Int -height Empty = 0 -height (Node h _ _ _) = h - -node :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b -node l val r = Node h l val r - where h=1+(height l `max` height r) - -avlBalance :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b -avlBalance l (i,x) r - | (hr + 1 < hl) && (bias l < 0) = rotr (node (rotl l) (i,x) r) - | (hr + 1 < hl) = rotr (node l (i,x) r) - | (hl + 1 < hr) && (0 < bias r) = rotl (node l (i,x) (rotr r)) - | (hl + 1 < hr) = rotl (node l (i,x) r) - | otherwise = node l (i,x) r - where hl=height l; hr=height r - -bias :: Ord a => FiniteMap a b -> Int -bias (Node _ l _ r) = height l - height r -bias Empty = 0 - -rotr :: Ord a => FiniteMap a b -> FiniteMap a b -rotr Empty = Empty -rotr (Node _ (Node _ l1 v1 r1) v2 r2) = node l1 v1 (node r1 v2 r2) -rotr (Node _ Empty _ _) = error "rotr on invalid FiniteMap" - -rotl :: Ord a => FiniteMap a b -> FiniteMap a b -rotl Empty = Empty -rotl (Node _ l1 v1 (Node _ l2 v2 r2)) = node (node l1 v1 l2) v2 r2 -rotl (Node _ _ _ Empty) = error "rotl on invalid FiniteMap" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/Heap.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/Heap.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/Heap.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/Heap.hs 2015-03-09 05:38:02.000000000 +0100 @@ -9,14 +9,14 @@ ) where -data Ord a => Heap a b = Empty | Node a b [Heap a b] +data Heap a b = Empty | Node a b [Heap a b] deriving Eq showsHeap :: (Show a,Ord a,Show b) => Heap a b -> ShowS showsHeap Empty = id showsHeap (Node key val []) = shows key . (": "++) . shows val showsHeap (Node key val hs) = shows key . (": "++) . shows val . (' ':) . shows hs - + instance (Show a,Ord a,Show b) => Show (Heap a b) where showsPrec _ d = showsHeap d @@ -49,7 +49,7 @@ isEmpty :: Ord a => Heap a b -> Bool isEmpty Empty = True isEmpty _ = False - + findMin :: Ord a => Heap a b -> (a, b) findMin Empty = error "Heap.findMin: empty heap" findMin (Node key val _) = (key, val) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/RootPath.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/RootPath.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/RootPath.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/RootPath.hs 2015-03-09 05:38:02.000000000 +0100 @@ -39,7 +39,7 @@ | otherwise = findP v ps getPath :: Node -> RTree -> Path -getPath v = reverse . first (\(w:_)->w==v) +getPath v = reverse . first (\(w:_)->w==v) 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.5.0.1/Data/Graph/Inductive/Internal/Thread.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/Thread.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Internal/Thread.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Internal/Thread.hs 2015-03-09 05:38:02.000000000 +0100 @@ -20,22 +20,22 @@ {- class Thread t a b where split :: a -> t -> (b,t) - - + + instance Thread (Graph a b) Node (MContext a b) where split = match - + instance D.Discrete a => Thread (D.Diet a) a a where split x s = (x,D.delete x s) -} {- Make clear different notions: - + "thread" = data structure + split operation ... = threadable data structure ... = split operation - + -} @@ -50,13 +50,13 @@ {- -- (1) simple collect in a list --- +-- foldT1' ys [] d = ys foldT1' ys (x:xs) d = foldT1' (y:ys) xs d' where (y,d') = split x d foldT1 xs d = foldT1' [] xs d -- (2) combine by a function --- +-- foldT2' f ys [] d = ys foldT2' f ys (x:xs) d = foldT2' f (f y ys) xs d' where (y,d') = split x d foldT2 f u xs d = foldT2' f u xs d @@ -75,21 +75,21 @@ type Collect r c = (r -> c -> c,c) -- (3) abstract from split --- +-- threadList' :: (Collect r c) -> (Split t i r) -> [i] -> t -> (c,t) -threadList' (_,c) _ [] t = (c,t) +threadList' (_,c) _ [] t = (c,t) threadList' (f,c) split (i:is) t = threadList' (f,f r c) split is t' where (r,t') = split i t -{- +{- Note: threadList' works top-down (or, from left), whereas dfs,gfold,... have been defined bottom-up (or from right). - + ==> therefore, we define a correpsonding operator for folding bottom-up/from right. -} threadList :: (Collect r c) -> (Split t i r) -> [i] -> t -> (c,t) -threadList (_,c) _ [] t = (c,t) +threadList (_,c) _ [] t = (c,t) threadList (f,c) split (i:is) t = (f r c',t'') where (r,t') = split i t (c',t'') = threadList (f,c) split is t' @@ -100,13 +100,13 @@ -- threading with "continuation" c, and ignore Nothing-values, ie, -- stop threading and return current data structure. -- --- threadMaybe' :: (r -> b) -> (Split t i r) -> (e -> f -> (Maybe i,t)) +-- threadMaybe' :: (r -> b) -> (Split t i r) -> (e -> f -> (Maybe i,t)) -- -> e -> f -> (Maybe b,t) type SplitM t i r = Split t i (Maybe r) threadMaybe' :: (r->a)->Split t i r->Split t j (Maybe i)->Split t j (Maybe a) -threadMaybe' f cont split j t = +threadMaybe' f cont split j t = case mi of Just i -> (Just (f r),t'') where (r,t'') = cont i t' Nothing -> (Nothing,t') where (mi,t') = split j t @@ -117,7 +117,7 @@ -- -> e -> f -> (Maybe c,d) -- threadMaybe :: (i->r->a)->Split t i r->Split t j (Maybe i)->Split t j (Maybe a) threadMaybe :: (i -> r -> a) -> Split t i r -> SplitM t j i -> SplitM t j a -threadMaybe f cont split j t = +threadMaybe f cont split j t = case mi of Just i -> (Just (f i r),t'') where (r,t'') = cont i t' Nothing -> (Nothing,t') where (mi,t') = split j t @@ -125,7 +125,7 @@ -- (C) compose splits in parallel (is a kind of generalized zip) -- --- splitPar :: (a -> b -> (c,d)) -> (e -> f -> (g,h)) +-- splitPar :: (a -> b -> (c,d)) -> (e -> f -> (g,h)) -- -> (a,e) -> (b,f) -> ((c,g),(d,h)) splitPar :: Split t i r -> Split u j s -> Split (t,u) (i,j) (r,s) splitPar split split' (i,j) (t,u) = ((r,s),(t',u')) @@ -135,15 +135,15 @@ splitParM :: SplitM t i r -> Split u j s -> SplitM (t,u) (i,j) (r,s) splitParM splitm split (i,j) (t,u) = case mr of Just r -> (Just (r,s),(t',u')) - Nothing -> (Nothing,(t',u)) -- ignore 2nd split + Nothing -> (Nothing,(t',u)) -- ignore 2nd split where (mr,t') = splitm i t (s,u') = split j u -- (D) merge a thread with/into a computation -- -{- +{- Example: assign consecutive numbers to the nodes of a tree - + Input: type d, thread (t,split), fold operation on d -} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Monad/IOArray.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Monad/IOArray.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Monad/IOArray.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Monad/IOArray.hs 2015-03-09 05:38:02.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} -- (c) 2002 by Martin Erwig [see file COPYRIGHT] -- | Static IOArray-based Graphs @@ -24,7 +24,7 @@ -- GRAPH REPRESENTATION ---------------------------------------------------------------------- -data SGr a b = SGr (GraphRep a b) +newtype SGr a b = SGr (GraphRep a b) type GraphRep a b = (Int,Array Node (Context' a b),IOArray Node Bool) type Context' a b = Maybe (Adj b,a,Adj b) @@ -82,9 +82,9 @@ 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" + 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" + 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,_)) = @@ -109,6 +109,3 @@ -- representing deleted marks removeDel :: IOArray Node Bool -> Adj b -> IO (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.0.1/Data/Graph/Inductive/NodeMap.hs new/fgl-5.5.1.0/Data/Graph/Inductive/NodeMap.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/NodeMap.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/NodeMap.hs 2015-03-09 05:38:02.000000000 +0100 @@ -24,21 +24,22 @@ insMapEdgesM, delMapNodesM, delMapEdgesM ) where -import Prelude hiding (map) -import qualified Prelude as P (map) -import Control.Monad.State -import Data.Graph.Inductive.Graph ---import Data.Graph.Inductive.Tree -import Data.Graph.Inductive.Internal.FiniteMap - -data (Ord a) => NodeMap a = - NodeMap { map :: FiniteMap a Node, - key :: Int } +import Control.Monad.State +import Data.Graph.Inductive.Graph +import Prelude hiding (map) +import qualified Prelude as P (map) + +import Data.Map (Map) +import qualified Data.Map as M + +data NodeMap a = + NodeMap { map :: Map a Node, + key :: Int } deriving Show -- | Create a new, empty mapping. new :: (Ord a) => NodeMap a -new = NodeMap { map = emptyFM, key = 0 } +new = NodeMap { map = M.empty, key = 0 } -- LNode = (Node, a) @@ -46,19 +47,19 @@ fromGraph :: (Ord a, Graph g) => g a b -> NodeMap a fromGraph g = let ns = labNodes g - aux (n, a) (m', k') = (addToFM m' a n, max n k') - (m, k) = foldr aux (emptyFM, 0) ns + aux (n, a) (m', k') = (M.insert a n m', max n k') + (m, k) = foldr aux (M.empty, 0) ns in NodeMap { map = m, key = k+1 } -- | Generate a labelled node from the given label. Will return the same node -- for the same label. mkNode :: (Ord a) => NodeMap a -> a -> (LNode a, NodeMap a) mkNode m@(NodeMap mp k) a = - case lookupFM mp a of - Just i -> ((i, a), m) - Nothing -> - let m' = NodeMap { map = addToFM mp a k, key = k+1 } - in ((k, a), m') + case M.lookup a mp of + Just i -> ((i, a), m) + Nothing -> + let m' = NodeMap { map = M.insert a k mp, key = k+1 } + in ((k, a), m') -- | Generate a labelled node and throw away the modified 'NodeMap'. mkNode_ :: (Ord a) => NodeMap a -> a -> LNode a @@ -67,8 +68,8 @@ -- | Generate a 'LEdge' from the node labels. mkEdge :: (Ord a) => NodeMap a -> (a, a, b) -> Maybe (LEdge b) mkEdge (NodeMap m _) (a1, a2, b) = - do n1 <- lookupFM m a1 - n2 <- lookupFM m a2 + do n1 <- M.lookup a1 m + n2 <- M.lookup a2 m return (n1, n2, b) -- | Generates a list of 'LEdge's. @@ -83,7 +84,7 @@ map' _ a [] = ([], a) map' f a (b:bs) = let (c, a') = f a b - (cs, a'') = map' f a' bs + (cs, a'') = map' f a' bs in (c:cs, a'') -- | Construct a list of nodes and throw away the modified 'NodeMap'. @@ -138,13 +139,13 @@ 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' + ns'' = P.map (\(a, b, _) -> (a, b)) ns' in delEdges ns'' g 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 + Just es' = mkEdges m' es in (mkGraph ns' es', m') -- | Graph construction monad; handles passing both the 'NodeMap' and the diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/ArtPoint.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/ArtPoint.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/ArtPoint.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/ArtPoint.hs 2015-03-09 05:38:02.000000000 +0100 @@ -33,7 +33,7 @@ -- Builds a DFS tree for a given graph. Each element (v,n,b) in the tree -- contains: the node number v, the DFS number n, and a list of backedges b. ------------------------------------------------------------------------------ -dfsTree :: Graph gr => Int -> Node -> [Node] -> [[(Node,Int)]] -> +dfsTree :: Graph gr => Int -> Node -> [Node] -> [[(Node,Int)]] -> gr a b -> ([DFSTree Int],gr a b,Int) dfsTree n _ [] _ g = ([],g,n) dfsTree n _ _ _ g | isEmpty g = ([],g,n) @@ -66,8 +66,8 @@ -- contains: the node number v, the DFS number n, and the low number low. ------------------------------------------------------------------------------ lowTree :: DFSTree Int -> LOWTree Int -lowTree (B (v,n,[] ) [] ) = Brc (v,n,n) [] -lowTree (B (v,n,bcks) [] ) = Brc (v,n,minbckEdge n bcks) [] +lowTree (B (v,n,[] ) [] ) = Brc (v,n,n) [] +lowTree (B (v,n,bcks) [] ) = Brc (v,n,minbckEdge n bcks) [] lowTree (B (v,n,bcks) trs) = Brc (v,n,lowv) ts where lowv = min (minbckEdge n bcks) lowChild lowChild = minimum (map getLow ts) @@ -119,4 +119,3 @@ -} ap :: Graph gr => gr a b -> [Node] ap g = artpoints g v where ((_,v,_,_),_) = matchAny g - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/BCC.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/BCC.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/BCC.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/BCC.hs 2015-03-09 05:38:02.000000000 +0100 @@ -4,8 +4,8 @@ import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.Query.DFS import Data.Graph.Inductive.Query.ArtPoint +import Data.Graph.Inductive.Query.DFS ------------------------------------------------------------------------------ @@ -43,7 +43,7 @@ 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 +splitGraphs gs (v:vs) = splitGraphs (gs''++gs''') vs where gs'' = embedContexts c gs' gs' = gComponents g' ((Just c,g'), gs''') = findGraph v gs @@ -55,22 +55,3 @@ -} bcc :: DynGraph gr => gr a b -> [gr a b] bcc g = splitGraphs [g] (ap g) - - - - - - - - - - - - - - - - - - - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/BFS.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/BFS.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/BFS.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/BFS.hs 2015-03-09 05:38:02.000000000 +0100 @@ -54,7 +54,7 @@ leveln _ g | isEmpty g = [] leveln ((v,j):vs) g = case match v g of (Just c,g') -> (v,j):leveln (vs++suci c (j+1)) g' - (Nothing,g') -> leveln vs g' + (Nothing,g') -> leveln vs g' -- bfe (breadth first edges) @@ -62,7 +62,7 @@ -- bfenInternal :: Graph gr => Queue Edge -> gr a b -> [Edge] bfenInternal q g | queueEmpty q || isEmpty g = [] - | otherwise = + | otherwise = case match v g of (Just c, g') -> (u,v):bfenInternal (queuePutList (outU c) q') g' (Nothing, g') -> bfenInternal q' g' @@ -83,16 +83,16 @@ -- bft :: Node -> gr a b -> IT.InTree Node -- bft v g = IT.build $ map swap $ bfe v g -- where swap (x,y) = (y,x) --- +-- -- sp (shortest path wrt to number of edges) -- -- sp :: Node -> Node -> gr a b -> [Node] -- sp s t g = reverse $ IT.rootPath (bft s g) t --- faster shortest paths +-- faster shortest paths -- here: with root path trees --- +-- bft :: Graph gr => Node -> gr a b -> RTree bft v = bf (queuePut [v] mkQueue) @@ -110,10 +110,10 @@ -- lesp is a version of esp that returns labeled paths -- Note that the label of the first node in a returned path is meaningless; --- all other nodes are paired with the label of their incoming edge. +-- all other nodes are paired with the label of their incoming edge. -- lbft :: Graph gr => Node -> gr a b -> LRTree b -lbft v g = case (out g v) of +lbft v g = case (out g v) of [] -> [LP []] (v',_,l):_ -> lbf (queuePut (LP [(v',l)]) mkQueue) g @@ -128,4 +128,3 @@ 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.5.0.1/Data/Graph/Inductive/Query/DFS.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/DFS.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/DFS.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/DFS.hs 2015-03-09 05:38:02.000000000 +0100 @@ -1,5 +1,5 @@ -- (c) 2000 - 2005 by Martin Erwig [see file COPYRIGHT] --- | Depth-First Search +-- | Depth-First Search module Data.Graph.Inductive.Query.DFS( CFun, @@ -8,17 +8,19 @@ xdfsWith,xdfWith,xdffWith, -- * Undirected DFS udfs,udfs',udff,udff', + udffWith,udffWith', -- * Reverse DFS rdff,rdff',rdfs,rdfs', + rdffWith,rdffWith', -- * Applications of DFS\/DFF topsort,topsort',scc,reachable, -- * Applications of UDFS\/UDFF components,noComponents,isConnected ) where -import Data.Tree -import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Graph +import Data.Tree ---------------------------------------------------------------------- -- DFS AND FRIENDS @@ -35,7 +37,7 @@ | structure direction | "s" "f" ------------------------ + optional With + optional ' - "x" | xdfs xdff + "x" | xdfs xdff " " | dfs dff "u" | udfs udff "r" | rdfs rdff @@ -43,23 +45,23 @@ Direction Parameter ------------------- - x : parameterized by a function that specifies which nodes + x : parameterized by a function that specifies which nodes to be visited next " ": the "normal case: just follow successors - + u : undirected, ie, follow predecesors and successors - + r : reverse, ie, follow predecesors Structure Parameter ------------------- - s : result is a list of + s : result is a list of (a) objects computed from visited contexts ("With"-version) (b) nodes (normal version) - f : result is a tree/forest of + f : result is a tree/forest of (a) objects computed from visited contexts ("With"-version) (b) nodes (normal version) @@ -68,12 +70,12 @@ With : objects to be put into list/tree are given by a function on contexts, default for non-"With" versions: nodes - ' : parameter node list is given implicitly by the nodes of the + ' : parameter node list is given implicitly by the nodes of the graph to be traversed, default for non-"'" versions: nodes must be provided explicitly - Defined are only the following 18 most important function versions: + Defined are only the following 22 most frabjuous function versions: xdfsWith dfsWith,dfsWith',dfs,dfs' @@ -81,11 +83,11 @@ rdfs,rdfs' xdffWith dffWith,dffWith',dff,dff' - udff,udff' - rdff,rdff' - + udffWith,udffWith',udff,udff' + rdffWith,rdffWith',rdff,rdff' + Others can be added quite easily if needed. - + -} -- fixNodes fixes the nodes of the graph as a parameter @@ -95,9 +97,9 @@ -- generalized depth-first search --- (could also be simply defined as applying preorderF to the +-- (could also be simply defined as applying preorderF to the -- result of xdffWith) --- +-- type CFun a b c = Context a b -> c xdfsWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c] @@ -105,7 +107,7 @@ xdfsWith _ _ _ g | isEmpty g = [] xdfsWith d f (v:vs) g = case match v g of (Just c,g') -> f c:xdfsWith d f (d c++vs) g' - (Nothing,g') -> xdfsWith d f vs g' + (Nothing,g') -> xdfsWith d f vs g' -- dfs @@ -126,7 +128,7 @@ -- undirected dfs, ie, ignore edge directions -- udfs :: Graph gr => [Node] -> gr a b -> [Node] -udfs = xdfsWith neighbors' node' +udfs = xdfsWith neighbors' node' udfs' :: Graph gr => gr a b -> [Node] udfs' = fixNodes udfs @@ -135,22 +137,22 @@ -- reverse dfs, ie, follow predecessors -- rdfs :: Graph gr => [Node] -> gr a b -> [Node] -rdfs = xdfsWith pre' node' +rdfs = xdfsWith pre' node' rdfs' :: Graph gr => gr a b -> [Node] rdfs' = fixNodes rdfs -- generalized depth-first forest --- +-- xdfWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> ([Tree c],gr a b) xdfWith _ _ [] g = ([],g) xdfWith _ _ _ g | isEmpty g = ([],g) xdfWith d f (v:vs) g = case match v g of - (Nothing,g1) -> xdfWith d f vs g1 - (Just c,g1) -> (Node (f c) ts:ts',g3) + (Nothing,g1) -> xdfWith d f vs g1 + (Just c,g1) -> (Node (f c) ts:ts',g3) where (ts,g2) = xdfWith d f (d c) g1 - (ts',g3) = xdfWith d f vs g2 + (ts',g3) = xdfWith d f vs g2 xdffWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c] xdffWith d f vs g = fst (xdfWith d f vs g) @@ -173,20 +175,32 @@ -- undirected dff -- +udffWith :: Graph gr => CFun a b c -> [Node] -> gr a b -> [Tree c] +udffWith = xdffWith neighbors' + +udffWith' :: Graph gr => CFun a b c -> gr a b -> [Tree c] +udffWith' f = fixNodes (udffWith f) + udff :: Graph gr => [Node] -> gr a b -> [Tree Node] -udff = xdffWith neighbors' node' +udff = udffWith node' udff' :: Graph gr => gr a b -> [Tree Node] -udff' = fixNodes udff +udff' = udffWith' node' -- reverse dff, ie, following predecessors -- +rdffWith :: Graph gr => CFun a b c -> [Node] -> gr a b -> [Tree c] +rdffWith = xdffWith pre' + +rdffWith' :: Graph gr => CFun a b c -> gr a b -> [Tree c] +rdffWith' f = fixNodes (rdffWith f) + rdff :: Graph gr => [Node] -> gr a b -> [Tree Node] -rdff = xdffWith pre' node' +rdff = rdffWith node' rdff' :: Graph gr => gr a b -> [Tree Node] -rdff' = fixNodes rdff +rdff' = rdffWith' node' ---------------------------------------------------------------------- @@ -220,4 +234,3 @@ reachable :: Graph gr => Node -> gr a b -> [Node] reachable v g = preorderF (dff [v] g) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/Dominators.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/Dominators.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/Dominators.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/Dominators.hs 2015-03-09 05:38:02.000000000 +0100 @@ -12,13 +12,13 @@ iDom ) where -import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.Query.DFS -import Data.Tree (Tree(..)) -import qualified Data.Tree as T -import Data.Array -import Data.IntMap (IntMap) -import qualified Data.IntMap as I +import Data.Array +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.Query.DFS +import Data.IntMap (IntMap) +import qualified Data.IntMap as I +import Data.Tree (Tree (..)) +import qualified Data.Tree as T -- | return immediate dominators for each node of a graph, given a root iDom :: Graph gr => gr a b -> Node -> [(Node,Node)] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/GVD.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/GVD.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/GVD.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/GVD.hs 2015-03-09 05:38:02.000000000 +0100 @@ -1,5 +1,5 @@ -- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] --- | Graph Voronoi Diagram +-- | Graph Voronoi Diagram module Data.Graph.Inductive.Query.GVD ( Voronoi, @@ -9,15 +9,15 @@ -- vdO,nnO,nsO ) where +import Data.List (nub) import Data.Maybe (listToMaybe) -import Data.List (nub) import qualified Data.Graph.Inductive.Internal.Heap as H +import Data.Graph.Inductive.Basic import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.Query.SP (dijkstra) import Data.Graph.Inductive.Internal.RootPath -import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Query.SP (dijkstra) type Voronoi a = LRTree a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/Indep.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/Indep.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/Indep.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/Indep.hs 2015-03-09 05:38:02.000000000 +0100 @@ -15,10 +15,9 @@ indep :: DynGraph gr => gr a b -> [Node] indep g | isEmpty g = [] indep g = if length i1>length i2 then i1 else i2 - where vs = nodes g - m = maximum (map (deg g) vs) - v = first (\v'->deg g v'==m) vs - (Just c,g') = match v g + where vs = nodes g + m = maximum (map (deg g) vs) + v = first (\v'->deg g v'==m) vs + (Just c,g') = match v g i1 = indep g' i2 = v:indep (delNodes (neighbors' c) g') - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/MST.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/MST.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/MST.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/MST.hs 2015-03-09 05:38:02.000000000 +0100 @@ -1,5 +1,5 @@ -- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] --- | Minimum-Spanning-Tree Algorithms +-- | Minimum-Spanning-Tree Algorithms module Data.Graph.Inductive.Query.MST ( msTreeAt,msTree, @@ -7,9 +7,9 @@ msPath ) where -import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.Internal.RootPath -import qualified Data.Graph.Inductive.Internal.Heap as H +import Data.Graph.Inductive.Graph +import qualified Data.Graph.Inductive.Internal.Heap as H +import Data.Graph.Inductive.Internal.RootPath newEdges :: Ord b => LPath b -> Context a b -> [H.Heap b (LPath b)] @@ -20,7 +20,7 @@ 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' + (Nothing,g') -> prim h' g' where (_,p@(LP ((v,_):_)),h') = H.splitMin h msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b @@ -31,11 +31,10 @@ msPath :: Real b => LRTree b -> Node -> Node -> Path msPath t a b = joinPaths (getLPathNodes a t) (getLPathNodes b t) - -joinPaths :: Path -> Path -> Path + +joinPaths :: Path -> Path -> Path joinPaths p q = joinAt (head p) p q joinAt :: Node -> Path -> Path -> Path joinAt _ (v:vs) (w:ws) | v==w = joinAt v vs ws joinAt x p q = reverse p++(x:q) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/MaxFlow.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/MaxFlow.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/MaxFlow.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/MaxFlow.hs 2015-03-09 05:38:02.000000000 +0100 @@ -2,7 +2,7 @@ -- We are given a flow network G=(V,E) with source s and sink t where each -- edge (u,v) in E has a nonnegative capacity c(u,v)>=0, and we wish to -- find a flow of maximum value from s to t. --- +-- -- A flow in G=(V,E) is a real-valued function f:VxV->R that satisfies: -- -- @ @@ -51,11 +51,11 @@ -- i (i,0,i) -- label of every edge from a---->b to a------->b -- @ --- +-- -- where label (x,y,z)=(Max Capacity, Current flow, Residual capacity) augmentGraph :: (DynGraph gr,Num b,Ord b) => gr a b -> gr a (b,b,b) augmentGraph g = emap (\i->(i,0,i)) (insEdges (getRevEdges (edges g)) g) - + -- | Given a successor or predecessor list for node u and given node v, find -- the label corresponding to edge (u,v) and update the flow and residual -- capacity of that edge's label. Then return the updated list. @@ -70,7 +70,7 @@ -- predecessor list, then update the corresponding edges (u,v) and (v,u) on -- those lists by using the minimum residual capacity of the path. updateFlow :: (DynGraph gr,Num b,Ord b) => Path -> b -> gr a (b,b,b) -> gr a (b,b,b) -updateFlow [] _ g = g +updateFlow [] _ g = g updateFlow [_] _ g = g updateFlow (u:v:vs) cf g = case match u g of (Nothing,g') -> g' @@ -117,11 +117,9 @@ ------------------------------------------------------------------------------ -- Some test cases: clr595 is from the CLR textbook, page 595. The value of --- the maximum flow for s=1 and t=6 (23) coincides with the example but the --- flow itself is slightly different since the textbook does not compute the --- shortest augmenting path from s to t, but just any path. However remember +-- the maximum flow for s=1 and t=6 (23) coincides with the example but the +-- flow itself is slightly different since the textbook does not compute the +-- shortest augmenting path from s to t, but just any path. However remember -- that for a given flow graph the maximum flow is not unique. -- (gr595 is defined in GraphData.hs) ------------------------------------------------------------------------------ - - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/MaxFlow2.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/MaxFlow2.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/MaxFlow2.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/MaxFlow2.hs 2015-03-09 05:38:02.000000000 +0100 @@ -10,11 +10,12 @@ import Data.Maybe import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.PatriciaTree -import Data.Graph.Inductive.Internal.FiniteMap import Data.Graph.Inductive.Internal.Queue -import Data.Graph.Inductive.Query.BFS (bft) +import Data.Graph.Inductive.PatriciaTree +import Data.Graph.Inductive.Query.BFS (bft) +import Data.Set (Set) +import qualified Data.Set as S ------------------------------------------------------------------------------ -- Data types @@ -118,7 +119,7 @@ -- ekFusedStep :: EKStepFunc ekFusedStep g s t = case maybePath of - Just _ -> + Just _ -> Just ((insEdges (integrateDelta es delta) newg), delta) Nothing -> Nothing where maybePath = augPathFused g s t @@ -158,7 +159,7 @@ Just (l, newg) -> ((v, u, l, Backward):tailedges, newerg) where (tailedges, newerg) = extractPath newg (v:ws) - Nothing -> error "extractPath: revExtract == Nothing" + Nothing -> error "extractPath: revExtract == Nothing" where fwdExtract = extractEdge g u v (\(c,f)->(c>f)) revExtract = extractEdge g v u (\(_,f)->(f>0)) @@ -190,7 +191,7 @@ integrateDelta :: [DirEdge (Double,Double)] -> Double -> [LEdge (Double, Double)] -integrateDelta [] _ = [] +integrateDelta [] _ = [] integrateDelta (e:es) delta = case e of (u, v, (c, f), Forward) -> (u, v, (c, f+delta)) : (integrateDelta es delta) @@ -222,25 +223,15 @@ -- Alternative implementation: Process list of edges to extract path instead -- of operating on graph structure --- EXTRACT fglEdmondsList.txt -setFromList :: Ord a => [a] -> FiniteMap a () -setFromList [] = emptyFM -setFromList (x:xs) = addToFM (setFromList xs) x () - -setContains :: Ord a => FiniteMap a () -> a -> Bool -setContains m i = case (lookupFM m i) of - Nothing -> False - Just () -> True - -extractPathList :: [LEdge (Double, Double)] -> FiniteMap (Node,Node) () +extractPathList :: [LEdge (Double, Double)] -> Set (Node,Node) -> ([DirEdge (Double, Double)], [LEdge (Double, Double)]) extractPathList [] _ = ([], []) extractPathList (edge@(u,v,l@(c,f)):es) set - | (c>f) && (setContains set (u,v)) = - let (pathrest, notrest)=extractPathList es (delFromFM set (u,v)) + | (c>f) && (S.member (u,v) set) = + let (pathrest, notrest)=extractPathList es (S.delete (u,v) set) in ((u,v,l,Forward):pathrest, notrest) - | (f>0) && (setContains set (v,u)) = - let (pathrest, notrest)=extractPathList es (delFromFM set (u,v)) + | (f>0) && (S.member (v,u) set) = + let (pathrest, notrest)=extractPathList es (S.delete (u,v) set) in ((u,v,l,Backward):pathrest, notrest) | otherwise = let (pathrest, notrest)=extractPathList es set in @@ -253,11 +244,10 @@ where newEdges = (integrateDelta es delta) ++ otheredges maybePath = augPathFused g s t (es, otheredges) = extractPathList (labEdges g) - (setFromList (zip justPath (tail justPath))) + (S.fromList (zip justPath (tail justPath))) delta = minimum $ getPathDeltas es justPath = pathFromDirPath (fromJust maybePath) ekList :: Network -> Node -> Node -> (Network, Double) ekList = ekWith ekStepList -- ENDEXTRACT - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/Monad.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/Monad.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/Monad.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/Monad.hs 2015-03-09 05:38:02.000000000 +0100 @@ -1,3 +1,5 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + -- (c) 2002 by Martin Erwig [see file COPYRIGHT] -- | Monadic Graph Algorithms @@ -22,12 +24,13 @@ -- Why all this? -- --- graph monad ensures single-threaded access +-- graph monad ensures single-threaded access -- ==> we can safely use imperative updates in the graph implementation -- +import Control.Applicative (Applicative (..)) +import Control.Monad (ap, liftM) import Data.Tree ---import Control.Monad (liftM) import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Monad @@ -51,7 +54,7 @@ -- monadic graph transformer monad ---------------------------------------------------------------------- -data GT m g a = MGT (m g -> m (a,g)) +newtype GT m g a = MGT (m g -> m (a,g)) apply :: GT m g a -> m g -> m (a,g) apply (MGT f) mg = f mg @@ -68,6 +71,12 @@ runGT :: Monad m => GT m g a -> m g -> m a runGT gt mg = do {(x,_) <- apply gt mg; return x} +instance Monad m => Functor (GT m g) where + fmap = liftM + +instance Monad m => Applicative (GT m g) where + pure = return + (<*>) = ap instance Monad m => Monad (GT m g) where return x = MGT (\mg->do {g<-mg; return (x,g)}) @@ -75,16 +84,16 @@ condMGT' :: Monad m => (s -> Bool) -> GT m s a -> GT m s a -> GT m s a condMGT' p f g = MGT (\mg->do {h<-mg; if p h then apply f mg else apply g mg}) - + recMGT' :: Monad m => (s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b -recMGT' p mg f u = condMGT' p (return u) +recMGT' p mg f u = condMGT' p (return u) (do {x<-mg;y<-recMGT' p mg f u;return (f x y)}) condMGT :: Monad m => (m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a condMGT p f g = MGT (\mg->do {b<-p mg; if b then apply f mg else apply g mg}) recMGT :: Monad m => (m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b -recMGT p mg f u = condMGT p (return u) +recMGT p mg f u = condMGT p (return u) (do {x<-mg;y<-recMGT p mg f u;return (f x y)}) @@ -94,7 +103,7 @@ -- some monadic graph accessing functions --- +-- getNode :: GraphM m gr => GT m (gr a b) Node getNode = MGT (\mg->do {((_,v,_,_),g) <- matchAnyM mg; return (v,g)}) @@ -103,7 +112,7 @@ -- some functions defined by using the do-notation explicitly -- Note: most of these can be expressed as an instance of graphRec --- +-- getNodes' :: (Graph gr,GraphM m gr) => GT m (gr a b) [Node] getNodes' = condMGT' isEmpty (return []) (do v <- getNode @@ -132,19 +141,19 @@ -- some derived graph recursion operators ---------------------------------------------------------------------- --- +-- -- graphRec :: GraphMonad a b c -> (c -> d -> d) -> d -> GraphMonad a b d --- graphRec f g u = cond isEmpty (return u) +-- graphRec f g u = cond isEmpty (return u) -- (do x <- f -- y <- graphRec f g u -- return (g x y)) -- | encapsulates a simple recursion schema on graphs -graphRec :: GraphM m gr => GT m (gr a b) c -> +graphRec :: GraphM m gr => GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d graphRec = recMGT isEmptyM -graphRec' :: (Graph gr,GraphM m gr) => GT m (gr a b) c -> +graphRec' :: (Graph gr,GraphM m gr) => GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d graphRec' = recMGT' isEmpty @@ -158,7 +167,7 @@ ---------------------------------------------------------------------- -- instances of graphRec --- +-- graphNodesM0 :: GraphM m gr => GT m (gr a b) [Node] graphNodesM0 = graphRec getNode (:) [] @@ -209,7 +218,7 @@ dffM vs = MGT (\mg-> do g<-mg b<-isEmptyM mg - if b||null vs then return ([],g) else + if b||null vs then return ([],g) else let (v:vs') = vs in do (mc,g1) <- matchM v mg case mc of @@ -224,4 +233,3 @@ graphDff' :: GraphM m gr => m (gr a b) -> m [Tree Node] graphDff' mg = do {vs <- nodesM mg; runGT (dffM vs) mg} - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/SP.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/SP.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/SP.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/SP.hs 2015-03-09 05:38:02.000000000 +0100 @@ -13,15 +13,15 @@ expand :: Real b => b -> LPath b -> Context a b -> [H.Heap b (LPath b)] expand d (LP p) (_,_,_,s) = map (\(l,v)->H.unit (l+d) (LP ((v,l+d):p))) s --- | Implementation of Dijkstra's shortest path algorithm +-- | Implementation of Dijkstra's shortest path algorithm dijkstra :: (Graph gr, Real b) => H.Heap b (LPath b) -> gr a b -> 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' + (Nothing,g') -> dijkstra h' g' where (_,p@(LP ((v,d):_)),h') = H.splitMin h - + spTree :: (Graph gr, Real b) => Node -> gr a b -> LRTree b spTree v = dijkstra (H.unit 0 (LP [(v,0)])) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query/TransClos.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query/TransClos.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query/TransClos.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query/TransClos.hs 2015-03-09 05:38:02.000000000 +0100 @@ -18,4 +18,3 @@ trc :: DynGraph gr => gr a b -> gr a () trc g = insEdges (getNewEdges ln g) (insNodes ln empty) where ln = labNodes g - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Query.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Query.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Query.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Query.hs 2015-03-09 05:38:02.000000000 +0100 @@ -14,16 +14,16 @@ module Data.Graph.Inductive.Query.Monad, ) where -import Data.Graph.Inductive.Query.DFS +import Data.Graph.Inductive.Query.ArtPoint +import Data.Graph.Inductive.Query.BCC import Data.Graph.Inductive.Query.BFS -import Data.Graph.Inductive.Query.SP +import Data.Graph.Inductive.Query.DFS +import Data.Graph.Inductive.Query.Dominators import Data.Graph.Inductive.Query.GVD -import Data.Graph.Inductive.Query.MST import Data.Graph.Inductive.Query.Indep import Data.Graph.Inductive.Query.MaxFlow import Data.Graph.Inductive.Query.MaxFlow2 -import Data.Graph.Inductive.Query.ArtPoint -import Data.Graph.Inductive.Query.BCC -import Data.Graph.Inductive.Query.Dominators -import Data.Graph.Inductive.Query.TransClos import Data.Graph.Inductive.Query.Monad +import Data.Graph.Inductive.Query.MST +import Data.Graph.Inductive.Query.SP +import Data.Graph.Inductive.Query.TransClos diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/Data/Graph/Inductive/Tree.hs new/fgl-5.5.1.0/Data/Graph/Inductive/Tree.hs --- old/fgl-5.5.0.1/Data/Graph/Inductive/Tree.hs 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/Data/Graph/Inductive/Tree.hs 2015-03-09 05:38:02.000000000 +0100 @@ -7,18 +7,21 @@ module Data.Graph.Inductive.Tree (Gr,UGr) where import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.Internal.FiniteMap -import Data.List (foldl', sort) -import Data.Maybe (fromJust) +import Control.Applicative (liftA2) +import Control.Arrow (first) +import Data.List (foldl', sort) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Maybe (fromMaybe) ---------------------------------------------------------------------- -- GRAPH REPRESENTATION ---------------------------------------------------------------------- -data Gr a b = Gr (GraphRep a b) +newtype Gr a b = Gr (GraphRep a b) -type GraphRep a b = FiniteMap Node (Context' a b) +type GraphRep a b = Map Node (Context' a b) type Context' a b = (Adj b,a,Adj b) type UGr = Gr () () @@ -49,58 +52,71 @@ -- Graph -- instance Graph Gr where - empty = Gr emptyFM - isEmpty (Gr g) = case g of {Empty -> True; _ -> False} - match = matchGr - mkGraph vs es = (insEdges' . insNodes vs) empty + empty = Gr M.empty + isEmpty (Gr g) = M.null g + match v gr@(Gr g) = maybe (Nothing, gr) + (first Just . uncurry (cleanSplit v)) + . (\(m,g') -> fmap (flip (,) g') m) + $ M.updateLookupWithKey (const (const Nothing)) v g + mkGraph vs es = (insEdges' . insNodes vs) empty where insEdges' g = foldl' (flip insEdge) g es - labNodes (Gr g) = map (\(v,(_,l,_))->(v,l)) (fmToList g) + labNodes (Gr g) = map (\(v,(_,l,_))->(v,l)) (M.toList g) -- more efficient versions of derived class members -- - matchAny (Gr Empty) = error "Match Exception, Empty Graph" - matchAny g@(Gr (Node _ _ (v,_) _)) = (c,g') where (Just c,g') = matchGr v g - noNodes (Gr g) = sizeFM g - nodeRange (Gr Empty) = (0,0) - nodeRange (Gr g) = (ix (minFM g),ix (maxFM g)) where ix = fst.fromJust - labEdges (Gr g) = concatMap (\(v,(_,_,s))->map (\(l,w)->(v,w,l)) s) (fmToList g) - - -matchGr v (Gr g) = - case splitFM g v of - Nothing -> (Nothing,Gr g) - Just (g',(_,(p,l,s))) -> (Just (p',v,l,s),Gr g2) - where s' = filter ((/=v).snd) s - p' = filter ((/=v).snd) p - g1 = updAdj g' s' (clearPred v) - g2 = updAdj g1 p' (clearSucc v) + matchAny (Gr g) = maybe (error "Match Exception, Empty Graph") + (uncurry (uncurry cleanSplit)) + (M.minViewWithKey g) + noNodes (Gr g) = M.size g + nodeRange (Gr g) = fromMaybe (0,0) + $ liftA2 (,) (ix (M.minViewWithKey g)) + (ix (M.maxViewWithKey g)) + where + ix = fmap (fst . fst) + labEdges (Gr g) = concatMap (\(v,(_,_,s))->map (\(l,w)->(v,w,l)) s) (M.toList g) + +-- After a Node (with its corresponding Context') are split out of a +-- GraphRep, clean up the remainders. +cleanSplit :: Node -> Context' a b -> GraphRep a b + -> (Context a b, Gr a b) +cleanSplit v (p,l,s) g = (c, Gr g') + where + -- Note: loops are kept only in successor list + c = (p', v, l, s) + p' = rmLoops p + s' = rmLoops s + rmLoops = filter ((/=v) . snd) + g' = updAdj s' (clearPred v) . updAdj p' (clearSucc v) $ g -- DynGraph -- instance DynGraph Gr where - (p,v,l,s) & (Gr g) | elemFM g v = error ("Node Exception, Node: "++show v) - | otherwise = Gr g3 - where g1 = addToFM g v (p,l,s) - g2 = updAdj g1 p (addSucc v) - g3 = updAdj g2 s (addPred v) - + (p,v,l,s) & (Gr g) = Gr + . updAdj p (addSucc v) + . updAdj s (addPred v) + $ M.alter addCntxt v g + where + addCntxt = maybe (Just cntxt') + (const (error ("Node Exception, Node: "++show v))) + cntxt' = (p,l,s) ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- +addSucc :: Node -> b -> Context' a b -> Context' a b addSucc v l (p,l',s) = (p,l',(l,v):s) + +addPred :: Node -> b -> Context' a b -> Context' a b addPred v l (p,l',s) = ((l,v):p,l',s) +clearSucc :: Node -> b -> Context' a b -> Context' a b clearSucc v _ (p,l,s) = (p,l,filter ((/=v).snd) s) -clearPred v _ (p,l,s) = (filter ((/=v).snd) p,l,s) - -updAdj :: GraphRep a b -> Adj b -> (b -> Context' a b -> Context' a b) -> GraphRep a b -updAdj g [] _ = g -updAdj g ((l,v):vs) f | elemFM g v = updAdj (updFM g v (f l)) vs f - | otherwise = error ("Edge Exception, Node: "++show v) - +clearPred :: Node -> b -> Context' a b -> Context' a b +clearPred v _ (p,l,s) = (filter ((/=v).snd) p,l,s) +updAdj :: Adj b -> (b -> Context' a b -> Context' a b) -> GraphRep a b -> GraphRep a b +updAdj adj f g = foldl' (\g' (l,v) -> M.adjust (f l) v g') g adj diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.0.1/fgl.cabal new/fgl-5.5.1.0/fgl.cabal --- old/fgl-5.5.0.1/fgl.cabal 2014-04-28 06:32:54.000000000 +0200 +++ new/fgl-5.5.1.0/fgl.cabal 2015-03-09 05:38:02.000000000 +0100 @@ -1,24 +1,28 @@ name: fgl -version: 5.5.0.1 +version: 5.5.1.0 license: BSD3 license-file: LICENSE author: Martin Erwig, Ivan Lazar Miljenovic maintainer: [email protected] -homepage: http://web.engr.oregonstate.edu/~erwig/fgl/haskell category: Data Structures, Graphs synopsis: Martin Erwig's Functional Graph Library + +description: { +An inductive representation of manipulating graph data structures. +. +Original website can be found at <http://web.engr.oregonstate.edu/~erwig/fgl/haskell>. +} cabal-version: >= 1.6 build-type: Simple extra-source-files: ChangeLog source-repository head - type: darcs - location: http://code.haskell.org/FGL/fgl-5 + type: git + location: git://github.com/haskell/fgl.git library { exposed-modules: - Data.Graph.Inductive.Internal.FiniteMap, Data.Graph.Inductive.Internal.Heap, Data.Graph.Inductive.Internal.Queue, Data.Graph.Inductive.Internal.RootPath,
