diff --git a/src/Topograph.hs b/src/Topograph.hs --- a/src/Topograph.hs +++ b/src/Topograph.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -53,8 +54,8 @@ import Data.Set (Set) import qualified Data.Graph as G -import qualified Data.Map as M -import qualified Data.Set as S +import qualified Data.Map as Map +import qualified Data.Set as Set import qualified Data.Tree as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U @@ -70,7 +71,7 @@ -- -- <> -- --- >>> let example :: Map Char (Set Char); example = M.map S.fromList $ M.fromList [('a', "bxde"), ('b', "d"), ('x', "de"), ('d', "e"), ('e', "")] +-- >>> let example :: Map Char (Set Char); example = Map.map Set.fromList $ Map.fromList [('a', "bxde"), ('b', "d"), ('x', "de"), ('d', "e"), ('e', "")] -- -- >>> :set -XRecordWildCards -- >>> import Data.Monoid (All (..)) @@ -155,11 +156,11 @@ -- -- ==== Not DAG -- --- >>> let loop = M.map S.fromList $ M.fromList [('a', "bx"), ('b', "cx"), ('c', "ax"), ('x', "")] +-- >>> let loop = Map.map Set.fromList $ Map.fromList [('a', "bx"), ('b', "cx"), ('c', "ax"), ('x', "")] -- >>> runG loop $ \G {..} -> map gFromVertex gVertices -- Left "abc" -- --- >>> runG (M.singleton 'a' (S.singleton 'a')) $ \G {..} -> map gFromVertex gVertices +-- >>> runG (Map.singleton 'a' (Set.singleton 'a')) $ \G {..} -> map gFromVertex gVertices -- Left "aa" -- runG @@ -175,7 +176,7 @@ r :: G.Vertex -> ((), v, [v]) _t :: v -> Maybe G.Vertex - (gr, r, _t) = G.graphFromEdges [ ((), v, S.toAscList us) | (v, us) <- M.toAscList m ] + (gr, r, _t) = G.graphFromEdges [ ((), v, Set.toAscList us) | (v, us) <- Map.toAscList m ] r' :: G.Vertex -> v r' i = case r i of (_, v, _) -> v @@ -187,14 +188,14 @@ indices = V.fromList (map r' topo) revIndices :: Map v Int - revIndices = M.fromList $ zip (map r' topo) [0..] + revIndices = Map.fromList $ zip (map r' topo) [0..] edges :: V.Vector [Int] edges = V.map (\v -> maybe [] - (\sv -> sort $ mapMaybe (\v' -> M.lookup v' revIndices) $ S.toList sv) - (M.lookup v m)) + (\sv -> sort $ mapMaybe (\v' -> Map.lookup v' revIndices) $ Set.toList sv) + (Map.lookup v m)) indices -- TODO: let's see if this check is too expensive @@ -212,7 +213,7 @@ g = G { gVertices = [0 .. V.length indices - 1] , gFromVertex = (indices V.!) - , gToVertex = (`M.lookup` revIndices) + , gToVertex = (`Map.lookup` revIndices) , gDiff = \a b -> b - a , gEdges = (edges V.!) , gVerticeCount = V.length indices @@ -279,11 +280,11 @@ -- >>> fmap3 (T.foldTree $ \a bs -> if null bs then [[a]] else concatMap (map (a:)) bs) t -- Right (Just (Just ["axde","axe","abde","ade","ae"])) -- --- >>> fmap3 (S.fromList . treePairs) t +-- >>> fmap3 (Set.fromList . treePairs) t -- Right (Just (Just (fromList [('a','b'),('a','d'),('a','e'),('a','x'),('b','d'),('d','e'),('x','d'),('x','e')]))) -- -- >>> let ls = runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'e' --- >>> fmap2 (S.fromList . concatMap pairs) ls +-- >>> fmap2 (Set.fromList . concatMap pairs) ls -- Right (Just (fromList [('a','b'),('a','d'),('a','e'),('a','x'),('b','d'),('d','e'),('x','d'),('x','e')])) -- -- 'Tree' paths show how one can explore the paths. @@ -397,20 +398,20 @@ pathLenghtsImpl :: forall v i. Ord i => (Int -> Int -> Int) -> G v i -> i -> [Int] pathLenghtsImpl merge G {..} a = runST $ do v <- MU.replicate (length gVertices) (0 :: Int) - go v (S.singleton a) + go v (Set.singleton a) v' <- U.freeze v pure (U.toList v') where go :: MU.MVector s Int -> Set i -> ST s () go v xs = do - case S.minView xs of + case Set.minView xs of Nothing -> pure () Just (x, xs') -> do c <- MU.unsafeRead v (gVertexIndex x) - let ys = S.fromList $ gEdges x + let ys = Set.fromList $ gEdges x for_ ys $ \y -> flip (MU.unsafeModify v) (gVertexIndex y) $ \d -> merge d (c + 1) - go v (xs' `S.union` ys) + go v (xs' `Set.union` ys) ------------------------------------------------------------------------------- -- Transpose @@ -537,8 +538,8 @@ -- Right (fromList [('a',fromList "bdex"),('b',fromList "d"),('d',fromList "e"),('e',fromList ""),('x',fromList "de")]) -- adjacencyMap :: Ord v => G v i -> Map v (Set v) -adjacencyMap G {..} = M.fromList $ map f gVertices where - f x = (gFromVertex x, S.fromList $ map gFromVertex $ gEdges x) +adjacencyMap G {..} = Map.fromList $ map f gVertices where + f x = (gFromVertex x, Set.fromList $ map gFromVertex $ gEdges x) -- | Adjacency list representation of 'G'. -- @@ -549,15 +550,15 @@ adjacencyList = flattenAM . adjacencyMap flattenAM :: Map a (Set a) -> [(a, [a])] -flattenAM = map (fmap S.toList) . M.toList +flattenAM = map (fmap Set.toList) . Map.toList -- | Edges set. -- --- >>> runG example $ \g@G{..} -> map (\(a,b) -> [gFromVertex a, gFromVertex b]) $ S.toList $ edgesSet g +-- >>> runG example $ \g@G{..} -> map (\(a,b) -> [gFromVertex a, gFromVertex b]) $ Set.toList $ edgesSet g -- Right ["ax","ab","ad","ae","xd","xe","bd","de"] -- edgesSet :: Ord i => G v i -> Set (i, i) -edgesSet G {..} = S.fromList +edgesSet G {..} = Set.fromList [ (x, y) | x <- gVertices , y <- gEdges x @@ -567,9 +568,11 @@ -- Utilities ------------------------------------------------------------------------------- +#if !(MIN_VERSION_base(4,14,0)) -- | Unwrap 'Down'. getDown :: Down a -> a getDown (Down a) = a +#endif -- | Like 'pairs' but for 'T.Tree'. treePairs :: T.Tree a -> [(a,a)] diff --git a/topograph.cabal b/topograph.cabal --- a/topograph.cabal +++ b/topograph.cabal @@ -1,25 +1,25 @@ -cabal-version: 2.2 -name: topograph -version: 1 -synopsis: Directed acyclic graphs. -category: Data, Graph +cabal-version: 2.2 +name: topograph +version: 1.0.0.1 +synopsis: Directed acyclic graphs. +category: Data, Graph description: Directed acyclic graphs can be sorted topographically. Existence of topographic ordering allows writing many graph algorithms efficiently. And many graphs, e.g. most dependency graphs are acyclic! . - There are some algorithms build-in: dfs, transpose, transitive closure, + There are some algorithms built-in: dfs, transpose, transitive closure, transitive reduction... Some algorithms even become not-so-hard to implement, like a longest path! -homepage: https://github.com/phadej/topograph -bug-reports: https://github.com/phadej/topograph/issues -license: BSD-3-Clause -license-file: LICENSE -author: Oleg Grenrus -maintainer: Oleg.Grenrus -copyright: (c) 2018-2019 Oleg Grenrus -build-type: Simple +homepage: https://github.com/phadej/topograph +bug-reports: https://github.com/phadej/topograph/issues +license: BSD-3-Clause +license-file: LICENSE +author: Oleg Grenrus +maintainer: Oleg.Grenrus +copyright: (c) 2018-2019 Oleg Grenrus +build-type: Simple extra-doc-files: dag-original.png dag-closure.png @@ -28,7 +28,15 @@ dag-tree.png tested-with: - GHC ==8.6.4 || ==8.4.4 || ==8.2.2 || ==8.0.2 || ==7.10.3 || ==7.8.4 || ==7.6.3 + GHC ==7.6.3 + || ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.3 + || ==8.10.1 source-repository head type: git @@ -37,8 +45,8 @@ library exposed-modules: Topograph build-depends: - , base >=4.6 && <4.13 - , base-compat ^>=0.10.5 + , base >=4.6 && <4.15 + , base-compat ^>=0.10.5 || ^>=0.11.0 , base-orphans ^>=0.8 , containers ^>=0.5.0.0 || ^>=0.6.0.1 , vector ^>=0.12