topograph 1 → 1.0.0.1
raw patch · 2 files changed
+49/−38 lines, 2 filesdep ~basedep ~base-compatdep ~vector
Dependency ranges changed: base, base-compat, vector
Files
- src/Topograph.hs +24/−21
- topograph.cabal +25/−17
src/Topograph.hs view
@@ -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 @@ -- -- <<dag-original.png>> ----- >>> 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)]
topograph.cabal view
@@ -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 <oleg.grenrus@iki.fi>-maintainer: Oleg.Grenrus <oleg.grenrus@iki.fi>-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 <oleg.grenrus@iki.fi>+maintainer: Oleg.Grenrus <oleg.grenrus@iki.fi>+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