digraph (empty) → 0.1.0.0

raw patch · 11 files changed

+1556/−0 lines, 11 filesdep +QuickCheckdep +basedep +containerssetup-changed

Dependencies added: QuickCheck, base, containers, deepseq, digraph, fgl, hashable, massiv, mwc-random, streaming, transformers, unordered-containers

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +8/−0
Setup.hs +2/−0
digraph.cabal +68/−0
src/Data/DiGraph.hs +605/−0
src/Data/DiGraph/FloydWarshall.hs +240/−0
src/Data/DiGraph/Random.hs +133/−0
test/Data/DiGraph/Random/Test.hs +300/−0
test/Data/DiGraph/Test.hs +109/−0
test/Main.hs +56/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for digraph++## 0.1.0.0 -- 2019-05-30++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Kadena LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Lars Kuhtz nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,8 @@+[![Build Status](https://travis-ci.org/kadena-io/digraph.svg?branch=master)](https://travis-ci.org/kadena-io/digraph)++Directed graphs in adjacency set representation. The implementation is based+on `Data.HashMap.Strict` and `Data.HashSet` from the [unordered-containers+package](https://hackage.haskell.org/package/unordered-containers).++Undirected graphs are represented as symmetric, irreflexive directed graphs.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ digraph.cabal view

@@ -0,0 +1,68 @@+cabal-version: 2.2+name: digraph+version: 0.1.0.0+synopsis: Directed Graphs+description: Directed graphs implementation that is based on unordered-containers+homepage: https://github.com/kadena-io/digraph+bug-reports: https://github.com/kadena-io/digraph/issues+license: BSD-3-Clause+license-file: LICENSE+author: Lars Kuhtz+maintainer: lars@kadena.io+copyright: Copyright (c) 2019, Kadena LLC+category: Data, Mathematics+tested-with:+      GHC==8.6.5+    , GHC==8.4.4+    , GHC==8.2.2+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+    type: git+    location: https://github.com/kadena-io/digraph.git++library+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options:+        -Wall+    exposed-modules:+          Data.DiGraph+        , Data.DiGraph.FloydWarshall+        , Data.DiGraph.Random+    build-depends:+          base >=4.10 && <4.14+        , containers >=0.5+        , deepseq >=1.4+        , hashable >=1.3+        , massiv >=0.3+        , mwc-random >=0.14+        , streaming >=0.2+        , transformers >=0.5+        , unordered-containers >=0.2++test-suite digraph-tests+    type: exitcode-stdio-1.0+    hs-source-dirs: test+    default-language: Haskell2010+    main-is: Main.hs+    ghc-options:+        -Wall+        -threaded+        -with-rtsopts=-N+    other-modules:+          Data.DiGraph.Test+        , Data.DiGraph.Random.Test+    build-depends:+        -- internal+          digraph++        -- external+        , QuickCheck >=2.11+        , base >=4.10 && <4.14+        , fgl >=5.7+        , hashable >=1.3+        , massiv >=0.3+

+ src/Data/DiGraph.hs view

@@ -0,0 +1,605 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: DiGraph+-- Copyright: Copyright © 2018-2019 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- Directed graphs in adjacency set representation. The implementation is based+-- on "Data.HashMap.Strict" and "Data.HashSet" from the [unordered-containers+-- package](https://hackage.haskell.org/package/unordered-containers)+--+-- Undirected graphs are represented as symmetric, irreflexive directed graphs.+--+module Data.DiGraph+( DiGraph+, DiEdge+, adjacencySets+, vertices+, edges+, adjacents+, incidents++-- * Construction and Modification of Graphs+, insertEdge+, fromEdges+, insertVertex+, mapVertices+, union+, transpose+, symmetric+, fromList+, unsafeFromList++-- * Predicates+, isDiGraph+, isAdjacent+, isRegular+, isSymmetric+, isIrreflexive+, isEdge+, isVertex++-- * Properties+, order+, size+, diSize+, symSize+, outDegree+, inDegree+, maxOutDegree+, maxInDegree+, minOutDegree+, minInDegree++-- * Distances, Shortest Paths, and Diameter+, ShortestPathCache+, shortestPathCache+, shortestPath+, shortestPath_+, distance+, distance_+, diameter+, diameter_++-- * Graphs+, emptyGraph+, singleton+, clique+, pair+, triangle+, cycle+, diCycle+, line+, diLine+, petersonGraph+, twentyChainGraph+, hoffmanSingleton++) where++import Control.Arrow+import Control.DeepSeq+import Control.Monad++import Data.Foldable+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import qualified Data.List as L+import Data.Maybe+import Data.Semigroup+import Data.Traversable+import Data.Tuple++import GHC.Generics++import Numeric.Natural++import Prelude hiding (cycle)++-- internal modules++import qualified Data.DiGraph.FloydWarshall as FW++-- -------------------------------------------------------------------------- --+-- Utils++int :: Integral a => Num b => a -> b+int = fromIntegral+{-# INLINE int #-}++-- -------------------------------------------------------------------------- --+-- Graph++-- | Directed Edge.+--+type DiEdge a = (a, a)++-- | Adjacency set representation of directed graphs.+--+-- It is assumed that each target of an edge is also explicitly a vertex in the+-- graph.+--+-- It is not generally required that graphs are irreflexive, but all concrete+-- graphs that are defined in this module are irreflexive.+--+-- Undirected graphs are represented as symmetric directed graphs.+--+newtype DiGraph a = DiGraph { unGraph :: HM.HashMap a (HS.HashSet a) }+    deriving (Show, Eq, Ord, Generic)+    deriving anyclass (NFData, Hashable)++instance (Hashable a, Eq a) => Semigroup (DiGraph a) where+    (DiGraph a) <> (DiGraph b) = DiGraph (HM.unionWith (<>) a b)+    {-# INLINE (<>) #-}++instance (Hashable a, Eq a) => Monoid (DiGraph a) where+    mempty = DiGraph mempty+    mappend = (<>)+    {-# INLINE mempty #-}+    {-# INLINE mappend #-}++-- | A predicate that asserts that every target of an edge is also a vertex in+-- the graph. Any graph that is constructed without using unsafe methods is+-- guaranteed to satisfy this predicate.+--+isDiGraph :: Eq a => Hashable a => DiGraph a -> Bool+isDiGraph g@(DiGraph m) = HS.null (HS.unions (HM.elems m) `HS.difference` vertices g)+{-# INLINE isDiGraph #-}++-- | The adjacency sets of a graph.+--+adjacencySets :: DiGraph a -> HM.HashMap a (HS.HashSet a)+adjacencySets = unGraph+{-# INLINE adjacencySets #-}++-- | The set of vertices of the graph.+--+vertices :: DiGraph a -> HS.HashSet a+vertices = HS.fromMap . HM.map (const ()) . unGraph+{-# INLINE vertices #-}++-- | The set edges of the graph.+--+edges :: Eq a => Hashable a => DiGraph a -> HS.HashSet (DiEdge a)+edges = HS.fromList . concatMap (traverse HS.toList) . HM.toList . unGraph+{-# INLINE edges #-}++-- | The set of adjacent pairs of a graph.+--+adjacents :: Eq a => Hashable a => a -> DiGraph a -> HS.HashSet a+adjacents a (DiGraph g) = g HM.! a+{-# INLINE adjacents #-}++-- | The set of incident edges of a graph.+--+incidents :: Eq a => Hashable a => a -> DiGraph a -> [(a, a)]+incidents a g = [ (a, b) | b <- toList (adjacents a g) ]+{-# INLINE incidents #-}++-- -------------------------------------------------------------------------- --+-- Constructing and Modifying Graphs++-- | Construct a graph from adjacency lists.+--+fromList :: Eq a => Hashable a => [(a,[a])] -> DiGraph a+fromList l = foldr insertVertex es (fst <$> l)+  where+    es = fromEdges [ (a,b) | (a, bs) <- l, b <- bs ]+{-# INLINE fromList #-}++-- | Unsafely construct a graph from adjacency lists.+--+-- This function assumes that the input includes a adjacency list of each vertex+-- that appears in a adjacency list of another vertex. Generally, 'fromList'+-- should be preferred.+--+unsafeFromList :: Eq a => Hashable a => [(a,[a])] -> DiGraph a+unsafeFromList = DiGraph . HM.map HS.fromList . HM.fromList+{-# INLINE unsafeFromList #-}++-- | Construct a graph from a foldable structure of edges.+--+fromEdges :: Eq a => Hashable a => Foldable f => f (a, a) -> DiGraph a+fromEdges = foldr insertEdge mempty+{-# INLINE fromEdges #-}++-- | The union of two graphs.+--+union :: Eq a => Hashable a => DiGraph a -> DiGraph a -> DiGraph a+union = (<>)+{-# INLINE union #-}++-- | Map a function over all vertices of a graph.+--+mapVertices :: Eq b => Hashable b => (a -> b) -> DiGraph a -> DiGraph b+mapVertices f = DiGraph . HM.fromList . fmap (f *** HS.map f) . HM.toList . unGraph+{-# INLINE mapVertices #-}++-- | Transpose a graph, i.e. reverse all edges of the graph.+--+transpose :: Eq a => Hashable a => DiGraph a -> DiGraph a+transpose g = (DiGraph $ mempty <$ unGraph g)+    `union` (fromEdges . HS.map swap $ edges g)++-- | Symmetric closure of a graph.+--+symmetric :: Eq a => Hashable a => DiGraph a -> DiGraph a+symmetric g = g <> transpose g+{-# INLINE symmetric #-}++-- | Insert an edge. Returns the graph unmodified if the edge is already in the+-- graph. Non-existing vertices are added.+--+insertEdge :: Eq a => Hashable a => DiEdge a -> DiGraph a -> DiGraph a+insertEdge (a,b) = DiGraph+    . HM.insertWith (<>) a [b]+    . HM.insertWith (<>) b []+    . unGraph+{-# INLINE insertEdge #-}++-- | Insert a vertex. Returns the graph unmodified if the vertex is already in+-- the graph.+--+insertVertex :: Eq a => Hashable a => a -> DiGraph a -> DiGraph a+insertVertex a = DiGraph . HM.insertWith (<>) a [] . unGraph+{-# INLINE insertVertex #-}++-- -------------------------------------------------------------------------- --+-- Properties++-- | The order of a graph is the number of vertices.+--+order :: DiGraph a -> Natural+order = int . HS.size . vertices+{-# INLINE order #-}++-- | Directed Size. This the number of edges of the graph.+--+diSize :: Eq a => Hashable a => DiGraph a -> Natural+diSize = int . HS.size . edges+{-# INLINE diSize #-}++-- | Directed Size. This the number of edges of the graph.+--+size :: Eq a => Hashable a => DiGraph a -> Natural+size = int . HS.size . edges+{-# INLINE size #-}++-- | Undirected Size of a graph. This is the number of edges of the symmetric+-- closure of the graph.+--+symSize :: Eq a => Hashable a => DiGraph a -> Natural+symSize g = diSize (symmetric g) `div` 2+{-# INLINE symSize #-}++-- | The number of outgoing edges of vertex in a graph.+--+outDegree :: Eq a => Hashable a => DiGraph a -> a -> Natural+outDegree (DiGraph g) a = int . HS.size $ g HM.! a+{-# INLINE outDegree #-}++-- | The maximum out-degree of the vertices of a graph.+--+maxOutDegree :: Eq a => Hashable a => DiGraph a -> Natural+maxOutDegree g = maximum $ HS.map (outDegree g) (vertices g)+{-# INLINE maxOutDegree #-}++-- | The minimum out-degree of the vertices of a graph.+--+minOutDegree :: Eq a => Hashable a => DiGraph a -> Natural+minOutDegree g = minimum $ HS.map (outDegree g) (vertices g)+{-# INLINE minOutDegree #-}++-- | The number of incoming edges of vertex in a graph.+--+inDegree :: Eq a => Hashable a => DiGraph a -> a -> Natural+inDegree g = outDegree (transpose g)+{-# INLINE inDegree #-}++-- | The maximum in-degree of the vertices of a graph.+--+maxInDegree :: Eq a => Hashable a => DiGraph a -> Natural+maxInDegree = maxOutDegree . transpose+{-# INLINE maxInDegree #-}++-- | The minimum in-degree of the vertices of a graph.+--+minInDegree :: Eq a => Hashable a => DiGraph a -> Natural+minInDegree = minOutDegree . transpose+{-# INLINE minInDegree #-}++-- -------------------------------------------------------------------------- --+-- Predicates++-- | Return whether a graph is regular, i.e. whether all vertices have the same+-- out-degree. Note that the latter implies that all vertices also have the same+-- in-degree.+--+isRegular :: DiGraph a -> Bool+isRegular = (== 1)+    . length+    . L.group+    . fmap (HS.size . snd)+    . HM.toList+    . unGraph+{-# INLINE isRegular #-}++-- | Return whether a graph is symmetric, i.e. whether for each edge \((a,b)\)+-- there is also the edge \((b,a)\) in the graph.+--+isSymmetric :: Hashable a => Eq a => DiGraph a -> Bool+isSymmetric g = all checkVertex $ HM.toList $ unGraph g+  where+    checkVertex (a, e) = all (\x -> isAdjacent x a g) e+{-# INLINE isSymmetric #-}++-- | Return whether a graph is irreflexive. A graph is irreflexive if for each+-- edge \((a,b)\) it holds that \(a \neq b\), i.e there are no self-loops in the+-- graph.+--+isIrreflexive :: Eq a => Hashable a => DiGraph a -> Bool+isIrreflexive = not . any (uncurry HS.member) . HM.toList . unGraph+{-# INLINE isIrreflexive #-}++-- | Return whether a vertex is contained in a graph.+--+isVertex :: Eq a => Hashable a => a -> DiGraph a -> Bool+isVertex a = HM.member a . unGraph+{-# INLINE isVertex #-}++-- | Return whether an edge is contained in a graph.+--+isEdge :: Eq a => Hashable a => DiEdge a -> DiGraph a -> Bool+isEdge (a, b) = maybe False (HS.member b) . HM.lookup a . unGraph+{-# INLINE isEdge #-}++-- | Return whether two vertices are adjacent in a graph.+--+isAdjacent :: Eq a => Hashable a => a -> a -> DiGraph a -> Bool+isAdjacent = curry isEdge+{-# INLINE isAdjacent #-}++-- -------------------------------------------------------------------------- --+-- Distances, Shortest Paths, and Diameter++-- | The shortest path matrix of a graph.+--+-- The shortest path matrix of a graph can be used to efficiently query the+-- distance and shortest path between any two vertices of the graph. It can also+-- be used to efficiently compute the diameter of the graph.+--+-- Computing the shortest path matrix is expensive for larger graphs. The matrix+-- is computed using the Floyd-Warshall algorithm. The space and time complexity+-- is quadratic in the /order/ of the graph. For sparse graphs there are more+-- efficient algorithms for computing distances and shortest paths between the+-- nodes of the graph.+--+data ShortestPathCache a = ShortestPathCache+    {-# UNPACK #-} !FW.ShortestPathMatrix+        -- ^ The shortest path matrix of a graph.+    !(HM.HashMap a Int)+        -- ^ mapping from vertices of the graph to indices in the shortest path+        -- matrix.+    !(HM.HashMap Int a)+        -- ^ mapping from indices in the shortest path matrix to vertices in the+        -- graph.+    deriving (Show, Eq, Ord, Generic)+    deriving anyclass (NFData)++-- | Compute the shortest path matrix for a graph. The result can be used to+-- efficiently query the distance and shortest path between any two vertices of+-- the graph. It can also be used to efficiently compute the diameter of the+-- graph.+--+shortestPathCache :: Eq a => Hashable a => DiGraph a -> ShortestPathCache a+shortestPathCache g = ShortestPathCache m vmap rvmap+  where+    m = FW.floydWarshall $ FW.fromAdjacencySets (unGraph ig)+    ig = mapVertices (vmap HM.!) g+    vmap = HM.fromList $ zip (HS.toList $ vertices g) [0..]+    rvmap = HM.fromList $ zip [0..] (HS.toList $ vertices g)++-- | Compute the Diameter of a graph, i.e. the maximum length of a shortest path+-- between two vertices in the graph.+--+-- This is expensive to compute for larger graphs. If also the shortest paths or+-- distances are needed, one should use 'shortestPathCache' to cache the result+-- of the search and use the 'diameter_', 'shortestPath_', and 'distance_' to+-- query the respective results from the cache.+--+-- The algorithm is optimized for dense graphs. For large sparse graphs a more+-- efficient algorithm should be used.+--+diameter :: Eq a => Hashable a => DiGraph a -> Maybe Natural+diameter = diameter_ . shortestPathCache+{-# INLINE diameter #-}++-- | Compute the Diameter of a graph from a shortest path matrix. The diameter+-- of a graph is the maximum length of a shortest path between two vertices in+-- the graph.+--+diameter_ :: ShortestPathCache a -> Maybe Natural+diameter_ (ShortestPathCache m _ _) = round <$> FW.diameter m+{-# INLINE diameter_ #-}++-- | Compute the shortest path between two vertices of a graph.+--+-- | This is expensive for larger graphs. If more than one path is needed one+-- should use 'shortestPathCache' to cache the result of the search and use+-- 'shortestPath_' to query paths from the cache.+--+-- The algorithm is optimized for dense graphs. For large sparse graphs a more+-- efficient algorithm should be used.+--+shortestPath :: Eq a => Hashable a => a -> a -> DiGraph a -> Maybe [a]+shortestPath src trg = shortestPath_ src trg . shortestPathCache+{-# INLINE shortestPath #-}++-- | Compute the shortest path between two vertices from the shortest path+-- matrix of a graph.+--+-- The algorithm is optimized for dense graphs. For large sparse graphs a more+-- efficient algorithm should be used.+--+shortestPath_ :: Eq a => Hashable a => a -> a -> ShortestPathCache a -> Maybe [a]+shortestPath_ src trg (ShortestPathCache c m r)+    = fmap ((HM.!) r) <$> FW.shortestPath c (m HM.! src) (m HM.! trg)+{-# INLINE shortestPath_ #-}++-- | Compute the distance between two vertices of a graph.+--+-- | This is expensive for larger graphs. If more than one distance is needed+-- one should use 'shortestPathCache' to cache the result of the search and use+-- 'distance_' to query paths from the cache.+--+-- The algorithm is optimized for dense graphs. For large sparse graphs a more+-- efficient algorithm should be used.+--+distance :: Eq a => Hashable a => a -> a -> DiGraph a -> Maybe Natural+distance src trg = distance_ src trg . shortestPathCache+{-# INLINE distance #-}++-- | Compute the distance between two vertices from the shortest path matrix of+-- a graph.+--+-- The algorithm is optimized for dense graphs. For large sparse graphs a more+-- efficient algorithm should be used.+--+distance_ :: Eq a => Hashable a => a -> a -> ShortestPathCache a -> Maybe Natural+distance_ src trg (ShortestPathCache c m _)+    = round <$> FW.distance c (m HM.! src) (m HM.! trg)+{-# INLINE distance_ #-}++-- -------------------------------------------------------------------------- --+-- Concrete Graph++-- | The empty graph on @n@ nodes. This is the graph of 'order' @n@ and 'size'+-- @0@.+--+emptyGraph :: Natural -> DiGraph Int+emptyGraph n = unsafeFromList [ (i, []) | i <- [0 .. int n - 1] ]++-- | Undirected clique.+--+clique :: Natural -> DiGraph Int+clique i = unsafeFromList+    [ (a, b)+    | a <- [0 .. int i - 1]+    , let b = [ x | x <- [0 .. int i - 1] , x /= a ]+    ]++-- | The (irreflexive) singleton graph.+--+singleton :: DiGraph Int+singleton = clique 1++-- | Undirected pair.+--+pair :: DiGraph Int+pair = clique 2++-- | Undirected triangle.+--+triangle :: DiGraph Int+triangle = clique 3++-- | Directed cycle.+--+diCycle :: Natural -> DiGraph Int+diCycle n = unsafeFromList [ (a, [(a + 1) `mod` int n]) | a <- [0 .. int n - 1] ]++-- | Undirected cycle.+--+cycle :: Natural -> DiGraph Int+cycle = symmetric . diCycle++-- | Directed line.+--+diLine :: Natural -> DiGraph Int+diLine n = unsafeFromList [ (a, [ a + 1 | a /= int n - 1]) | a <- [0 .. int n - 1] ]++-- | Undirected line.+--+line :: Natural -> DiGraph Int+line = symmetric . diLine++-- | The Peterson graph.+--+petersonGraph :: DiGraph Int+petersonGraph = DiGraph+    [ (0, [2,3,5])+    , (1, [3,4,6])+    , (2, [4,0,7])+    , (3, [0,1,8])+    , (4, [1,2,9])+    , (5, [0,6,9])+    , (6, [1,5,7])+    , (7, [2,6,8])+    , (8, [3,7,9])+    , (9, [4,8,5])+    ]++-- | The "twenty chain" graph.+--+twentyChainGraph :: DiGraph Int+twentyChainGraph  = pentagram `union` pentagon1 `union` pentagon2 `union` connections+  where+    pentagram = mapVertices (+ 5) $ pentagon2pentagram $ cycle 5+    pentagon1 = mapVertices (+ 10) $ cycle 5+    pentagon2 = mapVertices (+ 15) $ cycle 5+    connections = fromEdges $ HS.fromList $ mconcat+        [ [(i, x), (x, i)]+        | i <- [0..4]+        , x <- [i + 5, i + 10, i + 15]+        ]+    pentagon2pentagram = mapVertices $ \case+        0 -> 0+        1 -> 3+        2 -> 1+        3 -> 4+        4 -> 2+        _ -> error "invalid vertex"++-- | Hoffman-Singleton Graph.+--+-- The Hoffman-Singleton graph is a 7-regular graph with 50 vertices and 175+-- edges. It's the largest graph of max-degree 7 and diameter 2. Cf.+-- [https://en.wikipedia.org/wiki/Hoffman–Singleton_graph]()+--+hoffmanSingleton :: DiGraph Int+hoffmanSingleton = pentagons `union` pentagrams `union` connections+  where+    pentagons = mconcat+        [ mapVertices (p_off i) $ cycle 5 | i <- [0 .. 4] ]+    pentagrams = mconcat+        [ mapVertices (q_off i) $ pentagon2pentagram $ cycle 5 | i <- [0 .. 4] ]++    p_off h = (+) (25 + 5 * h)+    q_off i = (+) (5 * i)++    pentagon2pentagram = mapVertices $ \case+        0 -> 0+        1 -> 3+        2 -> 1+        3 -> 4+        4 -> 2+        _ -> error "invalid vertex"++    connections = fromEdges $ HS.fromList $ mconcat+        [ [(a, b), (b, a)]+        | h <- [0 .. 4]+        , j <- [0 .. 4]+        , let a = p_off h j+        , i <- [0 .. 4]+        , let b = q_off i ((h * i + j) `mod` 5)+        ]+

+ src/Data/DiGraph/FloydWarshall.hs view

@@ -0,0 +1,240 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module: Data.DiGraph.FloydWarshall+-- Copyright: Copyright © 2018 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- TODO+--+module Data.DiGraph.FloydWarshall+(+-- * Graph Representations+  DenseAdjMatrix+, AdjacencySets++-- * Conversions+, fromAdjacencySets+, toAdjacencySets++-- * FloydWarshall Algorithm+, ShortestPathMatrix(..)+, floydWarshall+, shortestPath+, distance+, diameter++-- * Legacy exports+, distMatrix_+, floydWarshall_+, diameter_+, shortestPaths_+) where++import Control.DeepSeq++import Data.Foldable+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import Data.Massiv.Array as M+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import GHC.Generics++import Numeric.Natural++-- -------------------------------------------------------------------------- --+-- Graph Representations++-- | Adjacency matrix representation of a directed graph.+--+type DenseAdjMatrix = Array U Ix2 Int++-- | Adjacency set representation of a directed graph.+--+type AdjacencySets = HM.HashMap Int (HS.HashSet Int)++-- -------------------------------------------------------------------------- --+-- Adjacency Matrix for dense Graphs+--+-- (uses massiv)++-- | Assumes that the input is an undirected graph and that the vertex+-- set is a prefix of the natural numbers.+--+fromAdjacencySets :: AdjacencySets -> DenseAdjMatrix+fromAdjacencySets g = makeArray Seq (Sz (n :. n)) go+  where+    n = HM.size g+    go (i :. j)+        | isEdge (i, j) = 1+        | isEdge (j, i) = 1+        | otherwise = 0+    isEdge (a, b) = maybe False (HS.member b) $ HM.lookup a g++-- | Converts an adjacency matrix into a graph in adjacnency set representation.+--+toAdjacencySets :: DenseAdjMatrix -> AdjacencySets+toAdjacencySets = ifoldlS f mempty+  where+    f a (i :. j) x+        | x == 0 = a+        | otherwise = HM.insertWith (<>) i (HS.singleton j) a++-- -------------------------------------------------------------------------- --+-- Floyd Warshall with Paths++-- | Shortest path matrix of a graph.+--+newtype ShortestPathMatrix = ShortestPathMatrix (Array U Ix2 (Double, Int))+    deriving (Show, Eq, Ord, Generic)+    deriving newtype (NFData)++-- | Shortest path computation for integral matrixes.+--+floydWarshall :: Unbox a => Real a => Array U Ix2 a -> ShortestPathMatrix+floydWarshall = ShortestPathMatrix+    . floydWarshallInternal+    . computeAs U+    . intDistMatrix++-- | Compute a shortest path between two vertices of a graph from the shortest+-- path matrix of the graph.+--+shortestPath+    :: ShortestPathMatrix+    -> Int+    -> Int+    -> Maybe [Int]+shortestPath (ShortestPathMatrix m) src trg+    | M.isEmpty mat = Nothing+    | not (M.isSafeIndex (size m) (src :. trg)) = Nothing+    | (mat M.! (src :. trg)) == (-1) = Nothing+    | otherwise = go src trg+  where+    mat = M.computeAs U $ M.map snd m+    go a b+        | a == b = return []+        | otherwise = do+            n <- M.index mat (a :. b)+            (:) n <$> go n b++-- | Compute the distance between two vertices of a graph from the shortest path+-- matrix of the graph.+--+distance :: ShortestPathMatrix -> Int -> Int -> Maybe Double+distance (ShortestPathMatrix m) src trg+    | M.isEmpty m = Nothing+    | otherwise = toDistance . fst =<< M.index m (src :. trg)++-- | Compute the diameter of a graph from the shortest path matrix of the graph.+--+diameter :: ShortestPathMatrix -> Maybe Double+diameter (ShortestPathMatrix m)+    | M.isEmpty m = Just 0+    | otherwise = toDistance $ maximum' $ M.map fst m++-- -------------------------------------------------------------------------- --+-- Internal++toDistance :: RealFrac a => a -> Maybe a+toDistance x+    | x == 1/0 = Nothing+    | otherwise = Just x++-- | Distance matrix for int inputs.+--+intDistMatrix+    :: Real a+    => Source r Ix2 a+    => Array r Ix2 a+    -> Array M.D Ix2 (Double, Int)+intDistMatrix = M.imap go+  where+    go (x :. y) e+        | x == y = (0, y)+        | e > 0 = (realToFrac e, y)+        | otherwise = (1/0, -1)++-- | Floyd-Warshall With Path Matrix+--+-- TODO: use a mutable array?+-- TODO: implement Dijkstra's algorithm for adj matrix representation.+--+floydWarshallInternal+    :: Array U Ix2 (Double, Int)+    -> Array U Ix2 (Double,Int)+floydWarshallInternal a = foldl' go a [0..n-1]+  where+    Sz (n :. _) = size a++    go :: Array U Ix2 (Double, Int) -> Int -> Array U Ix2 (Double,Int)+    go c k = makeArray Seq (Sz (n :. n)) $ \(x :. y) ->+        let+            !xy = fst $! c M.! (x :. y)+            !xk = fst $! c M.! (x :. k)+            !ky = fst $! c M.! (k :. y)+            !nxy = snd $! c M.! (x :. y)+            !nxk = snd $! c M.! (x :. k)+        in if xy > xk + ky then (xk + ky, nxk) else (xy, nxy)++-- -------------------------------------------------------------------------- --+-- Floyd Warshall Without Paths (more efficient, by factor of 2)++-- | Floyd Warshall Without Paths (more efficient, by factor of 2).+--+distMatrix_+    :: Source r Ix2 Int+    => Array r Ix2 Int+    -> Array M.D Ix2 Double+distMatrix_ = M.imap go+  where+    go (x :. y) e+        | x == y = 0+        | e > 0 = realToFrac e+        | otherwise = 1/0++-- | Floyd Warshall Without Paths (more efficient, by factor of 2).+--+-- TODO: use a mutable array?+-- TODO: implement Dijkstra's algorithm for adj matrix representation.+--+floydWarshall_+    :: Array U Ix2 Double+    -> Array U Ix2 Double+floydWarshall_ a = foldl' go a [0..n-1]+  where+    Sz (n :. _) = size a++    go :: Array U Ix2 Double -> Int -> Array U Ix2 Double+    go c k = makeArray Seq (Sz (n :. n)) $ \(x :. y) ->+        let+            !xy = c M.! (x :. y)+            !xk = c M.! (x :. k)+            !ky = c M.! (k :. y)+        in if xy > xk + ky then xk + ky else xy++-- | Shortest path matrix.+--+-- All entries of the result matrix are either whole numbers or @Infinity@.+--+shortestPaths_ :: Array U Ix2 Int -> Array U Ix2 Double+shortestPaths_ = floydWarshall_ . computeAs U . distMatrix_++-- | Diameter of a graph.+--+diameter_ :: Array U Ix2 Int -> Maybe Natural+diameter_ g+    | M.isEmpty g = Just 0+    | otherwise = let x = round $ maximum' $ shortestPaths_ g+        in if x == round (1/0 :: Double) then Nothing else Just x

+ src/Data/DiGraph/Random.hs view

@@ -0,0 +1,133 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Data.DiGraph.Random+-- Copyright: Copyright © 2019 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- Throughout the module an undirected graph is a directed graph that is+-- symmetric and irreflexive.+--+--+module Data.DiGraph.Random+(+-- * Random Regular Graph+  UniformRng+, rrgIO+, rrg++-- * Random Graphs in the \(G_{n,p}\) model+, gnp+) where++import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Maybe++import qualified Data.Set as S++import Numeric.Natural++import qualified Streaming.Prelude as S++import qualified System.Random.MWC as MWC++-- internal modules++import Data.DiGraph++-- -------------------------------------------------------------------------- --+-- Utils++-- | Type of a random number generator that uniformily chooses an element from a+-- range.+--+type UniformRng m = (Int, Int) -> m Int++int :: Integral a => Num b => a -> b+int = fromIntegral+{-# INLINE int #-}++-- -------------------------------------------------------------------------- --+-- Random Regular Graph++-- | Undirected, irreflexive random regular graph.+--+-- The algorithm here is incomplete. For a complete approach see for instance+-- https://users.cecs.anu.edu.au/~bdm/papers/RandRegGen.pdf+--+rrgIO+    :: Natural+    -> Natural+    -> IO (Maybe (DiGraph Int))+rrgIO n d = MWC.withSystemRandom $ \gen -> rrg @IO (`MWC.uniformR` gen) n d++-- | Undirected, irreflexive random regular graph.+--+-- The algorithm here is incomplete. For a complete approach see for instance+-- https://users.cecs.anu.edu.au/~bdm/papers/RandRegGen.pdf+--+rrg+    :: Monad m+    => UniformRng m+        -- ^ a uniform random number generator+    -> Natural+    -> Natural+    -> m (Maybe (DiGraph Int))+rrg gen n d = go 0 (S.fromList c) (emptyGraph n)+  where+    v = [0 .. int n - 1]+    c = [(x, y) | x <- v, y <- [0 :: Int .. int d - 1]]++    go i s g+        | S.null s = return $ Just g+        | (fst . fst <$> S.minView s) == (fst . fst <$> S.maxView s) = return Nothing+        | otherwise = sampleEdge s g >>= \case+            Nothing -> if i < n then go (i + 1) s g else return Nothing+            Just (s', g') -> go 0 s' g'++    sampleEdge s graph = runMaybeT $ do+        (s', v₁) <- lift $ uniformSample gen s+        (s'', v₂) <- lift $ uniformSample gen s'+        let e₁ = (fst v₁, fst v₂)+        let e₂ = (fst v₂, fst v₁)+        guard $ fst v₁ /= fst v₂ && not (isEdge e₁ graph)+        return (s'', insertEdge e₁ $ insertEdge e₂ graph)++-- | Uniformily sample an element from the input set. Returns the set with the+-- sampled element removed and the sampled element.+--+uniformSample :: Monad m => UniformRng m -> S.Set a -> m (S.Set a, a)+uniformSample gen s = do+    p <- gen (0, S.size s - 1)+    return (S.deleteAt p s, S.elemAt p s)++-- -------------------------------------------------------------------------- --+-- Gnp++-- | Undirected irreflexive random graph in the \(G_{n,p}\) model.+--+gnp+    :: forall m+    . Monad m+    => UniformRng m+    -> Natural+    -> Double+    -> m (DiGraph Int)+gnp gen n p = S.fold_ (flip insertEdge) (emptyGraph n) id+    $ S.concat+    $ S.filterM (const choice)+    $ S.each+        [ [(a,b), (b,a)]+        | a <- [0..int n - 1]+        , b <- [0..a-1]+        ]+  where+    choice = do+        v <- gen (0, maxBound)+        return $ int v <= p * int (maxBound :: Int)+

+ test/Data/DiGraph/Random/Test.hs view

@@ -0,0 +1,300 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Data.DiGraph.Random.Test+-- Copyright: Copyright © 2019 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- TODO+--+module Data.DiGraph.Random.Test+( RegularGraph(..)+, Gnp(..)+, RandomGraph(..)++-- * Test Properties+, properties+) where++import Data.Foldable+import qualified Data.Graph.Inductive.Graph as G+import qualified Data.Graph.Inductive.Internal.RootPath as G+import qualified Data.Graph.Inductive.PatriciaTree as G+import qualified Data.Graph.Inductive.Query.SP as G+import Data.Hashable+import Data.Massiv.Array (Array(..), U, Ix2(..), makeArray, Comp(..))+import qualified Data.Massiv.Array as M+import Data.Proxy+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import GHC.Generics+import GHC.TypeNats++import Numeric.Natural++import Test.QuickCheck++import Text.Printf++-- internal modules++import Data.DiGraph+import qualified Data.DiGraph.FloydWarshall as FW+import Data.DiGraph.Random++-- -------------------------------------------------------------------------- --+-- Utils++int :: Integral a => Num b => a -> b+int = fromIntegral+{-# INLINE int #-}++-- -------------------------------------------------------------------------- --+-- Arbitrary Graph Instances++-- | Uniformily distributed regular graph in edge list representation. The type+-- parameter is the degree of the graph. The size parameter of the QuickCheck+-- Arbirary instance is the order of the graph.+--+type role RegularGraph phantom+newtype RegularGraph (d :: Nat) = RegularGraph { getRegularGraph :: DiGraph Int }+    deriving (Show, Eq, Ord, Generic)++instance KnownNat d => Arbitrary (RegularGraph d) where+    arbitrary = fmap RegularGraph+        $ scale (if d > (0 :: Int) then (+ (d + 1)) else id)+        $ sized $ \n -> maybe discard return =<< rrg choose (int n) d+      where+        d :: Num a => a+        d = int $ natVal (Proxy @d)+++-- | Random graph in the \(G_{n,p}\) model in edge list representation. The type+-- parameter is the size of the graph. The size parameter of the QuickCheck+-- Arbitrary instance is the expected size of the graph (number of edges).+--+-- Notes:+--+-- For \(n * (n-1) * p / 2) = m\) the distributions \(G_{n,p}\) and \(G_{n,m}\)+-- have very similar properties.+--+type role Gnp phantom+newtype Gnp (n :: Nat) = Gnp { getGnp :: DiGraph Int }+    deriving (Show, Eq, Ord, Generic)++instance KnownNat n => Arbitrary (Gnp n) where+    arbitrary = sized $ \m -> Gnp <$> gnp choose n (p m)+      where+        -- m = p * n * (n-1) / 2+        p :: Int -> Double+        p m = min 1 ((2 * int m) / (n * (n - 1)))++        n :: Num a => a+        n = int $ natVal $ Proxy @n++-- | The uniform distribution over all undirected graphs in edge list+-- representation. This is the \(G_{n,1/2})\) random graph.+--+-- Note for graphs in the \(G_{n,1/2}\) model many important properties are+-- highly concentrated around their expectation. For instances, almost all+-- graphs of a large enough order \(n\) are connected. Therefore, in many cases+-- this is not a good testing model for test spaces where only a low coverage is+-- possible.+--+newtype RandomGraph = RandomGraph { getRandomGraph :: DiGraph Int }+    deriving (Show, Eq, Ord, Generic)++instance Arbitrary RandomGraph where+    arbitrary = sized $ \n -> RandomGraph <$> gnp choose (int n) 0.5++{-+-- | Random graph in the \(G_{n,m}\) model. The type parameter is the order+-- of the graph. The \(m\) parameter free at runtime and can be chosen+-- set to the @size@ parameter in 'Arbitrary' instances.+--+-- The random graph \(G_{n,m}\) is the uniform distribution over graphs of+-- order \(n\) and size \(m\).+--+type role Gnm phantom+newtype Gnm (n :: Nat) = Gnm { getGnm :: DiGraph Int }++instance (KnownNat n) => Arbitrary (Gnm n) where+    arbitrary = sized $ \m -> d+-}++-- -------------------------------------------------------------------------- --+-- Dijkstra's Shortest Path Algorithm+--++-- | On sparse Graphs Dijkstra's algorithm is, generally, much faster than+-- Floyd-Warshall. The FGL implementation, however, is very inefficient. So,+-- this is almost certainly slower than the implementation of Floyd-Warshall+-- above.+--+-- We include this only for testing the correctness short test path matrix+-- implementation in "Data.DiGraph" which is based on Floyd-Warshall.+--+-- All entries of the result matrix are either whole numbers or @Infinity@.+--+fglShortestPaths :: G.Graph g => g Int Int -> Array U Ix2 Double+fglShortestPaths g = makeArray Seq (M.Sz (n :. n)) $ \(i :. j) ->+    maybe (1/0) realToFrac $ G.getDistance j (sp i)+  where+    sp i = G.spTree i g+    n = G.order g++fglDiameter :: G.Graph g => g Int Int -> Maybe Natural+fglDiameter g = if M.isEmpty sps+    then Just 0+    else let x = round $ M.maximum' sps+        in if x == round (1/0 :: Double) then Nothing else Just x+  where+    sps = fglShortestPaths g++toFglGraph :: G.Graph g => DiGraph Int -> g Int Int+toFglGraph g = G.mkGraph vs es+  where+    vs = [(i,i) | i <- toList (vertices g)]+    es = concatMap (\(x,y) -> [(x, y, 1)]) $ edges g++-- -------------------------------------------------------------------------- --+-- Tools for collecting coverage data++collect_graphStats+    :: Testable prop+    => Natural+        -- ^ maximum value for the graph order of in the graph distribution+    -> DiGraph Int+    -> prop+    -> Property+collect_graphStats n g+    = collect (orderClass (n + 1) g)+    . collect (sizeClass (n + 1) g)+    . collect (densityClass g)+    . collect (diameterClass g)++-- | For undirected graphs. In steps of tenth.+--+densityClass :: Eq a => Hashable a => DiGraph a -> String+densityClass g+    | order g == 0 = "density: null graph"+    | otherwise = printf "density: %.1f" d+  where+    o :: Num a => a+    o = int (order g)++    d :: Double+    d = 2 * int (size g) / (o * (o - 1))++diameterClass :: Eq a => Hashable a => DiGraph a -> String+diameterClass g = "diameter: " <> show (diameter g)++orderClass :: Natural -> DiGraph a -> String+orderClass n g = classifyByRange "order" n (order g)++-- | undirected size+--+sizeClass :: Eq a => Hashable a => Natural -> DiGraph a -> String+sizeClass n g = classifyByRange "size" (n * (n - 1) `div` 2) (size g)++classifyByRange :: String -> Natural -> Natural -> String+classifyByRange s n x = printf "%s: (%d, %d)" s l u+  where+    l = (x * 10 `div` n) * (n `div` 10)+    u = ((x * 10 `div` n) + 1) * (n `div` 10)++-- -------------------------------------------------------------------------- --+-- Property Utils++graphProperty+    :: Testable prop+    => Natural+        -- ^ maximum value for the graph order in the graph distribution+    -> (DiGraph Int -> prop)+    -> Property+graphProperty maxN p = mapSize (`mod` int maxN) $ \(RandomGraph g) ->+    collect_graphStats maxN g $ p g++rrgProperty+    :: Testable prop+    => Natural+        -- ^ maximum value for the graph order of in the graph distribution+    -> (DiGraph Int -> prop)+    -> Property+rrgProperty maxN p = mapSize (`mod` int maxN) $ \(RegularGraph g :: RegularGraph 3) ->+    collect_graphStats maxN g $ p g++-- | The first type parameter is the static order of the graph. The size of the+-- QuichCheck Arbitrary instances is the expected size of the graph (number of+-- edges).+--+gnpProperty+    :: forall (n :: Nat) prop+    . KnownNat n+    => Testable prop+    => (DiGraph Int -> prop)+    -> Property+gnpProperty p = property $ \(Gnp g :: Gnp n) ->+    collect_graphStats (natVal $ Proxy @n) g $ p g++-- -------------------------------------------------------------------------- --+-- Properties of graph algorithms++prop_shortestPaths :: DiGraph Int -> Property+prop_shortestPaths g = fglShortestPaths fglG === M.computeAs M.U (M.map fst m)+  where+    fglG = toFglGraph @G.Gr g+    denseG = FW.fromAdjacencySets $ adjacencySets g+    FW.ShortestPathMatrix m = FW.floydWarshall denseG++prop_diameter :: DiGraph Int -> Property+prop_diameter g = fglDiameter (toFglGraph @G.Gr g) === diameter g++properties_randomGraph :: [(String, Property)]+properties_randomGraph = prefix "uniform random graph" <$>+    [ ("isDiGraph", graphProperty 20 isDiGraph)+    , ("isSymmetric", graphProperty 20 isSymmetric)+    , ("shortestPaths", graphProperty 20 prop_shortestPaths)+    , ("diameter", graphProperty 20 prop_diameter)+    ]++properties_gnp :: [(String, Property)]+properties_gnp = prefix "Gnp random graph" <$>+    [ ("isDiGraph", gnpProperty @20 isDiGraph)+    , ("isSymmetric", gnpProperty @20 isSymmetric)+    , ("shortestPaths", gnpProperty @20 prop_shortestPaths)+    , ("diameter", gnpProperty @20 prop_diameter)+    ]++properties_rrg :: [(String, Property)]+properties_rrg = prefix "random regular graph" <$>+    [ ("isDiGraph", rrgProperty 20 isDiGraph)+    , ("isRegular", rrgProperty 20 isRegular)+    , ("isSymmetric", rrgProperty 20 isSymmetric)+    , ("shortestPaths", rrgProperty 20 prop_shortestPaths)+    , ("diameter", rrgProperty 20 prop_diameter)+    ]++prefix :: String -> (String, b) -> (String, b)+prefix a (b, c) = (a <> "." <> b, c)++-- | Test properties.+--+properties :: [(String, Property)]+properties = mconcat+    [ properties_randomGraph+    , properties_gnp+    , properties_rrg+    ]+

+ test/Data/DiGraph/Test.hs view

@@ -0,0 +1,109 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Data.DiGraph.Test+-- Copyright: Copyright © 2019 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+module Data.DiGraph.Test+(+-- * Test Properties+  properties+) where++import Data.Bifunctor+import Data.Hashable+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import Numeric.Natural++import Test.QuickCheck++-- internal modules++import Data.DiGraph++-- -------------------------------------------------------------------------- --+-- Test Properties++prefixProperties :: String -> [(String, Property)] -> [(String, Property)]+prefixProperties p = fmap $ first (p <>)++properties_undirected :: Eq a => Hashable a => DiGraph a -> [(String, Property)]+properties_undirected g =+    [ ("isDiGraph", property $ isDiGraph g)+    , ("isIrreflexive", property $ isIrreflexive g)+    , ("isSymmetric", property $ isSymmetric g)+    ]++properties_emptyGraph :: Natural -> [(String, Property)]+properties_emptyGraph n = prefixProperties ("emptyGraph of order " <> show n <> ": ")+    $ ("order == " <> show n, order g === n)+    : ("size == 0", size g === 0)+    : properties_undirected g+  where+    g = emptyGraph n++properties_singletonGraph :: [(String, Property)]+properties_singletonGraph = prefixProperties "singletonGraph: "+    $ ("order == 1", order g === 1)+    : ("size == 0", symSize g === 0)+    : ("outDegree == 0", maxOutDegree g === 0)+    : ("isRegular", property $ isRegular g)+    : ("diameter == 0", diameter g === Just 0)+    : properties_undirected g+  where+    g = singleton++properties_petersonGraph :: [(String, Property)]+properties_petersonGraph = prefixProperties "petersonGraph: "+    $ ("order == 10", order g === 10)+    : ("size == 15", symSize g === 15)+    : ("outDegree == 3", maxOutDegree g === 3)+    : ("isRegular", property $ isRegular g)+    : ("diameter == 2", diameter g === Just 2)+    : properties_undirected g+  where+    g = petersonGraph++properties_twentyChainGraph :: [(String, Property)]+properties_twentyChainGraph = prefixProperties "twentyChainGraph: "+    $ ("order == 20", order g === 20)+    : ("size == 30", symSize g === 30)+    : ("outDegree == 3", maxOutDegree g === 3)+    : ("isRegular", property $ isRegular g)+    : ("diameter == 2", diameter g === Just 4)+    : properties_undirected g+  where+    g = twentyChainGraph++properties_hoffmanSingletonGraph :: [(String, Property)]+properties_hoffmanSingletonGraph = prefixProperties "HoffmanSingletonGraph: "+    $ ("order == 50", order g === 50)+    : ("size == 175", symSize g === 175)+    : ("outDegree == 7", maxOutDegree g === 7)+    : ("isRegular", property $ isRegular g)+    : ("diameter == 2", diameter g === Just 2)+    : properties_undirected g+  where+    g = hoffmanSingleton++-- | Test Properties.+--+properties :: [(String, Property)]+properties = (concat :: [[(String, Property)]] -> [(String, Property)])+    [ properties_emptyGraph 0+    , properties_emptyGraph 2+    , properties_singletonGraph+    , properties_petersonGraph+    , properties_twentyChainGraph+    , properties_hoffmanSingletonGraph+    ]+

+ test/Main.hs view

@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Main+-- Copyright: Copyright © 2019 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+module Main+( main+) where++import Data.Bitraversable+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import System.Exit++import Test.QuickCheck++-- internal modules++import qualified Data.DiGraph.Test (properties)+import qualified Data.DiGraph.Random.Test (properties)++-- -------------------------------------------------------------------------- --+-- Support for QuickCheck < 2.12++#if ! MIN_VERSION_QuickCheck(2,12,0)+isSuccess :: Result -> Bool+isSuccess Success{} = True+isSuccess _ = False+#endif++-- -------------------------------------------------------------------------- --+-- Main++main :: IO ()+main = do+    results <- traverse (bitraverse print quickCheckResult) properties+    if and $ isSuccess . snd <$> results+        then exitSuccess+        else exitFailure++properties :: [(String, Property)]+properties = mconcat+    [ prefix "Data.DiGraph.Test" <$> Data.DiGraph.Test.properties+    , prefix "Data.DiGraph.Random.Test" <$> Data.DiGraph.Random.Test.properties+    ]+  where+    prefix a (b, c) = (a <> "/" <> b, c)