algebraic-graphs 0.1.1.1 → 0.2

raw patch · 37 files changed

+3959/−2573 lines, 37 filesdep +mtldep −criteriondep ~base-compatdep ~base-orphansdep ~extraPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

Dependencies removed: criterion

Dependency ranges changed: base-compat, base-orphans, extra

API changes (from Hackage documentation)

Files

• CHANGES.md +24/−1
• README.md +6/−3
• algebraic-graphs.cabal +22/−36
• bench/Bench.hs +0/−200
• src/Algebra/Graph.hs +283/−83
• src/Algebra/Graph/AdjacencyIntMap.hs +692/−0
• src/Algebra/Graph/AdjacencyIntMap/Internal.hs +232/−0
• src/Algebra/Graph/AdjacencyMap.hs +253/−192
• src/Algebra/Graph/AdjacencyMap/Internal.hs +106/−70
• src/Algebra/Graph/Class.hs +43/−47
• src/Algebra/Graph/Export.hs +6/−6
• src/Algebra/Graph/Export/Dot.hs +2/−2
• src/Algebra/Graph/Fold.hs +197/−221
• src/Algebra/Graph/HigherKinded/Class.hs +15/−21
• src/Algebra/Graph/IntAdjacencyMap.hs +0/−646
• src/Algebra/Graph/IntAdjacencyMap/Internal.hs +0/−196
• src/Algebra/Graph/Internal.hs +22/−25
• src/Algebra/Graph/Label.hs +126/−0
• src/Algebra/Graph/Labelled.hs +122/−0
• src/Algebra/Graph/NonEmpty.hs +186/−50
• src/Algebra/Graph/Relation.hs +63/−106
• src/Algebra/Graph/Relation/Internal.hs +76/−22
• src/Algebra/Graph/Relation/InternalDerived.hs +7/−4
• src/Algebra/Graph/ToGraph.hs +452/−0
• src/Data/Graph/Typed.hs +160/−0
• test/Algebra/Graph/Test/API.hs +130/−246
• test/Algebra/Graph/Test/AdjacencyIntMap.hs +46/−0
• test/Algebra/Graph/Test/AdjacencyMap.hs +6/−18
• test/Algebra/Graph/Test/Arbitrary.hs +10/−10
• test/Algebra/Graph/Test/Fold.hs +5/−98
• test/Algebra/Graph/Test/Generic.hs +404/−153
• test/Algebra/Graph/Test/Graph.hs +43/−25
• test/Algebra/Graph/Test/IntAdjacencyMap.hs +0/−60
• test/Algebra/Graph/Test/NonEmptyGraph.hs +47/−17
• test/Algebra/Graph/Test/Relation.hs +6/−13
• test/Data/Graph/Test/Typed.hs +163/−0
• test/Main.hs +4/−2

@@ -1,8 +1,31 @@ # Change log
 
+## 0.2
+
+* #117: Add `sparsify`.
+* #115: Add `isDfsForestOf`.
+* #114: Add a basic implementation of edge-labelled graphs.
+* #107: Drop `starTranspose`.
+* #106: Extend `ToGraph` with algorithms based on adjacency maps.
+* #106: Add `isAcyclic` and `reachable`.
+* #106: Rename `isTopSort` to `isTopSortOf`.
+* #102: Switch the master branch to GHC 8.4.3. Add a CI instance for GHC 8.6.1.
+* #101: Drop `-O2` from the `ghc-options` section of the Cabal file.
+* #100: Rename `fromAdjacencyList` to `stars`.
+* #79: Improve the API consistency: rename `IntAdjacencyMap` to `AdjacencyIntMap`,
+       and then rename the function that extracts its adjacency map to
+       `adjacencyIntMap` to avoid the clash with `AdjacencyMap.adjacencyMap`,
+       which has incompatible type.
+* #82, #92: Add performance regression suite.
+* #76: Remove benchmarks.
+* #74: Drop dependency of `Algebra.Graph` on graph type classes.
+* #62: Move King-Launchbury graphs into `Data.Graph.Typed`.
+* #67, #68, #69, #77, #81, #93, #94, #97, #103, #110: Various performance improvements.
+* #66, #72, #96, #98: Add missing `NFData` instances.
+
 ## 0.1.1.1
 
-* #59: Allow base-compat-0.10.
+* #59: Allow `base-compat-0.10`.
 
 ## 0.1.1
 

@@ -3,8 +3,11 @@ [![Hackage version](https://img.shields.io/hackage/v/algebraic-graphs.svg?label=Hackage)](https://hackage.haskell.org/package/algebraic-graphs) [![Linux & OS X status](https://img.shields.io/travis/snowleopard/alga/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/snowleopard/alga) [![Windows status](https://img.shields.io/appveyor/ci/snowleopard/alga/master.svg?label=Windows)](https://ci.appveyor.com/project/snowleopard/alga)  **Alga** is a library for algebraic construction and manipulation of graphs in Haskell. See-[this paper](https://github.com/snowleopard/alga-paper) for the motivation behind the library, the underlying-theory and implementation details.+[this Haskell Symposium paper](https://github.com/snowleopard/alga-paper) and the+corresponding [talk](https://www.youtube.com/watch?v=EdQGLewU-8k) for the motivation+behind the library, the underlying theory and implementation details. There is also a+[Haskell eXchange talk](https://skillsmatter.com/skillscasts/10635-algebraic-graphs), +and a [tutorial](https://nobrakal.github.io/alga-tutorial) by Alexandre Moine.  ## Main idea @@ -57,7 +60,7 @@ enough for many applications. We believe there is a lot of potential for improving the performance of the library, and this is one of our top priorities. If you come across a performance issue when using the library, please let us know. -Some preliminary benchmarks can be found in [doc/benchmarks](https://github.com/snowleopard/alga/blob/master/doc/benchmarks.md).+Some preliminary benchmarks can be found [here](https://github.com/haskell-perf/graphs).  ## Blog posts 

@@ -1,10 +1,11 @@ name:          algebraic-graphs-version:       0.1.1.1+version:       0.2 synopsis:      A library for algebraic graph construction and transformation license:       MIT license-file:  LICENSE author:        Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard-maintainer:    Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard+maintainer:    Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard,+               Alexandre Moine <alexandre@moine.me>, github: @nobrakal copyright:     Andrey Mokhov, 2016-2018 homepage:      https://github.com/snowleopard/alga category:      Algebra, Algorithms, Data Structures, Graphs@@ -14,7 +15,8 @@                GHC==7.10.3,                GHC==8.0.2,                GHC==8.2.2,-               GHC==8.4.1+               GHC==8.4.3,+               GHC==8.6.1 stability:     experimental description:     <https://github.com/snowleopard/alga Alga> is a library for algebraic construction and@@ -64,9 +66,11 @@                         Algebra.Graph.Export.Dot,                         Algebra.Graph.Fold,                         Algebra.Graph.HigherKinded.Class,-                        Algebra.Graph.IntAdjacencyMap,-                        Algebra.Graph.IntAdjacencyMap.Internal,+                        Algebra.Graph.AdjacencyIntMap,+                        Algebra.Graph.AdjacencyIntMap.Internal,                         Algebra.Graph.Internal,+                        Algebra.Graph.Label,+                        Algebra.Graph.Labelled,                         Algebra.Graph.NonEmpty,                         Algebra.Graph.Relation,                         Algebra.Graph.Relation.Internal,@@ -74,12 +78,15 @@                         Algebra.Graph.Relation.Preorder,                         Algebra.Graph.Relation.Reflexive,                         Algebra.Graph.Relation.Symmetric,-                        Algebra.Graph.Relation.Transitive+                        Algebra.Graph.Relation.Transitive,+                        Algebra.Graph.ToGraph,+                        Data.Graph.Typed     build-depends:      array       >= 0.4     && < 0.6,                         base        >= 4.7     && < 5,                         base-compat >= 0.9.1   && < 0.11,                         containers  >= 0.5.5.1 && < 0.8,-                        deepseq     >= 1.3.0.1 && < 1.5+                        deepseq     >= 1.3.0.1 && < 1.5,+                        mtl         >= 2.1     && < 2.3     if !impl(ghc >= 8.0)         build-depends:  semigroups  >= 0.18.3  && < 0.18.4     default-language:   Haskell2010@@ -114,22 +121,23 @@                         Algebra.Graph.Test.Fold,                         Algebra.Graph.Test.Generic,                         Algebra.Graph.Test.Graph,-                        Algebra.Graph.Test.IntAdjacencyMap,+                        Algebra.Graph.Test.AdjacencyIntMap,                         Algebra.Graph.Test.Internal,                         Algebra.Graph.Test.NonEmptyGraph,-                        Algebra.Graph.Test.Relation+                        Algebra.Graph.Test.Relation,+                        Data.Graph.Test.Typed     build-depends:      algebraic-graphs,+                        array        >= 0.4     && < 0.6,                         base         >= 4.7     && < 5,-                        base-compat  >= 0.9.1   && < 0.10,-                        base-orphans >= 0.5.4   && < 0.8,+                        base-compat  >= 0.9.1   && < 0.11,+                        base-orphans >= 0.5.4   && < 0.9,                         containers   >= 0.5.5.1 && < 0.8,-                        extra        >= 1.5,+                        extra        >= 1.5     && < 2,                         QuickCheck   >= 2.9     && < 2.12     if !impl(ghc >= 8.0)         build-depends:  semigroups   >= 0.18.3  && < 0.18.4     default-language:   Haskell2010-    GHC-options:        -O2-                        -Wall+    GHC-options:        -Wall                         -fno-warn-name-shadowing     if impl(ghc >= 8.0)         GHC-options:    -Wcompat@@ -144,25 +152,3 @@                         ConstraintKinds                         RankNTypes                         ViewPatterns--benchmark benchmark-alga-    hs-source-dirs:     bench-    type:               exitcode-stdio-1.0-    main-is:            Bench.hs-    build-depends:      algebraic-graphs,-                        base        >= 4.7     && < 5,-                        base-compat >= 0.9.1   && < 0.10,-                        containers  >= 0.5.5.1 && < 0.8,-                        criterion   >= 1.1-    default-language:   Haskell2010-    GHC-options:        -O2-                        -Wall-                        -fno-warn-name-shadowing-    if impl(ghc >= 8.0)-        GHC-options:    -Wcompat-                        -Wincomplete-record-updates-                        -Wincomplete-uni-patterns-                        -Wredundant-constraints-    default-extensions: FlexibleContexts-                        TypeFamilies-                        ScopedTypeVariables

@@ -1,200 +0,0 @@-import Prelude ()-import Prelude.Compat--import Criterion.Main-import Data.Char-import Data.Foldable (toList)--import Algebra.Graph.Class-import Algebra.Graph.AdjacencyMap (AdjacencyMap, adjacencyMap)-import Algebra.Graph.Fold (Fold, box, deBruijn, gmap, vertexIntSet, vertexSet)-import Algebra.Graph.IntAdjacencyMap (IntAdjacencyMap)-import Algebra.Graph.Relation (Relation, relation)--import qualified Algebra.Graph.IntAdjacencyMap as Int-import qualified Data.IntSet                   as IntSet-import qualified Data.Set                      as Set--v :: Ord a => Fold a -> Int-v = Set.size . vertexSet--l :: Fold a -> Int-l = length . toList--e :: AdjacencyMap a -> Int-e = foldr (\s t -> Set.size s + t) 0 . adjacencyMap--r :: Relation a -> Int-r = Set.size . relation--vInt :: Fold Int -> Int-vInt = IntSet.size . vertexIntSet--eInt :: IntAdjacencyMap -> Int-eInt = foldr (\s t -> IntSet.size s + t) 0 . Int.adjacencyMap--vDeBruijn :: Int -> Int-vDeBruijn n = v $ deBruijn n "0123456789"--lDeBruijn :: Int -> Int-lDeBruijn n = l $ deBruijn n "0123456789"--eDeBruijn :: Int -> Int-eDeBruijn n = e $ deBruijn n "0123456789"--rDeBruijn :: Int -> Int-rDeBruijn n = r $ deBruijn n "0123456789"--vIntDeBruijn :: Int -> Int-vIntDeBruijn n = v $ gmap fastRead $ deBruijn n "0123456789"--eIntDeBruin :: Int -> Int-eIntDeBruin n = e $ gmap fastRead $ deBruijn n "0123456789"---- fastRead is ~3000x faster than read-fastRead :: String -> Int-fastRead = foldr (\c t -> t + ord c - ord '0') 0--fastReadInts :: Int -> Int-fastReadInts n = foldr (+) 0 $ map fastRead $ ints ++ ints-  where-    ints = mapM (const "0123456789") [1..n]--vMesh :: Int -> Int-vMesh n = v $ gmap (\(x, y) -> x * n + y) $ path [1..n] `box` path [1..n]--lMesh :: Int -> Int-lMesh n = l $ gmap (\(x, y) -> x * n + y) $ path [1..n] `box` path [1..n]--eMesh :: Int -> Int-eMesh n = e $ gmap (\(x, y) -> x * n + y) $ path [1..n] `box` path [1..n]--rMesh :: Int -> Int-rMesh n = r $ gmap (\(x, y) -> x * n + y) $ path [1..n] `box` path [1..n]--vIntMesh :: Int -> Int-vIntMesh n = vInt $ gmap (\(x, y) -> x * n + y) $ path [1..n] `box` path [1..n]--eIntMesh :: Int -> Int-eIntMesh n = eInt $ gmap (\(x, y) -> x * n + y) $ path [1..n] `box` path [1..n]--vIntClique :: Int -> Int-vIntClique n = vInt $ clique [1..n]--eIntClique :: Int -> Int-eIntClique n = eInt $ clique [1..n]--lClique :: Int -> Int-lClique n = l $ clique [1..n]--rClique :: Int -> Int-rClique n = r $ clique [1..n]--main :: IO ()-main = defaultMain-    [ bgroup "vDeBruijn"-        [ bench "10^1" $ whnf vDeBruijn 1-        , bench "10^2" $ whnf vDeBruijn 2-        , bench "10^3" $ whnf vDeBruijn 3-        , bench "10^4" $ whnf vDeBruijn 4-        , bench "10^5" $ whnf vDeBruijn 5-        , bench "10^6" $ whnf vDeBruijn 6 ]-    , bgroup "lDeBruijn"-        [ bench "10^1" $ whnf lDeBruijn 1-        , bench "10^2" $ whnf lDeBruijn 2-        , bench "10^3" $ whnf lDeBruijn 3-        , bench "10^4" $ whnf lDeBruijn 4-        , bench "10^5" $ whnf lDeBruijn 5-        , bench "10^6" $ whnf lDeBruijn 6 ]-    , bgroup "eDeBruijn"-        [ bench "10^1" $ whnf eDeBruijn 1-        , bench "10^2" $ whnf eDeBruijn 2-        , bench "10^3" $ whnf eDeBruijn 3-        , bench "10^4" $ whnf eDeBruijn 4-        , bench "10^5" $ whnf eDeBruijn 5-        , bench "10^6" $ whnf eDeBruijn 6 ]-    , bgroup "rDeBruijn"-        [ bench "10^1" $ whnf rDeBruijn 1-        , bench "10^2" $ whnf rDeBruijn 2-        , bench "10^3" $ whnf rDeBruijn 3-        , bench "10^4" $ whnf rDeBruijn 4-        , bench "10^5" $ whnf rDeBruijn 5-        , bench "10^6" $ whnf rDeBruijn 6 ]-    , bgroup "vIntDeBruijn"-        [ bench "10^1" $ whnf vIntDeBruijn 1-        , bench "10^2" $ whnf vIntDeBruijn 2-        , bench "10^3" $ whnf vIntDeBruijn 3-        , bench "10^4" $ whnf vIntDeBruijn 4-        , bench "10^5" $ whnf vIntDeBruijn 5-        , bench "10^6" $ whnf vIntDeBruijn 6 ]-    , bgroup "eIntDeBruin"-        [ bench "10^1" $ whnf eIntDeBruin 1-        , bench "10^2" $ whnf eIntDeBruin 2-        , bench "10^3" $ whnf eIntDeBruin 3-        , bench "10^4" $ whnf eIntDeBruin 4-        , bench "10^5" $ whnf eIntDeBruin 5-        , bench "10^6" $ whnf eIntDeBruin 6 ]-    , bgroup "fastReadInts"-        [ bench "10^1" $ whnf fastReadInts 1-        , bench "10^2" $ whnf fastReadInts 2-        , bench "10^3" $ whnf fastReadInts 3-        , bench "10^4" $ whnf fastReadInts 4-        , bench "10^5" $ whnf fastReadInts 5-        , bench "10^6" $ whnf fastReadInts 6 ]-    , bgroup "vMesh"-        [ bench "1x1"       $ whnf vMesh 1-        , bench "10x10"     $ whnf vMesh 10-        , bench "100x100"   $ whnf vMesh 100-        , bench "1000x1000" $ whnf vMesh 1000 ]-    , bgroup "lMesh"-        [ bench "1x1"       $ whnf lMesh 1-        , bench "10x10"     $ whnf lMesh 10-        , bench "100x100"   $ whnf lMesh 100-        , bench "1000x1000" $ whnf lMesh 1000 ]-    , bgroup "eMesh"-        [ bench "1x1"       $ whnf eMesh 1-        , bench "10x10"     $ whnf eMesh 10-        , bench "100x100"   $ whnf eMesh 100-        , bench "1000x1000" $ whnf eMesh 1000 ]-    , bgroup "rMesh"-        [ bench "1x1"       $ whnf rMesh 1-        , bench "10x10"     $ whnf rMesh 10-        , bench "100x100"   $ whnf rMesh 100-        , bench "1000x1000" $ whnf rMesh 1000 ]-    , bgroup "vIntMesh"-        [ bench "1x1"       $ whnf vIntMesh 1-        , bench "10x10"     $ whnf vIntMesh 10-        , bench "100x100"   $ whnf vIntMesh 100-        , bench "1000x1000" $ whnf vIntMesh 1000 ]-    , bgroup "eIntMesh"-        [ bench "1x1"       $ whnf eIntMesh 1-        , bench "10x10"     $ whnf eIntMesh 10-        , bench "100x100"   $ whnf eIntMesh 100-        , bench "1000x1000" $ whnf eIntMesh 1000 ]-    , bgroup "rClique"-        [ bench "1"       $ nf rClique 1-        , bench "10"      $ nf rClique 10-        , bench "100"     $ nf rClique 100-        , bench "1000"    $ nf rClique 1000-        , bench "10000"   $ nf rClique 10000 ]-    , bgroup "vIntClique"-        [ bench "1"      $ nf vIntClique 1-        , bench "10"     $ nf vIntClique 10-        , bench "100"    $ nf vIntClique 100-        , bench "1000"   $ nf vIntClique 1000-        , bench "10000"  $ nf vIntClique 10000-        , bench "44722"  $ nf vIntClique 44722 ]-    , bgroup "lClique"-        [ bench "1"      $ nf lClique 1-        , bench "10"     $ nf lClique 10-        , bench "100"    $ nf lClique 100-        , bench "1000"   $ nf lClique 1000-        , bench "10000"  $ nf lClique 10000-        , bench "44722"  $ nf lClique 44722 ]-    , bgroup "eIntClique"-        [ bench "1"      $ nf eIntClique 1-        , bench "10"     $ nf eIntClique 10-        , bench "100"    $ nf eIntClique 100-        , bench "1000"   $ nf eIntClique 1000-        , bench "10000"  $ nf eIntClique 10000-        , bench "44722"  $ nf eIntClique 44722 ] ]

@@ -33,37 +33,49 @@      -- * Graph properties     isEmpty, size, hasVertex, hasEdge, vertexCount, edgeCount, vertexList,-    edgeList, vertexSet, vertexIntSet, edgeSet,+    edgeList, vertexSet, vertexIntSet, edgeSet, adjacencyList, adjacencyMap,+    adjacencyIntMap,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, starTranspose, tree, forest, mesh,-    torus, deBruijn,+    path, circuit, clique, biclique, star, stars, tree, forest, mesh, torus,+    deBruijn,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, splitVertex,-    transpose, induce, simplify,+    transpose, induce, simplify, sparsify,      -- * Graph composition-    box+    box,++    -- * Context+    Context (..), context   ) where  import Prelude () import Prelude.Compat -import Control.Applicative (Alternative, (<|>))+import Control.Applicative (Alternative) import Control.DeepSeq (NFData (..)) import Control.Monad.Compat+import Control.Monad.State (runState, get, put)+import Data.Foldable (toList)+import Data.Maybe (fromMaybe)+import Data.Tree  import Algebra.Graph.Internal -import qualified Algebra.Graph.AdjacencyMap       as AM-import qualified Algebra.Graph.Class              as C-import qualified Algebra.Graph.HigherKinded.Class as H-import qualified Algebra.Graph.Relation           as R-import qualified Data.IntSet                      as IntSet-import qualified Data.Set                         as Set-import qualified Data.Tree                        as Tree+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Map    (Map)+import Data.Set    (Set) +import qualified Algebra.Graph.AdjacencyMap    as AM+import qualified Algebra.Graph.AdjacencyIntMap as AIM+import qualified Control.Applicative           as Ap+import qualified Data.IntSet                   as IntSet+import qualified Data.Set                      as Set+import qualified Data.Tree                     as Tree+ {-| The 'Graph' data type is a deep embedding of the core graph construction primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num' instance as a convenient notation for working with graphs:@@ -151,28 +163,6 @@     rnf (Overlay x y) = rnf x `seq` rnf y     rnf (Connect x y) = rnf x `seq` rnf y -instance C.Graph (Graph a) where-    type Vertex (Graph a) = a-    empty   = empty-    vertex  = vertex-    overlay = overlay-    connect = connect--instance C.ToGraph (Graph a) where-    type ToVertex (Graph a) = a-    foldg e v o c = go-      where-        go Empty         = e-        go (Vertex  x  ) = v x-        go (Overlay x y) = o (go x) (go y)-        go (Connect x y) = c (go x) (go y)--instance H.ToGraph Graph where-    toGraph = foldg H.empty H.vertex H.overlay H.connect--instance H.Graph Graph where-    connect = connect- instance Num a => Num (Graph a) where     fromInteger = Vertex . fromInteger     (+)         = Overlay@@ -182,8 +172,19 @@     negate      = id  instance Ord a => Eq (Graph a) where-    x == y = C.toGraph x == (C.toGraph y :: AM.AdjacencyMap a)+    (==) = equals +-- TODO: Find a more efficient equality check.+-- | Compare two graphs by converting them to their adjacency maps.+{-# NOINLINE [1] equals #-}+{-# RULES "equalsInt" equals = equalsInt #-}+equals :: Ord a => Graph a -> Graph a -> Bool+equals x y = adjacencyMap x == adjacencyMap y++-- | Like @equals@ but specialised for graphs with vertices of type 'Int'.+equalsInt :: Graph Int -> Graph Int -> Bool+equalsInt x y = adjacencyIntMap x == adjacencyIntMap y+ instance Applicative Graph where     pure  = Vertex     (<*>) = ap@@ -212,6 +213,7 @@ -- @ empty :: Graph a empty = Empty+{-# INLINE empty #-}  -- | Construct the graph comprising /a single isolated vertex/. An alias for the -- constructor 'Vertex'.@@ -226,6 +228,7 @@ -- @ vertex :: a -> Graph a vertex = Vertex+{-# INLINE vertex #-}  -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory and size.@@ -238,7 +241,7 @@ -- 'vertexCount' (edge 1 2) == 2 -- @ edge :: a -> a -> Graph a-edge = H.edge+edge x y = connect (vertex x) (vertex y)  -- | /Overlay/ two graphs. An alias for the constructor 'Overlay'. This is a -- commutative, associative and idempotent operation with the identity 'empty'.@@ -257,6 +260,7 @@ -- @ overlay :: Graph a -> Graph a -> Graph a overlay = Overlay+{-# INLINE overlay #-}  -- | /Connect/ two graphs. An alias for the constructor 'Connect'. This is an -- associative operation with the identity 'empty', which distributes over@@ -280,6 +284,7 @@ -- @ connect :: Graph a -> Graph a -> Graph a connect = Connect+{-# INLINE connect #-}  -- | Construct the graph comprising a given list of isolated vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -293,7 +298,8 @@ -- 'vertexSet'   . vertices == Set.'Set.fromList' -- @ vertices :: [a] -> Graph a-vertices = H.vertices+vertices = overlays . map vertex+{-# NOINLINE [1] vertices #-}  -- | Construct the graph from a list of edges. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -305,7 +311,7 @@ -- 'edgeCount' . edges == 'length' . 'Data.List.nub' -- @ edges :: [(a, a)] -> Graph a-edges = H.edges+edges = overlays . map (uncurry edge)  -- | Overlay a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -319,7 +325,8 @@ -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: [Graph a] -> Graph a-overlays = H.overlays+overlays = concatg overlay+{-# INLINE [2] overlays #-}  -- | Connect a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -333,8 +340,13 @@ -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: [Graph a] -> Graph a-connects = H.connects+connects = concatg connect+{-# INLINE [2] connects #-} +-- | Auxiliary function, similar to 'mconcat'.+concatg :: (Graph a -> Graph a -> Graph a) -> [Graph a] -> Graph a+concatg combine = fromMaybe empty . foldr1Safe combine+ -- | Generalised 'Graph' folding: recursively collapse a 'Graph' by applying -- the provided functions to the leaves and internal nodes of the expression. -- The order of arguments is: empty, vertex, overlay and connect.@@ -350,7 +362,12 @@ -- foldg True  (const False) (&&)    (&&)           == 'isEmpty' -- @ foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Graph a -> b-foldg = C.foldg+foldg e v o c = go+  where+    go Empty         = e+    go (Vertex  x  ) = v x+    go (Overlay x y) = o (go x) (go y)+    go (Connect x y) = c (go x) (go y)  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second.@@ -364,8 +381,9 @@ -- isSubgraphOf ('overlay' x y) ('connect' x y) == True -- isSubgraphOf ('path' xs)     ('circuit' xs)  == True -- @+{-# SPECIALISE isSubgraphOf :: Graph Int -> Graph Int -> Bool #-} isSubgraphOf :: Ord a => Graph a -> Graph a -> Bool-isSubgraphOf = H.isSubgraphOf+isSubgraphOf x y = overlay x y == y  -- | Structural equality on graph expressions. -- Complexity: /O(s)/ time.@@ -377,6 +395,7 @@ -- 1 + 2 === 2 + 1     == False -- x + y === x * y     == False -- @+{-# SPECIALISE (===) :: Graph Int -> Graph Int -> Bool #-} (===) :: Eq a => Graph a -> Graph a -> Bool Empty           === Empty           = True (Vertex  x1   ) === (Vertex  x2   ) = x1 ==  x2@@ -397,7 +416,7 @@ -- isEmpty ('removeEdge' x y $ 'edge' x y) == False -- @ isEmpty :: Graph a -> Bool-isEmpty = H.isEmpty+isEmpty = foldg True (const False) (&&) (&&)  -- | The /size/ of a graph, i.e. the number of leaves of the expression -- including 'empty' leaves.@@ -423,8 +442,9 @@ -- hasVertex 1 ('vertex' 2)       == False -- hasVertex x . 'removeVertex' x == const False -- @+{-# SPECIALISE hasVertex :: Int -> Graph Int -> Bool #-} hasVertex :: Eq a => a -> Graph a -> Bool-hasVertex = H.hasVertex+hasVertex x = foldg False (==x) (||) (||)  -- | Check if a graph contains a given edge. -- Complexity: /O(s)/ time.@@ -436,8 +456,20 @@ -- hasEdge x y . 'removeEdge' x y == const False -- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @-hasEdge :: Ord a => a -> a -> Graph a -> Bool-hasEdge = H.hasEdge+{-# SPECIALISE hasEdge :: Int -> Int -> Graph Int -> Bool #-}+hasEdge :: Eq a => a -> a -> Graph a -> Bool+hasEdge s t g = hit g == Edge+  where+    hit Empty         = Miss+    hit (Vertex x   ) = if x == s then Tail else Miss+    hit (Overlay x y) = case hit x of+        Miss -> hit y+        Tail -> max Tail (hit y)+        Edge -> Edge+    hit (Connect x y) = case hit x of+        Miss -> hit y+        Tail -> if hasVertex t y then Edge else Tail+        Edge -> Edge  -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time.@@ -447,9 +479,15 @@ -- vertexCount ('vertex' x) == 1 -- vertexCount            == 'length' . 'vertexList' -- @+{-# INLINE [1] vertexCount #-}+{-# RULES "vertexCount/Int" vertexCount = vertexIntCount #-} vertexCount :: Ord a => Graph a -> Int-vertexCount = length . vertexList+vertexCount = Set.size . vertexSet +-- | Like 'vertexCount' but specialised for graphs with vertices of type 'Int'.+vertexIntCount :: Graph Int -> Int+vertexIntCount = IntSet.size . vertexIntSet+ -- | The number of edges in a graph. -- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a -- graph can be quadratic with respect to the expression size /s/.@@ -460,9 +498,15 @@ -- edgeCount ('edge' x y) == 1 -- edgeCount            == 'length' . 'edgeList' -- @+{-# INLINE [1] edgeCount #-}+{-# RULES "edgeCount/Int" edgeCount = edgeCountInt #-} edgeCount :: Ord a => Graph a -> Int-edgeCount = length . edgeList+edgeCount = AM.edgeCount . toAdjacencyMap +-- | Like 'edgeCount' but specialised for graphs with vertices of type 'Int'.+edgeCountInt :: Graph Int -> Int+edgeCountInt = AIM.edgeCount . toAdjacencyIntMap+ -- | The sorted list of vertices of a given graph. -- Complexity: /O(s * log(n))/ time and /O(n)/ memory. --@@ -471,9 +515,15 @@ -- vertexList ('vertex' x) == [x] -- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' -- @+{-# INLINE [1] vertexList #-}+{-# RULES "vertexList/Int" vertexList = vertexIntList #-} vertexList :: Ord a => Graph a -> [a] vertexList = Set.toAscList . vertexSet +-- | Like 'vertexList' but specialised for graphs with vertices of type 'Int'.+vertexIntList :: Graph Int -> [Int]+vertexIntList = IntSet.toList . vertexIntSet+ -- | The sorted list of edges of a graph. -- Complexity: /O(s + m * log(m))/ time and /O(m)/ memory. Note that the number of -- edges /m/ of a graph can be quadratic with respect to the expression size /s/.@@ -486,9 +536,15 @@ -- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort' -- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList -- @+{-# INLINE [1] edgeList #-}+{-# RULES "edgeList/Int" edgeList = edgeIntList #-} edgeList :: Ord a => Graph a -> [(a, a)]-edgeList = AM.edgeList . C.toGraph+edgeList = AM.edgeList . toAdjacencyMap +-- | Like 'edgeList' but specialised for graphs with vertices of type 'Int'.+edgeIntList :: Graph Int -> [(Int, Int)]+edgeIntList = AIM.edgeList . toAdjacencyIntMap+ -- | The set of vertices of a given graph. -- Complexity: /O(s * log(n))/ time and /O(n)/ memory. --@@ -499,7 +555,7 @@ -- vertexSet . 'clique'   == Set.'Set.fromList' -- @ vertexSet :: Ord a => Graph a -> Set.Set a-vertexSet = H.vertexSet+vertexSet = foldg Set.empty Set.singleton Set.union Set.union  -- | The set of vertices of a given graph. Like 'vertexSet' but specialised for -- graphs with vertices of type 'Int'.@@ -512,7 +568,7 @@ -- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList' -- @ vertexIntSet :: Graph Int -> IntSet.IntSet-vertexIntSet = H.vertexIntSet+vertexIntSet = foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union  -- | The set of edges of a given graph. -- Complexity: /O(s * log(m))/ time and /O(m)/ memory.@@ -524,8 +580,50 @@ -- edgeSet . 'edges'    == Set.'Set.fromList' -- @ edgeSet :: Ord a => Graph a -> Set.Set (a, a)-edgeSet = R.edgeSet . C.toGraph+edgeSet = AM.edgeSet . toAdjacencyMap+{-# INLINE [1] edgeSet #-}+{-# RULES "edgeSet/Int" edgeSet = edgeIntSet #-} +-- | Like 'edgeSet' but specialised for graphs with vertices of type 'Int'.+edgeIntSet :: Graph Int -> Set.Set (Int,Int)+edgeIntSet = AIM.edgeSet . toAdjacencyIntMap++-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- adjacencyList 'empty'          == []+-- adjacencyList ('vertex' x)     == [(x, [])]+-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]+-- 'stars' . adjacencyList        == id+-- @+{-# SPECIALISE adjacencyList :: Graph Int -> [(Int, [Int])] #-}+adjacencyList :: Ord a => Graph a -> [(a, [a])]+adjacencyList = AM.adjacencyList . toAdjacencyMap++-- | The /adjacency map/ of a graph: each vertex is associated with a set of its+-- direct successors.+-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a+-- graph can be quadratic with respect to the expression size /s/.+adjacencyMap :: Ord a => Graph a -> Map a (Set a)+adjacencyMap = AM.adjacencyMap . toAdjacencyMap++-- TODO: This is a very inefficient implementation. Find a way to construct an+-- adjacency map directly, without building intermediate representations for all+-- subgraphs.+-- | Convert a graph to 'AM.AdjacencyMap'.+toAdjacencyMap :: Ord a => Graph a -> AM.AdjacencyMap a+toAdjacencyMap = foldg AM.empty AM.vertex AM.overlay AM.connect++-- | Like 'adjacencyMap' but specialised for graphs with vertices of type 'Int'.+adjacencyIntMap :: Graph Int -> IntMap IntSet+adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap++-- | Like @toAdjacencyMap@ but specialised for graphs with vertices of type 'Int'.+toAdjacencyIntMap :: Graph Int -> AIM.AdjacencyIntMap+toAdjacencyIntMap = foldg AIM.empty AIM.vertex AIM.overlay AIM.connect+ -- | The /path/ on a list of vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the -- given list.@@ -537,7 +635,9 @@ -- path . 'reverse' == 'transpose' . path -- @ path :: [a] -> Graph a-path = H.path+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)  -- | The /circuit/ on a list of vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -550,7 +650,8 @@ -- circuit . 'reverse' == 'transpose' . circuit -- @ circuit :: [a] -> Graph a-circuit = H.circuit+circuit []     = empty+circuit (x:xs) = path $ [x] ++ xs ++ [x]  -- | The /clique/ on a list of vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -565,7 +666,8 @@ -- clique . 'reverse'  == 'transpose' . clique -- @ clique :: [a] -> Graph a-clique = H.clique+clique = connects . map vertex+{-# NOINLINE [1] clique #-}  -- | The /biclique/ on two lists of vertices. -- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the@@ -579,7 +681,9 @@ -- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: [a] -> [a] -> Graph a-biclique = H.biclique+biclique xs [] = vertices xs+biclique [] ys = vertices ys+biclique xs ys = connect (vertices xs) (vertices ys)  -- | The /star/ formed by a centre vertex connected to a list of leaves. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -592,21 +696,27 @@ -- star x ys    == 'connect' ('vertex' x) ('vertices' ys) -- @ star :: a -> [a] -> Graph a-star = H.star+star x [] = vertex x+star x ys = connect (vertex x) (vertices ys)+{-# INLINE star #-} --- | The /star transpose/ formed by a list of leaves connected to a centre vertex.--- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the--- given list.+-- | The /stars/ formed by overlaying a list of 'star's. An inverse of+-- 'adjacencyList'.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the total size of the+-- input. -- -- @--- starTranspose x []    == 'vertex' x--- starTranspose x [y]   == 'edge' y x--- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]--- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)--- starTranspose x ys    == 'transpose' ('star' x ys)+-- stars []                      == 'empty'+-- stars [(x, [])]               == 'vertex' x+-- stars [(x, [y])]              == 'edge' x y+-- stars [(x, ys)]               == 'star' x ys+-- stars                         == 'overlays' . map (uncurry 'star')+-- stars . 'adjacencyList'         == id+-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys) -- @-starTranspose :: a -> [a] -> Graph a-starTranspose = H.starTranspose+stars :: [(a, [a])] -> Graph a+stars = overlays . map (uncurry star)+{-# INLINE stars #-}  -- | The /tree graph/ constructed from a given 'Tree.Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the@@ -619,7 +729,9 @@ -- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] -- @ tree :: Tree.Tree a -> Graph a-tree = H.tree+tree (Node x []) = vertex x+tree (Node x f ) = star x (map rootLabel f)+         `overlay` forest (filter (not . null . subForest) f)  -- | The /forest graph/ constructed from a given 'Tree.Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the@@ -632,7 +744,7 @@ -- forest                                                     == 'overlays' . map 'tree' -- @ forest :: Tree.Forest a -> Graph a-forest = H.forest+forest = overlays . map tree  -- | Construct a /mesh graph/ from two lists of vertices. -- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the@@ -647,7 +759,17 @@ --                           , ((2,\'a\'),(3,\'a\')), ((2,\'b\'),(3,\'b\')), ((3,\'a\'),(3,\'b\')) ] -- @ mesh :: [a] -> [b] -> Graph (a, b)-mesh = H.mesh+mesh []  _   = empty+mesh _   []  = empty+mesh [x] [y] = vertex (x, y)+mesh xs  ys  = stars $  [ ((a1, b1), [(a1, b2), (a2, b1)]) | (a1, a2) <- ipxs, (b1, b2) <- ipys ]+                     ++ [ ((lx,y1), [(lx,y2)]) | (y1,y2) <- ipys]+                     ++ [ ((x1,ly), [(x2,ly)]) | (x1,x2) <- ipxs]+  where+    lx = last xs+    ly = last ys+    ipxs = init (pairs xs)+    ipys = init (pairs ys)  -- | Construct a /torus graph/ from two lists of vertices. -- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the@@ -656,14 +778,19 @@ -- @ -- torus xs    []   == 'empty' -- torus []    ys   == 'empty'--- torus [x]   [y]  == 'edge' (x, y) (x, y)+-- torus [x]   [y]  == 'edge' (x,y) (x,y) -- torus xs    ys   == 'box' ('circuit' xs) ('circuit' ys) -- torus [1,2] "ab" == 'edges' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')), ((1,\'b\'),(1,\'a\')), ((1,\'b\'),(2,\'b\')) --                           , ((2,\'a\'),(1,\'a\')), ((2,\'a\'),(2,\'b\')), ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ] -- @ torus :: [a] -> [b] -> Graph (a, b)-torus = H.torus+torus xs ys = stars [ ((a1, b1), [(a1, b2), (a2, b1)]) | (a1, a2) <- pairs xs, (b1, b2) <- pairs ys ] +-- | Auxiliary function for 'mesh' and 'torus'+pairs :: [a] -> [(a, a)]+pairs [] = []+pairs as@(x:xs) = zip as (xs ++ [x])+ -- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols -- from a given alphabet. -- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the@@ -681,7 +808,12 @@ -- n > 0 ==> 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @ deBruijn :: Int -> [a] -> Graph [a]-deBruijn = H.deBruijn+deBruijn 0   _        = edge [] []+deBruijn len alphabet = skeleton >>= expand+  where+    overlaps = mapM (const alphabet) [2..len]+    skeleton = edges    [        (Left s, Right s)   | s <- overlaps ]+    expand v = vertices [ either ([a] ++) (++ [a]) v | a <- alphabet ]  -- | Remove a vertex from a given graph. -- Complexity: /O(s)/ time, memory and size.@@ -693,31 +825,34 @@ -- removeVertex 1 ('edge' 1 2)       == 'vertex' 2 -- removeVertex x . removeVertex x == removeVertex x -- @+{-# SPECIALISE removeVertex :: Int -> Graph Int -> Graph Int #-} removeVertex :: Eq a => a -> Graph a -> Graph a-removeVertex = H.removeVertex+removeVertex v = induce (/= v)  -- | Remove an edge from a given graph. -- Complexity: /O(s)/ time, memory and size. -- -- @--- removeEdge x y ('edge' x y)       == 'vertices' [x, y]+-- removeEdge x y ('edge' x y)       == 'vertices' [x,y] -- removeEdge x y . removeEdge x y == removeEdge x y -- removeEdge x y . 'removeVertex' x == 'removeVertex' x -- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2 -- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2 -- 'size' (removeEdge x y z)         <= 3 * 'size' z -- @+{-# SPECIALISE removeEdge :: Int -> Int -> Graph Int -> Graph Int #-} removeEdge :: Eq a => a -> a -> Graph a -> Graph a removeEdge s t = filterContext s (/=s) (/=t) + -- TODO: Export -- | Filter vertices in a subgraph context.+{-# SPECIALISE filterContext :: Int -> (Int -> Bool) -> (Int -> Bool) -> Graph Int -> Graph Int #-} filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> Graph a -> Graph a filterContext s i o g = maybe g go $ context (==s) g   where-    go (Context is os) = overlays [ induce (/=s) g-                                  , starTranspose s (filter i is)-                                  , star          s (filter o os) ]+    go (Context is os) = induce (/=s) g `overlay` transpose (star s (filter i is))+                                        `overlay` star          s (filter o os)  -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'Graph'. If @y@ already exists, @x@ and @y@ will be merged.@@ -728,9 +863,11 @@ -- replaceVertex x y ('vertex' x) == 'vertex' y -- replaceVertex x y            == 'mergeVertices' (== x) y -- @+{-# SPECIALISE replaceVertex :: Int -> Int -> Graph Int -> Graph Int #-} replaceVertex :: Eq a => a -> a -> Graph a -> Graph a-replaceVertex = H.replaceVertex+replaceVertex u v = fmap $ \w -> if w == u then v else w + -- | Merge vertices satisfying a given predicate into a given vertex. -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes -- /O(1)/ to be evaluated.@@ -742,7 +879,7 @@ -- mergeVertices odd  1 (3 + 4 * 5) == 4 * 1 -- @ mergeVertices :: (a -> Bool) -> a -> Graph a -> Graph a-mergeVertices = H.mergeVertices+mergeVertices p v = fmap $ \w -> if p w then v else w  -- | Split a vertex into a list of vertices with the same connectivity. -- Complexity: /O(s + k * L)/ time, memory and size, where /k/ is the number of@@ -755,8 +892,9 @@ -- splitVertex x [y]                 == 'replaceVertex' x y -- splitVertex 1 [0,1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3) -- @+{-# SPECIALISE splitVertex :: Int -> [Int] -> Graph Int -> Graph Int #-} splitVertex :: Eq a => a -> [a] -> Graph a -> Graph a-splitVertex = H.splitVertex+splitVertex v us g = g >>= \w -> if w == v then vertices us else vertex w  -- | Transpose a given graph. -- Complexity: /O(s)/ time, memory and size.@@ -771,7 +909,21 @@ -- @ transpose :: Graph a -> Graph a transpose = foldg Empty Vertex Overlay (flip Connect)+{-# NOINLINE [1] transpose #-} +{-# RULES+"transpose/Empty"    transpose Empty = Empty+"transpose/Vertex"   forall x. transpose (Vertex x) = Vertex x+"transpose/Overlay"  forall g1 g2. transpose (Overlay g1 g2) = Overlay (transpose g1) (transpose g2)+"transpose/Connect"  forall g1 g2. transpose (Connect g1 g2) = Connect (transpose g2) (transpose g1)++"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs)+"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs))++"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs+"transpose/clique"   forall xs. transpose (clique xs)   = clique (reverse xs)+ #-}+ -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate. -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes@@ -807,9 +959,11 @@ -- simplify (1 + 2 + 1) '===' 1 + 2 -- simplify (1 * 1 * 1) '===' 1 * 1 -- @+{-# SPECIALISE simplify :: Graph Int -> Graph Int #-} simplify :: Ord a => Graph a -> Graph a simplify = foldg Empty Vertex (simple Overlay) (simple Connect) +{-# SPECIALISE simple :: (Int -> Int -> Int) -> Int -> Int -> Int #-} simple :: Eq g => (g -> g -> g) -> g -> g -> g simple op x y     | x == z    = x@@ -844,4 +998,50 @@ -- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y -- @ box :: Graph a -> Graph b -> Graph (a, b)-box = H.box+box x y = overlays $ xs ++ ys+  where+    xs = map (\b -> fmap (,b) x) $ toList y+    ys = map (\a -> fmap (a,) y) $ toList x++-- | 'Focus' on a specified subgraph.+focus :: (a -> Bool) -> Graph a -> Focus a+focus f = foldg emptyFocus (vertexFocus f) overlayFoci connectFoci++-- | The context of a subgraph comprises the input and output vertices outside+-- the subgraph that are connected to the vertices inside the subgraph.+data Context a = Context { inputs :: [a], outputs :: [a] }++-- | Extract the context from a graph 'Focus'. Returns @Nothing@ if the focus+-- could not be obtained.+context :: (a -> Bool) -> Graph a -> Maybe (Context a)+context p g | ok f      = Just $ Context (toList $ is f) (toList $ os f)+            | otherwise = Nothing+  where+    f = focus p g++-- | /Sparsify/ a graph by adding intermediate 'Left' @Int@ vertices between the+-- original vertices (wrapping the latter in 'Right') such that the resulting+-- graph is /sparse/, i.e. contains only O(s) edges, but preserves the+-- reachability relation between the original vertices. Sparsification is useful+-- when working with dense graphs, as it can reduce the number of edges from+-- O(n^2) down to O(n) by replacing cliques, bicliques and similar densely+-- connected structures by sparse subgraphs built out of intermediate vertices.+-- Complexity: O(s) time, memory and size.+--+-- @+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x       == 'Data.List.sort' . 'Data.Either.rights' . 'Algebra.Graph.ToGraph.reachable' ('Data.Either.Right' x) . sparsify+-- 'vertexCount' (sparsify x) <= 'vertexCount' x + 'size' x + 1+-- 'edgeCount'   (sparsify x) <= 3 * 'size' x+-- 'size'        (sparsify x) <= 3 * 'size' x+-- @+sparsify :: Graph a -> Graph (Either Int a)+sparsify graph = res+  where+    (res, end) = runState (foldg e v o c graph 0 end) 1+    e     s t  = return $ path   [Left s,          Left t]+    v x   s t  = return $ clique [Left s, Right x, Left t]+    o x y s t  = overlay <$> s `x` t <*> s `y` t+    c x y s t  = do+        m <- get+        put (m + 1)+        overlay <$> s `x` m <*> m `y` t

@@ -0,0 +1,692 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.AdjacencyIntMap+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module defines the 'AdjacencyIntMap' data type, as well as associated+-- operations and algorithms. 'AdjacencyIntMap' is an instance of the 'C.Graph'+-- type class, which can be used for polymorphic graph construction+-- and manipulation. See "Algebra.Graph.AdjacencyMap" for graphs with+-- non-@Int@ vertices.+-----------------------------------------------------------------------------+module Algebra.Graph.AdjacencyIntMap (+    -- * Data structure+    AdjacencyIntMap, adjacencyIntMap,++    -- * Basic graph construction primitives+    empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,++    -- * Relations on graphs+    isSubgraphOf,++    -- * Graph properties+    isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,+    adjacencyList, vertexIntSet, edgeSet, preIntSet, postIntSet,++    -- * Standard families of graphs+    path, circuit, clique, biclique, star, stars, tree, forest,++    -- * Graph transformation+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap,+    induce,++    -- * Algorithms+    dfsForest, dfsForestFrom, dfs, reachable, topSort, isAcyclic,++    -- * Correctness properties+    isDfsForestOf, isTopSortOf+  ) where++import Control.Monad+import Data.Foldable (foldMap)+import Data.IntSet (IntSet)+import Data.Maybe+import Data.Monoid+import Data.Set (Set)+import Data.Tree++import Algebra.Graph.AdjacencyIntMap.Internal++import qualified Data.Graph.Typed   as Typed+import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet        as IntSet+import qualified Data.Set           as Set++-- | Construct the graph comprising /a single edge/.+-- Complexity: /O(1)/ time, memory.+--+-- @+-- edge x y               == 'connect' ('vertex' x) ('vertex' y)+-- 'hasEdge' x y (edge x y) == True+-- 'edgeCount'   (edge x y) == 1+-- 'vertexCount' (edge 1 1) == 1+-- 'vertexCount' (edge 1 2) == 2+-- @+edge :: Int -> Int -> AdjacencyIntMap+edge x y | x == y    = AM $ IntMap.singleton x (IntSet.singleton y)+         | otherwise = AM $ IntMap.fromList [(x, IntSet.singleton y), (y, IntSet.empty)]++-- | Construct the graph comprising a given list of isolated vertices.+-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length+-- of the given list.+--+-- @+-- vertices []             == 'empty'+-- vertices [x]            == 'vertex' x+-- 'hasVertex' x  . vertices == 'elem' x+-- 'vertexCount'  . vertices == 'length' . 'Data.List.nub'+-- 'vertexIntSet' . vertices == IntSet.'IntSet.fromList'+-- @+vertices :: [Int] -> AdjacencyIntMap+vertices = AM . IntMap.fromList . map (\x -> (x, IntSet.empty))+{-# NOINLINE [1] vertices #-}++-- | Construct the graph from a list of edges.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- edges []          == 'empty'+-- edges [(x,y)]     == 'edge' x y+-- 'edgeCount' . edges == 'length' . 'Data.List.nub'+-- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'+-- @+edges :: [(Int, Int)] -> AdjacencyIntMap+edges = fromAdjacencyIntSets . map (fmap IntSet.singleton)++-- | Overlay a given list of graphs.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- overlays []        == 'empty'+-- overlays [x]       == x+-- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty'+-- 'isEmpty' . overlays == 'all' 'isEmpty'+-- @+overlays :: [AdjacencyIntMap] -> AdjacencyIntMap+overlays = AM . IntMap.unionsWith IntSet.union . map adjacencyIntMap+{-# NOINLINE [1] overlays #-}++-- | Connect a given list of graphs.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- connects []        == 'empty'+-- connects [x]       == x+-- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty'+-- 'isEmpty' . connects == 'all' 'isEmpty'+-- @+connects :: [AdjacencyIntMap] -> AdjacencyIntMap+connects  = foldr connect empty+{-# NOINLINE [1] connects #-}++-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the+-- first graph is a /subgraph/ of the second.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- isSubgraphOf 'empty'         x             == True+-- isSubgraphOf ('vertex' x)    'empty'         == False+-- isSubgraphOf x             ('overlay' x y) == True+-- isSubgraphOf ('overlay' x y) ('connect' x y) == True+-- isSubgraphOf ('path' xs)     ('circuit' xs)  == True+-- @+isSubgraphOf :: AdjacencyIntMap -> AdjacencyIntMap -> Bool+isSubgraphOf x y = IntMap.isSubmapOfBy IntSet.isSubsetOf (adjacencyIntMap x) (adjacencyIntMap y)++-- | Check if a graph is empty.+-- Complexity: /O(1)/ time.+--+-- @+-- isEmpty 'empty'                       == True+-- isEmpty ('overlay' 'empty' 'empty')       == True+-- isEmpty ('vertex' x)                  == False+-- isEmpty ('removeVertex' x $ 'vertex' x) == True+-- isEmpty ('removeEdge' x y $ 'edge' x y) == False+-- @+isEmpty :: AdjacencyIntMap -> Bool+isEmpty = IntMap.null . adjacencyIntMap++-- | Check if a graph contains a given vertex.+-- Complexity: /O(log(n))/ time.+--+-- @+-- hasVertex x 'empty'            == False+-- hasVertex x ('vertex' x)       == True+-- hasVertex 1 ('vertex' 2)       == False+-- hasVertex x . 'removeVertex' x == const False+-- @+hasVertex :: Int -> AdjacencyIntMap -> Bool+hasVertex x = IntMap.member x . adjacencyIntMap++-- | Check if a graph contains a given edge.+-- Complexity: /O(log(n))/ time.+--+-- @+-- hasEdge x y 'empty'            == False+-- hasEdge x y ('vertex' z)       == False+-- hasEdge x y ('edge' x y)       == True+-- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList'+-- @+hasEdge :: Int -> Int -> AdjacencyIntMap -> Bool+hasEdge u v a = case IntMap.lookup u (adjacencyIntMap a) of+    Nothing -> False+    Just vs -> IntSet.member v vs++-- | The number of vertices in a graph.+-- Complexity: /O(1)/ time.+--+-- @+-- vertexCount 'empty'      == 0+-- vertexCount ('vertex' x) == 1+-- vertexCount            == 'length' . 'vertexList'+-- @+vertexCount :: AdjacencyIntMap -> Int+vertexCount = IntMap.size . adjacencyIntMap++-- | The number of edges in a graph.+-- Complexity: /O(n)/ time.+--+-- @+-- edgeCount 'empty'      == 0+-- edgeCount ('vertex' x) == 0+-- edgeCount ('edge' x y) == 1+-- edgeCount            == 'length' . 'edgeList'+-- @+edgeCount :: AdjacencyIntMap -> Int+edgeCount = getSum . foldMap (Sum . IntSet.size) . adjacencyIntMap++-- | The sorted list of vertices of a given graph.+-- Complexity: /O(n)/ time and memory.+--+-- @+-- vertexList 'empty'      == []+-- vertexList ('vertex' x) == [x]+-- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'+-- @+vertexList :: AdjacencyIntMap -> [Int]+vertexList = IntMap.keys . adjacencyIntMap++-- | The sorted list of edges of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- edgeList 'empty'          == []+-- edgeList ('vertex' x)     == []+-- edgeList ('edge' x y)     == [(x,y)]+-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]+-- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'+-- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList+-- @+edgeList :: AdjacencyIntMap -> [(Int, Int)]+edgeList (AM m) = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]++-- | The set of vertices of a given graph.+-- Complexity: /O(n)/ time and memory.+--+-- @+-- vertexIntSet 'empty'      == IntSet.'IntSet.empty'+-- vertexIntSet . 'vertex'   == IntSet.'IntSet.singleton'+-- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'+-- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList'+-- @+vertexIntSet :: AdjacencyIntMap -> IntSet+vertexIntSet = IntMap.keysSet . adjacencyIntMap++-- | The set of edges of a given graph.+-- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory.+--+-- @+-- edgeSet 'empty'      == Set.'Set.empty'+-- edgeSet ('vertex' x) == Set.'Set.empty'+-- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y)+-- edgeSet . 'edges'    == Set.'Set.fromList'+-- @+edgeSet :: AdjacencyIntMap -> Set (Int, Int)+edgeSet = Set.fromAscList . edgeList++-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- adjacencyList 'empty'          == []+-- adjacencyList ('vertex' x)     == [(x, [])]+-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]+-- 'stars' . adjacencyList        == id+-- @+adjacencyList :: AdjacencyIntMap -> [(Int, [Int])]+adjacencyList = map (fmap IntSet.toAscList) . IntMap.toAscList . adjacencyIntMap++-- | The /preset/ (here @preIntSet@) of an element @x@ is the set of its+-- /direct predecessors/.+-- Complexity: /O(n * log(n))/ time and /O(n)/ memory.+--+-- @+-- preIntSet x 'empty'      == Set.'Set.empty'+-- preIntSet x ('vertex' x) == Set.'Set.empty'+-- preIntSet 1 ('edge' 1 2) == Set.'Set.empty'+-- preIntSet y ('edge' x y) == Set.'Set.fromList' [x]+-- @+preIntSet :: Int -> AdjacencyIntMap -> IntSet.IntSet+preIntSet x = IntSet.fromAscList . map fst . filter p  . IntMap.toAscList . adjacencyIntMap+  where+    p (_, set) = x `IntSet.member` set++-- | The /postset/ (here @postIntSet@) of a vertex is the set of its+-- /direct successors/.+--+-- @+-- postIntSet x 'empty'      == IntSet.'IntSet.empty'+-- postIntSet x ('vertex' x) == IntSet.'IntSet.empty'+-- postIntSet x ('edge' x y) == IntSet.'IntSet.fromList' [y]+-- postIntSet 2 ('edge' 1 2) == IntSet.'IntSet.empty'+-- @+postIntSet :: Int -> AdjacencyIntMap -> IntSet+postIntSet x = IntMap.findWithDefault IntSet.empty x . adjacencyIntMap++-- | The /path/ on a list of vertices.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- path []        == 'empty'+-- path [x]       == 'vertex' x+-- path [x,y]     == 'edge' x y+-- path . 'reverse' == 'transpose' . path+-- @+path :: [Int] -> AdjacencyIntMap+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)++-- | The /circuit/ on a list of vertices.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- circuit []        == 'empty'+-- circuit [x]       == 'edge' x x+-- circuit [x,y]     == 'edges' [(x,y), (y,x)]+-- circuit . 'reverse' == 'transpose' . circuit+-- @+circuit :: [Int] -> AdjacencyIntMap+circuit []     = empty+circuit (x:xs) = path $ [x] ++ xs ++ [x]++-- | The /clique/ on a list of vertices.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- clique []         == 'empty'+-- clique [x]        == 'vertex' x+-- clique [x,y]      == 'edge' x y+-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]+-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique . 'reverse'  == 'transpose' . clique+-- @+clique :: [Int] -> AdjacencyIntMap+clique = fromAdjacencyIntSets . fst . go+  where+    go []     = ([], IntSet.empty)+    go (x:xs) = let (res, set) = go xs in ((x, set) : res, IntSet.insert x set)+{-# NOINLINE [1] clique #-}++-- | The /biclique/ on two lists of vertices.+-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.+--+-- @+-- biclique []      []      == 'empty'+-- biclique [x]     []      == 'vertex' x+-- biclique []      [y]     == 'vertex' y+-- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys)+-- @+biclique :: [Int] -> [Int] -> AdjacencyIntMap+biclique xs ys = AM $ IntMap.fromSet adjacent (x `IntSet.union` y)+  where+    x = IntSet.fromList xs+    y = IntSet.fromList ys+    adjacent v = if v `IntSet.member` x then y else IntSet.empty++-- TODO: Optimise.+-- | The /star/ formed by a centre vertex connected to a list of leaves.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- star x []    == 'vertex' x+-- star x [y]   == 'edge' x y+-- star x [y,z] == 'edges' [(x,y), (x,z)]+-- star x ys    == 'connect' ('vertex' x) ('vertices' ys)+-- @+star :: Int -> [Int] -> AdjacencyIntMap+star x [] = vertex x+star x ys = connect (vertex x) (vertices ys)+{-# INLINE star #-}++-- | The /stars/ formed by overlaying a list of 'star's. An inverse of+-- 'adjacencyList'.+-- Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total+-- size of the input.+--+-- @+-- stars []                      == 'empty'+-- stars [(x, [])]               == 'vertex' x+-- stars [(x, [y])]              == 'edge' x y+-- stars [(x, ys)]               == 'star' x ys+-- stars                         == 'overlays' . map (uncurry 'star')+-- stars . 'adjacencyList'         == id+-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)+-- @+stars :: [(Int, [Int])] -> AdjacencyIntMap+stars = fromAdjacencyIntSets . map (fmap IntSet.fromList)++-- | The /tree graph/ constructed from a given 'Tree' data structure.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @+tree :: Tree Int -> AdjacencyIntMap+tree (Node x []) = vertex x+tree (Node x f ) = star x (map rootLabel f)+    `overlay` forest (filter (not . null . subForest) f)++-- | The /forest graph/ constructed from a given 'Forest' data structure.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @+forest :: Forest Int -> AdjacencyIntMap+forest = overlays . map tree++-- | Remove a vertex from a given graph.+-- Complexity: /O(n*log(n))/ time.+--+-- @+-- removeVertex x ('vertex' x)       == 'empty'+-- removeVertex 1 ('vertex' 2)       == 'vertex' 2+-- removeVertex x ('edge' x x)       == 'empty'+-- removeVertex 1 ('edge' 1 2)       == 'vertex' 2+-- removeVertex x . removeVertex x == removeVertex x+-- @+removeVertex :: Int -> AdjacencyIntMap -> AdjacencyIntMap+removeVertex x = AM . IntMap.map (IntSet.delete x) . IntMap.delete x . adjacencyIntMap++-- | Remove an edge from a given graph.+-- Complexity: /O(log(n))/ time.+--+-- @+-- removeEdge x y ('edge' x y)       == 'vertices' [x,y]+-- removeEdge x y . removeEdge x y == removeEdge x y+-- removeEdge x y . 'removeVertex' x == 'removeVertex' x+-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2+-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2+-- @+removeEdge :: Int -> Int -> AdjacencyIntMap -> AdjacencyIntMap+removeEdge x y = AM . IntMap.adjust (IntSet.delete y) x . adjacencyIntMap++-- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a+-- given 'AdjacencyIntMap'. If @y@ already exists, @x@ and @y@ will be merged.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- replaceVertex x x            == id+-- replaceVertex x y ('vertex' x) == 'vertex' y+-- replaceVertex x y            == 'mergeVertices' (== x) y+-- @+replaceVertex :: Int -> Int -> AdjacencyIntMap -> AdjacencyIntMap+replaceVertex u v = gmap $ \w -> if w == u then v else w++-- | Merge vertices satisfying a given predicate into a given vertex.+-- Complexity: /O((n + m) * log(n))/ time, assuming that the predicate takes+-- /O(1)/ to be evaluated.+--+-- @+-- mergeVertices (const False) x    == id+-- mergeVertices (== x) y           == 'replaceVertex' x y+-- mergeVertices even 1 (0 * 2)     == 1 * 1+-- mergeVertices odd  1 (3 + 4 * 5) == 4 * 1+-- @+mergeVertices :: (Int -> Bool) -> Int -> AdjacencyIntMap -> AdjacencyIntMap+mergeVertices p v = gmap $ \u -> if p u then v else u++-- | Transpose a given graph.+-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.+--+-- @+-- transpose 'empty'       == 'empty'+-- transpose ('vertex' x)  == 'vertex' x+-- transpose ('edge' x y)  == 'edge' y x+-- transpose . transpose == id+-- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList'+-- @+transpose :: AdjacencyIntMap -> AdjacencyIntMap+transpose (AM m) = AM $ IntMap.foldrWithKey combine vs m+  where+    combine v es = IntMap.unionWith IntSet.union (IntMap.fromSet (const $ IntSet.singleton v) es)+    vs           = IntMap.fromSet (const IntSet.empty) (IntMap.keysSet m)+{-# NOINLINE [1] transpose #-}++{-# RULES+"transpose/empty"    transpose empty = empty+"transpose/vertex"   forall x. transpose (vertex x) = vertex x+"transpose/overlay"  forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2)+"transpose/connect"  forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1)++"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs)+"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs))++"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs+"transpose/clique"   forall xs. transpose (clique xs)   = clique (reverse xs)+ #-}++-- | Transform a graph by applying a function to each of its vertices. This is+-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric+-- 'AdjacencyIntMap'.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- gmap f 'empty'      == 'empty'+-- gmap f ('vertex' x) == 'vertex' (f x)+-- gmap f ('edge' x y) == 'edge' (f x) (f y)+-- gmap id           == id+-- gmap f . gmap g   == gmap (f . g)+-- @+gmap :: (Int -> Int) -> AdjacencyIntMap -> AdjacencyIntMap+gmap f = AM . IntMap.map (IntSet.map f) . IntMap.mapKeysWith IntSet.union f . adjacencyIntMap++-- | Construct the /induced subgraph/ of a given graph by removing the+-- vertices that do not satisfy a given predicate.+-- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to+-- be evaluated.+--+-- @+-- induce (const True ) x      == x+-- induce (const False) x      == 'empty'+-- induce (/= x)               == 'removeVertex' x+-- induce p . induce q         == induce (\\x -> p x && q x)+-- 'isSubgraphOf' (induce p x) x == True+-- @+induce :: (Int -> Bool) -> AdjacencyIntMap -> AdjacencyIntMap+induce p = AM . IntMap.map (IntSet.filter p) . IntMap.filterWithKey (\k _ -> p k) . adjacencyIntMap++-- | Compute the /depth-first search/ forest of a graph that corresponds to+-- searching from each of the graph vertices in the 'Ord' @a@ order.+--+-- @+-- dfsForest 'empty'                       == []+-- 'forest' (dfsForest $ 'edge' 1 1)         == 'vertex' 1+-- 'forest' (dfsForest $ 'edge' 1 2)         == 'edge' 1 2+-- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1,2]+-- 'isSubgraphOf' ('forest' $ dfsForest x) x == True+-- 'isDfsForestOf' (dfsForest x) x         == True+-- dfsForest . 'forest' . dfsForest        == dfsForest+-- dfsForest ('vertices' vs)               == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)+-- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x+-- dfsForest $ 3 * (1 + 4) * (1 + 5)     == [ Node { rootLabel = 1+--                                                 , subForest = [ Node { rootLabel = 5+--                                                                      , subForest = [] }]}+--                                          , Node { rootLabel = 3+--                                                 , subForest = [ Node { rootLabel = 4+--                                                                      , subForest = [] }]}]+-- @+dfsForest :: AdjacencyIntMap -> Forest Int+dfsForest = Typed.dfsForest . Typed.fromAdjacencyIntMap++-- | Compute the /depth-first search/ forest of a graph, searching from each of+-- the given vertices in order. Note that the resulting forest does not+-- necessarily span the whole graph, as some vertices may be unreachable.+--+-- @+-- dfsForestFrom vs 'empty'                           == []+-- 'forest' (dfsForestFrom [1]   $ 'edge' 1 1)          == 'vertex' 1+-- 'forest' (dfsForestFrom [1]   $ 'edge' 1 2)          == 'edge' 1 2+-- 'forest' (dfsForestFrom [2]   $ 'edge' 1 2)          == 'vertex' 2+-- 'forest' (dfsForestFrom [3]   $ 'edge' 1 2)          == 'empty'+-- 'forest' (dfsForestFrom [2,1] $ 'edge' 1 2)          == 'vertices' [1,2]+-- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x     == True+-- 'isDfsForestOf' (dfsForestFrom ('vertexList' x) x) x == True+-- dfsForestFrom ('vertexList' x) x                   == 'dfsForest' x+-- dfsForestFrom vs             ('vertices' vs)       == map (\\v -> Node v []) ('Data.List.nub' vs)+-- dfsForestFrom []             x                   == []+-- dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5)      == [ Node { rootLabel = 1+--                                                            , subForest = [ Node { rootLabel = 5+--                                                                                 , subForest = [] }+--                                                     , Node { rootLabel = 4+--                                                            , subForest = [] }]+-- @+dfsForestFrom :: [Int] -> AdjacencyIntMap -> Forest Int+dfsForestFrom vs = Typed.dfsForestFrom vs . Typed.fromAdjacencyIntMap++-- | Compute the list of vertices visited by the /depth-first search/ in a graph,+-- when searching from each of the given vertices in order.+--+-- @+-- dfs vs    $ 'empty'                    == []+-- dfs [1]   $ 'edge' 1 1                 == [1]+-- dfs [1]   $ 'edge' 1 2                 == [1,2]+-- dfs [2]   $ 'edge' 1 2                 == [2]+-- dfs [3]   $ 'edge' 1 2                 == []+-- dfs [1,2] $ 'edge' 1 2                 == [1,2]+-- dfs [2,1] $ 'edge' 1 2                 == [2,1]+-- dfs []    $ x                        == []+-- dfs [1,4] $ 3 * (1 + 4) * (1 + 5)    == [1,5,4]+-- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True+-- @+dfs :: [Int] -> AdjacencyIntMap -> [Int]+dfs vs = concatMap flatten . dfsForestFrom vs++-- | Compute the list of vertices that are /reachable/ from a given source+-- vertex in a graph. The vertices in the resulting list appear in the+-- /depth-first order/.+--+-- @+-- reachable x $ 'empty'                       == []+-- reachable 1 $ 'vertex' 1                    == [1]+-- reachable 1 $ 'vertex' 2                    == []+-- reachable 1 $ 'edge' 1 1                    == [1]+-- reachable 1 $ 'edge' 1 2                    == [1,2]+-- reachable 4 $ 'path'    [1..8]              == [4..8]+-- reachable 4 $ 'circuit' [1..8]              == [4..8] ++ [1..3]+-- reachable 8 $ 'clique'  [8,7..1]            == [8] ++ [1..7]+-- 'isSubgraphOf' ('vertices' $ reachable x y) y == True+-- @+reachable :: Int -> AdjacencyIntMap -> [Int]+reachable x = dfs [x]++-- | Compute the /topological sort/ of a graph or return @Nothing@ if the graph+-- is cyclic.+--+-- @+-- topSort (1 * 2 + 3 * 1)               == Just [3,1,2]+-- topSort (1 * 2 + 2 * 1)               == Nothing+-- fmap (flip 'isTopSortOf' x) (topSort x) /= Just False+-- 'isJust' . topSort                      == 'isAcyclic'+-- @+topSort :: AdjacencyIntMap -> Maybe [Int]+topSort m = if isTopSortOf result m then Just result else Nothing+  where+    result = Typed.topSort (Typed.fromAdjacencyIntMap m)++-- | Check if a given graph is /acyclic/.+--+-- @+-- isAcyclic (1 * 2 + 3 * 1) == True+-- isAcyclic (1 * 2 + 2 * 1) == False+-- isAcyclic . 'circuit'       == 'null'+-- isAcyclic                 == 'isJust' . 'topSort'+-- @+isAcyclic :: AdjacencyIntMap -> Bool+isAcyclic = isJust . topSort++-- | Check if a given forest is a correct /depth-first search/ forest of a graph.+-- The implementation is based on the paper "Depth-First Search and Strong+-- Connectivity in Coq" by François Pottier.+--+-- @+-- isDfsForestOf []                              'empty'            == True+-- isDfsForestOf []                              ('vertex' 1)       == False+-- isDfsForestOf [Node 1 []]                     ('vertex' 1)       == True+-- isDfsForestOf [Node 1 []]                     ('vertex' 2)       == False+-- isDfsForestOf [Node 1 [], Node 1 []]          ('vertex' 1)       == False+-- isDfsForestOf [Node 1 []]                     ('edge' 1 1)       == True+-- isDfsForestOf [Node 1 []]                     ('edge' 1 2)       == False+-- isDfsForestOf [Node 1 [], Node 2 []]          ('edge' 1 2)       == False+-- isDfsForestOf [Node 2 [], Node 1 []]          ('edge' 1 2)       == True+-- isDfsForestOf [Node 1 [Node 2 []]]            ('edge' 1 2)       == True+-- isDfsForestOf [Node 1 [], Node 2 []]          ('vertices' [1,2]) == True+-- isDfsForestOf [Node 2 [], Node 1 []]          ('vertices' [1,2]) == True+-- isDfsForestOf [Node 1 [Node 2 []]]            ('vertices' [1,2]) == False+-- isDfsForestOf [Node 1 [Node 2 [Node 3 []]]]   ('path' [1,2,3])   == True+-- isDfsForestOf [Node 1 [Node 3 [Node 2 []]]]   ('path' [1,2,3])   == False+-- isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] ('path' [1,2,3])   == True+-- isDfsForestOf [Node 2 [Node 3 []], Node 1 []] ('path' [1,2,3])   == True+-- isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] ('path' [1,2,3])   == False+-- @+isDfsForestOf :: Forest Int -> AdjacencyIntMap -> Bool+isDfsForestOf f am = case go IntSet.empty f of+    Just seen -> seen == vertexIntSet am+    Nothing   -> False+  where+    go seen []     = Just seen+    go seen (t:ts) = do+        let root = rootLabel t+        guard $ root `IntSet.notMember` seen+        guard $ and [ hasEdge root (rootLabel subTree) am | subTree <- subForest t ]+        newSeen <- go (IntSet.insert root seen) (subForest t)+        guard $ postIntSet root am `IntSet.isSubsetOf` newSeen+        go newSeen ts++-- | Check if a given list of vertices is a correct /topological sort/ of a graph.+--+-- @+-- isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True+-- isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False+-- isTopSortOf []      (1 * 2 + 3 * 1) == False+-- isTopSortOf []      'empty'           == True+-- isTopSortOf [x]     ('vertex' x)      == True+-- isTopSortOf [x]     ('edge' x x)      == False+-- @+isTopSortOf :: [Int] -> AdjacencyIntMap -> Bool+isTopSortOf xs m = go IntSet.empty xs+  where+    go seen []     = seen == IntMap.keysSet (adjacencyIntMap m)+    go seen (v:vs) = postIntSet v m `IntSet.intersection` newSeen == IntSet.empty+                  && go newSeen vs+      where+        newSeen = IntSet.insert v seen

@@ -0,0 +1,232 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.AdjacencyIntMap.Internal+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : unstable+--+-- This module exposes the implementation of adjacency maps. The API is unstable+-- and unsafe, and is exposed only for documentation. You should use the+-- non-internal module "Algebra.Graph.AdjacencyIntMap" instead.+-----------------------------------------------------------------------------+module Algebra.Graph.AdjacencyIntMap.Internal (+    -- * Adjacency map implementation+    AdjacencyIntMap (..), empty, vertex, overlay, connect, fromAdjacencyIntSets,+    consistent+  ) where++import Data.IntMap.Strict (IntMap, keysSet, fromSet)+import Data.IntSet (IntSet)+import Data.List++import Control.DeepSeq (NFData (..))++import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet        as IntSet++{-| The 'AdjacencyIntMap' data type represents a graph by a map of vertices to+their adjacency sets. We define a 'Num' instance as a convenient notation for+working with graphs:++    > 0           == vertex 0+    > 1 + 2       == overlay (vertex 1) (vertex 2)+    > 1 * 2       == connect (vertex 1) (vertex 2)+    > 1 + 2 * 3   == overlay (vertex 1) (connect (vertex 2) (vertex 3))+    > 1 * (2 + 3) == connect (vertex 1) (overlay (vertex 2) (vertex 3))++The 'Show' instance is defined using basic graph construction primitives:++@show (empty     :: AdjacencyIntMap Int) == "empty"+show (1         :: AdjacencyIntMap Int) == "vertex 1"+show (1 + 2     :: AdjacencyIntMap Int) == "vertices [1,2]"+show (1 * 2     :: AdjacencyIntMap Int) == "edge 1 2"+show (1 * 2 * 3 :: AdjacencyIntMap Int) == "edges [(1,2),(1,3),(2,3)]"+show (1 * 2 + 3 :: AdjacencyIntMap Int) == "overlay (vertex 3) (edge 1 2)"@++The 'Eq' instance satisfies all axioms of algebraic graphs:++    * 'Algebra.Graph.AdjacencyIntMap.overlay' is commutative and associative:++        >       x + y == y + x+        > x + (y + z) == (x + y) + z++    * 'Algebra.Graph.AdjacencyIntMap.connect' is associative and has+    'Algebra.Graph.AdjacencyIntMap.empty' as the identity:++        >   x * empty == x+        >   empty * x == x+        > x * (y * z) == (x * y) * z++    * 'Algebra.Graph.AdjacencyIntMap.connect' distributes over+    'Algebra.Graph.AdjacencyIntMap.overlay':++        > x * (y + z) == x * y + x * z+        > (x + y) * z == x * z + y * z++    * 'Algebra.Graph.AdjacencyIntMap.connect' can be decomposed:++        > x * y * z == x * y + x * z + y * z++The following useful theorems can be proved from the above set of axioms.++    * 'Algebra.Graph.AdjacencyIntMap.overlay' has+    'Algebra.Graph.AdjacencyIntMap.empty' as the identity and is idempotent:++        >   x + empty == x+        >   empty + x == x+        >       x + x == x++    * Absorption and saturation of 'Algebra.Graph.AdjacencyIntMap.connect':++        > x * y + x + y == x * y+        >     x * x * x == x * x++When specifying the time and memory complexity of graph algorithms, /n/ and /m/+will denote the number of vertices and edges in the graph, respectively.+-}+newtype AdjacencyIntMap = AM {+    -- | The /adjacency map/ of the graph: each vertex is associated with a set+    -- of its direct successors. Complexity: /O(1)/ time and memory.+    --+    -- @+    -- adjacencyIntMap 'empty'      == IntMap.'IntMap.empty'+    -- adjacencyIntMap ('vertex' x) == IntMap.'IntMap.singleton' x IntSet.'IntSet.empty'+    -- adjacencyIntMap ('Algebra.Graph.AdjacencyIntMap.edge' 1 1) == IntMap.'IntMap.singleton' 1 (IntSet.'IntSet.singleton' 1)+    -- adjacencyIntMap ('Algebra.Graph.AdjacencyIntMap.edge' 1 2) == IntMap.'IntMap.fromList' [(1,IntSet.'IntSet.singleton' 2), (2,IntSet.'IntSet.empty')]+    -- @+    adjacencyIntMap :: IntMap IntSet } deriving Eq++instance Show AdjacencyIntMap where+    show (AM m)+        | null vs    = "empty"+        | null es    = vshow vs+        | vs == used = eshow es+        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"+      where+        vs             = IntSet.toAscList (keysSet m)+        es             = internalEdgeList m+        vshow [x]      = "vertex "   ++ show x+        vshow xs       = "vertices " ++ show xs+        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y+        eshow xs       = "edges "    ++ show xs+        used           = IntSet.toAscList (referredToVertexSet m)++-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.AdjacencyIntMap.isEmpty'     empty == True+-- 'Algebra.Graph.AdjacencyIntMap.hasVertex' x empty == False+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' empty == 0+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   empty == 0+-- @+empty :: AdjacencyIntMap+empty = AM IntMap.empty+{-# NOINLINE [1] empty #-}++-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.AdjacencyIntMap.isEmpty'     (vertex x) == False+-- 'Algebra.Graph.AdjacencyIntMap.hasVertex' x (vertex x) == True+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (vertex x) == 1+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (vertex x) == 0+-- @+vertex :: Int -> AdjacencyIntMap+vertex x = AM $ IntMap.singleton x IntSet.empty+{-# NOINLINE [1] vertex #-}++-- | /Overlay/ two graphs. This is a commutative, associative and idempotent+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'Algebra.Graph.AdjacencyIntMap.isEmpty'     (overlay x y) == 'Algebra.Graph.AdjacencyIntMap.isEmpty'   x   && 'Algebra.Graph.AdjacencyIntMap.isEmpty'   y+-- 'Algebra.Graph.AdjacencyIntMap.hasVertex' z (overlay x y) == 'Algebra.Graph.AdjacencyIntMap.hasVertex' z x || 'Algebra.Graph.AdjacencyIntMap.hasVertex' z y+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (overlay x y) >= 'Algebra.Graph.AdjacencyIntMap.vertexCount' x+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (overlay x y) <= 'Algebra.Graph.AdjacencyIntMap.vertexCount' x + 'Algebra.Graph.AdjacencyIntMap.vertexCount' y+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (overlay x y) >= 'Algebra.Graph.AdjacencyIntMap.edgeCount' x+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (overlay x y) <= 'Algebra.Graph.AdjacencyIntMap.edgeCount' x   + 'Algebra.Graph.AdjacencyIntMap.edgeCount' y+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (overlay 1 2) == 2+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (overlay 1 2) == 0+-- @+overlay :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap+overlay x y = AM $ IntMap.unionWith IntSet.union (adjacencyIntMap x) (adjacencyIntMap y)+{-# NOINLINE [1] overlay #-}++-- | /Connect/ two graphs. This is an associative operation with the identity+-- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- 'Algebra.Graph.AdjacencyIntMap.isEmpty'     (connect x y) == 'Algebra.Graph.AdjacencyIntMap.isEmpty'   x   && 'Algebra.Graph.AdjacencyIntMap.isEmpty'   y+-- 'Algebra.Graph.AdjacencyIntMap.hasVertex' z (connect x y) == 'Algebra.Graph.AdjacencyIntMap.hasVertex' z x || 'Algebra.Graph.AdjacencyIntMap.hasVertex' z y+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (connect x y) >= 'Algebra.Graph.AdjacencyIntMap.vertexCount' x+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (connect x y) <= 'Algebra.Graph.AdjacencyIntMap.vertexCount' x + 'Algebra.Graph.AdjacencyIntMap.vertexCount' y+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (connect x y) >= 'Algebra.Graph.AdjacencyIntMap.edgeCount' x+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (connect x y) >= 'Algebra.Graph.AdjacencyIntMap.edgeCount' y+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (connect x y) >= 'Algebra.Graph.AdjacencyIntMap.vertexCount' x * 'Algebra.Graph.AdjacencyIntMap.vertexCount' y+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (connect x y) <= 'Algebra.Graph.AdjacencyIntMap.vertexCount' x * 'Algebra.Graph.AdjacencyIntMap.vertexCount' y + 'Algebra.Graph.AdjacencyIntMap.edgeCount' x + 'Algebra.Graph.AdjacencyIntMap.edgeCount' y+-- 'Algebra.Graph.AdjacencyIntMap.vertexCount' (connect 1 2) == 2+-- 'Algebra.Graph.AdjacencyIntMap.edgeCount'   (connect 1 2) == 1+-- @+connect :: AdjacencyIntMap -> AdjacencyIntMap -> AdjacencyIntMap+connect x y = AM $ IntMap.unionsWith IntSet.union [ adjacencyIntMap x, adjacencyIntMap y,+    fromSet (const . keysSet $ adjacencyIntMap y) (keysSet $ adjacencyIntMap x) ]+{-# NOINLINE [1] connect #-}++instance Num AdjacencyIntMap where+    fromInteger = vertex . fromInteger+    (+)         = overlay+    (*)         = connect+    signum      = const empty+    abs         = id+    negate      = id++instance NFData AdjacencyIntMap where+    rnf (AM a) = rnf a++-- | Construct a graph from a list of adjacency sets.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- fromAdjacencyIntSets []                                           == 'Algebra.Graph.AdjacencyIntMap.empty'+-- fromAdjacencyIntSets [(x, IntSet.'IntSet.empty')]                          == 'Algebra.Graph.AdjacencyIntMap.vertex' x+-- fromAdjacencyIntSets [(x, IntSet.'IntSet.singleton' y)]                    == 'Algebra.Graph.AdjacencyIntMap.edge' x y+-- fromAdjacencyIntSets . map (fmap IntSet.'IntSet.fromList') . 'Algebra.Graph.AdjacencyIntMap.adjacencyList' == id+-- 'Algebra.Graph.AdjacencyIntMap.overlay' (fromAdjacencyIntSets xs) (fromAdjacencyIntSets ys)       == fromAdjacencyIntSets (xs ++ ys)+-- @+fromAdjacencyIntSets :: [(Int, IntSet)] -> AdjacencyIntMap+fromAdjacencyIntSets ss = AM $ IntMap.unionWith IntSet.union vs es+  where+    vs = IntMap.fromSet (const IntSet.empty) . IntSet.unions $ map snd ss+    es = IntMap.fromListWith IntSet.union ss++-- | Check if the internal graph representation is consistent, i.e. that all+-- edges refer to existing vertices. It should be impossible to create an+-- inconsistent adjacency map, and we use this function in testing.+-- /Note: this function is for internal use only/.+--+-- @+-- consistent 'Algebra.Graph.AdjacencyIntMap.empty'         == True+-- consistent ('Algebra.Graph.AdjacencyIntMap.vertex' x)    == True+-- consistent ('Algebra.Graph.AdjacencyIntMap.overlay' x y) == True+-- consistent ('Algebra.Graph.AdjacencyIntMap.connect' x y) == True+-- consistent ('Algebra.Graph.AdjacencyIntMap.edge' x y)    == True+-- consistent ('Algebra.Graph.AdjacencyIntMap.edges' xs)    == True+-- consistent ('Algebra.Graph.AdjacencyIntMap.stars' xs)    == True+-- @+consistent :: AdjacencyIntMap -> Bool+consistent (AM m) = referredToVertexSet m `IntSet.isSubsetOf` keysSet m++-- The set of vertices that are referred to by the edges+referredToVertexSet :: IntMap IntSet -> IntSet+referredToVertexSet = IntSet.fromList . uncurry (++) . unzip . internalEdgeList++-- The list of edges in adjacency map+internalEdgeList :: IntMap IntSet -> [(Int, Int)]+internalEdgeList m = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]

@@ -13,7 +13,7 @@ -- This module defines the 'AdjacencyMap' data type, as well as associated -- operations and algorithms. 'AdjacencyMap' is an instance of the 'C.Graph' type -- class, which can be used for polymorphic graph construction and manipulation.--- "Algebra.Graph.IntAdjacencyMap" defines adjacency maps specialised to graphs+-- "Algebra.Graph.AdjacencyIntMap" defines adjacency maps specialised to graphs -- with @Int@ vertices. ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap (@@ -22,60 +22,42 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    fromAdjacencyList,      -- * Relations on graphs     isSubgraphOf,      -- * Graph properties     isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,-    adjacencyList, vertexSet, edgeSet, postSet,+    adjacencyList, vertexSet, vertexIntSet, edgeSet, preSet, postSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, starTranspose, tree, forest,+    path, circuit, clique, biclique, star, stars, tree, forest,      -- * Graph transformation-    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap,+    induce,      -- * Algorithms-    dfsForest, dfsForestFrom, dfs, topSort, isTopSort, scc+    dfsForest, dfsForestFrom, dfs, reachable, topSort, isAcyclic, scc,++    -- * Correctness properties+    isDfsForestOf, isTopSortOf   ) where -import Data.Foldable (toList)+import Control.Monad+import Data.Foldable (foldMap, toList) import Data.Maybe+import Data.Monoid import Data.Set (Set) import Data.Tree  import Algebra.Graph.AdjacencyMap.Internal -import qualified Algebra.Graph.Class as C-import qualified Data.Graph          as KL-import qualified Data.Map.Strict     as Map-import qualified Data.Set            as Set---- | Construct the /empty graph/.--- Complexity: /O(1)/ time and memory.------ @--- 'isEmpty'     empty == True--- 'hasVertex' x empty == False--- 'vertexCount' empty == 0--- 'edgeCount'   empty == 0--- @-empty :: Ord a => AdjacencyMap a-empty = C.empty---- | Construct the graph comprising /a single isolated vertex/.--- Complexity: /O(1)/ time and memory.------ @--- 'isEmpty'     (vertex x) == False--- 'hasVertex' x (vertex x) == True--- 'vertexCount' (vertex x) == 1--- 'edgeCount'   (vertex x) == 0--- @-vertex :: Ord a => a -> AdjacencyMap a-vertex = C.vertex+import qualified Data.Graph.Typed as Typed+import qualified Data.Graph       as KL+import qualified Data.Map.Strict  as Map+import qualified Data.Set         as Set+import qualified Data.IntSet      as IntSet  -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory.@@ -88,45 +70,8 @@ -- 'vertexCount' (edge 1 2) == 2 -- @ edge :: Ord a => a -> a -> AdjacencyMap a-edge = C.edge---- | /Overlay/ two graphs. This is a commutative, associative and idempotent--- operation with the identity 'empty'.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y--- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y--- 'vertexCount' (overlay x y) >= 'vertexCount' x--- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y--- 'edgeCount'   (overlay x y) >= 'edgeCount' x--- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y--- 'vertexCount' (overlay 1 2) == 2--- 'edgeCount'   (overlay 1 2) == 0--- @-overlay :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a-overlay = C.overlay---- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the--- number of edges in the resulting graph is quadratic with respect to the number--- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.------ @--- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y--- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y--- 'vertexCount' (connect x y) >= 'vertexCount' x--- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y--- 'edgeCount'   (connect x y) >= 'edgeCount' x--- 'edgeCount'   (connect x y) >= 'edgeCount' y--- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y--- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y--- 'vertexCount' (connect 1 2) == 2--- 'edgeCount'   (connect 1 2) == 1--- @-connect :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a-connect = C.connect+edge x y | x == y    = AM $ Map.singleton x (Set.singleton y)+         | otherwise = AM $ Map.fromList [(x, Set.singleton y), (y, Set.empty)]  -- | Construct the graph comprising a given list of isolated vertices. -- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length@@ -140,19 +85,20 @@ -- 'vertexSet'   . vertices == Set.'Set.fromList' -- @ vertices :: Ord a => [a] -> AdjacencyMap a-vertices = mkAM . Map.fromList . map (\x -> (x, Set.empty))+vertices = AM . Map.fromList . map (\x -> (x, Set.empty))+{-# NOINLINE [1] vertices #-}  -- | Construct the graph from a list of edges. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. -- -- @ -- edges []          == 'empty'--- edges [(x, y)]    == 'edge' x y+-- edges [(x,y)]     == 'edge' x y -- 'edgeCount' . edges == 'length' . 'Data.List.nub' -- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort' -- @ edges :: Ord a => [(a, a)] -> AdjacencyMap a-edges = fromAdjacencyList . map (fmap return)+edges = fromAdjacencySets . map (fmap Set.singleton)  -- | Overlay a given list of graphs. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -165,7 +111,8 @@ -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: Ord a => [AdjacencyMap a] -> AdjacencyMap a-overlays = C.overlays+overlays = AM . Map.unionsWith Set.union . map adjacencyMap+{-# NOINLINE overlays #-}  -- | Connect a given list of graphs. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -178,24 +125,8 @@ -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: Ord a => [AdjacencyMap a] -> AdjacencyMap a-connects = C.connects---- | Construct a graph from an adjacency list.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- fromAdjacencyList []                                  == 'empty'--- fromAdjacencyList [(x, [])]                           == 'vertex' x--- fromAdjacencyList [(x, [y])]                          == 'edge' x y--- fromAdjacencyList . 'adjacencyList'                     == id--- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--- @-fromAdjacencyList :: Ord a => [(a, [a])] -> AdjacencyMap a-fromAdjacencyList as = mkAM $ Map.unionWith Set.union vs es-  where-    ss = map (fmap Set.fromList) as-    vs = Map.fromSet (const Set.empty) . Set.unions $ map snd ss-    es = Map.fromListWith Set.union ss+connects = foldr connect empty+{-# NOINLINE connects #-}  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second.@@ -272,7 +203,7 @@ -- edgeCount            == 'length' . 'edgeList' -- @ edgeCount :: AdjacencyMap a -> Int-edgeCount = Map.foldr (\es r -> (Set.size es + r)) 0 . adjacencyMap+edgeCount = getSum . foldMap (Sum . Set.size) . adjacencyMap  -- | The sorted list of vertices of a given graph. -- Complexity: /O(n)/ time and memory.@@ -297,20 +228,7 @@ -- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList -- @ edgeList :: AdjacencyMap a -> [(a, a)]-edgeList (AM m _) = [ (x, y) | (x, ys) <- Map.toAscList m, y <- Set.toAscList ys ]---- | The sorted /adjacency list/ of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- adjacencyList 'empty'               == []--- adjacencyList ('vertex' x)          == [(x, [])]--- adjacencyList ('edge' 1 2)          == [(1, [2]), (2, [])]--- adjacencyList ('star' 2 [3,1])      == [(1, []), (2, [1,3]), (3, [])]--- 'fromAdjacencyList' . adjacencyList == id--- @-adjacencyList :: AdjacencyMap a -> [(a, [a])]-adjacencyList = map (fmap Set.toAscList) . Map.toAscList . adjacencyMap+edgeList (AM m) = [ (x, y) | (x, ys) <- Map.toAscList m, y <- Set.toAscList ys ]  -- | The set of vertices of a given graph. -- Complexity: /O(n)/ time and memory.@@ -324,6 +242,19 @@ vertexSet :: AdjacencyMap a -> Set a vertexSet = Map.keysSet . adjacencyMap +-- | The set of vertices of a given graph. Like 'vertexSet' but specialised for+-- graphs with vertices of type 'Int'.+-- Complexity: /O(n)/ time and memory.+--+-- @+-- vertexIntSet 'empty'      == IntSet.'IntSet.empty'+-- vertexIntSet . 'vertex'   == IntSet.'IntSet.singleton'+-- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'+-- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList'+-- @+vertexIntSet :: AdjacencyMap Int -> IntSet.IntSet+vertexIntSet = IntSet.fromAscList . Set.toAscList . vertexSet+ -- | The set of edges of a given graph. -- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory. --@@ -334,11 +265,39 @@ -- edgeSet . 'edges'    == Set.'Set.fromList' -- @ edgeSet :: Ord a => AdjacencyMap a -> Set (a, a)-edgeSet = Map.foldrWithKey (\v es -> Set.union (Set.mapMonotonic (v,) es)) Set.empty . adjacencyMap+edgeSet = Set.fromAscList . edgeList --- | The /postset/ (here 'postSet') of a vertex is the set of its /direct successors/.+-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory. -- -- @+-- adjacencyList 'empty'          == []+-- adjacencyList ('vertex' x)     == [(x, [])]+-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]+-- 'stars' . adjacencyList        == id+-- @+adjacencyList :: AdjacencyMap a -> [(a, [a])]+adjacencyList = map (fmap Set.toAscList) . Map.toAscList . adjacencyMap++-- | The /preset/ of an element @x@ is the set of its /direct predecessors/.+-- Complexity: /O(n * log(n))/ time and /O(n)/ memory.+--+-- @+-- preSet x 'empty'      == Set.'Set.empty'+-- preSet x ('vertex' x) == Set.'Set.empty'+-- preSet 1 ('edge' 1 2) == Set.'Set.empty'+-- preSet y ('edge' x y) == Set.'Set.fromList' [x]+-- @+preSet :: Ord a => a -> AdjacencyMap a -> Set.Set a+preSet x = Set.fromAscList . map fst . filter p  . Map.toAscList . adjacencyMap+  where+    p (_, set) = x `Set.member` set++-- | The /postset/ of a vertex is the set of its /direct successors/.+-- Complexity: /O(log(n))/ time and /O(1)/ memory.+--+-- @ -- postSet x 'empty'      == Set.'Set.empty' -- postSet x ('vertex' x) == Set.'Set.empty' -- postSet x ('edge' x y) == Set.'Set.fromList' [y]@@ -357,7 +316,9 @@ -- path . 'reverse' == 'transpose' . path -- @ path :: Ord a => [a] -> AdjacencyMap a-path = C.path+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)  -- | The /circuit/ on a list of vertices. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -369,7 +330,8 @@ -- circuit . 'reverse' == 'transpose' . circuit -- @ circuit :: Ord a => [a] -> AdjacencyMap a-circuit = C.circuit+circuit []     = empty+circuit (x:xs) = path $ [x] ++ xs ++ [x]  -- | The /clique/ on a list of vertices. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -383,7 +345,11 @@ -- clique . 'reverse'  == 'transpose' . clique -- @ clique :: Ord a => [a] -> AdjacencyMap a-clique = C.clique+clique = fromAdjacencySets . fst . go+  where+    go []     = ([], Set.empty)+    go (x:xs) = let (res, set) = go xs in ((x, set) : res, Set.insert x set)+{-# NOINLINE [1] clique #-}  -- | The /biclique/ on two lists of vertices. -- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.@@ -396,14 +362,13 @@ -- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Ord a => [a] -> [a] -> AdjacencyMap a-biclique xs ys = mkAM $ Map.fromSet adjacent (x `Set.union` y)+biclique xs ys = AM $ Map.fromSet adjacent (x `Set.union` y)   where     x = Set.fromList xs     y = Set.fromList ys-    adjacent v-        | v `Set.member` x = y-        | otherwise        = Set.empty+    adjacent v = if v `Set.member` x then y else Set.empty +-- TODO: Optimise. -- | The /star/ formed by a centre vertex connected to a list of leaves. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -414,21 +379,26 @@ -- star x ys    == 'connect' ('vertex' x) ('vertices' ys) -- @ star :: Ord a => a -> [a] -> AdjacencyMap a-star = C.star+star x [] = vertex x+star x ys = connect (vertex x) (vertices ys)+{-# INLINE star #-} --- | The /star transpose/ formed by a list of leaves connected to a centre vertex.--- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the--- given list.+-- | The /stars/ formed by overlaying a list of 'star's. An inverse of+-- 'adjacencyList'.+-- Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total+-- size of the input. -- -- @--- starTranspose x []    == 'vertex' x--- starTranspose x [y]   == 'edge' y x--- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]--- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)--- starTranspose x ys    == 'transpose' ('star' x ys)+-- stars []                      == 'empty'+-- stars [(x, [])]               == 'vertex' x+-- stars [(x, [y])]              == 'edge' x y+-- stars [(x, ys)]               == 'star' x ys+-- stars                         == 'overlays' . map (uncurry 'star')+-- stars . 'adjacencyList'         == id+-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys) -- @-starTranspose :: Ord a => a -> [a] -> AdjacencyMap a-starTranspose = C.starTranspose+stars :: Ord a => [(a, [a])] -> AdjacencyMap a+stars = fromAdjacencySets . map (fmap Set.fromList)  -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -440,7 +410,9 @@ -- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] -- @ tree :: Ord a => Tree a -> AdjacencyMap a-tree = C.tree+tree (Node x []) = vertex x+tree (Node x f ) = star x (map rootLabel f)+    `overlay` forest (filter (not . null . subForest) f)  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -452,7 +424,7 @@ -- forest                                                     == 'overlays' . map 'tree' -- @ forest :: Ord a => Forest a -> AdjacencyMap a-forest = C.forest+forest = overlays . map tree  -- | Remove a vertex from a given graph. -- Complexity: /O(n*log(n))/ time.@@ -465,20 +437,20 @@ -- removeVertex x . removeVertex x == removeVertex x -- @ removeVertex :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a-removeVertex x = mkAM . Map.map (Set.delete x) . Map.delete x . adjacencyMap+removeVertex x = AM . Map.map (Set.delete x) . Map.delete x . adjacencyMap  -- | Remove an edge from a given graph. -- Complexity: /O(log(n))/ time. -- -- @--- removeEdge x y ('edge' x y)       == 'vertices' [x, y]+-- removeEdge x y ('edge' x y)       == 'vertices' [x,y] -- removeEdge x y . removeEdge x y == removeEdge x y -- removeEdge x y . 'removeVertex' x == 'removeVertex' x -- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2 -- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2 -- @ removeEdge :: Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a-removeEdge x y = mkAM . Map.adjust (Set.delete y) x . adjacencyMap+removeEdge x y = AM . Map.adjust (Set.delete y) x . adjacencyMap  -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'AdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged.@@ -516,11 +488,25 @@ -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: Ord a => AdjacencyMap a -> AdjacencyMap a-transpose (AM m _) = mkAM $ Map.foldrWithKey combine vs m+transpose (AM m) = AM $ Map.foldrWithKey combine vs m   where     combine v es = Map.unionWith Set.union (Map.fromSet (const $ Set.singleton v) es)     vs           = Map.fromSet (const Set.empty) (Map.keysSet m)+{-# NOINLINE [1] transpose #-} +{-# RULES+"transpose/empty"    transpose empty = empty+"transpose/vertex"   forall x. transpose (vertex x) = vertex x+"transpose/overlay"  forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2)+"transpose/connect"  forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1)++"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs)+"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs))++"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs+"transpose/clique"   forall xs. transpose (clique xs)   = clique (reverse xs)+ #-}+ -- | Transform a graph by applying a function to each of its vertices. This is -- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric -- 'AdjacencyMap'.@@ -534,7 +520,7 @@ -- gmap f . gmap g   == gmap (f . g) -- @ gmap :: (Ord a, Ord b) => (a -> b) -> AdjacencyMap a -> AdjacencyMap b-gmap f = mkAM . Map.map (Set.map f) . Map.mapKeysWith Set.union f . adjacencyMap+gmap f = AM . Map.map (Set.map f) . Map.mapKeysWith Set.union f . adjacencyMap  -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate.@@ -548,16 +534,19 @@ -- induce p . induce q         == induce (\\x -> p x && q x) -- 'isSubgraphOf' (induce p x) x == True -- @-induce :: Ord a => (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a-induce p = mkAM . Map.map (Set.filter p) . Map.filterWithKey (\k _ -> p k) . adjacencyMap+induce :: (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a+induce p = AM . Map.map (Set.filter p) . Map.filterWithKey (\k _ -> p k) . adjacencyMap --- | Compute the /depth-first search/ forest of a graph.+-- | Compute the /depth-first search/ forest of a graph that corresponds to+-- searching from each of the graph vertices in the 'Ord' @a@ order. -- -- @+-- dfsForest 'empty'                       == [] -- 'forest' (dfsForest $ 'edge' 1 1)         == 'vertex' 1 -- 'forest' (dfsForest $ 'edge' 1 2)         == 'edge' 1 2--- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1, 2]+-- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1,2] -- 'isSubgraphOf' ('forest' $ dfsForest x) x == True+-- 'isDfsForestOf' (dfsForest x) x         == True -- dfsForest . 'forest' . dfsForest        == dfsForest -- dfsForest ('vertices' vs)               == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs) -- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x@@ -568,79 +557,94 @@ --                                                 , subForest = [ Node { rootLabel = 4 --                                                                      , subForest = [] }]}] -- @-dfsForest :: AdjacencyMap a -> Forest a-dfsForest (AM _ (GraphKL g r _)) = fmap (fmap r) (KL.dff g)+dfsForest :: Ord a => AdjacencyMap a -> Forest a+dfsForest g = dfsForestFrom (vertexList g) g  -- | Compute the /depth-first search/ forest of a graph, searching from each of -- the given vertices in order. Note that the resulting forest does not -- necessarily span the whole graph, as some vertices may be unreachable. -- -- @--- 'forest' (dfsForestFrom [1]    $ 'edge' 1 1)     == 'vertex' 1--- 'forest' (dfsForestFrom [1]    $ 'edge' 1 2)     == 'edge' 1 2--- 'forest' (dfsForestFrom [2]    $ 'edge' 1 2)     == 'vertex' 2--- 'forest' (dfsForestFrom [3]    $ 'edge' 1 2)     == 'empty'--- 'forest' (dfsForestFrom [2, 1] $ 'edge' 1 2)     == 'vertices' [1, 2]--- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x == True--- dfsForestFrom ('vertexList' x) x               == 'dfsForest' x--- dfsForestFrom vs             ('vertices' vs)   == map (\\v -> Node v []) ('Data.List.nub' vs)--- dfsForestFrom []             x               == []--- dfsForestFrom [1, 4] $ 3 * (1 + 4) * (1 + 5) == [ Node { rootLabel = 1---                                                        , subForest = [ Node { rootLabel = 5---                                                                             , subForest = [] }---                                                 , Node { rootLabel = 4---                                                        , subForest = [] }]+-- dfsForestFrom vs 'empty'                           == []+-- 'forest' (dfsForestFrom [1]   $ 'edge' 1 1)          == 'vertex' 1+-- 'forest' (dfsForestFrom [1]   $ 'edge' 1 2)          == 'edge' 1 2+-- 'forest' (dfsForestFrom [2]   $ 'edge' 1 2)          == 'vertex' 2+-- 'forest' (dfsForestFrom [3]   $ 'edge' 1 2)          == 'empty'+-- 'forest' (dfsForestFrom [2,1] $ 'edge' 1 2)          == 'vertices' [1,2]+-- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x     == True+-- 'isDfsForestOf' (dfsForestFrom ('vertexList' x) x) x == True+-- dfsForestFrom ('vertexList' x) x                   == 'dfsForest' x+-- dfsForestFrom vs             ('vertices' vs)       == map (\\v -> Node v []) ('Data.List.nub' vs)+-- dfsForestFrom []             x                   == []+-- dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5)      == [ Node { rootLabel = 1+--                                                            , subForest = [ Node { rootLabel = 5+--                                                                                 , subForest = [] }+--                                                     , Node { rootLabel = 4+--                                                            , subForest = [] }] -- @-dfsForestFrom :: [a] -> AdjacencyMap a -> Forest a-dfsForestFrom vs (AM _ (GraphKL g r t)) = fmap (fmap r) (KL.dfs g (mapMaybe t vs))+dfsForestFrom :: Ord a => [a] -> AdjacencyMap a -> Forest a+dfsForestFrom vs = Typed.dfsForestFrom vs . Typed.fromAdjacencyMap --- | Compute the list of vertices visited by the /depth-first search/ in a graph,--- when searching from each of the given vertices in order.+-- | Compute the list of vertices visited by the /depth-first search/ in a+-- graph, when searching from each of the given vertices in order. -- -- @--- dfs [1]    $ 'edge' 1 1                == [1]--- dfs [1]    $ 'edge' 1 2                == [1, 2]--- dfs [2]    $ 'edge' 1 2                == [2]--- dfs [3]    $ 'edge' 1 2                == []--- dfs [1, 2] $ 'edge' 1 2                == [1, 2]--- dfs [2, 1] $ 'edge' 1 2                == [2, 1]--- dfs []     $ x                       == []--- dfs [1, 4] $ 3 * (1 + 4) * (1 + 5)   == [1, 5, 4]+-- dfs vs    $ 'empty'                    == []+-- dfs [1]   $ 'edge' 1 1                 == [1]+-- dfs [1]   $ 'edge' 1 2                 == [1,2]+-- dfs [2]   $ 'edge' 1 2                 == [2]+-- dfs [3]   $ 'edge' 1 2                 == []+-- dfs [1,2] $ 'edge' 1 2                 == [1,2]+-- dfs [2,1] $ 'edge' 1 2                 == [2,1]+-- dfs []    $ x                        == []+-- dfs [1,4] $ 3 * (1 + 4) * (1 + 5)    == [1,5,4] -- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True -- @-dfs :: [a] -> AdjacencyMap a -> [a]+dfs :: Ord a => [a] -> AdjacencyMap a -> [a] dfs vs = concatMap flatten . dfsForestFrom vs +-- | Compute the list of vertices that are /reachable/ from a given source+-- vertex in a graph. The vertices in the resulting list appear in the+-- /depth-first order/.+--+-- @+-- reachable x $ 'empty'                       == []+-- reachable 1 $ 'vertex' 1                    == [1]+-- reachable 1 $ 'vertex' 2                    == []+-- reachable 1 $ 'edge' 1 1                    == [1]+-- reachable 1 $ 'edge' 1 2                    == [1,2]+-- reachable 4 $ 'path'    [1..8]              == [4..8]+-- reachable 4 $ 'circuit' [1..8]              == [4..8] ++ [1..3]+-- reachable 8 $ 'clique'  [8,7..1]            == [8] ++ [1..7]+-- 'isSubgraphOf' ('vertices' $ reachable x y) y == True+-- @+reachable :: Ord a => a -> AdjacencyMap a -> [a]+reachable x = dfs [x]+ -- | Compute the /topological sort/ of a graph or return @Nothing@ if the graph -- is cyclic. -- -- @--- topSort (1 * 2 + 3 * 1)             == Just [3,1,2]--- topSort (1 * 2 + 2 * 1)             == Nothing--- fmap (flip 'isTopSort' x) (topSort x) /= Just False+-- topSort (1 * 2 + 3 * 1)               == Just [3,1,2]+-- topSort (1 * 2 + 2 * 1)               == Nothing+-- fmap (flip 'isTopSortOf' x) (topSort x) /= Just False+-- 'isJust' . topSort                      == 'isAcyclic' -- @ topSort :: Ord a => AdjacencyMap a -> Maybe [a]-topSort m@(AM _ (GraphKL g r _)) =-    if isTopSort result m then Just result else Nothing+topSort m = if isTopSortOf result m then Just result else Nothing   where-    result = map r (KL.topSort g)+    result = Typed.topSort (Typed.fromAdjacencyMap m) --- | Check if a given list of vertices is a valid /topological sort/ of a graph.+-- | Check if a given graph is /acyclic/. -- -- @--- isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True--- isTopSort [1, 2, 3] (1 * 2 + 3 * 1) == False--- isTopSort []        (1 * 2 + 3 * 1) == False--- isTopSort []        'empty'           == True--- isTopSort [x]       ('vertex' x)      == True--- isTopSort [x]       ('edge' x x)      == False+-- isAcyclic (1 * 2 + 3 * 1) == True+-- isAcyclic (1 * 2 + 2 * 1) == False+-- isAcyclic . 'circuit'       == 'null'+-- isAcyclic                 == 'isJust' . 'topSort' -- @-isTopSort :: Ord a => [a] -> AdjacencyMap a -> Bool-isTopSort xs m = go Set.empty xs-  where-    go seen []     = seen == Map.keysSet (adjacencyMap m)-    go seen (v:vs) = let newSeen = seen `seq` Set.insert v seen-        in postSet v m `Set.intersection` newSeen == Set.empty && go newSeen vs+isAcyclic :: Ord a => AdjacencyMap a -> Bool+isAcyclic = isJust . topSort  -- | Compute the /condensation/ of a graph, where each vertex corresponds to a -- /strongly-connected component/ of the original graph.@@ -656,8 +660,65 @@ --                                  , (Set.'Set.fromList' [3]  , Set.'Set.fromList' [5]  )] -- @ scc :: Ord a => AdjacencyMap a -> AdjacencyMap (Set a)-scc m@(AM _ (GraphKL g r _)) =-    gmap (\v -> Map.findWithDefault Set.empty v components) m+scc m = gmap (\v -> Map.findWithDefault Set.empty v components) m   where+    (Typed.GraphKL g r _) = Typed.fromAdjacencyMap m     components = Map.fromList $ concatMap (expand . fmap r . toList) (KL.scc g)     expand xs  = let s = Set.fromList xs in map (\x -> (x, s)) xs++-- | Check if a given forest is a correct /depth-first search/ forest of a graph.+-- The implementation is based on the paper "Depth-First Search and Strong+-- Connectivity in Coq" by François Pottier.+--+-- @+-- isDfsForestOf []                              'empty'            == True+-- isDfsForestOf []                              ('vertex' 1)       == False+-- isDfsForestOf [Node 1 []]                     ('vertex' 1)       == True+-- isDfsForestOf [Node 1 []]                     ('vertex' 2)       == False+-- isDfsForestOf [Node 1 [], Node 1 []]          ('vertex' 1)       == False+-- isDfsForestOf [Node 1 []]                     ('edge' 1 1)       == True+-- isDfsForestOf [Node 1 []]                     ('edge' 1 2)       == False+-- isDfsForestOf [Node 1 [], Node 2 []]          ('edge' 1 2)       == False+-- isDfsForestOf [Node 2 [], Node 1 []]          ('edge' 1 2)       == True+-- isDfsForestOf [Node 1 [Node 2 []]]            ('edge' 1 2)       == True+-- isDfsForestOf [Node 1 [], Node 2 []]          ('vertices' [1,2]) == True+-- isDfsForestOf [Node 2 [], Node 1 []]          ('vertices' [1,2]) == True+-- isDfsForestOf [Node 1 [Node 2 []]]            ('vertices' [1,2]) == False+-- isDfsForestOf [Node 1 [Node 2 [Node 3 []]]]   ('path' [1,2,3])   == True+-- isDfsForestOf [Node 1 [Node 3 [Node 2 []]]]   ('path' [1,2,3])   == False+-- isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] ('path' [1,2,3])   == True+-- isDfsForestOf [Node 2 [Node 3 []], Node 1 []] ('path' [1,2,3])   == True+-- isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] ('path' [1,2,3])   == False+-- @+isDfsForestOf :: Ord a => Forest a -> AdjacencyMap a -> Bool+isDfsForestOf f am = case go Set.empty f of+    Just seen -> seen == vertexSet am+    Nothing   -> False+  where+    go seen []     = Just seen+    go seen (t:ts) = do+        let root = rootLabel t+        guard $ root `Set.notMember` seen+        guard $ and [ hasEdge root (rootLabel subTree) am | subTree <- subForest t ]+        newSeen <- go (Set.insert root seen) (subForest t)+        guard $ postSet root am `Set.isSubsetOf` newSeen+        go newSeen ts++-- | Check if a given list of vertices is a correct /topological sort/ of a graph.+--+-- @+-- isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True+-- isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False+-- isTopSortOf []      (1 * 2 + 3 * 1) == False+-- isTopSortOf []      'empty'           == True+-- isTopSortOf [x]     ('vertex' x)      == True+-- isTopSortOf [x]     ('edge' x x)      == False+-- @+isTopSortOf :: Ord a => [a] -> AdjacencyMap a -> Bool+isTopSortOf xs m = go Set.empty xs+  where+    go seen []     = seen == Map.keysSet (adjacencyMap m)+    go seen (v:vs) = postSet v m `Set.intersection` newSeen == Set.empty+                  && go newSeen vs+      where+        newSeen = Set.insert v seen

@@ -12,19 +12,16 @@ ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap.Internal (     -- * Adjacency map implementation-    AdjacencyMap (..), mkAM, consistent,--    -- * Interoperability with King-Launchbury graphs-    GraphKL (..), mkGraphKL+    AdjacencyMap (..), empty, vertex, overlay, connect, fromAdjacencySets,+    consistent   ) where  import Data.List import Data.Map.Strict (Map, keysSet, fromSet) import Data.Set (Set) -import Algebra.Graph.Class+import Control.DeepSeq (NFData (..)) -import qualified Data.Graph      as KL import qualified Data.Map.Strict as Map import qualified Data.Set        as Set @@ -88,25 +85,20 @@ When specifying the time and memory complexity of graph algorithms, /n/ and /m/ will denote the number of vertices and edges in the graph, respectively. -}-data AdjacencyMap a = AM {+newtype AdjacencyMap a = AM {     -- | The /adjacency map/ of the graph: each vertex is associated with a set-    -- of its direct successors.-    adjacencyMap :: !(Map a (Set a)),-    -- | Cached King-Launchbury representation.-    -- /Note: this field is for internal use only/.-    graphKL :: GraphKL a }---- | Construct an 'AdjacencyMap' from a map of successor sets and (lazily)--- compute the corresponding King-Launchbury representation.--- /Note: this function is for internal use only/.-mkAM :: Ord a => Map a (Set a) -> AdjacencyMap a-mkAM m = AM m (mkGraphKL m)--instance Eq a => Eq (AdjacencyMap a) where-    x == y = adjacencyMap x == adjacencyMap y+    -- of its direct successors. Complexity: /O(1)/ time and memory.+    --+    -- @+    -- adjacencyMap 'empty'      == Map.'Map.empty'+    -- adjacencyMap ('vertex' x) == Map.'Map.singleton' x Set.'Set.empty'+    -- adjacencyMap ('Algebra.Graph.AdjacencyMap.edge' 1 1) == Map.'Map.singleton' 1 (Set.'Set.singleton' 1)+    -- adjacencyMap ('Algebra.Graph.AdjacencyMap.edge' 1 2) == Map.'Map.fromList' [(1,Set.'Set.singleton' 2), (2,Set.'Set.empty')]+    -- @+    adjacencyMap :: Map a (Set a) } deriving Eq  instance (Ord a, Show a) => Show (AdjacencyMap a) where-    show (AM m _)+    show (AM m)         | null vs    = "empty"         | null es    = vshow vs         | vs == used = eshow es@@ -120,14 +112,73 @@         eshow xs       = "edges "    ++ show xs         used           = Set.toAscList (referredToVertexSet m) -instance Ord a => Graph (AdjacencyMap a) where-    type Vertex (AdjacencyMap a) = a-    empty       = mkAM   Map.empty-    vertex x    = mkAM $ Map.singleton x Set.empty-    overlay x y = mkAM $ Map.unionWith Set.union (adjacencyMap x) (adjacencyMap y)-    connect x y = mkAM $ Map.unionsWith Set.union [ adjacencyMap x, adjacencyMap y,-        fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]+-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.AdjacencyMap.isEmpty'     empty == True+-- 'Algebra.Graph.AdjacencyMap.hasVertex' x empty == False+-- 'Algebra.Graph.AdjacencyMap.vertexCount' empty == 0+-- 'Algebra.Graph.AdjacencyMap.edgeCount'   empty == 0+-- @+empty :: AdjacencyMap a+empty = AM Map.empty+{-# NOINLINE [1] empty #-} +-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.AdjacencyMap.isEmpty'     (vertex x) == False+-- 'Algebra.Graph.AdjacencyMap.hasVertex' x (vertex x) == True+-- 'Algebra.Graph.AdjacencyMap.vertexCount' (vertex x) == 1+-- 'Algebra.Graph.AdjacencyMap.edgeCount'   (vertex x) == 0+-- @+vertex :: a -> AdjacencyMap a+vertex x = AM $ Map.singleton x Set.empty+{-# NOINLINE [1] vertex #-}++-- | /Overlay/ two graphs. This is a commutative, associative and idempotent+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'Algebra.Graph.AdjacencyMap.isEmpty'     (overlay x y) == 'Algebra.Graph.AdjacencyMap.isEmpty'   x   && 'Algebra.Graph.AdjacencyMap.isEmpty'   y+-- 'Algebra.Graph.AdjacencyMap.hasVertex' z (overlay x y) == 'Algebra.Graph.AdjacencyMap.hasVertex' z x || 'Algebra.Graph.AdjacencyMap.hasVertex' z y+-- 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay x y) >= 'Algebra.Graph.AdjacencyMap.vertexCount' x+-- 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay x y) <= 'Algebra.Graph.AdjacencyMap.vertexCount' x + 'Algebra.Graph.AdjacencyMap.vertexCount' y+-- 'Algebra.Graph.AdjacencyMap.edgeCount'   (overlay x y) >= 'Algebra.Graph.AdjacencyMap.edgeCount' x+-- 'Algebra.Graph.AdjacencyMap.edgeCount'   (overlay x y) <= 'Algebra.Graph.AdjacencyMap.edgeCount' x   + 'Algebra.Graph.AdjacencyMap.edgeCount' y+-- 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay 1 2) == 2+-- 'Algebra.Graph.AdjacencyMap.edgeCount'   (overlay 1 2) == 0+-- @+overlay :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a+overlay x y = AM $ Map.unionWith Set.union (adjacencyMap x) (adjacencyMap y)+{-# NOINLINE [1] overlay #-}++-- | /Connect/ two graphs. This is an associative operation with the identity+-- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'Algebra.Graph.AdjacencyMap.isEmpty'   y+-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'Algebra.Graph.AdjacencyMap.hasVertex' z y+-- 'vertexCount' (connect x y) >= 'vertexCount' x+-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'Algebra.Graph.AdjacencyMap.vertexCount' y+-- 'edgeCount'   (connect x y) >= 'edgeCount' x+-- 'edgeCount'   (connect x y) >= 'edgeCount' y+-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'Algebra.Graph.AdjacencyMap.vertexCount' y+-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'Algebra.Graph.AdjacencyMap.vertexCount' y + 'Algebra.Graph.AdjacencyMap.edgeCount' x + 'Algebra.Graph.AdjacencyMap.edgeCount' y+-- 'vertexCount' (connect 1 2) == 2+-- 'edgeCount'   (connect 1 2) == 1+-- @+connect :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a+connect x y = AM $ Map.unionsWith Set.union [ adjacencyMap x, adjacencyMap y,+    fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]+{-# NOINLINE [1] connect #-}+ instance (Ord a, Num a) => Num (AdjacencyMap a) where     fromInteger = vertex . fromInteger     (+)         = overlay@@ -136,27 +187,41 @@     abs         = id     negate      = id -instance ToGraph (AdjacencyMap a) where-    type ToVertex (AdjacencyMap a) = a-    toGraph = overlays . map (uncurry star . fmap Set.toList) . Map.toList . adjacencyMap+instance NFData a => NFData (AdjacencyMap a) where+    rnf (AM a) = rnf a +-- | Construct a graph from a list of adjacency sets.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- fromAdjacencySets []                                        == 'Algebra.Graph.AdjacencyMap.empty'+-- fromAdjacencySets [(x, Set.'Set.empty')]                          == 'Algebra.Graph.AdjacencyMap.vertex' x+-- fromAdjacencySets [(x, Set.'Set.singleton' y)]                    == 'Algebra.Graph.AdjacencyMap.edge' x y+-- fromAdjacencySets . map (fmap Set.'Set.fromList') . 'Algebra.Graph.AdjacencyMap.adjacencyList' == id+-- 'Algebra.Graph.AdjacencyMap.overlay' (fromAdjacencySets xs) (fromAdjacencySets ys)       == fromAdjacencySets (xs ++ ys)+-- @+fromAdjacencySets :: Ord a => [(a, Set a)] -> AdjacencyMap a+fromAdjacencySets ss = AM $ Map.unionWith Set.union vs es+  where+    vs = Map.fromSet (const Set.empty) . Set.unions $ map snd ss+    es = Map.fromListWith Set.union ss+ -- | Check if the internal graph representation is consistent, i.e. that all -- edges refer to existing vertices. It should be impossible to create an -- inconsistent adjacency map, and we use this function in testing. -- /Note: this function is for internal use only/. -- -- @--- consistent 'Algebra.Graph.AdjacencyMap.empty'                  == True--- consistent ('Algebra.Graph.AdjacencyMap.vertex' x)             == True--- consistent ('Algebra.Graph.AdjacencyMap.overlay' x y)          == True--- consistent ('Algebra.Graph.AdjacencyMap.connect' x y)          == True--- consistent ('Algebra.Graph.AdjacencyMap.edge' x y)             == True--- consistent ('Algebra.Graph.AdjacencyMap.edges' xs)             == True--- consistent ('Algebra.Graph.AdjacencyMap.graph' xs ys)          == True--- consistent ('Algebra.Graph.AdjacencyMap.fromAdjacencyList' xs) == True+-- consistent 'Algebra.Graph.AdjacencyMap.empty'         == True+-- consistent ('Algebra.Graph.AdjacencyMap.vertex' x)    == True+-- consistent ('Algebra.Graph.AdjacencyMap.overlay' x y) == True+-- consistent ('Algebra.Graph.AdjacencyMap.connect' x y) == True+-- consistent ('Algebra.Graph.AdjacencyMap.edge' x y)    == True+-- consistent ('Algebra.Graph.AdjacencyMap.edges' xs)    == True+-- consistent ('Algebra.Graph.AdjacencyMap.stars' xs)    == True -- @ consistent :: Ord a => AdjacencyMap a -> Bool-consistent (AM m _) = referredToVertexSet m `Set.isSubsetOf` keysSet m+consistent (AM m) = referredToVertexSet m `Set.isSubsetOf` keysSet m  -- The set of vertices that are referred to by the edges referredToVertexSet :: Ord a => Map a (Set a) -> Set a@@ -165,32 +230,3 @@ -- The list of edges in adjacency map internalEdgeList :: Map a (Set a) -> [(a, a)] internalEdgeList m = [ (x, y) | (x, ys) <- Map.toAscList m, y <- Set.toAscList ys ]---- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in--- the "Data.Graph" module of the @containers@ library.--- /Note: this data structure is for internal use only/.------ If @mkGraphKL (adjacencyMap g) == h@ then the following holds:------ @--- map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h)                               == 'Algebra.Graph.AdjacencyMap.vertexList' g--- map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.edgeList' g--- @-data GraphKL a = GraphKL {-    -- | Array-based graph representation (King and Launchbury, 1995).-    toGraphKL :: KL.Graph,-    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.-    fromVertexKL :: KL.Vertex -> a,-    -- | A mapping from vertices of type @a@ to "Data.Graph.Vertex".-    -- Returns 'Nothing' if the argument is not in the graph.-    toVertexKL :: a -> Maybe KL.Vertex }---- | Build 'GraphKL' from a map of successor sets.--- /Note: this function is for internal use only/.-mkGraphKL :: Ord a => Map a (Set a) -> GraphKL a-mkGraphKL m = GraphKL-    { toGraphKL    = g-    , fromVertexKL = \u -> case r u of (_, v, _) -> v-    , toVertexKL   = t }-  where-    (g, r, t) = KL.graphFromEdges [ ((), v, Set.toAscList us) | (v, us) <- Map.toAscList m ]

@@ -44,10 +44,7 @@     isSubgraphOf,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, starTranspose, tree, forest,--    -- * Conversion between graph data types-    ToGraph (..)+    path, circuit, clique, biclique, star, starTranspose, tree, forest   ) where  import Prelude ()@@ -55,6 +52,12 @@  import Data.Tree +import qualified Algebra.Graph                 as G+import qualified Algebra.Graph.AdjacencyMap    as AM+import qualified Algebra.Graph.Fold            as F+import qualified Algebra.Graph.AdjacencyIntMap as AIM+import qualified Algebra.Graph.Relation        as R+ {-| The core type class for constructing algebraic graphs, characterised by the following minimal set of axioms. In equations we use @+@ and @*@ as convenient@@ -114,6 +117,41 @@     -- | Connect two graphs.     connect :: g -> g -> g +instance Graph (G.Graph a) where+    type Vertex (G.Graph a) = a+    empty   = G.empty+    vertex  = G.vertex+    overlay = G.overlay+    connect = G.connect++instance Ord a => Graph (AM.AdjacencyMap a) where+    type Vertex (AM.AdjacencyMap a) = a+    empty   = AM.empty+    vertex  = AM.vertex+    overlay = AM.overlay+    connect = AM.connect++instance Graph (F.Fold a) where+    type Vertex (F.Fold a) = a+    empty   = F.empty+    vertex  = F.vertex+    overlay = F.overlay+    connect = F.connect++instance Graph AIM.AdjacencyIntMap where+    type Vertex AIM.AdjacencyIntMap = Int+    empty   = AIM.empty+    vertex  = AIM.vertex+    overlay = AIM.overlay+    connect = AIM.connect++instance Ord a => Graph (R.Relation a) where+    type Vertex (R.Relation a) = a+    empty   = R.empty+    vertex  = R.vertex+    overlay = R.overlay+    connect = R.connect+ {-| The class of /undirected graphs/ that satisfy the following additional axiom. @@ -395,7 +433,7 @@ tree :: Graph g => Tree (Vertex g) -> g tree (Node x []) = vertex x tree (Node x f ) = star x (map rootLabel f)-         `overlay` forest (filter (not . null . subForest) f)+    `overlay` forest (filter (not . null . subForest) f)  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the@@ -409,45 +447,3 @@ -- @ forest :: Graph g => Forest (Vertex g) -> g forest = overlays . map tree---- | The 'ToGraph' type class captures data types that can be converted to--- polymorphic graph expressions. The conversion method 'toGraph' semantically--- acts as the identity on graph data structures, but allows to convert graphs--- between different data representations.------ @---       toGraph (g     :: 'Algebra.Graph.Graph' a  ) :: 'Algebra.Graph.Graph' a       == g--- 'show' (toGraph (1 * 2 :: 'Algebra.Graph.Graph' Int) :: 'Algebra.Graph.Relation' Int) == "edge 1 2"--- @------ The second method 'foldg' is used for generalised graph folding. It recursively--- collapses a given data type by applying the provided graph construction--- primitives. The order of arguments is: empty, vertex, overlay and connect,--- and it is assumed that the functions satisfy the axioms of the algebra.--- The following law establishes the relation between 'toGraph' and 'foldg':------ @--- toGraph == foldg 'empty' 'vertex' 'overlay' 'connect'--- @-class ToGraph t where-    type ToVertex t-    toGraph :: (Graph g, Vertex g ~ ToVertex t) => t -> g-    toGraph = foldg empty vertex overlay connect-    foldg :: r -> (ToVertex t -> r) -> (r -> r -> r) -> (r -> r -> r) -> t -> r-    foldg e v o c = go . toGraph-      where-        go E       = e-        go (V x  ) = v x-        go (O x y) = o (go x) (go y)-        go (C x y) = c (go x) (go y)---- TODO: Get rid of code duplication. Note: we do not use the data type Graph--- here due to import cycle.-data G a = E | V a | O (G a) (G a) | C (G a) (G a)--instance Graph (G a) where-    type Vertex (G a) = a-    empty   = E-    vertex  = V-    overlay = O-    connect = C

@@ -32,8 +32,8 @@ import Data.Semigroup import Data.String hiding (unlines) -import Algebra.Graph.AdjacencyMap-import Algebra.Graph.Class (ToGraph (..))+import Algebra.Graph.ToGraph (ToGraph, ToVertex, toAdjacencyMap)+import Algebra.Graph.AdjacencyMap (vertexList, edgeList) import Algebra.Graph.Internal  -- | An abstract document data type with /O(1)/ time concatenation (the current@@ -159,8 +159,8 @@ -- 2 -> 4 -- @ export :: (Ord a, ToGraph g, ToVertex g ~ a) => (a -> Doc s) -> (a -> a -> Doc s) -> g -> Doc s-export vs es g = vDoc <> eDoc+export v e g = vDoc <> eDoc   where-    vDoc   = mconcat $ map  vs          (vertexList adjMap)-    eDoc   = mconcat $ map (uncurry es) (edgeList   adjMap)-    adjMap = toGraph g+    vDoc   = mconcat $ map  v          (vertexList adjMap)+    eDoc   = mconcat $ map (uncurry e) (edgeList   adjMap)+    adjMap = toAdjacencyMap g

@@ -26,7 +26,7 @@ import Data.String hiding (unlines) import Prelude hiding (unlines) -import Algebra.Graph.Class (ToGraph (..))+import Algebra.Graph.ToGraph (ToGraph (..)) import Algebra.Graph.Export hiding (export) import qualified Algebra.Graph.Export as E @@ -124,7 +124,7 @@     vDoc x    = line $ label x <+>                      attributes (vertexAttributes x)     eDoc x y  = line $ label x <> " -> " <> label y <+> attributes (edgeAttributes x y) --- A list of attributes formatted as a DOT document.+-- | A list of attributes formatted as a DOT document. -- Example: @attributes ["label" := "A label", "shape" := "box"]@ -- corresponds to document: @ [label="A label" shape="box"]@. attributes :: IsString s => [Attribute s] -> Doc s

@@ -29,40 +29,37 @@     foldg,      -- * Relations on graphs-    C.isSubgraphOf,+    isSubgraphOf,      -- * Graph properties     isEmpty, size, hasVertex, hasEdge, vertexCount, edgeCount, vertexList,-    edgeList, vertexSet, vertexIntSet, edgeSet,+    edgeList, vertexSet, vertexIntSet, edgeSet, adjacencyList,      -- * Standard families of graphs-    C.path, C.circuit, C.clique, C.biclique, C.star, C.starTranspose, C.tree,-    C.forest, mesh, torus, deBruijn,+    path, circuit, clique, biclique, star, stars,      -- * Graph transformation-    removeVertex, removeEdge, replaceVertex, mergeVertices, splitVertex,-    transpose, gmap, bind, induce, simplify,--    -- * Graph composition-    box+    removeVertex, removeEdge, transpose, induce, simplify,   ) where  import Prelude () import Prelude.Compat -import Control.Applicative hiding (empty)+import Control.Applicative (Alternative, liftA2) import Control.Monad.Compat (MonadPlus (..), ap)-import Data.Foldable+import Data.Function -import Algebra.Graph.Internal+import Control.DeepSeq (NFData (..)) -import qualified Algebra.Graph.AdjacencyMap       as AM-import qualified Algebra.Graph.Class              as C-import qualified Algebra.Graph.HigherKinded.Class as H-import qualified Algebra.Graph.Relation           as R-import qualified Data.IntSet                      as IntSet-import qualified Data.Set                         as Set+import Algebra.Graph.ToGraph (ToGraph, ToVertex, toGraph) +import qualified Algebra.Graph              as G+import qualified Algebra.Graph.AdjacencyMap as AM+import qualified Algebra.Graph.ToGraph      as T+import qualified Control.Applicative        as Ap+import qualified Data.IntSet                as IntSet+import qualified Data.Set                   as Set+ {-| The 'Fold' data type is the Boehm-Berarducci encoding of the core graph construction primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num' instance as a convenient notation for working with graphs:@@ -150,17 +147,13 @@ newtype Fold a = Fold { runFold :: forall b. b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> b }  instance (Ord a, Show a) => Show (Fold a) where-    show f = show (C.toGraph f :: AM.AdjacencyMap a)+    show = show . foldg AM.empty AM.vertex AM.overlay AM.connect  instance Ord a => Eq (Fold a) where-    x == y = C.toGraph x == (C.toGraph y :: AM.AdjacencyMap a)+    x == y = T.adjacencyMap x == T.adjacencyMap y -instance C.Graph (Fold a) where-    type Vertex (Fold a) = a-    empty       = Fold $ \e _ _ _ -> e-    vertex x    = Fold $ \_ v _ _ -> v x-    overlay x y = Fold $ \e v o c -> runFold x e v o c `o` runFold y e v o c-    connect x y = Fold $ \e v o c -> runFold x e v o c `c` runFold y e v o c+instance NFData a => NFData (Fold a) where+    rnf = foldg () rnf seq seq  instance Num a => Num (Fold a) where     fromInteger = vertex . fromInteger@@ -171,7 +164,7 @@     negate      = id  instance Functor Fold where-    fmap = gmap+    fmap f = foldg empty (vertex . f) overlay connect  instance Applicative Fold where     pure  = vertex@@ -187,10 +180,7 @@  instance Monad Fold where     return = vertex-    (>>=)  = bind--instance H.Graph Fold where-    connect = connect+    g >>=f = foldg empty f overlay connect g  instance Foldable Fold where     foldMap f = foldg mempty f mappend mappend@@ -198,12 +188,9 @@ instance Traversable Fold where     traverse f = foldg (pure empty) (fmap vertex . f) (liftA2 overlay) (liftA2 connect) -instance C.ToGraph (Fold a) where+instance ToGraph (Fold a) where     type ToVertex (Fold a) = a-    foldg e v o c g = runFold g e v o c--instance H.ToGraph Fold where-    toGraph = foldg H.empty H.vertex H.overlay H.connect+    foldg = foldg  -- | Construct the /empty graph/. -- Complexity: /O(1)/ time, memory and size.@@ -215,8 +202,9 @@ -- 'edgeCount'   empty == 0 -- 'size'        empty == 1 -- @-empty :: C.Graph g => g-empty = C.empty+empty :: Fold a+empty = Fold $ \e _ _ _ -> e+{-# NOINLINE [1] empty #-}  -- | Construct the graph comprising /a single isolated vertex/. -- Complexity: /O(1)/ time, memory and size.@@ -228,8 +216,9 @@ -- 'edgeCount'   (vertex x) == 0 -- 'size'        (vertex x) == 1 -- @-vertex :: C.Graph g => C.Vertex g -> g-vertex = C.vertex+vertex :: a -> Fold a+vertex x = Fold $ \_ v _ _ -> v x+{-# NOINLINE [1] vertex #-}  -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory and size.@@ -241,8 +230,8 @@ -- 'vertexCount' (edge 1 1) == 1 -- 'vertexCount' (edge 1 2) == 2 -- @-edge :: C.Graph g => C.Vertex g -> C.Vertex g -> g-edge = C.edge+edge :: a -> a -> Fold a+edge x y = Fold $ \_ v _ c -> v x `c` v y  -- | /Overlay/ two graphs. This is a commutative, associative and idempotent -- operation with the identity 'empty'.@@ -259,8 +248,9 @@ -- 'vertexCount' (overlay 1 2) == 2 -- 'edgeCount'   (overlay 1 2) == 0 -- @-overlay :: C.Graph g => g -> g -> g-overlay = C.overlay+overlay :: Fold a -> Fold a -> Fold a+overlay x y = Fold $ \e v o c -> runFold x e v o c `o` runFold y e v o c+{-# NOINLINE [1] overlay #-}  -- | /Connect/ two graphs. This is an associative operation with the identity -- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.@@ -281,8 +271,9 @@ -- 'vertexCount' (connect 1 2) == 2 -- 'edgeCount'   (connect 1 2) == 1 -- @-connect :: C.Graph g => g -> g -> g-connect = C.connect+connect :: Fold a -> Fold a -> Fold a+connect x y = Fold $ \e v o c -> runFold x e v o c `c` runFold y e v o c+{-# NOINLINE [1] connect #-}  -- | Construct the graph comprising a given list of isolated vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -295,8 +286,9 @@ -- 'vertexCount' . vertices == 'length' . 'Data.List.nub' -- 'vertexSet'   . vertices == Set.'Set.fromList' -- @-vertices :: C.Graph g => [C.Vertex g] -> g-vertices = C.vertices+vertices :: [a] -> Fold a+vertices = overlays . map vertex+{-# NOINLINE [1] vertices #-}  -- | Construct the graph from a list of edges. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -307,8 +299,8 @@ -- edges [(x,y)]     == 'edge' x y -- 'edgeCount' . edges == 'length' . 'Data.List.nub' -- @-edges :: C.Graph g => [(C.Vertex g, C.Vertex g)] -> g-edges = C.edges+edges :: [(a, a)] -> Fold a+edges es = Fold $ \e v o c -> foldr (flip o . uncurry (c `on` v)) e es  -- | Overlay a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -321,8 +313,9 @@ -- overlays           == 'foldr' 'overlay' 'empty' -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @-overlays :: C.Graph g => [g] -> g-overlays = C.overlays+overlays :: [Fold a] -> Fold a+overlays = foldr overlay empty+{-# INLINE [2] overlays #-}  -- | Connect a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -335,10 +328,11 @@ -- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @-connects :: C.Graph g => [g] -> g-connects = C.connects+connects :: [Fold a] -> Fold a+connects = foldr connect empty+{-# INLINE [2] connects #-} --- | Generalised graph folding: recursively collapse a 'Fold' by applying+-- | Generalised 'Graph' folding: recursively collapse a 'Graph' by applying -- the provided functions to the leaves and internal nodes of the expression. -- The order of arguments is: empty, vertex, overlay and connect. -- Complexity: /O(s)/ applications of given functions. As an example, the@@ -353,8 +347,23 @@ -- foldg True  (const False) (&&)    (&&)           == 'isEmpty' -- @ foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Fold a -> b-foldg = C.foldg+foldg e v o c g = runFold g e v o c +-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the+-- first graph is a /subgraph/ of the second.+-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a+-- graph can be quadratic with respect to the expression size /s/.+--+-- @+-- isSubgraphOf 'empty'         x             == True+-- isSubgraphOf ('vertex' x)    'empty'         == False+-- isSubgraphOf x             ('overlay' x y) == True+-- isSubgraphOf ('overlay' x y) ('connect' x y) == True+-- isSubgraphOf ('path' xs)     ('circuit' xs)  == True+-- @+isSubgraphOf :: Ord a => Fold a -> Fold a -> Bool+isSubgraphOf x y = overlay x y == y+ -- | Check if a graph is empty. A convenient alias for 'null'. -- Complexity: /O(s)/ time. --@@ -366,7 +375,7 @@ -- isEmpty ('removeEdge' x y $ 'edge' x y) == False -- @ isEmpty :: Fold a -> Bool-isEmpty = H.isEmpty+isEmpty = T.isEmpty  -- | The /size/ of a graph, i.e. the number of leaves of the expression -- including 'empty' leaves.@@ -381,7 +390,7 @@ -- size x             >= 'vertexCount' x -- @ size :: Fold a -> Int-size = foldg 1 (const 1) (+) (+)+size = T.size  -- | Check if a graph contains a given vertex. A convenient alias for `elem`. -- Complexity: /O(s)/ time.@@ -393,7 +402,7 @@ -- hasVertex x . 'removeVertex' x == const False -- @ hasVertex :: Eq a => a -> Fold a -> Bool-hasVertex = H.hasVertex+hasVertex = T.hasVertex  -- | Check if a graph contains a given edge. -- Complexity: /O(s)/ time.@@ -405,8 +414,8 @@ -- hasEdge x y . 'removeEdge' x y == const False -- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @-hasEdge :: Ord a => a -> a -> Fold a -> Bool-hasEdge = H.hasEdge+hasEdge :: Eq a => a -> a -> Fold a -> Bool+hasEdge = T.hasEdge  -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time.@@ -417,7 +426,7 @@ -- vertexCount            == 'length' . 'vertexList' -- @ vertexCount :: Ord a => Fold a -> Int-vertexCount = length . vertexList+vertexCount = T.vertexCount  -- | The number of edges in a graph. -- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a@@ -430,7 +439,7 @@ -- edgeCount            == 'length' . 'edgeList' -- @ edgeCount :: Ord a => Fold a -> Int-edgeCount = length . edgeList+edgeCount = T.edgeCount  -- | The sorted list of vertices of a given graph. -- Complexity: /O(s * log(n))/ time and /O(n)/ memory.@@ -441,7 +450,7 @@ -- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' -- @ vertexList :: Ord a => Fold a -> [a]-vertexList = Set.toAscList . vertexSet+vertexList = T.vertexList  -- | The sorted list of edges of a graph. -- Complexity: /O(s + m * log(m))/ time and /O(m)/ memory. Note that the number of@@ -456,7 +465,7 @@ -- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList -- @ edgeList :: Ord a => Fold a -> [(a, a)]-edgeList = AM.edgeList . C.toGraph+edgeList = T.edgeList  -- | The set of vertices of a given graph. -- Complexity: /O(s * log(n))/ time and /O(n)/ memory.@@ -468,7 +477,7 @@ -- vertexSet . 'clique'   == Set.'Set.fromList' -- @ vertexSet :: Ord a => Fold a -> Set.Set a-vertexSet = H.vertexSet+vertexSet = T.vertexSet  -- | The set of vertices of a given graph. Like 'vertexSet' but specialised for -- graphs with vertices of type 'Int'.@@ -481,7 +490,7 @@ -- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList' -- @ vertexIntSet :: Fold Int -> IntSet.IntSet-vertexIntSet = H.vertexIntSet+vertexIntSet = T.vertexIntSet  -- | The set of edges of a given graph. -- Complexity: /O(s * log(m))/ time and /O(m)/ memory.@@ -493,62 +502,116 @@ -- edgeSet . 'edges'    == Set.'Set.fromList' -- @ edgeSet :: Ord a => Fold a -> Set.Set (a, a)-edgeSet = R.edgeSet . C.toGraph+edgeSet = T.edgeSet --- | Construct a /mesh graph/ from two lists of vertices.--- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the--- lengths of the given lists.+-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a+-- graph can be quadratic with respect to the expression size /s/. -- -- @--- mesh xs     []   == 'empty'--- mesh []     ys   == 'empty'--- mesh [x]    [y]  == 'vertex' (x, y)--- mesh xs     ys   == 'box' ('path' xs) ('path' ys)--- mesh [1..3] "ab" == 'edges' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')), ((1,\'b\'),(2,\'b\')), ((2,\'a\'),(2,\'b\'))---                           , ((2,\'a\'),(3,\'a\')), ((2,\'b\'),(3,\'b\')), ((3,\'a\'),(3,\'b\')) ]+-- adjacencyList 'empty'          == []+-- adjacencyList ('vertex' x)     == [(x, [])]+-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]+-- 'stars' . adjacencyList        == id -- @-mesh :: (C.Graph g, C.Vertex g ~ (a, b)) => [a] -> [b] -> g-mesh xs ys = C.path xs `box` C.path ys+adjacencyList :: Ord a => Fold a -> [(a, [a])]+adjacencyList = T.adjacencyList --- | Construct a /torus graph/ from two lists of vertices.--- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the+-- | The /path/ on a list of vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- path []        == 'empty'+-- path [x]       == 'vertex' x+-- path [x,y]     == 'edge' x y+-- path . 'reverse' == 'transpose' . path+-- @+path :: [a] -> Fold a+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)++-- | The /circuit/ on a list of vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- circuit []        == 'empty'+-- circuit [x]       == 'edge' x x+-- circuit [x,y]     == 'edges' [(x,y), (y,x)]+-- circuit . 'reverse' == 'transpose' . circuit+-- @+circuit :: [a] -> Fold a+circuit []     = empty+circuit (x:xs) = path $ [x] ++ xs ++ [x]++-- | The /clique/ on a list of vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- clique []         == 'empty'+-- clique [x]        == 'vertex' x+-- clique [x,y]      == 'edge' x y+-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]+-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique . 'reverse'  == 'transpose' . clique+-- @+clique :: [a] -> Fold a+clique = connects . map vertex+{-# NOINLINE [1] clique #-}++-- | The /biclique/ on two lists of vertices.+-- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the -- lengths of the given lists. -- -- @--- torus xs    []   == 'empty'--- torus []    ys   == 'empty'--- torus [x]   [y]  == 'edge' (x, y) (x, y)--- torus xs    ys   == 'box' ('circuit' xs) ('circuit' ys)--- torus [1,2] "ab" == 'edges' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')), ((1,\'b\'),(1,\'a\')), ((1,\'b\'),(2,\'b\'))---                           , ((2,\'a\'),(1,\'a\')), ((2,\'a\'),(2,\'b\')), ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ]+-- biclique []      []      == 'empty'+-- biclique [x]     []      == 'vertex' x+-- biclique []      [y]     == 'vertex' y+-- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @-torus :: (C.Graph g, C.Vertex g ~ (a, b)) => [a] -> [b] -> g-torus xs ys = C.circuit xs `box` C.circuit ys+biclique :: [a] -> [a] -> Fold a+biclique xs [] = vertices xs+biclique [] ys = vertices ys+biclique xs ys = connect (vertices xs) (vertices ys) --- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols--- from a given alphabet.--- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the--- alphabet and /D/ is the dimension of the graph.+-- | The /star/ formed by a centre vertex connected to a list of leaves.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list. -- -- @---           deBruijn 0 xs               == 'edge' [] []--- n > 0 ==> deBruijn n []               == 'empty'---           deBruijn 1 [0,1]            == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]---           deBruijn 2 "0"              == 'edge' "00" "00"---           deBruijn 2 "01"             == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")---                                                , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]---           'transpose'   (deBruijn n xs) == 'gmap' 'reverse' $ deBruijn n xs---           'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n--- n > 0 ==> 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1)+-- star x []    == 'vertex' x+-- star x [y]   == 'edge' x y+-- star x [y,z] == 'edges' [(x,y), (x,z)]+-- star x ys    == 'connect' ('vertex' x) ('vertices' ys) -- @-deBruijn :: (C.Graph g, C.Vertex g ~ [a]) => Int -> [a] -> g-deBruijn 0   _        = edge [] []-deBruijn len alphabet = bind skeleton expand-  where-    overlaps = mapM (const alphabet) [2..len]-    skeleton = C.edges    [        (Left s, Right s)   | s <- overlaps ]-    expand v = C.vertices [ either ([a] ++) (++ [a]) v | a <- alphabet ]+star :: a -> [a] -> Fold a+star x [] = vertex x+star x ys = connect (vertex x) (vertices ys)+{-# INLINE star #-} +-- | The /stars/ formed by overlaying a list of 'star's. An inverse of+-- 'adjacencyList'.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the total size of the+-- input.+--+-- @+-- stars []                      == 'empty'+-- stars [(x, [])]               == 'vertex' x+-- stars [(x, [y])]              == 'edge' x y+-- stars [(x, ys)]               == 'star' x ys+-- stars                         == 'overlays' . map (uncurry 'star')+-- stars . 'adjacencyList'         == id+-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)+-- @+stars :: [(a, [a])] -> Fold a+stars = overlays . map (uncurry star)+{-# INLINE stars #-}+ -- | Remove a vertex from a given graph. -- Complexity: /O(s)/ time, memory and size. --@@ -559,71 +622,30 @@ -- removeVertex 1 ('edge' 1 2)       == 'vertex' 2 -- removeVertex x . removeVertex x == removeVertex x -- @-removeVertex :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> Fold (C.Vertex g) -> g+removeVertex :: Eq a => a -> Fold a -> Fold a removeVertex v = induce (/= v)  -- | Remove an edge from a given graph. -- Complexity: /O(s)/ time, memory and size. -- -- @--- removeEdge x y ('edge' x y)       == 'vertices' [x, y]+-- removeEdge x y ('edge' x y)       == 'vertices' [x,y] -- removeEdge x y . removeEdge x y == removeEdge x y -- removeEdge x y . 'removeVertex' x == 'removeVertex' x -- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2 -- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2 -- 'size' (removeEdge x y z)         <= 3 * 'size' z -- @-removeEdge :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> C.Vertex g -> Fold (C.Vertex g) -> g+removeEdge :: Eq a => a -> a -> Fold a -> Fold a removeEdge s t = filterContext s (/=s) (/=t)  -- TODO: Export -- | Filter vertices in a subgraph context.-filterContext :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> (C.Vertex g -> Bool)-              -> (C.Vertex g -> Bool) -> Fold (C.Vertex g) -> g-filterContext s i o g = maybe (C.toGraph g) go $ context (==s) g+filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> Fold a -> Fold a+filterContext s i o g = maybe g go $ G.context (==s) (toGraph g)   where-    go (Context is os) = overlays [ induce (/=s) g-                                  , C.starTranspose s (filter i is)-                                  , C.star          s (filter o os) ]---- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a--- given graph expression. If @y@ already exists, @x@ and @y@ will be merged.--- Complexity: /O(s)/ time, memory and size.------ @--- replaceVertex x x            == id--- replaceVertex x y ('vertex' x) == 'vertex' y--- replaceVertex x y            == 'mergeVertices' (== x) y--- @-replaceVertex :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> C.Vertex g -> Fold (C.Vertex g) -> g-replaceVertex u v = gmap $ \w -> if w == u then v else w---- | Merge vertices satisfying a given predicate into a given vertex.--- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes--- /O(1)/ to be evaluated.------ @--- mergeVertices (const False) x    == id--- mergeVertices (== x) y           == 'replaceVertex' x y--- mergeVertices even 1 (0 * 2)     == 1 * 1--- mergeVertices odd  1 (3 + 4 * 5) == 4 * 1--- @-mergeVertices :: C.Graph g => (C.Vertex g -> Bool) -> C.Vertex g -> Fold (C.Vertex g) -> g-mergeVertices p v = gmap $ \u -> if p u then v else u---- | Split a vertex into a list of vertices with the same connectivity.--- Complexity: /O(s + k * L)/ time, memory and size, where /k/ is the number of--- occurrences of the vertex in the expression and /L/ is the length of the--- given list.------ @--- splitVertex x []                  == 'removeVertex' x--- splitVertex x [x]                 == id--- splitVertex x [y]                 == 'replaceVertex' x y--- splitVertex 1 [0,1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3)--- @-splitVertex :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> [C.Vertex g] -> Fold (C.Vertex g) -> g-splitVertex v vs g = bind g $ \u -> if u == v then C.vertices vs else C.vertex u+    go (G.Context is os) = induce (/=s) g `overlay` transpose (star s (filter i is))+                                          `overlay` star      s (filter o os)  -- | Transpose a given graph. -- Complexity: /O(s)/ time, memory and size.@@ -636,38 +658,23 @@ -- transpose ('box' x y)   == 'box' (transpose x) (transpose y) -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @-transpose :: C.Graph g => Fold (C.Vertex g) -> g-transpose = foldg C.empty C.vertex C.overlay (flip C.connect)+transpose :: Fold a -> Fold a+transpose = foldg empty vertex overlay (flip connect)+{-# NOINLINE [1] transpose #-} --- | Transform a given graph by applying a function to each of its vertices.--- This is similar to 'fmap' but can be used with non-fully-parametric graphs.------ @--- gmap f 'empty'      == 'empty'--- gmap f ('vertex' x) == 'vertex' (f x)--- gmap f ('edge' x y) == 'edge' (f x) (f y)--- gmap id           == id--- gmap f . gmap g   == gmap (f . g)--- @-gmap :: C.Graph g => (a -> C.Vertex g) -> Fold a -> g-gmap f = foldg C.empty (C.vertex . f) C.overlay C.connect+{-# RULES+"transpose/empty"    transpose empty = empty+"transpose/vertex"   forall x. transpose (vertex x) = vertex x+"transpose/overlay"  forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2)+"transpose/connect"  forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1) --- | Transform a given graph by substituting each of its vertices with a subgraph.--- This is similar to Monad's bind '>>=' but can be used with non-fully-parametric--- graphs.------ @--- bind 'empty' f         == 'empty'--- bind ('vertex' x) f    == f x--- bind ('edge' x y) f    == 'connect' (f x) (f y)--- bind ('vertices' xs) f == 'overlays' ('map' f xs)--- bind x (const 'empty') == 'empty'--- bind x 'vertex'        == x--- bind (bind x f) g    == bind x (\\y -> bind (f y) g)--- @-bind :: C.Graph g => Fold a -> (a -> g) -> g-bind g f = foldg C.empty f C.overlay C.connect g+"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs)+"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs)) +"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs+"transpose/clique"   forall xs. transpose (clique xs)   = clique (reverse xs)+ #-}+ -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate. -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes@@ -680,8 +687,8 @@ -- induce p . induce q         == induce (\\x -> p x && q x) -- 'isSubgraphOf' (induce p x) x == True -- @-induce :: C.Graph g => (C.Vertex g -> Bool) -> Fold (C.Vertex g) -> g-induce p = C.toGraph . foldg empty (\x -> if p x then vertex x else empty) (k overlay) (k connect)+induce :: (a -> Bool) -> Fold a -> Fold a+induce p = foldg empty (\x -> if p x then vertex x else empty) (k overlay) (k connect)   where     k f x y | isEmpty x = y -- Constant folding to get rid of Empty leaves             | isEmpty y = x@@ -704,8 +711,8 @@ -- simplify (1 + 2 + 1) ~> 1 + 2 -- simplify (1 * 1 * 1) ~> 1 * 1 -- @-simplify :: (Eq g, C.Graph g) => Fold (C.Vertex g) -> g-simplify = foldg C.empty C.vertex (simple C.overlay) (simple C.connect)+simplify :: Ord a => Fold a -> Fold a+simplify = foldg empty vertex (simple overlay) (simple connect)  simple :: Eq g => (g -> g -> g) -> g -> g -> g simple op x y@@ -714,34 +721,3 @@     | otherwise = z   where     z = op x y---- | Compute the /Cartesian product/ of graphs.--- Complexity: /O(s1 * s2)/ time, memory and size, where /s1/ and /s2/ are the--- sizes of the given graphs.------ @--- box ('path' [0,1]) ('path' "ab") == 'edges' [ ((0,\'a\'), (0,\'b\'))---                                       , ((0,\'a\'), (1,\'a\'))---                                       , ((0,\'b\'), (1,\'b\'))---                                       , ((1,\'a\'), (1,\'b\')) ]--- @--- Up to an isomorphism between the resulting vertex types, this operation--- is /commutative/, /associative/, /distributes/ over 'overlay', has singleton--- graphs as /identities/ and 'empty' as the /annihilating zero/. Below @~~@--- stands for the equality up to an isomorphism, e.g. @(x, ()) ~~ x@.------ @--- box x y               ~~ box y x--- box x (box y z)       ~~ box (box x y) z--- box x ('overlay' y z)   == 'overlay' (box x y) (box x z)--- box x ('vertex' ())     ~~ x--- box x 'empty'           ~~ 'empty'--- 'transpose'   (box x y) == box ('transpose' x) ('transpose' y)--- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y--- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y--- @-box :: (C.Graph g, C.Vertex g ~ (a, b)) => Fold a -> Fold b -> g-box x y = C.overlays $ xs ++ ys-  where-    xs = map (\b -> gmap (,b) x) $ toList y-    ys = map (\a -> gmap (a,) y) $ toList x

@@ -53,11 +53,7 @@     removeVertex, replaceVertex, mergeVertices, splitVertex, induce,      -- * Graph composition-    box,--    -- * Conversion between graph data types-    ToGraph (..)-+    box   ) where  import Prelude ()@@ -68,8 +64,10 @@ import Data.Foldable (toList) import Data.Tree -import qualified Data.IntSet as IntSet-import qualified Data.Set    as Set+import qualified Algebra.Graph      as G+import qualified Algebra.Graph.Fold as F+import qualified Data.IntSet        as IntSet+import qualified Data.Set           as Set  {-| The core type class for constructing algebraic graphs is defined by introducing@@ -138,6 +136,12 @@     -- | Connect two graphs.     connect :: g a -> g a -> g a +instance Graph G.Graph where+    connect = G.connect++instance Graph F.Fold where+    connect = F.connect+ -- | Construct the graph comprising a single isolated vertex. An alias for 'pure'. vertex :: Graph g => a -> g a vertex = pure@@ -212,7 +216,9 @@ -- 'vertexSet'   . vertices == Set.'Set.fromList' -- @ vertices :: Graph g => [a] -> g a-vertices = overlays . map vertex+vertices []     = empty+vertices [x]    = vertex x+vertices (x:xs) = vertex x `overlay` vertices xs  -- | Construct the graph from a list of edges. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -495,7 +501,7 @@ -- @ -- torus xs    []   == 'empty' -- torus []    ys   == 'empty'--- torus [x]   [y]  == 'edge' (x, y) (x, y)+-- torus [x]   [y]  == 'edge' (x,y) (x,y) -- torus xs    ys   == 'box' ('circuit' xs) ('circuit' ys) -- torus [1,2] "ab" == 'edges' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')), ((1,\'b\'),(1,\'a\')), ((1,\'b\'),(2,\'b\')) --                           , ((2,\'a\'),(1,\'a\')), ((2,\'a\'),(2,\'b\')), ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ]@@ -623,15 +629,3 @@   where     xs = map (\b -> fmap (,b) x) $ toList y     ys = map (\a -> fmap (a,) y) $ toList x---- | The 'ToGraph' type class captures data types that can be converted to--- polymorphic graph expressions. The conversion method 'toGraph' semantically--- acts as the identity on graph data structures, but allows to convert graphs--- between different data representations.------ @---       toGraph (g     :: 'Algebra.Graph.Graph' a  ) :: 'Algebra.Graph.Graph' a   == g--- 'show' (toGraph (1 * 2 :: 'Algebra.Graph.Graph' Int) :: 'Algebra.Graph.Fold' Int) == "edge 1 2"--- @-class ToGraph t where-    toGraph :: Graph g => t a -> g a

@@ -1,646 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Algebra.Graph.IntAdjacencyMap--- Copyright  : (c) Andrey Mokhov 2016-2018--- License    : MIT (see the file LICENSE)--- Maintainer : andrey.mokhov@gmail.com--- Stability  : experimental------ __Alga__ is a library for algebraic construction and manipulation of graphs--- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the--- motivation behind the library, the underlying theory, and implementation details.------ This module defines the 'IntAdjacencyMap' data type, as well as associated--- operations and algorithms. 'IntAdjacencyMap' is an instance of the 'C.Graph'--- type class, which can be used for polymorphic graph construction--- and manipulation. See "Algebra.Graph.AdjacencyMap" for graphs with--- non-@Int@ vertices.-------------------------------------------------------------------------------module Algebra.Graph.IntAdjacencyMap (-    -- * Data structure-    IntAdjacencyMap, adjacencyMap,--    -- * Basic graph construction primitives-    empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    fromAdjacencyList,--    -- * Relations on graphs-    isSubgraphOf,--    -- * Graph properties-    isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,-    adjacencyList, vertexIntSet, edgeSet, postIntSet,--    -- * Standard families of graphs-    path, circuit, clique, biclique, star, starTranspose, tree, forest,--    -- * Graph transformation-    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,--    -- * Algorithms-    dfsForest, dfsForestFrom, dfs, topSort, isTopSort-  ) where--import Data.IntSet (IntSet)-import Data.Maybe-import Data.Set (Set)-import Data.Tree--import Algebra.Graph.IntAdjacencyMap.Internal--import qualified Algebra.Graph.Class as C-import qualified Data.Graph          as KL-import qualified Data.IntMap.Strict  as IntMap-import qualified Data.IntSet         as IntSet-import qualified Data.Set            as Set---- | Construct the /empty graph/.--- Complexity: /O(1)/ time and memory.------ @--- 'isEmpty'     empty == True--- 'hasVertex' x empty == False--- 'vertexCount' empty == 0--- 'edgeCount'   empty == 0--- @-empty :: IntAdjacencyMap-empty = C.empty---- | Construct the graph comprising /a single isolated vertex/.--- Complexity: /O(1)/ time and memory.------ @--- 'isEmpty'     (vertex x) == False--- 'hasVertex' x (vertex x) == True--- 'vertexCount' (vertex x) == 1--- 'edgeCount'   (vertex x) == 0--- @-vertex :: Int -> IntAdjacencyMap-vertex = C.vertex---- | Construct the graph comprising /a single edge/.--- Complexity: /O(1)/ time, memory.------ @--- edge x y               == 'connect' ('vertex' x) ('vertex' y)--- 'hasEdge' x y (edge x y) == True--- 'edgeCount'   (edge x y) == 1--- 'vertexCount' (edge 1 1) == 1--- 'vertexCount' (edge 1 2) == 2--- @-edge :: Int -> Int -> IntAdjacencyMap-edge = C.edge---- | /Overlay/ two graphs. This is a commutative, associative and idempotent--- operation with the identity 'empty'.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y--- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y--- 'vertexCount' (overlay x y) >= 'vertexCount' x--- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y--- 'edgeCount'   (overlay x y) >= 'edgeCount' x--- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y--- 'vertexCount' (overlay 1 2) == 2--- 'edgeCount'   (overlay 1 2) == 0--- @-overlay :: IntAdjacencyMap -> IntAdjacencyMap -> IntAdjacencyMap-overlay = C.overlay---- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the--- number of edges in the resulting graph is quadratic with respect to the number--- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.------ @--- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y--- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y--- 'vertexCount' (connect x y) >= 'vertexCount' x--- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y--- 'edgeCount'   (connect x y) >= 'edgeCount' x--- 'edgeCount'   (connect x y) >= 'edgeCount' y--- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y--- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y--- 'vertexCount' (connect 1 2) == 2--- 'edgeCount'   (connect 1 2) == 1--- @-connect :: IntAdjacencyMap -> IntAdjacencyMap -> IntAdjacencyMap-connect = C.connect---- | Construct the graph comprising a given list of isolated vertices.--- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length--- of the given list.------ @--- vertices []             == 'empty'--- vertices [x]            == 'vertex' x--- 'hasVertex' x  . vertices == 'elem' x--- 'vertexCount'  . vertices == 'length' . 'Data.List.nub'--- 'vertexIntSet' . vertices == IntSet.'IntSet.fromList'--- @-vertices :: [Int] -> IntAdjacencyMap-vertices = mkAM . IntMap.fromList . map (\x -> (x, IntSet.empty))---- | Construct the graph from a list of edges.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- edges []          == 'empty'--- edges [(x, y)]    == 'edge' x y--- 'edgeCount' . edges == 'length' . 'Data.List.nub'--- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'--- @-edges :: [(Int, Int)] -> IntAdjacencyMap-edges = fromAdjacencyList . map (fmap return)---- | Overlay a given list of graphs.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- overlays []        == 'empty'--- overlays [x]       == x--- overlays [x,y]     == 'overlay' x y--- overlays           == 'foldr' 'overlay' 'empty'--- 'isEmpty' . overlays == 'all' 'isEmpty'--- @-overlays :: [IntAdjacencyMap] -> IntAdjacencyMap-overlays = C.overlays---- | Connect a given list of graphs.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- connects []        == 'empty'--- connects [x]       == x--- connects [x,y]     == 'connect' x y--- connects           == 'foldr' 'connect' 'empty'--- 'isEmpty' . connects == 'all' 'isEmpty'--- @-connects :: [IntAdjacencyMap] -> IntAdjacencyMap-connects = C.connects---- | Construct a graph from an adjacency list.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- fromAdjacencyList []                                  == 'empty'--- fromAdjacencyList [(x, [])]                           == 'vertex' x--- fromAdjacencyList [(x, [y])]                          == 'edge' x y--- fromAdjacencyList . 'adjacencyList'                     == id--- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--- @-fromAdjacencyList :: [(Int, [Int])] -> IntAdjacencyMap-fromAdjacencyList as = mkAM $ IntMap.unionWith IntSet.union vs es-  where-    ss = map (fmap IntSet.fromList) as-    vs = IntMap.fromSet (const IntSet.empty) . IntSet.unions $ map snd ss-    es = IntMap.fromListWith IntSet.union ss---- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the--- first graph is a /subgraph/ of the second.--- Complexity: /O((n + m) * log(n))/ time.------ @--- isSubgraphOf 'empty'         x             == True--- isSubgraphOf ('vertex' x)    'empty'         == False--- isSubgraphOf x             ('overlay' x y) == True--- isSubgraphOf ('overlay' x y) ('connect' x y) == True--- isSubgraphOf ('path' xs)     ('circuit' xs)  == True--- @-isSubgraphOf :: IntAdjacencyMap -> IntAdjacencyMap -> Bool-isSubgraphOf x y = IntMap.isSubmapOfBy IntSet.isSubsetOf (adjacencyMap x) (adjacencyMap y)---- | Check if a graph is empty.--- Complexity: /O(1)/ time.------ @--- isEmpty 'empty'                       == True--- isEmpty ('overlay' 'empty' 'empty')       == True--- isEmpty ('vertex' x)                  == False--- isEmpty ('removeVertex' x $ 'vertex' x) == True--- isEmpty ('removeEdge' x y $ 'edge' x y) == False--- @-isEmpty :: IntAdjacencyMap -> Bool-isEmpty = IntMap.null . adjacencyMap---- | Check if a graph contains a given vertex.--- Complexity: /O(log(n))/ time.------ @--- hasVertex x 'empty'            == False--- hasVertex x ('vertex' x)       == True--- hasVertex 1 ('vertex' 2)       == False--- hasVertex x . 'removeVertex' x == const False--- @-hasVertex :: Int -> IntAdjacencyMap -> Bool-hasVertex x = IntMap.member x . adjacencyMap---- | Check if a graph contains a given edge.--- Complexity: /O(log(n))/ time.------ @--- hasEdge x y 'empty'            == False--- hasEdge x y ('vertex' z)       == False--- hasEdge x y ('edge' x y)       == True--- hasEdge x y . 'removeEdge' x y == const False--- hasEdge x y                  == 'elem' (x,y) . 'edgeList'--- @-hasEdge :: Int -> Int -> IntAdjacencyMap -> Bool-hasEdge u v a = case IntMap.lookup u (adjacencyMap a) of-    Nothing -> False-    Just vs -> IntSet.member v vs---- | The number of vertices in a graph.--- Complexity: /O(1)/ time.------ @--- vertexCount 'empty'      == 0--- vertexCount ('vertex' x) == 1--- vertexCount            == 'length' . 'vertexList'--- @-vertexCount :: IntAdjacencyMap -> Int-vertexCount = IntMap.size . adjacencyMap---- | The number of edges in a graph.--- Complexity: /O(n)/ time.------ @--- edgeCount 'empty'      == 0--- edgeCount ('vertex' x) == 0--- edgeCount ('edge' x y) == 1--- edgeCount            == 'length' . 'edgeList'--- @-edgeCount :: IntAdjacencyMap -> Int-edgeCount = IntMap.foldr (\es r -> (IntSet.size es + r)) 0 . adjacencyMap---- | The sorted list of vertices of a given graph.--- Complexity: /O(n)/ time and memory.------ @--- vertexList 'empty'      == []--- vertexList ('vertex' x) == [x]--- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'--- @-vertexList :: IntAdjacencyMap -> [Int]-vertexList = IntMap.keys . adjacencyMap---- | The sorted list of edges of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- edgeList 'empty'          == []--- edgeList ('vertex' x)     == []--- edgeList ('edge' x y)     == [(x,y)]--- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]--- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'--- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList--- @-edgeList :: IntAdjacencyMap -> [(Int, Int)]-edgeList (AM m _) = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]---- | The sorted /adjacency list/ of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- adjacencyList 'empty'               == []--- adjacencyList ('vertex' x)          == [(x, [])]--- adjacencyList ('edge' 1 2)          == [(1, [2]), (2, [])]--- adjacencyList ('star' 2 [3,1])      == [(1, []), (2, [1,3]), (3, [])]--- 'fromAdjacencyList' . adjacencyList == id--- @-adjacencyList :: IntAdjacencyMap -> [(Int, [Int])]-adjacencyList = map (fmap IntSet.toAscList) . IntMap.toAscList . adjacencyMap---- | The set of vertices of a given graph.--- Complexity: /O(n)/ time and memory.------ @--- vertexIntSet 'empty'      == IntSet.'IntSet.empty'--- vertexIntSet . 'vertex'   == IntSet.'IntSet.singleton'--- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'--- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList'--- @-vertexIntSet :: IntAdjacencyMap -> IntSet-vertexIntSet = IntMap.keysSet . adjacencyMap---- | The set of edges of a given graph.--- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory.------ @--- edgeSet 'empty'      == Set.'Set.empty'--- edgeSet ('vertex' x) == Set.'Set.empty'--- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y)--- edgeSet . 'edges'    == Set.'Set.fromList'--- @-edgeSet :: IntAdjacencyMap -> Set (Int, Int)-edgeSet = IntMap.foldrWithKey combine Set.empty . adjacencyMap-  where-    combine u es = Set.union (Set.fromAscList [ (u, v) | v <- IntSet.toAscList es ])---- | The /postset/ (here 'postIntSet') of a vertex is the set of its /direct successors/.------ @--- postIntSet x 'empty'      == IntSet.'IntSet.empty'--- postIntSet x ('vertex' x) == IntSet.'IntSet.empty'--- postIntSet x ('edge' x y) == IntSet.'IntSet.fromList' [y]--- postIntSet 2 ('edge' 1 2) == IntSet.'IntSet.empty'--- @-postIntSet :: Int -> IntAdjacencyMap -> IntSet-postIntSet x = IntMap.findWithDefault IntSet.empty x . adjacencyMap---- | The /path/ on a list of vertices.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- path []        == 'empty'--- path [x]       == 'vertex' x--- path [x,y]     == 'edge' x y--- path . 'reverse' == 'transpose' . path--- @-path :: [Int] -> IntAdjacencyMap-path = C.path---- | The /circuit/ on a list of vertices.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- circuit []        == 'empty'--- circuit [x]       == 'edge' x x--- circuit [x,y]     == 'edges' [(x,y), (y,x)]--- circuit . 'reverse' == 'transpose' . circuit--- @-circuit :: [Int] -> IntAdjacencyMap-circuit = C.circuit---- | The /clique/ on a list of vertices.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- clique []         == 'empty'--- clique [x]        == 'vertex' x--- clique [x,y]      == 'edge' x y--- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]--- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)--- clique . 'reverse'  == 'transpose' . clique--- @-clique :: [Int] -> IntAdjacencyMap-clique = C.clique---- | The /biclique/ on two lists of vertices.--- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.------ @--- biclique []      []      == 'empty'--- biclique [x]     []      == 'vertex' x--- biclique []      [y]     == 'vertex' y--- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]--- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys)--- @-biclique :: [Int] -> [Int] -> IntAdjacencyMap-biclique xs ys = mkAM $ IntMap.fromSet adjacent (x `IntSet.union` y)-  where-    x = IntSet.fromList xs-    y = IntSet.fromList ys-    adjacent v-        | v `IntSet.member` x = y-        | otherwise        = IntSet.empty---- | The /star/ formed by a centre vertex connected to a list of leaves.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- star x []    == 'vertex' x--- star x [y]   == 'edge' x y--- star x [y,z] == 'edges' [(x,y), (x,z)]--- star x ys    == 'connect' ('vertex' x) ('vertices' ys)--- @-star :: Int -> [Int] -> IntAdjacencyMap-star = C.star---- | The /star transpose/ formed by a list of leaves connected to a centre vertex.--- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the--- given list.------ @--- starTranspose x []    == 'vertex' x--- starTranspose x [y]   == 'edge' y x--- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]--- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)--- starTranspose x ys    == 'transpose' ('star' x ys)--- @-starTranspose :: Int -> [Int] -> IntAdjacencyMap-starTranspose = C.starTranspose---- | The /tree graph/ constructed from a given 'Tree' data structure.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- tree (Node x [])                                         == 'vertex' x--- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]--- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]--- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]--- @-tree :: Tree Int -> IntAdjacencyMap-tree = C.tree---- | The /forest graph/ constructed from a given 'Forest' data structure.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- forest []                                                  == 'empty'--- forest [x]                                                 == 'tree' x--- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]--- forest                                                     == 'overlays' . map 'tree'--- @-forest :: Forest Int -> IntAdjacencyMap-forest = C.forest---- | Remove a vertex from a given graph.--- Complexity: /O(n*log(n))/ time.------ @--- removeVertex x ('vertex' x)       == 'empty'--- removeVertex 1 ('vertex' 2)       == 'vertex' 2--- removeVertex x ('edge' x x)       == 'empty'--- removeVertex 1 ('edge' 1 2)       == 'vertex' 2--- removeVertex x . removeVertex x == removeVertex x--- @-removeVertex :: Int -> IntAdjacencyMap -> IntAdjacencyMap-removeVertex x = mkAM . IntMap.map (IntSet.delete x) . IntMap.delete x . adjacencyMap---- | Remove an edge from a given graph.--- Complexity: /O(log(n))/ time.------ @--- removeEdge x y ('edge' x y)       == 'vertices' [x, y]--- removeEdge x y . removeEdge x y == removeEdge x y--- removeEdge x y . 'removeVertex' x == 'removeVertex' x--- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2--- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2--- @-removeEdge :: Int -> Int -> IntAdjacencyMap -> IntAdjacencyMap-removeEdge x y = mkAM . IntMap.adjust (IntSet.delete y) x . adjacencyMap---- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a--- given 'IntAdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged.--- Complexity: /O((n + m) * log(n))/ time.------ @--- replaceVertex x x            == id--- replaceVertex x y ('vertex' x) == 'vertex' y--- replaceVertex x y            == 'mergeVertices' (== x) y--- @-replaceVertex :: Int -> Int -> IntAdjacencyMap -> IntAdjacencyMap-replaceVertex u v = gmap $ \w -> if w == u then v else w---- | Merge vertices satisfying a given predicate into a given vertex.--- Complexity: /O((n + m) * log(n))/ time, assuming that the predicate takes--- /O(1)/ to be evaluated.------ @--- mergeVertices (const False) x    == id--- mergeVertices (== x) y           == 'replaceVertex' x y--- mergeVertices even 1 (0 * 2)     == 1 * 1--- mergeVertices odd  1 (3 + 4 * 5) == 4 * 1--- @-mergeVertices :: (Int -> Bool) -> Int -> IntAdjacencyMap -> IntAdjacencyMap-mergeVertices p v = gmap $ \u -> if p u then v else u---- | Transpose a given graph.--- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.------ @--- transpose 'empty'       == 'empty'--- transpose ('vertex' x)  == 'vertex' x--- transpose ('edge' x y)  == 'edge' y x--- transpose . transpose == id--- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList'--- @-transpose :: IntAdjacencyMap -> IntAdjacencyMap-transpose (AM m _) = mkAM $ IntMap.foldrWithKey combine vs m-  where-    combine v es = IntMap.unionWith IntSet.union (IntMap.fromSet (const $ IntSet.singleton v) es)-    vs           = IntMap.fromSet (const IntSet.empty) (IntMap.keysSet m)---- | Transform a graph by applying a function to each of its vertices. This is--- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric--- 'IntAdjacencyMap'.--- Complexity: /O((n + m) * log(n))/ time.------ @--- gmap f 'empty'      == 'empty'--- gmap f ('vertex' x) == 'vertex' (f x)--- gmap f ('edge' x y) == 'edge' (f x) (f y)--- gmap id           == id--- gmap f . gmap g   == gmap (f . g)--- @-gmap :: (Int -> Int) -> IntAdjacencyMap -> IntAdjacencyMap-gmap f = mkAM . IntMap.map (IntSet.map f) . IntMap.mapKeysWith IntSet.union f . adjacencyMap---- | Construct the /induced subgraph/ of a given graph by removing the--- vertices that do not satisfy a given predicate.--- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to--- be evaluated.------ @--- induce (const True ) x      == x--- induce (const False) x      == 'empty'--- induce (/= x)               == 'removeVertex' x--- induce p . induce q         == induce (\\x -> p x && q x)--- 'isSubgraphOf' (induce p x) x == True--- @-induce :: (Int -> Bool) -> IntAdjacencyMap -> IntAdjacencyMap-induce p = mkAM . IntMap.map (IntSet.filter p) . IntMap.filterWithKey (\k _ -> p k) . adjacencyMap---- | Compute the /depth-first search/ forest of a graph.------ @--- 'forest' (dfsForest $ 'edge' 1 1)         == 'vertex' 1--- 'forest' (dfsForest $ 'edge' 1 2)         == 'edge' 1 2--- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1, 2]--- 'isSubgraphOf' ('forest' $ dfsForest x) x == True--- dfsForest . 'forest' . dfsForest        == dfsForest--- dfsForest ('vertices' vs)               == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)--- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x--- dfsForest $ 3 * (1 + 4) * (1 + 5)     == [ Node { rootLabel = 1---                                                 , subForest = [ Node { rootLabel = 5---                                                                      , subForest = [] }]}---                                          , Node { rootLabel = 3---                                                 , subForest = [ Node { rootLabel = 4---                                                                      , subForest = [] }]}]--- @-dfsForest :: IntAdjacencyMap -> Forest Int-dfsForest (AM _ (GraphKL g r _)) = fmap (fmap r) (KL.dff g)---- | Compute the /depth-first search/ forest of a graph, searching from each of--- the given vertices in order. Note that the resulting forest does not--- necessarily span the whole graph, as some vertices may be unreachable.------ @--- 'forest' (dfsForestFrom [1]    $ 'edge' 1 1)     == 'vertex' 1--- 'forest' (dfsForestFrom [1]    $ 'edge' 1 2)     == 'edge' 1 2--- 'forest' (dfsForestFrom [2]    $ 'edge' 1 2)     == 'vertex' 2--- 'forest' (dfsForestFrom [3]    $ 'edge' 1 2)     == 'empty'--- 'forest' (dfsForestFrom [2, 1] $ 'edge' 1 2)     == 'vertices' [1, 2]--- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x == True--- dfsForestFrom ('vertexList' x) x               == 'dfsForest' x--- dfsForestFrom vs             ('vertices' vs)   == map (\\v -> Node v []) ('Data.List.nub' vs)--- dfsForestFrom []             x               == []--- dfsForestFrom [1, 4] $ 3 * (1 + 4) * (1 + 5) == [ Node { rootLabel = 1---                                                        , subForest = [ Node { rootLabel = 5---                                                                             , subForest = [] }---                                                 , Node { rootLabel = 4---                                                        , subForest = [] }]--- @-dfsForestFrom :: [Int] -> IntAdjacencyMap -> Forest Int-dfsForestFrom vs (AM _ (GraphKL g r t)) = fmap (fmap r) (KL.dfs g (mapMaybe t vs))---- | Compute the list of vertices visited by the /depth-first search/ in a graph,--- when searching from each of the given vertices in order.------ @--- dfs [1]    $ 'edge' 1 1                == [1]--- dfs [1]    $ 'edge' 1 2                == [1, 2]--- dfs [2]    $ 'edge' 1 2                == [2]--- dfs [3]    $ 'edge' 1 2                == []--- dfs [1, 2] $ 'edge' 1 2                == [1, 2]--- dfs [2, 1] $ 'edge' 1 2                == [2, 1]--- dfs []     $ x                       == []--- dfs [1, 4] $ 3 * (1 + 4) * (1 + 5)   == [1, 5, 4]--- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True--- @-dfs :: [Int] -> IntAdjacencyMap -> [Int]-dfs vs = concatMap flatten . dfsForestFrom vs---- | Compute the /topological sort/ of a graph or return @Nothing@ if the graph--- is cyclic.------ @--- topSort (1 * 2 + 3 * 1)             == Just [3,1,2]--- topSort (1 * 2 + 2 * 1)             == Nothing--- fmap (flip 'isTopSort' x) (topSort x) /= Just False--- @-topSort :: IntAdjacencyMap -> Maybe [Int]-topSort m@(AM _ (GraphKL g r _)) =-    if isTopSort result m then Just result else Nothing-  where-    result = map r (KL.topSort g)---- | Check if a given list of vertices is a valid /topological sort/ of a graph.------ @--- isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True--- isTopSort [1, 2, 3] (1 * 2 + 3 * 1) == False--- isTopSort []        (1 * 2 + 3 * 1) == False--- isTopSort []        'empty'           == True--- isTopSort [x]       ('vertex' x)      == True--- isTopSort [x]       ('edge' x x)      == False--- @-isTopSort :: [Int] -> IntAdjacencyMap -> Bool-isTopSort xs m = go IntSet.empty xs-  where-    go seen []     = seen == IntMap.keysSet (adjacencyMap m)-    go seen (v:vs) = let newSeen = seen `seq` IntSet.insert v seen-        in postIntSet v m `IntSet.intersection` newSeen == IntSet.empty && go newSeen vs

@@ -1,196 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Algebra.Graph.IntAdjacencyMap.Internal--- Copyright  : (c) Andrey Mokhov 2016-2018--- License    : MIT (see the file LICENSE)--- Maintainer : andrey.mokhov@gmail.com--- Stability  : unstable------ This module exposes the implementation of adjacency maps. The API is unstable--- and unsafe, and is exposed only for documentation. You should use the--- non-internal module "Algebra.Graph.IntAdjacencyMap" instead.-------------------------------------------------------------------------------module Algebra.Graph.IntAdjacencyMap.Internal (-    -- * Adjacency map implementation-    IntAdjacencyMap (..), mkAM, consistent,--    -- * Interoperability with King-Launchbury graphs-    GraphKL (..), mkGraphKL-  ) where--import Data.IntMap.Strict (IntMap, keysSet, fromSet)-import Data.IntSet (IntSet)-import Data.List--import Algebra.Graph.Class--import qualified Data.Graph         as KL-import qualified Data.IntMap.Strict as IntMap-import qualified Data.IntSet        as IntSet--{-| The 'IntAdjacencyMap' data type represents a graph by a map of vertices to-their adjacency sets. We define a 'Num' instance as a convenient notation for-working with graphs:--    > 0           == vertex 0-    > 1 + 2       == overlay (vertex 1) (vertex 2)-    > 1 * 2       == connect (vertex 1) (vertex 2)-    > 1 + 2 * 3   == overlay (vertex 1) (connect (vertex 2) (vertex 3))-    > 1 * (2 + 3) == connect (vertex 1) (overlay (vertex 2) (vertex 3))--The 'Show' instance is defined using basic graph construction primitives:--@show (empty     :: IntAdjacencyMap Int) == "empty"-show (1         :: IntAdjacencyMap Int) == "vertex 1"-show (1 + 2     :: IntAdjacencyMap Int) == "vertices [1,2]"-show (1 * 2     :: IntAdjacencyMap Int) == "edge 1 2"-show (1 * 2 * 3 :: IntAdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]"-show (1 * 2 + 3 :: IntAdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)"@--The 'Eq' instance satisfies all axioms of algebraic graphs:--    * 'Algebra.Graph.IntAdjacencyMap.overlay' is commutative and associative:--        >       x + y == y + x-        > x + (y + z) == (x + y) + z--    * 'Algebra.Graph.IntAdjacencyMap.connect' is associative and has-    'Algebra.Graph.IntAdjacencyMap.empty' as the identity:--        >   x * empty == x-        >   empty * x == x-        > x * (y * z) == (x * y) * z--    * 'Algebra.Graph.IntAdjacencyMap.connect' distributes over-    'Algebra.Graph.IntAdjacencyMap.overlay':--        > x * (y + z) == x * y + x * z-        > (x + y) * z == x * z + y * z--    * 'Algebra.Graph.IntAdjacencyMap.connect' can be decomposed:--        > x * y * z == x * y + x * z + y * z--The following useful theorems can be proved from the above set of axioms.--    * 'Algebra.Graph.IntAdjacencyMap.overlay' has-    'Algebra.Graph.IntAdjacencyMap.empty' as the identity and is idempotent:--        >   x + empty == x-        >   empty + x == x-        >       x + x == x--    * Absorption and saturation of 'Algebra.Graph.IntAdjacencyMap.connect':--        > x * y + x + y == x * y-        >     x * x * x == x * x--When specifying the time and memory complexity of graph algorithms, /n/ and /m/-will denote the number of vertices and edges in the graph, respectively.--}-data IntAdjacencyMap = AM {-    -- | The /adjacency map/ of the graph: each vertex is associated with a set-    -- of its direct successors.-    adjacencyMap :: !(IntMap IntSet),-    -- | Cached King-Launchbury representation.-    -- /Note: this field is for internal use only/.-    graphKL :: GraphKL }---- | Construct an 'AdjacencyMap' from a map of successor sets and (lazily)--- compute the corresponding King-Launchbury representation.--- /Note: this function is for internal use only/.-mkAM :: IntMap IntSet -> IntAdjacencyMap-mkAM m = AM m (mkGraphKL m)--instance Eq IntAdjacencyMap where-    x == y = adjacencyMap x == adjacencyMap y--instance Show IntAdjacencyMap where-    show (AM m _)-        | null vs    = "empty"-        | null es    = vshow vs-        | vs == used = eshow es-        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"-      where-        vs             = IntSet.toAscList (keysSet m)-        es             = internalEdgeList m-        vshow [x]      = "vertex "   ++ show x-        vshow xs       = "vertices " ++ show xs-        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y-        eshow xs       = "edges "    ++ show xs-        used           = IntSet.toAscList (referredToVertexSet m)--instance Graph IntAdjacencyMap where-    type Vertex IntAdjacencyMap = Int-    empty       = mkAM   IntMap.empty-    vertex x    = mkAM $ IntMap.singleton x IntSet.empty-    overlay x y = mkAM $ IntMap.unionWith IntSet.union (adjacencyMap x) (adjacencyMap y)-    connect x y = mkAM $ IntMap.unionsWith IntSet.union [ adjacencyMap x, adjacencyMap y,-        fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]--instance Num IntAdjacencyMap where-    fromInteger = vertex . fromInteger-    (+)         = overlay-    (*)         = connect-    signum      = const empty-    abs         = id-    negate      = id--instance ToGraph IntAdjacencyMap where-    type ToVertex IntAdjacencyMap = Int-    toGraph = overlays . map (uncurry star . fmap IntSet.toList) . IntMap.toList . adjacencyMap---- | Check if the internal graph representation is consistent, i.e. that all--- edges refer to existing vertices. It should be impossible to create an--- inconsistent adjacency map, and we use this function in testing.--- /Note: this function is for internal use only/.------ @--- consistent 'Algebra.Graph.IntAdjacencyMap.empty'                  == True--- consistent ('Algebra.Graph.IntAdjacencyMap.vertex' x)             == True--- consistent ('Algebra.Graph.IntAdjacencyMap.overlay' x y)          == True--- consistent ('Algebra.Graph.IntAdjacencyMap.connect' x y)          == True--- consistent ('Algebra.Graph.IntAdjacencyMap.edge' x y)             == True--- consistent ('Algebra.Graph.IntAdjacencyMap.edges' xs)             == True--- consistent ('Algebra.Graph.IntAdjacencyMap.graph' xs ys)          == True--- consistent ('Algebra.Graph.IntAdjacencyMap.fromAdjacencyList' xs) == True--- @-consistent :: IntAdjacencyMap -> Bool-consistent (AM m _) = referredToVertexSet m `IntSet.isSubsetOf` keysSet m---- The set of vertices that are referred to by the edges-referredToVertexSet :: IntMap IntSet -> IntSet-referredToVertexSet = IntSet.fromList . uncurry (++) . unzip . internalEdgeList---- The list of edges in adjacency map-internalEdgeList :: IntMap IntSet -> [(Int, Int)]-internalEdgeList m = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]---- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in--- the "Data.Graph" module of the @containers@ library.--- /Note: this data structure is for internal use only/.------ If @mkGraphKL (adjacencyMap g) == h@ then the following holds:------ @--- map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h)                               == 'Algebra.Graph.AdjacencyMap.vertexList' g--- map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.edgeList' g--- @-data GraphKL = GraphKL {-    -- | Array-based graph representation (King and Launchbury, 1995).-    toGraphKL :: KL.Graph,-    -- | A mapping of "Data.Graph.Vertex" to vertices of type @Int@.-    fromVertexKL :: KL.Vertex -> Int,-    -- | A mapping from vertices of type @Int@ to "Data.Graph.Vertex".-    -- Returns 'Nothing' if the argument is not in the graph.-    toVertexKL :: Int -> Maybe KL.Vertex }---- | Build 'GraphKL' from a map of successor sets.--- /Note: this function is for internal use only/.-mkGraphKL :: IntMap IntSet -> GraphKL-mkGraphKL m = GraphKL-    { toGraphKL    = g-    , fromVertexKL = \u -> case r u of (_, v, _) -> v-    , toVertexKL   = t }-  where-    (g, r, t) = KL.graphFromEdges [ ((), v, IntSet.toAscList us) | (v, us) <- IntMap.toAscList m ]

@@ -20,7 +20,9 @@     List (..),      -- * Data structures for graph traversal-    Focus, focus, Context (..), context+    Focus (..), emptyFocus, vertexFocus, overlayFoci, connectFoci, Hit (..),++    foldr1Safe   ) where  import Prelude ()@@ -29,8 +31,6 @@ import Data.Foldable import Data.Semigroup -import Algebra.Graph.Class (ToGraph(..))- import qualified GHC.Exts as Exts  -- | An abstract list data type with /O(1)/ time concatenation (the current@@ -77,6 +77,15 @@     return  = pure     x >>= f = Exts.fromList (toList x >>= toList . f) +-- | The /focus/ of a graph expression is a flattened represenentation of the+-- subgraph under focus, its context, as well as the list of all encountered+-- vertices. See 'Algebra.Graph.removeEdge' for a use-case example.+data Focus a = Focus+    { ok :: Bool     -- ^ True if focus on the specified subgraph is obtained.+    , is :: List a   -- ^ Inputs into the focused subgraph.+    , os :: List a   -- ^ Outputs out of the focused subgraph.+    , vs :: List a } -- ^ All vertices (leaves) of the graph expression.+ -- | Focus on the empty graph. emptyFocus :: Focus a emptyFocus = Focus False mempty mempty mempty@@ -97,27 +106,15 @@     xs = if ok y then vs x else is x     ys = if ok x then vs y else os y --- | The context of a subgraph comprises the input and output vertices outside--- the subgraph that are connected to the vertices inside the subgraph.-data Context a = Context { inputs :: [a], outputs :: [a] }+-- | An auxiliary data type for 'hasEdge': when searching for an edge, we can hit+-- its 'Tail', i.e. the source vertex, the whole 'Edge', or 'Miss' it entirely.+data Hit = Miss | Tail | Edge deriving (Eq, Ord) --- | Extract the context from a graph 'Focus'. Returns @Nothing@ if the focus--- could not be obtained.-context :: ToGraph g => (ToVertex g -> Bool) -> g -> Maybe (Context (ToVertex g))-context p g | ok f      = Just $ Context (toList $ is f) (toList $ os f)-            | otherwise = Nothing+-- | A safe version of 'foldr1'+foldr1Safe :: (a -> a -> a) -> [a] -> Maybe a+foldr1Safe f = foldr mf Nothing   where-    f = focus p g---- | The /focus/ of a graph expression is a flattened represenentation of the--- subgraph under focus, its context, as well as the list of all encountered--- vertices. See 'Algebra.Graph.removeEdge' for a use-case example.-data Focus a = Focus-    { ok :: Bool     -- ^ True if focus on the specified subgraph is obtained.-    , is :: List a   -- ^ Inputs into the focused subgraph.-    , os :: List a   -- ^ Outputs out of the focused subgraph.-    , vs :: List a } -- ^ All vertices (leaves) of the graph expression.---- | 'Focus' on a specified subgraph.-focus :: ToGraph g => (ToVertex g -> Bool) -> g -> Focus (ToVertex g)-focus f = foldg emptyFocus (vertexFocus f) overlayFoci connectFoci+    mf x m = Just (case m of+                        Nothing -> x+                        Just y  -> f x y)+{-# INLINE foldr1Safe #-}

@@ -0,0 +1,126 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Label+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module provides basic data types and type classes for representing edge+-- labels in edge-labelled graphs, e.g. see "Algebra.Graph.Labelled".+--+-----------------------------------------------------------------------------+module Algebra.Graph.Label (+    -- * Type classes for edge labels+    Semilattice (..), Dioid (..),++    -- * Data types for edge labels+    Distance (..)+  ) where++import Prelude ()+import Prelude.Compat+import Data.Set (Set)++import qualified Data.Set as Set++{-| A /bounded join semilattice/, satisfying the following laws:++    * Commutativity:++        > x \/ y == y \/ x++    * Associativity:++        > x \/ (y \/ z) == (x \/ y) \/ z++    * Identity:++        > x \/ zero == x++    * Idempotence:++        > x \/ x == x+-}+class Semilattice a where+    zero :: a+    (\/) :: a -> a -> a++{-| A /dioid/ is an /idempotent semiring/, i.e. it satisfies the following laws:++    * Associativity:++        > x /\ (y /\ z) == (x /\ y) /\ z++    * Identity:++        > x /\ one == x+        > one /\ x == x++    * Annihilating zero:++        > x /\ zero == zero+        > zero /\ x == zero++    * Distributivity:++        > x /\ (y \/ z) == x /\ y \/ x /\ z+        > (x \/ y) /\ z == x /\ z \/ y /\ z+-}+class Semilattice a => Dioid a where+    one  :: a+    (/\) :: a -> a -> a++infixl 6 \/+infixl 7 /\++instance Semilattice Bool where+    zero = False+    (\/) = (||)++instance Dioid Bool where+    one  = True+    (/\) = (&&)++-- | A /distance/ is a non-negative value that can be 'Finite' or 'Infinite'.+data Distance a = Finite a | Infinite deriving (Eq, Ord, Show)++instance (Ord a, Num a) => Num (Distance a) where+    fromInteger = Finite . fromInteger++    Infinite + _        = Infinite+    _        + Infinite = Infinite+    Finite x + Finite y = Finite (x + y)++    Infinite * _        = Infinite+    _        * Infinite = Infinite+    Finite x * Finite y = Finite (x * y)++    negate _ = error "Negative distances not allowed"++    signum (Finite 0) = 0+    signum _          = 1++    abs = id++instance Ord a => Semilattice (Distance a) where+    zero = Infinite++    Infinite \/ x        = x+    x        \/ Infinite = x+    Finite x \/ Finite y = Finite (min x y)++instance (Num a, Ord a) => Dioid (Distance a) where+    one = Finite 0++    Infinite /\ _        = Infinite+    _        /\ Infinite = Infinite+    Finite x /\ Finite y = Finite (x + y)++instance Ord a => Semilattice (Set a) where+    zero = Set.empty+    (\/) = Set.union

@@ -0,0 +1,122 @@+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Labelled+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module provides a minimal and experimental implementation of algebraic+-- graphs with edge labels. The API will be expanded in the next release.+-----------------------------------------------------------------------------+module Algebra.Graph.Labelled (+    -- * Algebraic data type for edge-labeleld graphs+    Graph (..), UnlabelledGraph, empty, vertex, edge, overlay, connect,+    connectBy, (-<), (>-),++    -- * Operations+    edgeLabel+  ) where++import Prelude ()+import Prelude.Compat++import Algebra.Graph.Label+import qualified Algebra.Graph.Class as C++-- | Edge-labelled graphs, where the type variable @e@ stands for edge labels.+-- For example, @Graph Bool a@ is isomorphic to unlabelled graphs defined in+-- the top-level module "Algebra.Graph.Graph", where @False@ and @True@ denote+-- the lack of and the existence of an unlabelled edge, respectively.+data Graph e a = Empty+               | Vertex a+               | Connect e (Graph e a) (Graph e a)+               deriving (Foldable, Functor, Show, Traversable)++-- | A type synonym for unlabelled graphs.+type UnlabelledGraph a = Graph Bool a++-- | Construct the /empty graph/. An alias for the constructor 'Empty'.+-- Complexity: /O(1)/ time, memory and size.+empty :: Graph e a+empty = Empty++-- | Construct the graph comprising /a single isolated vertex/. An alias for the+-- constructor 'Vertex'.+-- Complexity: /O(1)/ time, memory and size.+vertex :: a -> Graph e a+vertex = Vertex++-- | Construct the graph comprising /a single edge/ with the label 'one'.+-- Complexity: /O(1)/ time, memory and size.+edge :: Dioid e => a -> a -> Graph e a+edge = C.edge++-- | /Overlay/ two graphs. An alias for 'Connect' 'zero'. This is a commutative,+-- associative and idempotent operation with the identity 'empty'.+-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size.+overlay :: Semilattice e => Graph e a -> Graph e a -> Graph e a+overlay = Connect zero++-- | /Connect/ two graphs. An alias for 'Connect' 'one'. This is an associative+-- operation with the identity 'empty', which distributes over 'overlay' and+-- obeys the decomposition axiom. See the full list of laws in "Algebra.Graph".+-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. Note that the number+-- of edges in the resulting graph is quadratic with respect to the number of+-- vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+connect :: Dioid e => Graph e a -> Graph e a -> Graph e a+connect = Connect one++-- | /Connect/ two graphs with edges labelled by a given label. An alias for+-- 'Connect'.+-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. Note that the number+-- of edges in the resulting graph is quadratic with respect to the number of+-- vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+connectBy :: e -> Graph e a -> Graph e a -> Graph e a+connectBy = Connect++-- | The left-hand part of a convenient ternary-ish operator @x -\<e\>- y@ for+-- connecting graphs with labelled edges. For example:+--+-- @+-- x = 'vertex' "x"+-- y = 'vertex' "y"+-- z = x -\<2\>- y+-- @+(-<) :: Graph e a -> e -> (Graph e a, e)+g -< e = (g, e)++-- | The right-hand part of a convenient ternary-ish operator @x -\<e\>- y@ for+-- connecting graphs with labelled edges. For example:+--+-- @+-- x = 'vertex' "x"+-- y = 'vertex' "y"+-- z = x -\<2\>- y+-- @+(>-) :: (Graph e a, e) -> Graph e a -> Graph e a+(g, e) >- h = Connect e g h++infixl 5 -<+infixl 5 >-++instance Dioid e => C.Graph (Graph e a) where+    type Vertex (Graph e a) = a+    empty   = Empty+    vertex  = Vertex+    overlay = overlay+    connect = connect++-- | Extract the label of a specified edge from a graph.+edgeLabel :: (Eq a, Semilattice e) => a -> a -> Graph e a -> e+edgeLabel _ _ Empty           = zero+edgeLabel _ _ (Vertex _)      = zero+edgeLabel x y (Connect e g h) = edgeLabel x y g \/ edgeLabel x y h \/ new+  where+    new | x `elem` g && y `elem` h = e+        | otherwise                = zero

@@ -36,11 +36,11 @@     vertexSet, vertexIntSet, edgeSet,      -- * Standard families of graphs-    path1, circuit1, clique1, biclique1, star, starTranspose, tree, mesh1, torus1,+    path1, circuit1, clique1, biclique1, star, stars1, tree, mesh1, torus1,      -- * Graph transformation     removeVertex1, removeEdge, replaceVertex, mergeVertices, splitVertex1,-    transpose, induce1, simplify,+    transpose, induce1, simplify, sparsify,      -- * Graph composition     box@@ -55,20 +55,18 @@  import Control.DeepSeq (NFData (..)) import Control.Monad.Compat+import Control.Monad.State (runState, get, put) import Data.List.NonEmpty (NonEmpty (..))  import Algebra.Graph.Internal -import qualified Algebra.Graph                    as G-import qualified Algebra.Graph.AdjacencyMap       as AM-import qualified Algebra.Graph.Class              as C-import qualified Algebra.Graph.HigherKinded.Class as H-import qualified Algebra.Graph.IntAdjacencyMap    as IAM-import qualified Algebra.Graph.Relation           as R-import qualified Data.IntSet                      as IntSet-import qualified Data.List.NonEmpty               as NonEmpty-import qualified Data.Set                         as Set-import qualified Data.Tree                        as Tree+import qualified Algebra.Graph                 as G+import qualified Algebra.Graph.AdjacencyIntMap as AIM+import qualified Algebra.Graph.ToGraph         as T+import qualified Data.IntSet                   as IntSet+import qualified Data.List.NonEmpty            as NonEmpty+import qualified Data.Set                      as Set+import qualified Data.Tree                     as Tree  {-| The 'NonEmptyGraph' data type is a deep embedding of the core graph construction primitives 'vertex', 'overlay' and 'connect'. As one can guess from@@ -143,12 +141,10 @@     rnf (Overlay x y) = rnf x `seq` rnf y     rnf (Connect x y) = rnf x `seq` rnf y -instance C.ToGraph (NonEmptyGraph a) where+instance T.ToGraph (NonEmptyGraph a) where     type ToVertex (NonEmptyGraph a) = a     foldg _ = foldg1--instance H.ToGraph NonEmptyGraph where-    toGraph = foldg1 H.vertex H.overlay H.connect+    hasEdge = hasEdge  instance Num a => Num (NonEmptyGraph a) where     fromInteger = Vertex . fromInteger@@ -159,8 +155,19 @@     negate      = id  instance Ord a => Eq (NonEmptyGraph a) where-    x == y = C.toGraph x == (C.toGraph y :: AM.AdjacencyMap a)+    (==) = equals +-- TODO: Find a more efficient equality check.+-- | Compare two graphs by converting them to their adjacency maps.+{-# NOINLINE [1] equals #-}+{-# RULES "equalsInt" equals = equalsInt #-}+equals :: Ord a => NonEmptyGraph a -> NonEmptyGraph a -> Bool+equals x y = T.adjacencyMap x == T.adjacencyMap y++-- | Like @equals@ but specialised for graphs with vertices of type 'Int'.+equalsInt :: NonEmptyGraph Int -> NonEmptyGraph Int -> Bool+equalsInt x y = T.adjacencyIntMap x == T.adjacencyIntMap y+ instance Applicative NonEmptyGraph where     pure  = Vertex     (<*>) = ap@@ -196,6 +203,7 @@ -- @ vertex :: a -> NonEmptyGraph a vertex = Vertex+{-# INLINE vertex #-}  -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory and size.@@ -226,6 +234,7 @@ -- @ overlay :: NonEmptyGraph a -> NonEmptyGraph a -> NonEmptyGraph a overlay = Overlay+{-# INLINE overlay #-}  -- | Overlay a possibly empty graph with a non-empty graph. If the first -- argument is 'G.empty', the function returns the second argument; otherwise@@ -260,6 +269,7 @@ -- @ connect :: NonEmptyGraph a -> NonEmptyGraph a -> NonEmptyGraph a connect = Connect+{-# INLINE connect #-}  -- | Construct the graph comprising a given list of isolated vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -273,6 +283,7 @@ -- @ vertices1 :: NonEmpty a -> NonEmptyGraph a vertices1 = overlays1 . fmap vertex+{-# NOINLINE [1] vertices1 #-}  -- | Construct the graph from a list of edges. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -283,7 +294,7 @@ -- 'edgeCount' . edges1   == 'Data.List.NonEmpty.length' . 'Data.List.NonEmpty.nub' -- @ edges1 :: NonEmpty (a, a) -> NonEmptyGraph a-edges1 = overlays1 . fmap (uncurry edge)+edges1  = overlays1 . fmap (uncurry edge)  -- | Overlay a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -294,8 +305,8 @@ -- overlays1 (x ':|' [y]) == 'overlay' x y -- @ overlays1 :: NonEmpty (NonEmptyGraph a) -> NonEmptyGraph a-overlays1 (x :| xs) = case xs of []     -> x-                                 (y:ys) -> overlay x (overlays1 $ y :| ys)+overlays1 = concatg1 overlay+{-# INLINE [2] overlays1 #-}  -- | Connect a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -306,9 +317,13 @@ -- connects1 (x ':|' [y]) == 'connect' x y -- @ connects1 :: NonEmpty (NonEmptyGraph a) -> NonEmptyGraph a-connects1 (x :| xs) = case xs of []     -> x-                                 (y:ys) -> connect x (connects1 $ y :| ys)+connects1 = concatg1 connect+{-# INLINE [2] connects1 #-} +-- | Auxiliary function, similar to 'sconcat'.+concatg1 :: (NonEmptyGraph a -> NonEmptyGraph a -> NonEmptyGraph a) -> NonEmpty (NonEmptyGraph a) -> NonEmptyGraph a+concatg1 combine (x :| xs) = maybe x (combine x) $ foldr1Safe combine xs+ -- | Generalised graph folding: recursively collapse a 'NonEmptyGraph' by -- applying the provided functions to the leaves and internal nodes of the -- expression. The order of arguments is: vertex, overlay and connect.@@ -336,6 +351,7 @@ -- isSubgraphOf ('overlay' x y) ('connect' x y) == True -- isSubgraphOf ('path1' xs)    ('circuit1' xs) == True -- @+{-# SPECIALISE isSubgraphOf :: NonEmptyGraph Int -> NonEmptyGraph Int -> Bool #-} isSubgraphOf :: Ord a => NonEmptyGraph a -> NonEmptyGraph a -> Bool isSubgraphOf x y = overlay x y == y @@ -348,6 +364,7 @@ -- 1 + 2 === 2 + 1 == False -- x + y === x * y == False -- @+{-# SPECIALISE (===) :: NonEmptyGraph Int -> NonEmptyGraph Int -> Bool #-} (===) :: Eq a => NonEmptyGraph a -> NonEmptyGraph a -> Bool (Vertex  x1   ) === (Vertex  x2   ) = x1 ==  x2 (Overlay x1 y1) === (Overlay x2 y2) = x1 === x2 && y1 === y2@@ -376,9 +393,11 @@ -- hasVertex x ('vertex' x) == True -- hasVertex 1 ('vertex' 2) == False -- @+{-# SPECIALISE hasVertex :: Int -> NonEmptyGraph Int -> Bool #-} hasVertex :: Eq a => a -> NonEmptyGraph a -> Bool hasVertex v = foldg1 (==v) (||) (||) +-- TODO: Reduce code duplication with 'Algebra.Graph.hasEdge'. -- | Check if a graph contains a given edge. -- Complexity: /O(s)/ time. --@@ -388,8 +407,19 @@ -- hasEdge x y . 'removeEdge' x y == const False -- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @-hasEdge :: Ord a => a -> a -> NonEmptyGraph a -> Bool-hasEdge u v = G.hasEdge u v . H.toGraph+{-# SPECIALISE hasEdge :: Int -> Int -> NonEmptyGraph Int -> Bool #-}+hasEdge :: Eq a => a -> a -> NonEmptyGraph a -> Bool+hasEdge s t g = hit g == Edge+  where+    hit (Vertex x   ) = if x == s then Tail else Miss+    hit (Overlay x y) = case hit x of+        Miss -> hit y+        Tail -> max Tail (hit y)+        Edge -> Edge+    hit (Connect x y) = case hit x of+        Miss -> hit y+        Tail -> if hasVertex t y then Edge else Tail+        Edge -> Edge  -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time.@@ -399,9 +429,15 @@ -- vertexCount x          >= 1 -- vertexCount            == 'length' . 'vertexList1' -- @+{-# RULES "vertexCount/Int" vertexCount = vertexIntCount #-}+{-# INLINE [1] vertexCount #-} vertexCount :: Ord a => NonEmptyGraph a -> Int-vertexCount = length . vertexList1+vertexCount = T.vertexCount +-- | Like 'vertexCount' but specialised for NonEmptyGraph with vertices of type 'Int'.+vertexIntCount :: NonEmptyGraph Int -> Int+vertexIntCount = IntSet.size . vertexIntSet+ -- | The number of edges in a graph. -- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a -- graph can be quadratic with respect to the expression size /s/.@@ -411,9 +447,15 @@ -- edgeCount ('edge' x y) == 1 -- edgeCount            == 'length' . 'edgeList' -- @+{-# INLINE [1] edgeCount #-}+{-# RULES "edgeCount/Int" edgeCount = edgeCountInt #-} edgeCount :: Ord a => NonEmptyGraph a -> Int-edgeCount = AM.edgeCount . C.toGraph+edgeCount = T.edgeCount +-- | Like 'edgeCount' but specialised for graphs with vertices of type 'Int'.+edgeCountInt :: NonEmptyGraph Int -> Int+edgeCountInt = AIM.edgeCount . T.toAdjacencyIntMap+ -- | The sorted list of vertices of a given graph. -- Complexity: /O(s * log(n))/ time and /O(n)/ memory. --@@ -421,9 +463,15 @@ -- vertexList1 ('vertex' x)  == x ':|' [] -- vertexList1 . 'vertices1' == 'Data.List.NonEmpty.nub' . 'Data.List.NonEmpty.sort' -- @+{-# RULES "vertexList1/Int" vertexList1 = vertexIntList1 #-}+{-# INLINE [1] vertexList1 #-} vertexList1 :: Ord a => NonEmptyGraph a -> NonEmpty a-vertexList1 = NonEmpty.fromList . G.vertexList . H.toGraph+vertexList1 = NonEmpty.fromList . Set.toAscList . vertexSet +-- | Like 'vertexList1' but specialised for NonEmptyGraph with vertices of type 'Int'.+vertexIntList1 :: NonEmptyGraph Int -> NonEmpty Int+vertexIntList1 = NonEmpty.fromList . IntSet.toAscList . vertexIntSet+ -- | The sorted list of edges of a graph. -- Complexity: /O(s + m * log(m))/ time and /O(m)/ memory. Note that the number of -- edges /m/ of a graph can be quadratic with respect to the expression size /s/.@@ -435,9 +483,15 @@ -- edgeList . 'edges1'       == 'Data.List.nub' . 'Data.List.sort' . 'Data.List.NonEmpty.toList' -- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList -- @+{-# RULES "edgeList/Int" edgeList = edgeIntList #-}+{-# INLINE [1] edgeList #-} edgeList :: Ord a => NonEmptyGraph a -> [(a, a)]-edgeList = AM.edgeList . C.toGraph+edgeList = T.edgeList +-- | Like 'edgeList' but specialised for NonEmptyGraph with vertices of type 'Int'.+edgeIntList :: NonEmptyGraph Int -> [(Int,Int)]+edgeIntList = AIM.edgeList . T.toAdjacencyIntMap+ -- | The set of vertices of a given graph. -- Complexity: /O(s * log(n))/ time and /O(n)/ memory. --@@ -447,7 +501,7 @@ -- vertexSet . 'clique1'   == Set.'Set.fromList' . 'Data.List.NonEmpty.toList' -- @ vertexSet :: Ord a => NonEmptyGraph a -> Set.Set a-vertexSet = AM.vertexSet . C.toGraph+vertexSet = T.vertexSet  -- | The set of vertices of a given graph. Like 'vertexSet' but specialised for -- graphs with vertices of type 'Int'.@@ -459,7 +513,7 @@ -- vertexIntSet . 'clique1'   == IntSet.'IntSet.fromList' . 'Data.List.NonEmpty.toList' -- @ vertexIntSet :: NonEmptyGraph Int -> IntSet.IntSet-vertexIntSet = IAM.vertexIntSet . C.toGraph+vertexIntSet = T.vertexIntSet  -- | The set of edges of a given graph. -- Complexity: /O(s * log(m))/ time and /O(m)/ memory.@@ -470,7 +524,7 @@ -- edgeSet . 'edges1'   == Set.'Set.fromList' . 'Data.List.NonEmpty.toList' -- @ edgeSet :: Ord a => NonEmptyGraph a -> Set.Set (a, a)-edgeSet = R.edgeSet . C.toGraph+edgeSet = T.edgeSet  -- | The /path/ on a list of vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -510,6 +564,7 @@ -- @ clique1 :: NonEmpty a -> NonEmptyGraph a clique1 = connects1 . fmap vertex+{-# NOINLINE [1] clique1 #-}  -- | The /biclique/ on two lists of vertices. -- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the@@ -534,20 +589,22 @@ star :: a -> [a] -> NonEmptyGraph a star x []     = vertex x star x (y:ys) = connect (vertex x) (vertices1 $ y :| ys)+{-# INLINE star #-} --- | The /star transpose/ formed by a list of leaves connected to a centre vertex.--- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the--- given list.+-- | The /stars/ formed by overlaying a non-empty list of 'star's.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the total size of the+-- input. -- -- @--- starTranspose x []    == 'vertex' x--- starTranspose x [y]   == 'edge' y x--- starTranspose x [y,z] == 'edges1' ((y,x) ':|' [(z,x)])--- starTranspose x ys    == 'transpose' ('star' x ys)+-- stars1 ((x, [])  ':|' [])         == 'vertex' x+-- stars1 ((x, [y]) ':|' [])         == 'edge' x y+-- stars1 ((x, ys)  ':|' [])         == 'star' x ys+-- stars1                          == 'overlays1' . fmap (uncurry 'star')+-- 'overlay' (stars1 xs) (stars1 ys) == stars1 (xs <> ys) -- @-starTranspose :: a -> [a] -> NonEmptyGraph a-starTranspose x []     = vertex x-starTranspose x (y:ys) = connect (vertices1 $ y :| ys) (vertex x)+stars1 :: NonEmpty (a, [a]) -> NonEmptyGraph a+stars1 = overlays1 . fmap (uncurry star)+{-# INLINE stars1 #-}  -- | The /tree graph/ constructed from a given 'Tree.Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the@@ -575,14 +632,34 @@ --                                                     , ((3,\'a\'),(3,\'b\')) ]) -- @ mesh1 :: NonEmpty a -> NonEmpty b -> NonEmptyGraph (a, b)-mesh1 xs ys = path1 xs `box` path1 ys+mesh1 xx@(x:|xs) yy@(y:|ys) =+  case NonEmpty.nonEmpty ipxs of+    Nothing ->+      case NonEmpty.nonEmpty ipys of+        Nothing    -> vertex (x,y)+        Just ipys' ->+          stars1 $ fmap (\(y1,y2) -> ((x,y1), [(x,y2)]) ) ipys'+    Just ipxs' ->+      case NonEmpty.nonEmpty ipys of+        Nothing ->+          stars1 $ fmap (\(x1,x2) -> ((x1,y), [(x2,y)]) ) ipxs'+        Just ipys' ->+          stars1 $+            appendNonEmpty (fmap (\((a1,a2),(b1,b2)) -> ((a1, b1), [(a1, b2), (a2, b1)])) $ liftM2 (,) ipxs' ipys') $+              [ ((lx,y1), [(lx,y2)]) | (y1,y2) <- ipys]+           ++ [ ((x1,ly), [(x2,ly)]) | (x1,x2) <- ipxs]+  where+    lx = last xs+    ly = last ys+    ipxs = NonEmpty.init (pairs1 xx)+    ipys = NonEmpty.init (pairs1 yy)  -- | Construct a /torus graph/ from two lists of vertices. -- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the -- lengths of the given lists. -- -- @--- torus1 (x ':|' [])  (y ':|' [])    == 'edge' (x, y) (x, y)+-- torus1 (x ':|' [])  (y ':|' [])    == 'edge' (x,y) (x,y) -- torus1 xs         ys           == 'box' ('circuit1' xs) ('circuit1' ys) -- torus1 (1 ':|' [2]) (\'a\' ':|' "b") == 'edges1' ('Data.List.NonEmpty.fromList' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')) --                                                    , ((1,\'b\'),(1,\'a\')), ((1,\'b\'),(2,\'b\'))@@ -590,8 +667,16 @@ --                                                    , ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ]) -- @ torus1 :: NonEmpty a -> NonEmpty b -> NonEmptyGraph (a, b)-torus1 xs ys = circuit1 xs `box` circuit1 ys+torus1 xs ys = stars1 $ fmap (\((a1,a2),(b1,b2)) -> ((a1, b1), [(a1, b2), (a2, b1)])) $ liftM2 (,) (pairs1 xs) (pairs1 ys) +-- | Auxiliary function for 'mesh1' and 'torus1'+pairs1 :: NonEmpty a -> NonEmpty (a, a)+pairs1 as@(x:|xs) = NonEmpty.zip as $ maybe (x :| []) (`appendNonEmpty` [x]) $ NonEmpty.nonEmpty xs++-- | Append a list to a non-empty one+appendNonEmpty :: NonEmpty a -> [a] -> NonEmpty a+appendNonEmpty (w:|ws) zs = w :| (ws++zs)+ -- | Remove a vertex from a given graph. Returns @Nothing@ if the resulting -- graph is empty. -- Complexity: /O(s)/ time, memory and size.@@ -603,6 +688,7 @@ -- removeVertex1 1 ('edge' 1 2)          == Just ('vertex' 2) -- removeVertex1 x '>=>' removeVertex1 x == removeVertex1 x -- @+{-# SPECIALISE removeVertex1 :: Int -> NonEmptyGraph Int -> Maybe (NonEmptyGraph Int) #-} removeVertex1 :: Eq a => a -> NonEmptyGraph a -> Maybe (NonEmptyGraph a) removeVertex1 x = induce1 (/= x) @@ -616,17 +702,17 @@ -- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2 -- 'size' (removeEdge x y z)         <= 3 * 'size' z -- @+{-# SPECIALISE removeEdge :: Int -> Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-} removeEdge :: Eq a => a -> a -> NonEmptyGraph a -> NonEmptyGraph a removeEdge s t = filterContext s (/=s) (/=t)  -- TODO: Export--- TODO: Here if @context (==s) g == Just ctx@ then we know for sure that--- @induce1 (/=s) g == Just subgraph@. Can we exploit this?+{-# SPECIALISE filterContext :: Int -> (Int -> Bool) -> (Int -> Bool) -> NonEmptyGraph Int -> NonEmptyGraph Int #-} filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> NonEmptyGraph a -> NonEmptyGraph a-filterContext s i o g = maybe g go $ context (==s) g+filterContext s i o g = maybe g go $ G.context (==s) (T.toGraph g)   where-    go (Context is os) = G.induce (/=s) (C.toGraph g)  `overlay1`-                         starTranspose s (filter i is) `overlay` star s (filter o os)+    go (G.Context is os) = G.induce (/=s) (T.toGraph g)     `overlay1`+                           transpose (star s (filter i is)) `overlay` star s (filter o os)  -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'NonEmptyGraph'. If @y@ already exists, @x@ and @y@ will be merged.@@ -637,6 +723,7 @@ -- replaceVertex x y ('vertex' x) == 'vertex' y -- replaceVertex x y            == 'mergeVertices' (== x) y -- @+{-# SPECIALISE replaceVertex :: Int -> Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-} replaceVertex :: Eq a => a -> a -> NonEmptyGraph a -> NonEmptyGraph a replaceVertex u v = fmap $ \w -> if w == u then v else w @@ -663,6 +750,7 @@ -- splitVertex1 x (y ':|' [] )               == 'replaceVertex' x y -- splitVertex1 1 (0 ':|' [1]) $ 1 * (2 + 3) == (0 + 1) * (2 + 3) -- @+{-# SPECIALISE splitVertex1 :: Int -> NonEmpty Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-} splitVertex1 :: Eq a => a -> NonEmpty a -> NonEmptyGraph a -> NonEmptyGraph a splitVertex1 v us g = g >>= \w -> if w == v then vertices1 us else vertex w @@ -678,7 +766,20 @@ -- @ transpose :: NonEmptyGraph a -> NonEmptyGraph a transpose = foldg1 vertex overlay (flip connect)+{-# NOINLINE [1] transpose #-} +{-# RULES+"transpose/Vertex"   forall x. transpose (Vertex x) = Vertex x+"transpose/Overlay"  forall g1 g2. transpose (Overlay g1 g2) = Overlay (transpose g1) (transpose g2)+"transpose/Connect"  forall g1 g2. transpose (Connect g1 g2) = Connect (transpose g2) (transpose g1)++"transpose/overlays1" forall xs. transpose (overlays1 xs) = overlays1 (fmap transpose xs)+"transpose/connects1" forall xs. transpose (connects1 xs) = connects1 (NonEmpty.reverse (fmap transpose xs))++"transpose/vertices1" forall xs. transpose (vertices1 xs) = vertices1 xs+"transpose/clique1"   forall xs. transpose (clique1 xs) = clique1 (NonEmpty.reverse xs)+ #-}+ -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate. Returns @Nothing@ if the -- resulting graph is empty.@@ -692,7 +793,14 @@ -- induce1 p '>=>' induce1 q == induce1 (\\x -> p x && q x) -- @ induce1 :: (a -> Bool) -> NonEmptyGraph a -> Maybe (NonEmptyGraph a)-induce1 p = toNonEmptyGraph . G.induce p . C.toGraph+induce1 p = foldg1+  (\x -> if p x then Just (Vertex x) else Nothing)+  (k Overlay)+  (k Connect)+  where+    k _ Nothing a = a+    k _ a Nothing = a+    k f (Just a) (Just b) = Just $ f a b  -- | Simplify a graph expression. Semantically, this is the identity function, -- but it simplifies a given expression according to the laws of the algebra.@@ -709,9 +817,11 @@ -- simplify (1 + 2 + 1) '===' 1 + 2 -- simplify (1 * 1 * 1) '===' 1 * 1 -- @+{-# SPECIALISE simplify :: NonEmptyGraph Int -> NonEmptyGraph Int #-} simplify :: Ord a => NonEmptyGraph a -> NonEmptyGraph a simplify = foldg1 Vertex (simple Overlay) (simple Connect) +{-# SPECIALISE simple :: (NonEmptyGraph Int -> NonEmptyGraph Int -> NonEmptyGraph Int) -> NonEmptyGraph Int -> NonEmptyGraph Int -> NonEmptyGraph Int #-} simple :: Eq g => (g -> g -> g) -> g -> g -> g simple op x y     | x == z    = x@@ -749,6 +859,32 @@   where     xs = fmap (\b -> fmap (,b) x) $ toNonEmpty y     ys = fmap (\a -> fmap (a,) y) $ toNonEmpty x++-- | /Sparsify/ a graph by adding intermediate 'Left' @Int@ vertices between the+-- original vertices (wrapping the latter in 'Right') such that the resulting+-- graph is /sparse/, i.e. contains only O(s) edges, but preserves the+-- reachability relation between the original vertices. Sparsification is useful+-- when working with dense graphs, as it can reduce the number of edges from+-- O(n^2) down to O(n) by replacing cliques, bicliques and similar densely+-- connected structures by sparse subgraphs built out of intermediate vertices.+-- Complexity: O(s) time, memory and size.+--+-- @+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x       == 'Data.List.sort' . 'Data.Either.rights' . 'Algebra.Graph.ToGraph.reachable' ('Data.Either.Right' x) . sparsify+-- 'vertexCount' (sparsify x) <= 'vertexCount' x + 'size' x + 1+-- 'edgeCount'   (sparsify x) <= 3 * 'size' x+-- 'size'        (sparsify x) <= 3 * 'size' x+-- @+sparsify :: NonEmptyGraph a -> NonEmptyGraph (Either Int a)+sparsify graph = res+  where+    (res, end) = runState (foldg1 v o c graph 0 end) 1+    v x   s t  = return $ clique1 (Left s :| [Right x, Left t])+    o x y s t  = overlay <$> s `x` t <*> s `y` t+    c x y s t  = do+        m <- get+        put (m + 1)+        overlay <$> s `x` m <*> m `y` t  -- Shall we export this? I suggest to wait for Foldable1 type class instead. toNonEmpty :: NonEmptyGraph a -> NonEmpty a

@@ -20,17 +20,16 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    fromAdjacencyList,      -- * Relations on graphs     isSubgraphOf,      -- * Graph properties     isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,-    vertexSet, vertexIntSet, edgeSet, preSet, postSet,+    adjacencyList, vertexSet, vertexIntSet, edgeSet, preSet, postSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, starTranspose, tree, forest,+    path, circuit, clique, biclique, star, stars, tree, forest,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,@@ -42,38 +41,14 @@ import Prelude () import Prelude.Compat +import Data.Tree import Data.Tuple  import Algebra.Graph.Relation.Internal -import qualified Algebra.Graph.Class as C-import qualified Data.IntSet         as IntSet-import qualified Data.Set            as Set-import qualified Data.Tree           as Tree---- | Construct the /empty graph/.--- Complexity: /O(1)/ time and memory.------ @--- 'isEmpty'     empty == True--- 'hasVertex' x empty == False--- 'vertexCount' empty == 0--- 'edgeCount'   empty == 0--- @-empty :: Ord a => Relation a-empty = C.empty---- | Construct the graph comprising /a single isolated vertex/.--- Complexity: /O(1)/ time and memory.------ @--- 'isEmpty'     (vertex x) == False--- 'hasVertex' x (vertex x) == True--- 'vertexCount' (vertex x) == 1--- 'edgeCount'   (vertex x) == 0--- @-vertex :: Ord a => a -> Relation a-vertex = C.vertex+import qualified Data.IntSet as IntSet+import qualified Data.Set    as Set+import qualified Data.Tree   as Tree  -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory and size.@@ -86,45 +61,7 @@ -- 'vertexCount' (edge 1 2) == 2 -- @ edge :: Ord a => a -> a -> Relation a-edge = C.edge---- | /Overlay/ two graphs. This is a commutative, associative and idempotent--- operation with the identity 'empty'.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y--- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y--- 'vertexCount' (overlay x y) >= 'vertexCount' x--- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y--- 'edgeCount'   (overlay x y) >= 'edgeCount' x--- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y--- 'vertexCount' (overlay 1 2) == 2--- 'edgeCount'   (overlay 1 2) == 0--- @-overlay :: Ord a => Relation a -> Relation a -> Relation a-overlay = C.overlay---- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the--- number of edges in the resulting graph is quadratic with respect to the number--- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.------ @--- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y--- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y--- 'vertexCount' (connect x y) >= 'vertexCount' x--- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y--- 'edgeCount'   (connect x y) >= 'edgeCount' x--- 'edgeCount'   (connect x y) >= 'edgeCount' y--- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y--- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y--- 'vertexCount' (connect 1 2) == 2--- 'edgeCount'   (connect 1 2) == 1--- @-connect :: Ord a => Relation a -> Relation a -> Relation a-connect = C.connect+edge x y = Relation (Set.fromList [x, y]) (Set.singleton (x, y))  -- | Construct the graph comprising a given list of isolated vertices. -- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length@@ -162,7 +99,7 @@ -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: Ord a => [Relation a] -> Relation a-overlays = C.overlays+overlays xs = Relation (Set.unions $ map domain xs) (Set.unions $ map relation xs)  -- | Connect a given list of graphs. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -175,22 +112,7 @@ -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: Ord a => [Relation a] -> Relation a-connects = C.connects---- | Construct a graph from an adjacency list.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- fromAdjacencyList []                                  == 'empty'--- fromAdjacencyList [(x, [])]                           == 'vertex' x--- fromAdjacencyList [(x, [y])]                          == 'edge' x y--- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--- @-fromAdjacencyList :: Ord a => [(a, [a])] -> Relation a-fromAdjacencyList as = Relation (Set.fromList vs) (Set.fromList es)-  where-    vs = concatMap (uncurry (:)) as-    es = [ (x, y) | (x, ys) <- as, y <- ys ]+connects = foldr connect empty  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second.@@ -329,7 +251,24 @@ edgeSet :: Relation a -> Set.Set (a, a) edgeSet = relation --- | The /preset/ (here 'preSet') of an element @x@ is the set of elements that are related to+-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- adjacencyList 'empty'          == []+-- adjacencyList ('vertex' x)     == [(x, [])]+-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]+-- 'stars' . adjacencyList        == id+-- @+adjacencyList :: Eq a => Relation a -> [(a, [a])]+adjacencyList r = go (Set.toAscList $ domain r) (Set.toAscList $ relation r)+  where+    go [] _      = []+    go vs []     = map ((,[])) vs+    go (x:vs) es = let (ys, zs) = span ((==x) . fst) es in (x, map snd ys) : go vs zs++-- | The /preset/ of an element @x@ is the set of elements that are related to -- it on the /left/, i.e. @preSet x == { a | aRx }@. In the context of directed -- graphs, this corresponds to the set of /direct predecessors/ of vertex @x@. -- Complexity: /O(n + m)/ time and /O(n)/ memory.@@ -343,7 +282,7 @@ preSet :: Ord a => a -> Relation a -> Set.Set a preSet x = Set.mapMonotonic fst . Set.filter ((== x) . snd) . relation --- | The /postset/ (here 'postSet') of an element @x@ is the set of elements that are related to+-- | The /postset/ of an element @x@ is the set of elements that are related to -- it on the /right/, i.e. @postSet x == { a | xRa }@. In the context of directed -- graphs, this corresponds to the set of /direct successors/ of vertex @x@. -- Complexity: /O(n + m)/ time and /O(n)/ memory.@@ -367,7 +306,9 @@ -- path . 'reverse' == 'transpose' . path -- @ path :: Ord a => [a] -> Relation a-path = C.path+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)  -- | The /circuit/ on a list of vertices. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -379,7 +320,8 @@ -- circuit . 'reverse' == 'transpose' . circuit -- @ circuit :: Ord a => [a] -> Relation a-circuit = C.circuit+circuit []     = empty+circuit (x:xs) = path $ [x] ++ xs ++ [x]  -- | The /clique/ on a list of vertices. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -393,7 +335,12 @@ -- clique . 'reverse'  == 'transpose' . clique -- @ clique :: Ord a => [a] -> Relation a-clique = C.clique+clique xs = Relation (Set.fromList xs) (fst $ go xs)+  where+    go []     = (Set.empty, Set.empty)+    go (x:xs) = (Set.union res (Set.map (x,) set), Set.insert x set)+      where+        (res, set) = go xs  -- | The /biclique/ on two lists of vertices. -- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory.@@ -411,6 +358,7 @@     x = Set.fromList xs     y = Set.fromList ys +-- TODO: Optimise. -- | The /star/ formed by a centre vertex connected to a list of leaves. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -421,21 +369,28 @@ -- star x ys    == 'connect' ('vertex' x) ('vertices' ys) -- @ star :: Ord a => a -> [a] -> Relation a-star = C.star+star x [] = vertex x+star x ys = connect (vertex x) (vertices ys) --- | The /star transpose/ formed by a list of leaves connected to a centre vertex.--- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the--- given list.+-- | The /stars/ formed by overlaying a list of 'star's. An inverse of+-- 'adjacencyList'.+-- Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total+-- size of the input. -- -- @--- starTranspose x []    == 'vertex' x--- starTranspose x [y]   == 'edge' y x--- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]--- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)--- starTranspose x ys    == 'transpose' ('star' x ys)+-- stars []                      == 'empty'+-- stars [(x, [])]               == 'vertex' x+-- stars [(x, [y])]              == 'edge' x y+-- stars [(x, ys)]               == 'star' x ys+-- stars                         == 'overlays' . map (uncurry 'star')+-- stars . 'adjacencyList'         == id+-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys) -- @-starTranspose :: Ord a => a -> [a] -> Relation a-starTranspose = C.starTranspose+stars :: Ord a => [(a, [a])] -> Relation a+stars as = Relation (Set.fromList vs) (Set.fromList es)+  where+    vs = concatMap (uncurry (:)) as+    es = [ (x, y) | (x, ys) <- as, y <- ys ]  -- | The /tree graph/ constructed from a given 'Tree.Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -447,7 +402,9 @@ -- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] -- @ tree :: Ord a => Tree.Tree a -> Relation a-tree = C.tree+tree (Node x []) = vertex x+tree (Node x f ) = star x (map rootLabel f)+    `overlay` forest (filter (not . null . subForest) f)  -- | The /forest graph/ constructed from a given 'Tree.Forest' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -459,7 +416,7 @@ -- forest                                                     == 'overlays' . map 'tree' -- @ forest :: Ord a => Tree.Forest a -> Relation a-forest = C.forest+forest = overlays. map tree  -- | Remove a vertex from a given graph. -- Complexity: /O(n + m)/ time.@@ -480,7 +437,7 @@ -- Complexity: /O(log(m))/ time. -- -- @--- removeEdge x y ('AdjacencyMap.edge' x y)       == 'vertices' [x, y]+-- removeEdge x y ('AdjacencyMap.edge' x y)       == 'vertices' [x,y] -- removeEdge x y . removeEdge x y == removeEdge x y -- removeEdge x y . 'removeVertex' x == 'removeVertex' x -- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2

@@ -12,15 +12,16 @@ ----------------------------------------------------------------------------- module Algebra.Graph.Relation.Internal (     -- * Binary relation implementation-    Relation (..), consistent, setProduct, referredToVertexSet+    Relation (..), empty, vertex, overlay, connect, setProduct, consistent,+    referredToVertexSet   ) where  import Data.Set (Set, union) -import Algebra.Graph.Class- import qualified Data.Set as Set +import Control.DeepSeq (NFData, rnf)+ {-| The 'Relation' data type represents a graph as a /binary relation/. We define a 'Num' instance as a convenient notation for working with graphs: @@ -102,14 +103,72 @@         eshow xs       = "edges "    ++ show xs         used           = referredToVertexSet r -instance Ord a => Graph (Relation a) where-    type Vertex (Relation a) = a-    empty       = Relation Set.empty Set.empty-    vertex x    = Relation (Set.singleton x) Set.empty-    overlay x y = Relation (domain x `union` domain y) (relation x `union` relation y)-    connect x y = Relation (domain x `union` domain y) (relation x `union` relation y-        `union` (domain x `setProduct` domain y))+-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.Relation.isEmpty'     empty == True+-- 'Algebra.Graph.Relation.hasVertex' x empty == False+-- 'Algebra.Graph.Relation.vertexCount' empty == 0+-- 'Algebra.Graph.Relation.edgeCount'   empty == 0+-- @+empty :: Relation a+empty = Relation Set.empty Set.empty +-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.Relation.isEmpty'     (vertex x) == False+-- 'Algebra.Graph.Relation.hasVertex' x (vertex x) == True+-- 'Algebra.Graph.Relation.vertexCount' (vertex x) == 1+-- 'Algebra.Graph.Relation.edgeCount'   (vertex x) == 0+-- @+vertex :: a -> Relation a+vertex x = Relation (Set.singleton x) Set.empty++-- | /Overlay/ two graphs. This is a commutative, associative and idempotent+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'Algebra.Graph.Relation.isEmpty'     (overlay x y) == 'Algebra.Graph.Relation.isEmpty'   x   && 'iAlgebra.Graph.Relation.sEmpty'   y+-- 'Algebra.Graph.Relation.hasVertex' z (overlay x y) == 'Algebra.Graph.Relation.hasVertex' z x || 'Algebra.Graph.Relation.hasVertex' z y+-- 'Algebra.Graph.Relation.vertexCount' (overlay x y) >= 'Algebra.Graph.Relation.vertexCount' x+-- 'Algebra.Graph.Relation.vertexCount' (overlay x y) <= 'Algebra.Graph.Relation.vertexCount' x + 'Algebra.Graph.Relation.vertexCount' y+-- 'Algebra.Graph.Relation.edgeCount'   (overlay x y) >= 'Algebra.Graph.Relation.edgeCount' x+-- 'Algebra.Graph.Relation.edgeCount'   (overlay x y) <= 'Algebra.Graph.Relation.edgeCount' x   + 'Algebra.Graph.Relation.edgeCount' y+-- 'Algebra.Graph.Relation.vertexCount' (overlay 1 2) == 2+-- 'Algebra.Graph.Relation.edgeCount'   (overlay 1 2) == 0+-- @+overlay :: Ord a => Relation a -> Relation a -> Relation a+overlay x y = Relation (domain x `union` domain y) (relation x `union` relation y)++-- | /Connect/ two graphs. This is an associative operation with the identity+-- 'empty', which distributes over 'overlay' and obeys the decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- 'Algebra.Graph.Relation.isEmpty'     (connect x y) == 'Algebra.Graph.Relation.isEmpty'   x   && 'Algebra.Graph.Relation.isEmpty'   y+-- 'Algebra.Graph.Relation.hasVertex' z (connect x y) == 'Algebra.Graph.Relation.hasVertex' z x || 'Algebra.Graph.Relation.hasVertex' z y+-- 'Algebra.Graph.Relation.vertexCount' (connect x y) >= 'Algebra.Graph.Relation.vertexCount' x+-- 'Algebra.Graph.Relation.vertexCount' (connect x y) <= 'Algebra.Graph.Relation.vertexCount' x + 'Algebra.Graph.Relation.vertexCount' y+-- 'Algebra.Graph.Relation.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.edgeCount' x+-- 'Algebra.Graph.Relation.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.edgeCount' y+-- 'Algebra.Graph.Relation.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.vertexCount' x * 'Algebra.Graph.Relation.vertexCount' y+-- 'Algebra.Graph.Relation.edgeCount'   (connect x y) <= 'Algebra.Graph.Relation.vertexCount' x * 'Algebra.Graph.Relation.vertexCount' y + 'Algebra.Graph.Relation.edgeCount' x + 'Algebra.Graph.Relation.edgeCount' y+-- 'Algebra.Graph.Relation.vertexCount' (connect 1 2) == 2+-- 'Algebra.Graph.Relation.edgeCount'   (connect 1 2) == 1+-- @+connect :: Ord a => Relation a -> Relation a -> Relation a+connect x y = Relation (domain x `union` domain y)+    (relation x `union` relation y `union` (domain x `setProduct` domain y))++instance NFData a => NFData (Relation a) where+    rnf (Relation d r) = rnf d `seq` rnf r `seq` ()+ -- | Compute the Cartesian product of two sets. /Note: this function is for internal use only/. setProduct :: Set a -> Set b -> Set (a, b) setProduct x y = Set.fromDistinctAscList [ (a, b) | a <- Set.toAscList x, b <- Set.toAscList y ]@@ -122,10 +181,6 @@     abs         = id     negate      = id -instance ToGraph (Relation a) where-    type ToVertex (Relation a) = a-    toGraph (Relation d r) = vertices (Set.toList d) `overlay` edges (Set.toList r)- -- | Check if the internal representation of a relation is consistent, i.e. if all -- pairs of elements in the 'relation' refer to existing elements in the 'domain'. -- It should be impossible to create an inconsistent 'Relation', and we use this@@ -133,14 +188,13 @@ -- /Note: this function is for internal use only/. -- -- @--- consistent 'Algebra.Graph.Relation.empty'                  == True--- consistent ('Algebra.Graph.Relation.vertex' x)             == True--- consistent ('Algebra.Graph.Relation.overlay' x y)          == True--- consistent ('Algebra.Graph.Relation.connect' x y)          == True--- consistent ('Algebra.Graph.Relation.edge' x y)             == True--- consistent ('Algebra.Graph.Relation.edges' xs)             == True--- consistent ('Algebra.Graph.Relation.graph' xs ys)          == True--- consistent ('Algebra.Graph.Relation.fromAdjacencyList' xs) == True+-- consistent 'Algebra.Graph.Relation.empty'         == True+-- consistent ('Algebra.Graph.Relation.vertex' x)    == True+-- consistent ('Algebra.Graph.Relation.overlay' x y) == True+-- consistent ('Algebra.Graph.Relation.connect' x y) == True+-- consistent ('Algebra.Graph.Relation.edge' x y)    == True+-- consistent ('Algebra.Graph.Relation.edges' xs)    == True+-- consistent ('Algebra.Graph.Relation.stars' xs)    == True -- @ consistent :: Ord a => Relation a -> Bool consistent (Relation d r) = referredToVertexSet r `Set.isSubsetOf` d

@@ -18,6 +18,9 @@     PreorderRelation (..)   ) where ++import Control.DeepSeq (NFData (..))+ import Algebra.Graph.Class import Algebra.Graph.Relation (Relation, reflexiveClosure, symmetricClosure,                                transitiveClosure, preorderClosure)@@ -34,7 +37,7 @@ show (1 * 2 :: ReflexiveRelation Int) == "edges [(1,1),(1,2),(2,2)]"@ -} newtype ReflexiveRelation a = ReflexiveRelation { fromReflexive :: Relation a }-    deriving Num+    deriving (Num, NFData)  instance Ord a => Eq (ReflexiveRelation a) where     x == y = reflexiveClosure (fromReflexive x) == reflexiveClosure (fromReflexive y)@@ -65,7 +68,7 @@ show (1 * 2 :: SymmetricRelation Int) == "edges [(1,2),(2,1)]"@ -} newtype SymmetricRelation a = SymmetricRelation { fromSymmetric :: Relation a }-    deriving Num+    deriving (Num, NFData)  instance Ord a => Eq (SymmetricRelation a) where     x == y = symmetricClosure (fromSymmetric x) == symmetricClosure (fromSymmetric y)@@ -100,7 +103,7 @@ show (1 * 2 + 2 * 3 :: TransitiveRelation Int) == "edges [(1,2),(1,3),(2,3)]"@ -} newtype TransitiveRelation a = TransitiveRelation { fromTransitive :: Relation a }-    deriving Num+    deriving (Num, NFData)  instance Ord a => Eq (TransitiveRelation a) where     x == y = transitiveClosure (fromTransitive x) == transitiveClosure (fromTransitive y)@@ -140,7 +143,7 @@ show (1 * 2 + 2 * 3 :: PreorderRelation Int) == "edges [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]"@ -} newtype PreorderRelation a = PreorderRelation { fromPreorder :: Relation a }-    deriving Num+    deriving (Num, NFData)  instance (Ord a, Show a) => Show (PreorderRelation a) where     show = show . preorderClosure . fromPreorder

@@ -0,0 +1,452 @@+{-# LANGUAGE ConstrainedClassMethods #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.ToGraph+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module defines the type class 'ToGraph' for capturing data types that+-- can be converted to algebraic graphs. To make an instance of this class you+-- need to define just a single method ('toGraph' or 'foldg'), which gives you+-- access to many other useful methods for free. This type class is similar to+-- the standard "Data.Foldable" defined for lists.+--+-----------------------------------------------------------------------------+module Algebra.Graph.ToGraph (ToGraph (..)) where++import Prelude ()+import Prelude.Compat++import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Map    (Map)+import Data.Set    (Set)+import Data.Tree++import qualified Algebra.Graph                          as G+import qualified Algebra.Graph.AdjacencyMap             as AM+import qualified Algebra.Graph.AdjacencyMap.Internal    as AM+import qualified Algebra.Graph.AdjacencyIntMap          as AIM+import qualified Algebra.Graph.AdjacencyIntMap.Internal as AIM+import qualified Algebra.Graph.Relation                 as R+import qualified Data.IntMap                            as IntMap+import qualified Data.IntSet                            as IntSet+import qualified Data.Map                               as Map+import qualified Data.Set                               as Set++-- | The 'ToGraph' type class captures data types that can be converted to+-- algebraic graphs.+class ToGraph t where+    {-# MINIMAL toGraph | foldg #-}+    type ToVertex t++    -- | Convert a value to the corresponding algebraic graph, see "Algebra.Graph".+    --+    -- @+    -- toGraph == 'foldg' 'G.Empty' 'G.Vertex' 'G.Overlay' 'G.Connect'+    -- @+    toGraph :: t -> G.Graph (ToVertex t)+    toGraph = foldg G.Empty G.Vertex G.Overlay G.Connect++    -- | The method 'foldg' is used for generalised graph folding. It collapses+    -- a given value by applying the provided graph construction primitives. The+    -- order of arguments is: empty, vertex, overlay and connect, and it is+    -- assumed that the arguments satisfy the axioms of the graph algebra.+    --+    -- @+    -- foldg == Algebra.Graph.'G.foldg' . 'toGraph'+    -- @+    foldg :: r -> (ToVertex t -> r) -> (r -> r -> r) -> (r -> r -> r) -> t -> r+    foldg e v o c = G.foldg e v o c . toGraph++    -- | Check if a graph is empty.+    --+    -- @+    -- isEmpty == 'foldg' True (const False) (&&) (&&)+    -- @+    isEmpty :: t -> Bool+    isEmpty = foldg True (const False) (&&) (&&)++    -- | The /size/ of a graph, i.e. the number of leaves of the expression+    -- including 'empty' leaves.+    --+    -- @+    -- size == 'foldg' 1 (const 1) (+) (+)+    -- @+    size :: t -> Int+    size = foldg 1 (const 1) (+) (+)++    -- | Check if a graph contains a given vertex.+    --+    -- @+    -- hasVertex x == 'foldg' False (==x) (||) (||)+    -- @+    hasVertex :: Eq (ToVertex t) => ToVertex t -> t -> Bool+    hasVertex x = foldg False (==x) (||) (||)++    -- | Check if a graph contains a given edge.+    --+    -- @+    -- hasEdge x y == Algebra.Graph.'G.hasEdge' x y . 'toGraph'+    -- @+    hasEdge :: Eq (ToVertex t) => ToVertex t -> ToVertex t -> t -> Bool+    hasEdge x y = G.hasEdge x y . toGraph++    -- | The number of vertices in a graph.+    --+    -- @+    -- vertexCount == Set.'Set.size' . 'vertexSet'+    -- @+    vertexCount :: Ord (ToVertex t) => t -> Int+    vertexCount = Set.size . vertexSet++    -- | The number of edges in a graph.+    --+    -- @+    -- edgeCount == Set.'Set.size' . 'edgeSet'+    -- @+    edgeCount :: Ord (ToVertex t) => t -> Int+    edgeCount = AM.edgeCount . toAdjacencyMap++    -- | The sorted list of vertices of a given graph.+    --+    -- @+    -- vertexList == Set.'Set.toAscList' . 'vertexSet'+    -- @+    vertexList :: Ord (ToVertex t) => t -> [ToVertex t]+    vertexList = Set.toAscList . vertexSet++    -- | The sorted list of edges of a graph.+    --+    -- @+    -- edgeList == Set.'Set.toAscList' . 'edgeSet'+    -- @+    edgeList :: Ord (ToVertex t) => t -> [(ToVertex t, ToVertex t)]+    edgeList = AM.edgeList . toAdjacencyMap++    -- | The set of vertices of a graph.+    --+    -- @+    -- vertexSet == 'foldg' Set.'Set.empty' Set.'Set.singleton' Set.'Set.union' Set.'Set.union'+    -- @+    vertexSet :: Ord (ToVertex t) => t -> Set (ToVertex t)+    vertexSet = foldg Set.empty Set.singleton Set.union Set.union++    -- | The set of vertices of a graph. Like 'vertexSet' but specialised for+    -- graphs with vertices of type 'Int'.+    --+    -- @+    -- vertexIntSet == 'foldg' IntSet.'IntSet.empty' IntSet.'IntSet.singleton' IntSet.'IntSet.union' IntSet.'IntSet.union'+    -- @+    vertexIntSet :: ToVertex t ~ Int => t -> IntSet+    vertexIntSet = foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union++    -- | The set of edges of a graph.+    --+    -- @+    -- edgeSet == Algebra.Graph.AdjacencyMap.'AM.edgeSet' . 'toAdjacencyMap'+    -- @+    edgeSet :: Ord (ToVertex t) => t -> Set (ToVertex t, ToVertex t)+    edgeSet = AM.edgeSet . toAdjacencyMap++    -- | The /preset/ of a vertex is the set of its /direct predecessors/.+    --+    -- @+    -- preSet x == Algebra.Graph.AdjacencyMap.'AM.preSet' x . 'toAdjacencyMap'+    -- @+    preSet :: Ord (ToVertex t) => ToVertex t -> t -> Set (ToVertex t)+    preSet x = AM.postSet x . toAdjacencyMapTranspose++    -- | The /preset/ (here @preIntSet@) of a vertex is the set of its+    -- /direct predecessors/. Like 'preSet' but specialised for graphs with+    -- vertices of type 'Int'.+    --+    -- @+    -- preIntSet x == Algebra.Graph.AdjacencyIntMap.'AIM.preIntSet' x . 'toAdjacencyIntMap'+    -- @+    preIntSet :: ToVertex t ~ Int => Int -> t -> IntSet+    preIntSet x = AIM.postIntSet x . toAdjacencyIntMapTranspose++    -- | The /postset/ of a vertex is the set of its /direct successors/.+    --+    -- @+    -- postSet x == Algebra.Graph.AdjacencyMap.'AM.postSet' x . 'toAdjacencyMap'+    -- @+    postSet :: Ord (ToVertex t) => ToVertex t -> t -> Set (ToVertex t)+    postSet x = AM.postSet x . toAdjacencyMap++    -- | The /postset/ (here @postIntSet@) of a vertex is the set of its+    -- /direct successors/. Like 'postSet' but specialised for graphs with+    -- vertices of type 'Int'.+    --+    -- @+    -- postIntSet x == Algebra.Graph.AdjacencyIntMap.'AIM.postIntSet' x . 'toAdjacencyIntMap'+    -- @+    postIntSet :: ToVertex t ~ Int => Int -> t -> IntSet+    postIntSet x = AIM.postIntSet x . toAdjacencyIntMap++    -- | The sorted /adjacency list/ of a graph.+    --+    -- @+    -- adjacencyList == Algebra.Graph.AdjacencyMap.'AM.adjacencyList' . 'toAdjacencyMap'+    -- @+    adjacencyList :: Ord (ToVertex t) => t -> [(ToVertex t, [ToVertex t])]+    adjacencyList = AM.adjacencyList . toAdjacencyMap++    -- | The /adjacency map/ of a graph: each vertex is associated with a set+    -- of its /direct successors/.+    --+    -- @+    -- adjacencyMap == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMap'+    -- @+    adjacencyMap :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t))+    adjacencyMap = AM.adjacencyMap . toAdjacencyMap++    -- | The /adjacency map/ of a graph: each vertex is associated with a set+    -- of its /direct successors/. Like 'adjacencyMap' but specialised for+    -- graphs with vertices of type 'Int'.+    --+    -- @+    -- adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMap'+    -- @+    adjacencyIntMap :: ToVertex t ~ Int => t -> IntMap IntSet+    adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap++    -- | The transposed /adjacency map/ of a graph: each vertex is associated+    -- with a set of its /direct predecessors/.+    --+    -- @+    -- adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMapTranspose'+    -- @+    adjacencyMapTranspose :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t))+    adjacencyMapTranspose = AM.adjacencyMap . toAdjacencyMapTranspose++    -- | The transposed /adjacency map/ of a graph: each vertex is associated+    -- with a set of its /direct predecessors/. Like 'adjacencyMapTranspose' but+    -- specialised for graphs with vertices of type 'Int'.+    --+    -- @+    -- adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMapTranspose'+    -- @+    adjacencyIntMapTranspose :: ToVertex t ~ Int => t -> IntMap IntSet+    adjacencyIntMapTranspose = AIM.adjacencyIntMap . toAdjacencyIntMapTranspose++    -- | Compute the /depth-first search/ forest of a graph that corresponds to+    -- searching from each of the graph vertices in the 'Ord' @a@ order.+    --+    -- @+    -- dfsForest == Algebra.Graph.AdjacencyMap.'AM.dfsForest' . toAdjacencyMap+    -- @+    dfsForest :: Ord (ToVertex t) => t -> Forest (ToVertex t)+    dfsForest = AM.dfsForest . toAdjacencyMap++    -- | Compute the /depth-first search/ forest of a graph, searching from each+    -- of the given vertices in order. Note that the resulting forest does not+    -- necessarily span the whole graph, as some vertices may be unreachable.+    --+    -- @+    -- dfsForestFrom vs == Algebra.Graph.AdjacencyMap.'AM.dfsForestFrom' vs . toAdjacencyMap+    -- @+    dfsForestFrom :: Ord (ToVertex t) => [ToVertex t] -> t -> Forest (ToVertex t)+    dfsForestFrom vs = AM.dfsForestFrom vs . toAdjacencyMap++    -- | Compute the list of vertices visited by the /depth-first search/ in a+    -- graph, when searching from each of the given vertices in order.+    --+    -- @+    -- dfs vs == Algebra.Graph.AdjacencyMap.'AM.dfs' vs . toAdjacencyMap+    -- @+    dfs :: Ord (ToVertex t) => [ToVertex t] -> t -> [ToVertex t]+    dfs vs = AM.dfs vs . toAdjacencyMap++    -- | Compute the list of vertices that are /reachable/ from a given source+    -- vertex in a graph. The vertices in the resulting list appear in the+    -- /depth-first order/.+    --+    -- @+    -- reachable x == Algebra.Graph.AdjacencyMap.'AM.reachable' x . toAdjacencyMap+    -- @+    reachable :: Ord (ToVertex t) => ToVertex t -> t -> [ToVertex t]+    reachable x = AM.reachable x . toAdjacencyMap++    -- | Compute the /topological sort/ of a graph or return @Nothing@ if the+    -- graph is cyclic.+    --+    -- @+    -- topSort == Algebra.Graph.AdjacencyMap.'AM.topSort' . toAdjacencyMap+    -- @+    topSort :: Ord (ToVertex t) => t -> Maybe [ToVertex t]+    topSort = AM.topSort . toAdjacencyMap++    -- | Check if a given graph is /acyclic/.+    --+    -- @+    -- isAcyclic == Algebra.Graph.AdjacencyMap.'AM.isAcyclic' . toAdjacencyMap+    -- @+    isAcyclic :: Ord (ToVertex t) => t -> Bool+    isAcyclic = AM.isAcyclic . toAdjacencyMap++    -- | Convert a value to the corresponding 'AM.AdjacencyMap'.+    --+    -- @+    -- toAdjacencyMap == 'foldg' 'AM.empty' 'AM.vertex' 'AM.overlay' 'AM.connect'+    -- @+    toAdjacencyMap :: Ord (ToVertex t) => t -> AM.AdjacencyMap (ToVertex t)+    toAdjacencyMap = foldg AM.empty AM.vertex AM.overlay AM.connect++    -- | Convert a value to the corresponding 'AM.AdjacencyMap' and transpose the+    -- result.+    --+    -- @+    -- toAdjacencyMapTranspose == 'foldg' 'AM.empty' 'AM.vertex' 'AM.overlay' (flip 'AM.connect')+    -- @+    toAdjacencyMapTranspose :: Ord (ToVertex t) => t -> AM.AdjacencyMap (ToVertex t)+    toAdjacencyMapTranspose = foldg AM.empty AM.vertex AM.overlay (flip AM.connect)++    -- | Convert a value to the corresponding 'AIM.AdjacencyIntMap'.+    --+    -- @+    -- toAdjacencyIntMap == 'foldg' 'AIM.empty' 'AIM.vertex' 'AIM.overlay' 'AIM.connect'+    -- @+    toAdjacencyIntMap :: ToVertex t ~ Int => t -> AIM.AdjacencyIntMap+    toAdjacencyIntMap = foldg AIM.empty AIM.vertex AIM.overlay AIM.connect++    -- | Convert a value to the corresponding 'AIM.AdjacencyIntMap' and transpose+    -- the result.+    --+    -- @+    -- toAdjacencyIntMapTranspose == 'foldg' 'AIM.empty' 'AIM.vertex' 'AIM.overlay' (flip 'AIM.connect')+    -- @+    toAdjacencyIntMapTranspose :: ToVertex t ~ Int => t -> AIM.AdjacencyIntMap+    toAdjacencyIntMapTranspose = foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect)++    -- | Check if a given forest is a valid /depth-first search/ forest of a+    -- graph.+    --+    -- @+    -- isDfsForestOf f == Algebra.Graph.AdjacencyMap.'AM.isDfsForestOf' f . toAdjacencyMap+    -- @+    isDfsForestOf :: Ord (ToVertex t) => Forest (ToVertex t) -> t -> Bool+    isDfsForestOf f = AM.isDfsForestOf f . toAdjacencyMap++    -- | Check if a given list of vertices is a valid /topological sort/ of a+    -- graph.+    --+    -- @+    -- isTopSortOf vs == Algebra.Graph.AdjacencyMap.'AM.isTopSortOf' vs . toAdjacencyMap+    -- @+    isTopSortOf :: Ord (ToVertex t) => [ToVertex t] -> t -> Bool+    isTopSortOf vs = AM.isTopSortOf vs . toAdjacencyMap++instance Ord a => ToGraph (G.Graph a) where+    type ToVertex (G.Graph a) = a+    toGraph = id+    foldg   = G.foldg+    hasEdge = G.hasEdge++instance Ord a => ToGraph (AM.AdjacencyMap a) where+    type ToVertex (AM.AdjacencyMap a) = a+    toGraph                    = G.stars+                               . map (fmap Set.toList)+                               . Map.toList+                               . AM.adjacencyMap+    isEmpty                    = AM.isEmpty+    hasVertex                  = AM.hasVertex+    hasEdge                    = AM.hasEdge+    vertexCount                = AM.vertexCount+    edgeCount                  = AM.edgeCount+    vertexList                 = AM.vertexList+    vertexSet                  = AM.vertexSet+    vertexIntSet               = AM.vertexIntSet+    edgeList                   = AM.edgeList+    edgeSet                    = AM.edgeSet+    adjacencyList              = AM.adjacencyList+    preSet                     = AM.preSet+    postSet                    = AM.postSet+    adjacencyMap               = AM.adjacencyMap+    adjacencyIntMap            = IntMap.fromAscList+                               . map (fmap $ IntSet.fromAscList . Set.toAscList)+                               . Map.toAscList+                               . AM.adjacencyMap+    dfsForest                  = AM.dfsForest+    dfsForestFrom              = AM.dfsForestFrom+    dfs                        = AM.dfs+    reachable                  = AM.reachable+    topSort                    = AM.topSort+    isAcyclic                  = AM.isAcyclic+    toAdjacencyMap             = id+    toAdjacencyIntMap          = AIM.AM . adjacencyIntMap+    toAdjacencyMapTranspose    = AM.transpose . toAdjacencyMap+    toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap+    isDfsForestOf              = AM.isDfsForestOf+    isTopSortOf                = AM.isTopSortOf++instance ToGraph AIM.AdjacencyIntMap where+    type ToVertex AIM.AdjacencyIntMap = Int+    toGraph                    = G.stars+                               . map (fmap IntSet.toList)+                               . IntMap.toList+                               . AIM.adjacencyIntMap+    isEmpty                    = AIM.isEmpty+    hasVertex                  = AIM.hasVertex+    hasEdge                    = AIM.hasEdge+    vertexCount                = AIM.vertexCount+    edgeCount                  = AIM.edgeCount+    vertexList                 = AIM.vertexList+    vertexSet                  = Set.fromAscList . IntSet.toAscList . AIM.vertexIntSet+    vertexIntSet               = AIM.vertexIntSet+    edgeList                   = AIM.edgeList+    edgeSet                    = AIM.edgeSet+    adjacencyList              = AIM.adjacencyList+    preIntSet                  = AIM.preIntSet+    postIntSet                 = AIM.postIntSet+    adjacencyMap               = Map.fromAscList+                               . map (fmap $ Set.fromAscList . IntSet.toAscList)+                               . IntMap.toAscList+                               . AIM.adjacencyIntMap+    dfsForest                  = AIM.dfsForest+    dfsForestFrom              = AIM.dfsForestFrom+    dfs                        = AIM.dfs+    reachable                  = AIM.reachable+    topSort                    = AIM.topSort+    isAcyclic                  = AIM.isAcyclic+    adjacencyIntMap            = AIM.adjacencyIntMap+    toAdjacencyMap             = AM.AM . adjacencyMap+    toAdjacencyIntMap          = id+    toAdjacencyMapTranspose    = AM.transpose . toAdjacencyMap+    toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap+    isDfsForestOf              = AIM.isDfsForestOf+    isTopSortOf                = AIM.isTopSortOf++-- TODO: Get rid of "Relation.Internal" and move this instance to "Relation".+instance Ord a => ToGraph (R.Relation a) where+    type ToVertex (R.Relation a) = a+    toGraph r                  = G.vertices (Set.toList $ R.domain   r) `G.overlay`+                                 G.edges    (Set.toList $ R.relation r)+    isEmpty                    = R.isEmpty+    hasVertex                  = R.hasVertex+    hasEdge                    = R.hasEdge+    vertexCount                = R.vertexCount+    edgeCount                  = R.edgeCount+    vertexList                 = R.vertexList+    vertexSet                  = R.vertexSet+    vertexIntSet               = R.vertexIntSet+    edgeList                   = R.edgeList+    edgeSet                    = R.edgeSet+    adjacencyList              = R.adjacencyList+    adjacencyMap               = Map.fromAscList+                               . map (fmap Set.fromAscList)+                               . R.adjacencyList+    adjacencyIntMap            = IntMap.fromAscList+                               . map (fmap IntSet.fromAscList)+                               . R.adjacencyList+    toAdjacencyMap             = AM.AM . adjacencyMap+    toAdjacencyIntMap          = AIM.AM . adjacencyIntMap+    toAdjacencyMapTranspose    = AM.transpose . toAdjacencyMap+    toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap

@@ -0,0 +1,160 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Graph.Typed+-- Copyright  : (c) Anton Lorenzen, Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : anfelor@posteo.de, andrey.mokhov@gmail.com+-- Stability  : unstable+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module provides primitives for interoperability between this library and+-- the "Data.Graph" module of the containers library. It is for internal use only+-- and may be removed without notice at any point.+-----------------------------------------------------------------------------+module Data.Graph.Typed (+    -- * Data type and construction+    GraphKL(..), fromAdjacencyMap, fromAdjacencyIntMap,++    -- * Basic algorithms+    dfsForest, dfsForestFrom, dfs, topSort+  ) where++import Algebra.Graph.AdjacencyMap.Internal    as AM+import Algebra.Graph.AdjacencyIntMap.Internal as AIM++import Data.Tree+import Data.Maybe++import qualified Data.Graph         as KL+import qualified Data.Map.Strict    as Map+import qualified Data.IntMap.Strict as IntMap+import qualified Data.Set           as Set+import qualified Data.IntSet        as IntSet++-- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in+-- the "Data.Graph" module of the @containers@ library.+data GraphKL a = GraphKL {+    -- | Array-based graph representation (King and Launchbury, 1995).+    toGraphKL :: KL.Graph,+    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.+    -- This is partial and may fail if the vertex is out of bounds.+    fromVertexKL :: KL.Vertex -> a,+    -- | A mapping from vertices of type @a@ to "Data.Graph.Vertex".+    -- Returns 'Nothing' if the argument is not in the graph.+    toVertexKL :: a -> Maybe KL.Vertex }++-- | Build 'GraphKL' from an 'AdjacencyMap'.+-- If @fromAdjacencyMap g == h@ then the following holds:+--+-- @+-- map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h)                               == 'Algebra.Graph.AdjacencyMap.vertexList' g+-- map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.edgeList' g+-- 'toGraphKL' (fromAdjacencyMap (1 * 2 + 3 * 1))                                == 'array' (0,2) [(0,[1]), (1,[]), (2,[0])]+-- 'toGraphKL' (fromAdjacencyMap (1 * 2 + 2 * 1))                                == 'array' (0,1) [(0,[1]), (1,[0])]+-- @+fromAdjacencyMap :: Ord a => AdjacencyMap a -> GraphKL a+fromAdjacencyMap (AM.AM m) = GraphKL+    { toGraphKL    = g+    , fromVertexKL = \u -> case r u of (_, v, _) -> v+    , toVertexKL   = t }+  where+    (g, r, t) = KL.graphFromEdges [ ((), v, Set.toAscList us) | (v, us) <- Map.toAscList m ]++-- | Build 'GraphKL' from an 'AdjacencyIntMap'.+-- If @fromAdjacencyIntMap g == h@ then the following holds:+--+-- @+-- map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h)                               == 'Data.IntSet.toAscList' ('Algebra.Graph.AdjacencyIntMap.vertexIntSet' g)+-- map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyIntMap.edgeList' g+-- 'toGraphKL' (fromAdjacencyIntMap (1 * 2 + 3 * 1))                             == 'array' (0,2) [(0,[1]), (1,[]), (2,[0])]+-- 'toGraphKL' (fromAdjacencyIntMap (1 * 2 + 2 * 1))                             == 'array' (0,1) [(0,[1]), (1,[0])]+-- @+fromAdjacencyIntMap :: AdjacencyIntMap -> GraphKL Int+fromAdjacencyIntMap (AIM.AM m) = GraphKL+    { toGraphKL    = g+    , fromVertexKL = \u -> case r u of (_, v, _) -> v+    , toVertexKL   = t }+  where+    (g, r, t) = KL.graphFromEdges [ ((), v, IntSet.toAscList us) | (v, us) <- IntMap.toAscList m ]++-- | Compute the /depth-first search/ forest of a graph.+--+-- In the following we will use the helper function:+--+-- @+-- (%) :: (GraphKL Int -> a) -> AM.AdjacencyMap Int -> a+-- a % g = a $ fromAdjacencyMap g+-- @+-- for greater clarity. (One could use an AdjacencyIntMap just as well)+--+-- @+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % 'Algebra.Graph.AdjacencyMap.edge' 1 1)           == 'AM.vertex' 1+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % 'Algebra.Graph.AdjacencyMap.edge' 1 2)           == 'Algebra.Graph.AdjacencyMap.edge' 1 2+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % 'Algebra.Graph.AdjacencyMap.edge' 2 1)           == 'AM.vertices' [1, 2]+-- 'AM.isSubgraphOf' ('Algebra.Graph.AdjacencyMap.forest' $ dfsForest % x) x == True+-- dfsForest % 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % x)      == dfsForest % x+-- dfsForest % 'AM.vertices' vs                 == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)+-- 'Algebra.Graph.AdjacencyMap.dfsForestFrom' ('Algebra.Graph.AdjacencyMap.vertexList' x) % x        == dfsForest % x+-- dfsForest % (3 * (1 + 4) * (1 + 5))     == [ Node { rootLabel = 1+--                                                   , subForest = [ Node { rootLabel = 5+--                                                                        , subForest = [] }]}+--                                            , Node { rootLabel = 3+--                                                   , subForest = [ Node { rootLabel = 4+--                                                                        , subForest = [] }]}]+-- @+dfsForest :: GraphKL a -> Forest a+dfsForest (GraphKL g r _) = fmap (fmap r) (KL.dff g)++-- | Compute the /depth-first search/ forest of a graph, searching from each of+-- the given vertices in order. Note that the resulting forest does not+-- necessarily span the whole graph, as some vertices may be unreachable.+--+-- @+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [1]    % 'Algebra.Graph.AdjacencyMap.edge' 1 1)       == 'AM.vertex' 1+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [1]    % 'Algebra.Graph.AdjacencyMap.edge' 1 2)       == 'Algebra.Graph.AdjacencyMap.edge' 1 2+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [2]    % 'Algebra.Graph.AdjacencyMap.edge' 1 2)       == 'AM.vertex' 2+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [3]    % 'Algebra.Graph.AdjacencyMap.edge' 1 2)       == 'AM.empty'+-- 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [2, 1] % 'Algebra.Graph.AdjacencyMap.edge' 1 2)       == 'Algebra.Graph.AdjacencyMap.vertices' [1, 2]+-- 'Algebra.Graph.AdjacencyMap.isSubgraphOf' ('Algebra.Graph.AdjacencyMap.forest' $ dfsForestFrom vs % x) x == True+-- dfsForestFrom ('Algebra.Graph.AdjacencyMap.vertexList' x) % x               == 'dfsForest' % x+-- dfsForestFrom vs               % 'Algebra.Graph.AdjacencyMap.vertices' vs   == map (\\v -> Node v []) ('Data.List.nub' vs)+-- dfsForestFrom []               % x             == []+-- dfsForestFrom [1, 4] % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1+--                                                          , subForest = [ Node { rootLabel = 5+--                                                                               , subForest = [] }+--                                                   , Node { rootLabel = 4+--                                                          , subForest = [] }]+-- @+dfsForestFrom :: [a] -> GraphKL a -> Forest a+dfsForestFrom vs (GraphKL g r t) = fmap (fmap r) (KL.dfs g (mapMaybe t vs))++-- | Compute the list of vertices visited by the /depth-first search/ in a graph,+-- when searching from each of the given vertices in order.+--+-- @+-- dfs [1]   % 'Algebra.Graph.AdjacencyMap.edge' 1 1                 == [1]+-- dfs [1]   % 'Algebra.Graph.AdjacencyMap.edge' 1 2                 == [1,2]+-- dfs [2]   % 'Algebra.Graph.AdjacencyMap.edge' 1 2                 == [2]+-- dfs [3]   % 'Algebra.Graph.AdjacencyMap.edge' 1 2                 == []+-- dfs [1,2] % 'Algebra.Graph.AdjacencyMap.edge' 1 2                 == [1,2]+-- dfs [2,1] % 'Algebra.Graph.AdjacencyMap.edge' 1 2                 == [2,1]+-- dfs []    % x                        == []+-- dfs [1,4] % (3 * (1 + 4) * (1 + 5))  == [1, 5, 4]+-- 'Algebra.Graph.AdjacencyMap.isSubgraphOf' ('Algebra.Graph.AdjacencyMap.vertices' $ dfs vs x) x == True+-- @+dfs :: [a] -> GraphKL a -> [a]+dfs vs = concatMap flatten . dfsForestFrom vs++-- | Compute the /topological sort/ of a graph.+-- Unlike the (Int)AdjacencyMap algorithm this returns+-- a result even if the graph is cyclic.+--+-- @+-- topSort % (1 * 2 + 3 * 1) == [3,1,2]+-- topSort % (1 * 2 + 2 * 1) == [1,2]+-- @+topSort :: GraphKL a -> [a]+topSort (GraphKL g r _) = map r (KL.topSort g)

@@ -14,126 +14,84 @@     GraphAPI (..)   ) where -import Data.IntSet (IntSet)-import Data.Set (Set) import Data.Tree -import Algebra.Graph.Class hiding (toGraph)+import Algebra.Graph.Class (Graph (..)) -import qualified Algebra.Graph.AdjacencyMap    as AdjacencyMap-import qualified Algebra.Graph.Class           as Class-import qualified Algebra.Graph.Fold            as Fold-import qualified Algebra.Graph                 as Graph-import qualified Algebra.Graph.IntAdjacencyMap as IntAdjacencyMap-import qualified Algebra.Graph.Relation        as Relation-import qualified Data.Set                      as Set-import qualified Data.IntSet                   as IntSet+import qualified Algebra.Graph                          as Graph+import qualified Algebra.Graph.AdjacencyMap             as AdjacencyMap+import qualified Algebra.Graph.AdjacencyMap.Internal    as AdjacencyMap+import qualified Algebra.Graph.Fold                     as Fold+import qualified Algebra.Graph.HigherKinded.Class       as HClass+import qualified Algebra.Graph.AdjacencyIntMap          as AdjacencyIntMap+import qualified Algebra.Graph.AdjacencyIntMap.Internal as AdjacencyIntMap+import qualified Algebra.Graph.Relation                 as Relation+import qualified Data.Set                               as Set+import qualified Data.IntSet                            as IntSet  class Graph g => GraphAPI g where-    edge              :: Vertex g -> Vertex g -> g-    edge              = notImplemented-    vertices          :: [Vertex g] -> g-    vertices          = notImplemented-    edges             :: [(Vertex g, Vertex g)] -> g-    edges             = notImplemented-    overlays          :: [g] -> g-    overlays          = notImplemented-    connects          :: [g] -> g-    connects          = notImplemented-    fromAdjacencyList :: [(Vertex g, [Vertex g])] -> g-    fromAdjacencyList = notImplemented-    toGraph           :: (Graph h, Vertex g ~ Vertex h) => g -> h-    toGraph           = notImplemented-    foldg             :: r -> (Vertex g -> r) -> (r -> r -> r) -> (r -> r -> r) -> g -> r-    foldg             = notImplemented-    isSubgraphOf      :: g -> g -> Bool-    isSubgraphOf      = notImplemented-    (===)             :: g -> g -> Bool-    (===)             = notImplemented-    isEmpty           :: g -> Bool-    isEmpty           = notImplemented-    size              :: g -> Int-    size              = notImplemented-    hasVertex         :: Vertex g -> g -> Bool-    hasVertex         = notImplemented-    hasEdge           :: Vertex g -> Vertex g -> g -> Bool-    hasEdge           = notImplemented-    vertexCount       :: g -> Int-    vertexCount       = notImplemented-    edgeCount         :: g -> Int-    edgeCount         = notImplemented-    vertexList        :: g -> [Vertex g]-    vertexList        = notImplemented-    edgeList          :: g -> [(Vertex g, Vertex g)]-    edgeList          = notImplemented-    adjacencyList     :: g -> [(Vertex g, [Vertex g])]-    adjacencyList     = notImplemented-    vertexSet         :: g -> Set (Vertex g)-    vertexSet         = notImplemented-    vertexIntSet      :: Vertex g ~ Int => g -> IntSet-    vertexIntSet      = notImplemented-    edgeSet           :: g -> Set (Vertex g, Vertex g)-    edgeSet           = notImplemented-    preSet            :: Vertex g -> g -> Set (Vertex g)-    preSet            = notImplemented-    postSet           :: Vertex g -> g -> Set (Vertex g)-    postSet           = notImplemented-    postIntSet        :: Vertex g ~ Int => Int -> g -> IntSet-    postIntSet        = notImplemented-    path              :: [Vertex g] -> g-    path              = notImplemented-    circuit           :: [Vertex g] -> g-    circuit           = notImplemented-    clique            :: [Vertex g] -> g-    clique            = notImplemented-    biclique          :: [Vertex g] -> [Vertex g] -> g-    biclique          = notImplemented-    star              :: Vertex g -> [Vertex g] -> g-    star              = notImplemented-    starTranspose     :: Vertex g -> [Vertex g] -> g-    starTranspose     = notImplemented-    tree              :: Tree (Vertex g) -> g-    tree              = notImplemented-    forest            :: Forest (Vertex g) -> g-    forest            = notImplemented-    mesh              :: Vertex g ~ (a, b) => [a] -> [b] -> g-    mesh              = notImplemented-    torus             :: Vertex g ~ (a, b) => [a] -> [b] -> g-    torus             = notImplemented-    deBruijn          :: Vertex g ~ [a] => Int -> [a] -> g-    deBruijn          = notImplemented-    removeVertex      :: Vertex g -> g -> g-    removeVertex      = notImplemented-    removeEdge        :: Vertex g -> Vertex g -> g -> g-    removeEdge        = notImplemented-    replaceVertex     :: Vertex g -> Vertex g -> g -> g-    replaceVertex     = notImplemented-    mergeVertices     :: (Vertex g -> Bool) -> Vertex g -> g -> g-    mergeVertices     = notImplemented-    splitVertex       :: Vertex g -> [Vertex g] -> g -> g-    splitVertex       = notImplemented-    transpose         :: g -> g-    transpose         = notImplemented-    gmap              :: Vertex g ~ Int => (Int -> Int) -> g -> g-    gmap              = notImplemented-    induce            :: (Vertex g -> Bool) -> g -> g-    induce            = notImplemented-    bind              :: Vertex g ~ Int => g -> (Int -> g) -> g-    bind              = notImplemented-    simplify          :: g -> g-    simplify          = notImplemented-    box               :: forall a b f. (Vertex (f a) ~ a, Vertex (f b) ~ b, Vertex (f (a, b)) ~ (a, b), g ~ f (a, b)) => f a -> f b -> f (a, b)-    box               = notImplemented-    dfsForest         :: g -> Forest (Vertex g)-    dfsForest         = notImplemented-    dfsForestFrom     :: [Vertex g] -> g -> Forest (Vertex g)-    dfsForestFrom     = notImplemented-    dfs               :: [Vertex g] -> g -> [Vertex g]-    dfs               = notImplemented-    topSort           :: g -> Maybe [Vertex g]-    topSort           = notImplemented-    isTopSort         :: [Vertex g] -> g -> Bool-    isTopSort         = notImplemented+    edge                 :: Vertex g -> Vertex g -> g+    edge                 = notImplemented+    vertices             :: [Vertex g] -> g+    vertices             = notImplemented+    edges                :: [(Vertex g, Vertex g)] -> g+    edges                = notImplemented+    overlays             :: [g] -> g+    overlays             = notImplemented+    connects             :: [g] -> g+    connects             = notImplemented+    fromAdjacencySets    :: [(Vertex g, Set.Set (Vertex g))] -> g+    fromAdjacencySets    = notImplemented+    fromAdjacencyIntSets :: [(Int, IntSet.IntSet)] -> g+    fromAdjacencyIntSets = notImplemented+    isSubgraphOf         :: g -> g -> Bool+    isSubgraphOf         = notImplemented+    (===)                :: g -> g -> Bool+    (===)                = notImplemented+    path                 :: [Vertex g] -> g+    path                 = notImplemented+    circuit              :: [Vertex g] -> g+    circuit              = notImplemented+    clique               :: [Vertex g] -> g+    clique               = notImplemented+    biclique             :: [Vertex g] -> [Vertex g] -> g+    biclique             = notImplemented+    star                 :: Vertex g -> [Vertex g] -> g+    star                 = notImplemented+    stars                :: [(Vertex g, [Vertex g])] -> g+    stars                = notImplemented+    tree                 :: Tree (Vertex g) -> g+    tree                 = notImplemented+    forest               :: Forest (Vertex g) -> g+    forest               = notImplemented+    mesh                 :: Vertex g ~ (a, b) => [a] -> [b] -> g+    mesh                 = notImplemented+    torus                :: Vertex g ~ (a, b) => [a] -> [b] -> g+    torus                = notImplemented+    deBruijn             :: Vertex g ~ [a] => Int -> [a] -> g+    deBruijn             = notImplemented+    removeVertex         :: Vertex g -> g -> g+    removeVertex         = notImplemented+    removeEdge           :: Vertex g -> Vertex g -> g -> g+    removeEdge           = notImplemented+    replaceVertex        :: Vertex g -> Vertex g -> g -> g+    replaceVertex        = notImplemented+    mergeVertices        :: (Vertex g -> Bool) -> Vertex g -> g -> g+    mergeVertices        = notImplemented+    splitVertex          :: Vertex g -> [Vertex g] -> g -> g+    splitVertex          = notImplemented+    transpose            :: g -> g+    transpose            = notImplemented+    gmap                 :: Vertex g ~ Int => (Int -> Int) -> g -> g+    gmap                 = notImplemented+    induce               :: (Vertex g -> Bool) -> g -> g+    induce               = notImplemented+    bind                 :: Vertex g ~ Int => g -> (Int -> g) -> g+    bind                 = notImplemented+    simplify             :: g -> g+    simplify             = notImplemented+    box                  :: forall a b f. (Vertex (f a) ~ a, Vertex (f b) ~ b, Vertex (f (a, b)) ~ (a, b), g ~ f (a, b)) => f a -> f b -> f (a, b)+    box                  = notImplemented  notImplemented :: a notImplemented = error "Not implemented"@@ -144,26 +102,14 @@     edges             = AdjacencyMap.edges     overlays          = AdjacencyMap.overlays     connects          = AdjacencyMap.connects-    fromAdjacencyList = AdjacencyMap.fromAdjacencyList+    fromAdjacencySets = AdjacencyMap.fromAdjacencySets     isSubgraphOf      = AdjacencyMap.isSubgraphOf-    isEmpty           = AdjacencyMap.isEmpty-    hasVertex         = AdjacencyMap.hasVertex-    hasEdge           = AdjacencyMap.hasEdge-    vertexCount       = AdjacencyMap.vertexCount-    edgeCount         = AdjacencyMap.edgeCount-    vertexList        = AdjacencyMap.vertexList-    edgeList          = AdjacencyMap.edgeList-    adjacencyList     = AdjacencyMap.adjacencyList-    vertexSet         = AdjacencyMap.vertexSet-    vertexIntSet      = IntSet.fromAscList . Set.toAscList . AdjacencyMap.vertexSet-    edgeSet           = AdjacencyMap.edgeSet-    postSet           = AdjacencyMap.postSet     path              = AdjacencyMap.path     circuit           = AdjacencyMap.circuit     clique            = AdjacencyMap.clique     biclique          = AdjacencyMap.biclique     star              = AdjacencyMap.star-    starTranspose     = AdjacencyMap.starTranspose+    stars             = AdjacencyMap.stars     tree              = AdjacencyMap.tree     forest            = AdjacencyMap.forest     removeVertex      = AdjacencyMap.removeVertex@@ -173,11 +119,6 @@     transpose         = AdjacencyMap.transpose     gmap              = AdjacencyMap.gmap     induce            = AdjacencyMap.induce-    dfsForest         = AdjacencyMap.dfsForest-    dfsForestFrom     = AdjacencyMap.dfsForestFrom-    dfs               = AdjacencyMap.dfs-    topSort           = AdjacencyMap.topSort-    isTopSort         = AdjacencyMap.isTopSort  instance Ord a => GraphAPI (Fold.Fold a) where     edge          = Fold.edge@@ -185,42 +126,29 @@     edges         = Fold.edges     overlays      = Fold.overlays     connects      = Fold.connects-    toGraph       = Class.toGraph-    foldg         = Fold.foldg     isSubgraphOf  = Fold.isSubgraphOf-    isEmpty       = Fold.isEmpty-    size          = Fold.size-    hasVertex     = Fold.hasVertex-    hasEdge       = Fold.hasEdge-    vertexCount   = Fold.vertexCount-    edgeCount     = Fold.edgeCount-    vertexList    = Fold.vertexList-    edgeList      = Fold.edgeList-    vertexSet     = Fold.vertexSet-    vertexIntSet  = Fold.vertexIntSet-    edgeSet       = Fold.edgeSet     path          = Fold.path     circuit       = Fold.circuit     clique        = Fold.clique     biclique      = Fold.biclique     star          = Fold.star-    starTranspose = Fold.starTranspose-    tree          = Fold.tree-    forest        = Fold.forest-    mesh          = Fold.mesh-    torus         = Fold.torus-    deBruijn      = Fold.deBruijn+    stars         = Fold.stars+    tree          = HClass.tree+    forest        = HClass.forest+    mesh          = HClass.mesh+    torus         = HClass.torus+    deBruijn      = HClass.deBruijn     removeVertex  = Fold.removeVertex     removeEdge    = Fold.removeEdge-    replaceVertex = Fold.replaceVertex-    mergeVertices = Fold.mergeVertices-    splitVertex   = Fold.splitVertex+    replaceVertex = HClass.replaceVertex+    mergeVertices = HClass.mergeVertices+    splitVertex   = HClass.splitVertex     transpose     = Fold.transpose     gmap          = fmap     induce        = Fold.induce     bind          = (>>=)     simplify      = Fold.simplify-    box           = Fold.box+    box           = HClass.box  instance Ord a => GraphAPI (Graph.Graph a) where     edge          = Graph.edge@@ -228,27 +156,14 @@     edges         = Graph.edges     overlays      = Graph.overlays     connects      = Graph.connects-    toGraph       = Class.toGraph-    foldg         = Graph.foldg     isSubgraphOf  = Graph.isSubgraphOf     (===)         = (Graph.===)-    isEmpty       = Graph.isEmpty-    size          = Graph.size-    hasVertex     = Graph.hasVertex-    hasEdge       = Graph.hasEdge-    vertexCount   = Graph.vertexCount-    edgeCount     = Graph.edgeCount-    vertexList    = Graph.vertexList-    edgeList      = Graph.edgeList-    vertexSet     = Graph.vertexSet-    vertexIntSet  = Graph.vertexIntSet-    edgeSet       = Graph.edgeSet     path          = Graph.path     circuit       = Graph.circuit     clique        = Graph.clique     biclique      = Graph.biclique     star          = Graph.star-    starTranspose = Graph.starTranspose+    stars         = Graph.stars     tree          = Graph.tree     forest        = Graph.forest     mesh          = Graph.mesh@@ -266,80 +181,49 @@     simplify      = Graph.simplify     box           = Graph.box -instance GraphAPI IntAdjacencyMap.IntAdjacencyMap where-    edge              = IntAdjacencyMap.edge-    vertices          = IntAdjacencyMap.vertices-    edges             = IntAdjacencyMap.edges-    overlays          = IntAdjacencyMap.overlays-    connects          = IntAdjacencyMap.connects-    fromAdjacencyList = IntAdjacencyMap.fromAdjacencyList-    isSubgraphOf      = IntAdjacencyMap.isSubgraphOf-    isEmpty           = IntAdjacencyMap.isEmpty-    hasVertex         = IntAdjacencyMap.hasVertex-    hasEdge           = IntAdjacencyMap.hasEdge-    vertexCount       = IntAdjacencyMap.vertexCount-    edgeCount         = IntAdjacencyMap.edgeCount-    vertexList        = IntAdjacencyMap.vertexList-    edgeList          = IntAdjacencyMap.edgeList-    postIntSet        = IntAdjacencyMap.postIntSet-    adjacencyList     = IntAdjacencyMap.adjacencyList-    vertexSet         = Set.fromAscList . IntSet.toAscList . IntAdjacencyMap.vertexIntSet-    vertexIntSet      = IntAdjacencyMap.vertexIntSet-    edgeSet           = IntAdjacencyMap.edgeSet-    path              = IntAdjacencyMap.path-    circuit           = IntAdjacencyMap.circuit-    clique            = IntAdjacencyMap.clique-    biclique          = IntAdjacencyMap.biclique-    star              = IntAdjacencyMap.star-    starTranspose     = IntAdjacencyMap.starTranspose-    tree              = IntAdjacencyMap.tree-    forest            = IntAdjacencyMap.forest-    removeVertex      = IntAdjacencyMap.removeVertex-    removeEdge        = IntAdjacencyMap.removeEdge-    replaceVertex     = IntAdjacencyMap.replaceVertex-    mergeVertices     = IntAdjacencyMap.mergeVertices-    transpose         = IntAdjacencyMap.transpose-    gmap              = IntAdjacencyMap.gmap-    induce            = IntAdjacencyMap.induce-    dfsForest         = IntAdjacencyMap.dfsForest-    dfsForestFrom     = IntAdjacencyMap.dfsForestFrom-    dfs               = IntAdjacencyMap.dfs-    topSort           = IntAdjacencyMap.topSort-    isTopSort         = IntAdjacencyMap.isTopSort+instance GraphAPI AdjacencyIntMap.AdjacencyIntMap where+    edge                 = AdjacencyIntMap.edge+    vertices             = AdjacencyIntMap.vertices+    edges                = AdjacencyIntMap.edges+    overlays             = AdjacencyIntMap.overlays+    connects             = AdjacencyIntMap.connects+    fromAdjacencyIntSets = AdjacencyIntMap.fromAdjacencyIntSets+    isSubgraphOf         = AdjacencyIntMap.isSubgraphOf+    path                 = AdjacencyIntMap.path+    circuit              = AdjacencyIntMap.circuit+    clique               = AdjacencyIntMap.clique+    biclique             = AdjacencyIntMap.biclique+    star                 = AdjacencyIntMap.star+    stars                = AdjacencyIntMap.stars+    tree                 = AdjacencyIntMap.tree+    forest               = AdjacencyIntMap.forest+    removeVertex         = AdjacencyIntMap.removeVertex+    removeEdge           = AdjacencyIntMap.removeEdge+    replaceVertex        = AdjacencyIntMap.replaceVertex+    mergeVertices        = AdjacencyIntMap.mergeVertices+    transpose            = AdjacencyIntMap.transpose+    gmap                 = AdjacencyIntMap.gmap+    induce               = AdjacencyIntMap.induce  instance Ord a => GraphAPI (Relation.Relation a) where-    edge              = Relation.edge-    vertices          = Relation.vertices-    edges             = Relation.edges-    overlays          = Relation.overlays-    connects          = Relation.connects-    fromAdjacencyList = Relation.fromAdjacencyList-    isSubgraphOf      = Relation.isSubgraphOf-    isEmpty           = Relation.isEmpty-    hasVertex         = Relation.hasVertex-    hasEdge           = Relation.hasEdge-    vertexCount       = Relation.vertexCount-    edgeCount         = Relation.edgeCount-    vertexList        = Relation.vertexList-    edgeList          = Relation.edgeList-    preSet            = Relation.preSet-    postSet           = Relation.postSet-    adjacencyList     = AdjacencyMap.adjacencyList . Class.toGraph-    vertexSet         = Relation.vertexSet-    vertexIntSet      = IntSet.fromAscList . Set.toAscList . Relation.vertexSet-    edgeSet           = Relation.edgeSet-    path              = Relation.path-    circuit           = Relation.circuit-    clique            = Relation.clique-    biclique          = Relation.biclique-    star              = Relation.star-    starTranspose     = Relation.starTranspose-    tree              = Relation.tree-    forest            = Relation.forest-    removeVertex      = Relation.removeVertex-    removeEdge        = Relation.removeEdge-    replaceVertex     = Relation.replaceVertex-    mergeVertices     = Relation.mergeVertices-    transpose         = Relation.transpose-    gmap              = Relation.gmap-    induce            = Relation.induce+    edge          = Relation.edge+    vertices      = Relation.vertices+    edges         = Relation.edges+    overlays      = Relation.overlays+    connects      = Relation.connects+    isSubgraphOf  = Relation.isSubgraphOf+    path          = Relation.path+    circuit       = Relation.circuit+    clique        = Relation.clique+    biclique      = Relation.biclique+    star          = Relation.star+    stars         = Relation.stars+    tree          = Relation.tree+    forest        = Relation.forest+    removeVertex  = Relation.removeVertex+    removeEdge    = Relation.removeEdge+    replaceVertex = Relation.replaceVertex+    mergeVertices = Relation.mergeVertices+    transpose     = Relation.transpose+    gmap          = Relation.gmap+    induce        = Relation.induce

@@ -0,0 +1,46 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.AdjacencyIntMap+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Testsuite for "Algebra.Graph.AdjacencyIntMap".+-----------------------------------------------------------------------------+module Algebra.Graph.Test.AdjacencyIntMap (+    -- * Testsuite+    testAdjacencyIntMap+  ) where++import Algebra.Graph.AdjacencyIntMap+import Algebra.Graph.AdjacencyIntMap.Internal+import Algebra.Graph.Test+import Algebra.Graph.Test.Generic++t :: Testsuite+t = testsuite "AdjacencyIntMap." empty++testAdjacencyIntMap :: IO ()+testAdjacencyIntMap = do+    putStrLn "\n============ AdjacencyIntMap ============"+    test "Axioms of graphs" (axioms :: GraphTestsuite AdjacencyIntMap)++    test "Consistency of arbitraryAdjacencyMap" $ \m ->+        consistent m++    testShow                 t+    testBasicPrimitives      t+    testFromAdjacencyIntSets t+    testIsSubgraphOf         t+    testToGraph              t+    testGraphFamilies        t+    testTransformations      t+    testDfsForest            t+    testDfsForestFrom        t+    testDfs                  t+    testReachable            t+    testTopSort              t+    testIsAcyclic            t+    testIsDfsForestOf        t+    testIsTopSortOf          t

@@ -18,7 +18,6 @@ import Algebra.Graph.Test import Algebra.Graph.Test.Generic -import qualified Data.Graph as KL import qualified Data.Set   as Set  t :: Testsuite@@ -34,23 +33,21 @@     test "Consistency of arbitraryAdjacencyMap" $ \(m :: AI) ->         consistent m -    test "Consistency of fromAdjacencyList" $ \xs ->-        consistent (fromAdjacencyList xs :: AI)-     testShow              t     testBasicPrimitives   t-    testFromAdjacencyList t+    testFromAdjacencySets t     testIsSubgraphOf      t-    testProperties        t-    testAdjacencyList     t-    testPostSet           t+    testToGraph           t     testGraphFamilies     t     testTransformations   t     testDfsForest         t     testDfsForestFrom     t     testDfs               t+    testReachable         t     testTopSort           t-    testIsTopSort         t+    testIsAcyclic         t+    testIsDfsForestOf     t+    testIsTopSortOf       t      putStrLn "\n============ AdjacencyMap.scc ============"     test "scc empty               == empty" $@@ -70,12 +67,3 @@                                            , (Set.fromList [1,4], Set.fromList [5]  )                                            , (Set.fromList [3]  , Set.fromList [1,4])                                            , (Set.fromList [3]  , Set.fromList [5 :: Int])]--    putStrLn "\n============ AdjacencyMap.Internal.GraphKL ============"-    test "map (fromVertexKL h) (vertices $ toGraphKL h) == vertexList g"-      $ \(g :: AI) -> let h = mkGraphKL (adjacencyMap g) in-          map (fromVertexKL h) (KL.vertices $ toGraphKL h) == vertexList g--    test "map (\\(x, y) -> (fromVertexKL h x, fromVertexKL h y)) (edges $ toGraphKL h) == edgeList g"-      $ \(g :: AI) -> let h = mkGraphKL (adjacencyMap g) in-          map ( \(x, y) -> (fromVertexKL h x, fromVertexKL h y)) (KL.edges $ toGraphKL h) == edgeList g

@@ -11,7 +11,7 @@ ----------------------------------------------------------------------------- module Algebra.Graph.Test.Arbitrary (     -- * Generators of arbitrary graph instances-    arbitraryGraph, arbitraryRelation, arbitraryAdjacencyMap, arbitraryIntAdjacencyMap+    arbitraryGraph, arbitraryRelation, arbitraryAdjacencyMap, arbitraryAdjacencyIntMap   ) where  import Prelude ()@@ -25,13 +25,13 @@ import Algebra.Graph.AdjacencyMap.Internal import Algebra.Graph.Export import Algebra.Graph.Fold (Fold)-import Algebra.Graph.IntAdjacencyMap.Internal+import Algebra.Graph.AdjacencyIntMap.Internal import Algebra.Graph.Relation.Internal import Algebra.Graph.Relation.InternalDerived  import qualified Algebra.Graph.AdjacencyMap    as AdjacencyMap import qualified Algebra.Graph.Class           as C-import qualified Algebra.Graph.IntAdjacencyMap as IntAdjacencyMap+import qualified Algebra.Graph.AdjacencyIntMap as AdjacencyIntMap import qualified Algebra.Graph.NonEmpty        as NE import qualified Algebra.Graph.Relation        as Relation @@ -78,17 +78,17 @@  -- | Generate an arbitrary 'Relation'. arbitraryRelation :: (Arbitrary a, Ord a) => Gen (Relation a)-arbitraryRelation = Relation.fromAdjacencyList <$> arbitrary+arbitraryRelation = Relation.stars <$> arbitrary  -- | Generate an arbitrary 'AdjacencyMap'. It is guaranteed that the -- resulting adjacency map is 'consistent'. arbitraryAdjacencyMap :: (Arbitrary a, Ord a) => Gen (AdjacencyMap a)-arbitraryAdjacencyMap = AdjacencyMap.fromAdjacencyList <$> arbitrary+arbitraryAdjacencyMap = AdjacencyMap.stars <$> arbitrary --- | Generate an arbitrary 'IntAdjacencyMap'. It is guaranteed that the+-- | Generate an arbitrary 'AdjacencyIntMap'. It is guaranteed that the -- resulting adjacency map is 'consistent'.-arbitraryIntAdjacencyMap :: Gen IntAdjacencyMap-arbitraryIntAdjacencyMap = IntAdjacencyMap.fromAdjacencyList <$> arbitrary+arbitraryAdjacencyIntMap :: Gen AdjacencyIntMap+arbitraryAdjacencyIntMap = AdjacencyIntMap.stars <$> arbitrary  -- TODO: Implement a custom shrink method. instance (Arbitrary a, Ord a) => Arbitrary (Relation a) where@@ -109,8 +109,8 @@ instance (Arbitrary a, Ord a) => Arbitrary (AdjacencyMap a) where     arbitrary = arbitraryAdjacencyMap -instance Arbitrary IntAdjacencyMap where-    arbitrary = arbitraryIntAdjacencyMap+instance Arbitrary AdjacencyIntMap where+    arbitrary = arbitraryAdjacencyIntMap  instance Arbitrary a => Arbitrary (Fold a) where     arbitrary = arbitraryGraph

@@ -21,10 +21,7 @@ t :: Testsuite t = testsuite "Fold." (empty :: Fold Int) -h :: HTestsuite-h = hTestsuite "Fold." (empty :: Fold Int)--type F  = Fold Int+type F = Fold Int  testFold :: IO () testFold = do@@ -33,101 +30,11 @@      testShow            t     testBasicPrimitives t-    testToGraph         h     testIsSubgraphOf    t+    testToGraph         t     testSize            t-    testProperties      t     testGraphFamilies   t     testTransformations t--    putStrLn "\n============ Fold.mesh ============"-    test "mesh xs     []   == empty" $ \xs ->-          mesh xs     []   == (empty :: Fold (Int, Int))--    test "mesh []     ys   == empty" $ \ys ->-          mesh []     ys   == (empty :: Fold (Int, Int))--    test "mesh [x]    [y]  == vertex (x, y)" $ \(x :: Int) (y :: Int) ->-          mesh [x]    [y]  == (vertex (x, y) :: Fold (Int, Int))--    test "mesh xs     ys   == box (path xs) (path ys)" $ \(xs :: [Int]) (ys :: [Int]) ->-          mesh xs     ys   == (box (path xs) (path ys) :: Fold (Int, Int))--    test "mesh [1..3] \"ab\" == <correct result>" $-         (mesh [1..3]  "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))-                                                          , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3,'b')) ]--    putStrLn "\n============ Fold.torus ============"-    test "torus xs    []   == empty" $ \xs ->-          torus xs    []   == (empty :: Fold (Int, Int))--    test "torus []    ys   == empty" $ \ys ->-          torus []    ys   == (empty :: Fold (Int, Int))--    test "torus [x]   [y]  == edge (x, y) (x, y)" $ \(x :: Int) (y :: Int) ->-          torus [x]   [y]  == (edge (x, y) (x, y) :: Fold (Int, Int))--    test "torus xs    ys   == box (circuit xs) (circuit ys)" $ \(xs :: [Int]) (ys :: [Int]) ->-          torus xs    ys   == (box (circuit xs) (circuit ys) :: Fold (Int, Int))--    test "torus [1,2] \"ab\" == <correct result>" $-         (torus [1,2]  "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))-                                                          , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2,'a')) ]--    putStrLn "\n============ Fold.deBruijn ============"-    test "          deBruijn 0 xs               == edge [] []" $ \(xs :: [Int]) ->-                    deBruijn 0 xs               ==(edge [] [] :: Fold [Int])--    test "n > 0 ==> deBruijn n []               == empty" $ \n ->-          n > 0 ==> deBruijn n []               == (empty :: Fold [Int])--    test "          deBruijn 1 [0,1]            == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $-                    deBruijn 1 [0,1]            ==(edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] :: Fold [Int])--    test "          deBruijn 2 \"0\"              == edge \"00\" \"00\"" $-                    deBruijn 2 "0"              ==(edge "00" "00" :: Fold String)--    test "          deBruijn 2 \"01\"             == <correct result>" $-                    deBruijn 2 "01"             ==(edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")-                                                         , ("10","00"), ("10","01"), ("11","10"), ("11","11") ] :: Fold String)--    test "          transpose   (deBruijn n xs) == gmap reverse $ deBruijn n xs" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->-                    transpose   (deBruijn n xs) == ((gmap reverse $ deBruijn n xs) :: Fold [Int])--    test "          vertexCount (deBruijn n xs) == (length $ nub xs)^n" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->-                    vertexCount (deBruijn n xs) == (length $ nubOrd xs)^n--    test "n > 0 ==> edgeCount   (deBruijn n xs) == (length $ nub xs)^(n + 1)" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->-          n > 0 ==> edgeCount   (deBruijn n xs) == (length $ nubOrd xs)^(n + 1)--    testSplitVertex t-    testBind        t-    testSimplify    t--    putStrLn "\n============ Fold.box ============"-    let unit = fmap $ \(a, ()) -> a-        comm = fmap $ \(a,  b) -> (b, a)-    test "box x y               ~~ box y x" $ mapSize (min 10) $ \(x :: F) (y :: F) ->-          comm (box x y)        == (box y x :: Fold (Int, Int))--    test "box x (overlay y z)   == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: F) (y :: F) z ->-          box x (overlay y z)   == (overlay (box x y) (box x z) :: Fold (Int, Int))--    test "box x (vertex ())     ~~ x" $ mapSize (min 10) $ \(x :: F) ->-     unit(box x (vertex ()))    == x--    test "box x empty           ~~ empty" $ mapSize (min 10) $ \(x :: F) ->-     unit(box x empty)          == empty--    let assoc = fmap $ \(a, (b, c)) -> ((a, b), c)-    test "box x (box y z)       ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: F) (y :: F) (z :: F) ->-      assoc (box x (box y z))   == (box (box x y) z :: Fold ((Int, Int), Int))--    test "transpose   (box x y) == box (transpose x) (transpose y)" $ mapSize (min 10) $ \(x :: F) (y :: F) ->-          transpose   (box x y) == (box (transpose x) (transpose y) :: Fold (Int, Int))--    test "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \(x :: F) (y :: F) ->-          vertexCount (box x y) == vertexCount x * vertexCount y--    test "edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y" $ mapSize (min 10) $ \(x :: F) (y :: F) ->-          edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y+    testSplitVertex     t+    testBind            t+    testSimplify        t