diff --git a/Data/Graph/Generators.hs b/Data/Graph/Generators.hs --- a/Data/Graph/Generators.hs +++ b/Data/Graph/Generators.hs @@ -2,7 +2,7 @@ module Data.Graph.Generators where -{- +{-| The information required to build a graph. This datastructure is designed to occupy minimal space. @@ -25,7 +25,7 @@ edges :: [(Int,Int)] -- ^ Edge list } deriving (Eq, Show) -{- +{-| The context of a single graph node. This data-structure is library-agnostic, however, @@ -37,7 +37,7 @@ outEdges :: [Int] -- ^ Nodes having an ingoing edge from the current node } -{- +{-| Check the integrity of a GraphInfo instance: Ensures for every edge (i,j), the following condition is met: @0 <= i < n && 0 <= j < n@ diff --git a/Data/Graph/Generators/Classic.hs b/Data/Graph/Generators/Classic.hs --- a/Data/Graph/Generators/Classic.hs +++ b/Data/Graph/Generators/Classic.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Safe #-} -{- +{-| Generators for classic non-parametric graphs. Built using NetworkX 1.8.1, see @@ -46,14 +46,14 @@ import Data.Graph.Generators -{- +{-| Generates the trivial graph, containing only one node and no edges -} trivialGraph :: GraphInfo trivialGraph = GraphInfo 1 [] -{- +{-| Generates the Bull graph. Contains only one edge between two connected nodes, @@ -73,7 +73,7 @@ let edges = [(0,2),(1,3),(2,3),(2,4),(3,4)] in GraphInfo 5 edges -{- +{-| Generate the Frucht Graph. Contains only one edge between two connected nodes, @@ -89,7 +89,7 @@ (6,10),(7,11),(8,9),(8,11),(10,11)] in GraphInfo 12 edges -{- +{-| Generate the house graph. Contains only one edge between two connected nodes, @@ -110,7 +110,7 @@ let edges = [(0,1),(0,2),(1,3),(2,3),(2,4),(3,4)] in GraphInfo 5 edges -{- +{-| Generate the house X graph. Contains only one edge between two connected nodes, @@ -131,7 +131,7 @@ let edges = [(0,1),(0,2),(0,3),(1,2),(1,3),(2,3),(2,4),(3,4)] in GraphInfo 5 edges -{- +{-| Generate the Pappus Graph. Contains only one edge between two connected nodes, @@ -148,7 +148,7 @@ (13,14),(14,15),(15,16),(16,17)] in GraphInfo 18 edges -{- +{-| Generate the Sedgewick Maze Graph. Contains only one edge between two connected nodes, @@ -161,7 +161,7 @@ (3,4),(3,5),(4,5),(4,6),(4,7)] in GraphInfo 8 edges -{- +{-| Generate the Petersen Graph. Contains only one edge between two connected nodes, @@ -175,7 +175,7 @@ (6,8),(6,9),(7,9)] in GraphInfo 10 edges -{- +{-| Generate the Heawood Graph. Contains only one edge between two connected nodes, @@ -190,7 +190,7 @@ (10,11),(11,12),(12,13)] in GraphInfo 14 edges -{- +{-| Generate the Diamond Graph. Contains only one edge between two connected nodes, @@ -202,7 +202,7 @@ let edges = [(0,1),(0,2),(1,2),(1,3),(2,3)] in GraphInfo 4 edges -{- +{-| Generate the dodecahedral Graph. Contains only one edge between two connected nodes, @@ -219,7 +219,7 @@ (17,18),(18,19)] in GraphInfo 20 edges -{- +{-| Generate the icosahedral Graph. Contains only one edge between two connected nodes, @@ -235,7 +235,7 @@ (9,10),(10,11)] in GraphInfo 12 edges -{- +{-| Generate the Krackhardt-Kite Graph. Contains only one edge between two connected nodes, @@ -249,7 +249,7 @@ (7,8),(8,9)] in GraphInfo 10 edges -{- +{-| Generate the Möbius-Kantor Graph. Contains only one edge between two connected nodes, @@ -263,13 +263,27 @@ (8,13),(9,10),(10,11),(10,15),(11,12),(12,13),(13,14),(14,15)] in GraphInfo 16 edges + +{-| + Generate the octahedral graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} octahedralGraph :: GraphInfo octahedralGraph = let edges = [(0,1),(0,2),(0,3),(0,4),(1,2),(1,3),(1,5),(2,4), (2,5),(3,4),(3,5),(4,5)] in GraphInfo 6 edges +{-| + Generate the Chvatal graph. + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} chvatalGraph :: GraphInfo chvatalGraph = let edges = [(0,1),(0,4),(0,6),(0,9),(1,2),(1,5),(1,7),(2,8),(2,3), @@ -277,13 +291,26 @@ (6,10),(7,8),(7,11),(8,10),(9,11),(9,10)] in GraphInfo 12 edges +{-| + Generate the cubical graph. + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} cubicalGraph :: GraphInfo cubicalGraph = let edges = [(0,1),(0,3),(0,4),(1,2),(1,7),(2,3),(2,6),(3,5),(4,5), (4,7),(5,6),(6,7)] in GraphInfo 8 edges +{-| + Generate the Desargues graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} desarguesGraph :: GraphInfo desarguesGraph = let edges = [(0,1),(0,19),(0,5),(1,16),(1,2),(2,11),(2,3),(3,4), @@ -292,11 +319,25 @@ (12,13),(13,14),(14,15),(15,16),(16,17),(17,18),(18,19)] in GraphInfo 20 edges +{-| + Generate the tetrahedral graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} tetrahedralGraph :: GraphInfo tetrahedralGraph = let edges = [(0,1),(0,2),(0,3),(1,2),(1,3),(2,3)] in GraphInfo 4 edges +{-| + Generate the truncated cube graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} truncatedCubeGraph :: GraphInfo truncatedCubeGraph = let edges = [(0,1),(0,2),(0,4),(1,11),(1,14),(2,3),(2,4),(3,8),(3,6), @@ -306,12 +347,26 @@ (19,23),(20,21),(21,22),(22,23)] in GraphInfo 24 edges +{-| + Generate the truncated tetrahedron graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} truncatedTetrahedronGraph :: GraphInfo truncatedTetrahedronGraph = let edges = [(0,1),(0,2),(0,9),(1,2),(1,6),(2,3),(3,11),(3,4),(4,11), (4,5),(5,6),(5,7),(6,7),(7,8),(8,9),(8,10),(9,10),(10,11)] in GraphInfo 12 edges +{-| + Generate the Tutte graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} tutteGraph :: GraphInfo tutteGraph = let edges = [(0,1),(0,2),(0,3),(1,26),(1,4),(2,10),(2,11),(3,18),(3,19), @@ -325,7 +380,7 @@ (36,39),(37,38),(40,41),(40,44),(41,42),(42,43),(42,45),(43,44)] in GraphInfo 46 edges -{- +{-| The null graph with no nodes and edges -} nullGraph :: GraphInfo diff --git a/Data/Graph/Generators/FGL.hs b/Data/Graph/Generators/FGL.hs --- a/Data/Graph/Generators/FGL.hs +++ b/Data/Graph/Generators/FGL.hs @@ -1,4 +1,4 @@ -{- +{-| Functions to convert graph-generators 'Data.Graph.Generators.GraphInfo' to FGL data structures. @@ -12,6 +12,7 @@ import Data.Graph.Generators import Data.Graph.Inductive +-- | Convert a graph-generators 'GraphInfo' to a FGL 'UGr' (unlabelled) graphInfoToUGr :: GraphInfo -- ^ The graph to convert -> UGr -- ^ The resulting FGL graph graphInfoToUGr (GraphInfo n edges) = diff --git a/Data/Graph/Generators/Random/BarabasiAlbert.hs b/Data/Graph/Generators/Random/BarabasiAlbert.hs --- a/Data/Graph/Generators/Random/BarabasiAlbert.hs +++ b/Data/Graph/Generators/Random/BarabasiAlbert.hs @@ -1,4 +1,4 @@ -{- +{-| Random graph generators using the generator algorithm introduced by A. L. Barabási and R. Albert. @@ -74,7 +74,7 @@ -- TODO: Remove this declaration from global namespace type BarabasiState = (IntMultiSet, [Int], [(Int, Int)]) -{- +{-| Generate a random quasi-undirected Barabasi graph. Only one edge (with nondeterministic direction) is created between a node pair, @@ -112,7 +112,7 @@ (_, _, allEdges) <- foldM folder initState [m..n-1] return $ GraphInfo n allEdges -{- +{-| Like 'barabasiAlbertGraph', but uses a newly initialized random number generator. See 'System.Random.MWC.withSystemRandom' for details on how the generator is diff --git a/Data/Graph/Generators/Random/ErdosRenyi.hs b/Data/Graph/Generators/Random/ErdosRenyi.hs --- a/Data/Graph/Generators/Random/ErdosRenyi.hs +++ b/Data/Graph/Generators/Random/ErdosRenyi.hs @@ -1,4 +1,4 @@ -{- +{-| Implementations of binomially random graphs, as described by Erdős and Rényi. Graphs generated using this method have a constant edge probability between two nodes. @@ -32,7 +32,7 @@ import Data.Graph.Generators import Control.Applicative ((<$>)) -{- +{-| Generate a unlabelled context using the Erdős and Rényi method. See 'erdosRenyiGraph' for a detailed algorithm description. @@ -55,7 +55,7 @@ outEdges <- endpoints return $ GraphContext inEdges n outEdges -{- +{-| Generate a unlabelled directed random graph using the Algorithm introduced by Erdős and Rényi, also called a binomial random graph generator. @@ -88,7 +88,7 @@ allEdges <- concat <$> mapM singleNodeEdges allNodes return $ GraphInfo n allEdges -{- +{-| Like 'erdosRenyiGraph', but uses a newly initialized random number generator. See 'System.Random.MWC.withSystemRandom' for details on how the generator is @@ -107,7 +107,7 @@ erdosRenyiGraph' n p = withSystemRandom . asGenIO $ \gen -> erdosRenyiGraph gen n p -{- +{-| Filter a list by selecting each list element uniformly with a given probability p diff --git a/Data/Graph/Generators/Random/WattsStrogatz.hs b/Data/Graph/Generators/Random/WattsStrogatz.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators/Random/WattsStrogatz.hs @@ -0,0 +1,162 @@ +{-| + Implementations of binomially random graphs, as described by Erdős and Rényi. + + Graphs generated using this method have a constant edge probability between two nodes. + + See Erdős and A. Rényi, On Random Graphs, Publ. Math. 6, 290 (1959). + + graph-generators copyright: + Copyright (C) 2014 Uli Köhler + + NetworkX copyright: + Copyright (C) 2004-2010 by + Aric Hagberg + Dan Schult + Pieter Swart + All rights reserved. + BSD license. +-} +module Data.Graph.Generators.Random.WattsStrogatz ( + -- ** Graph generators + wattsStrogatzGraph, + wattsStrogatzGraph', + -- ** Graph component generators + wattsStrogatzContext, + -- ** Utility functions + selectWithProbability + ) + where + +import System.Random.MWC +import Control.Monad +import Data.Graph.Generators +import Control.Applicative ((<$>)) +import qualified Data.Map as Map +import qualified Data.Set as Set + +{-| + Generate a small-world context using the Wattz Strogatz method. + + See 'wattsStrogatzGraph' for a detailed algorithm description. + + Example usage, using a truly random generator: + + > import System.Random.MWC + > gen <- withSystemRandom . asGenIO $ return + > +-} +wattsStrogatzContext :: GenIO -- ^ The random number generator to use + -> Int -- ^ Identifier of the context's central node + -> [Int] -- ^ The algorithm will generate random edges to those nodes + -- from or to the given node + -> Double -- ^ The probability for any pair of nodes to be connected + -> IO GraphContext -- ^ The resulting graph (IO required for randomness) +wattsStrogatzContext gen n allNodes p = do + let endpoints = selectWithProbability gen p allNodes + inEdges <- endpoints + outEdges <- endpoints + return $ GraphContext inEdges n outEdges + +{-| + Generate a unlabelled undirected random graph using the Algorithm introduced by + WattsStrogatz. + + Note that self-loops with also be generated with probability p. + + This algorithm runs in O(kn). + + The generated nodes are identified by [0..n-1]. + + Example usage, using a truly random generator: + + > import System.Random.MWC + > gen <- withSystemRandom . asGenIO $ return + > wattsStrogatzGraph gen 1000 10 0.6 + ... + +-} +wattsStrogatzGraph :: GenIO -- ^ The random number generator to use + -> Int -- ^ n, The number of nodes + -> Int -- ^ k, the size of the neighborhood / degree (should be even) + -> Double -- ^ \beta, The probability of a forward edge getting rewritten + -> IO GraphInfo -- ^ The resulting graph (IO required for randomness) +wattsStrogatzGraph gen n k p = do + let allNodes = [0..n-1] + -- Outgoing edge targets for any node + let insert m (i, js) = Map.insert i js m + let initialEdges = foldl (insert) (Map.empty) [ (i, forward_neighbors i) | i <- allNodes ] + allEdges <- rewrites (return initialEdges) $ + [ (i, j) | + (i,s) <- Map.toList initialEdges, + j <- Set.toList s ] + return $ GraphInfo n (delineate allEdges) + where + k' = fromInteger.toInteger $ k + forward_neighbors :: Int -> Set.Set Int + forward_neighbors i = foldr (Set.insert) Set.empty $ + fmap (`mod` n) + [i+1..i+k'] + rewrites :: IO (Map.Map Int (Set.Set Int)) + -> [(Int, Int)] + -> IO (Map.Map Int (Set.Set Int)) + rewrites ioedges [] = ioedges + rewrites ioedges (t:tuples) = do + r <- uniform gen :: IO Double + edges <- ioedges :: IO (Map.Map Int (Set.Set Int)) + if (r > p) + then rewrites (return edges) tuples + else do es <- rewrite t edges + rewrites (return es) tuples + rewrite (i, j1) edges = do + r <- uniform gen :: IO Double + let j2 = floor $ r*((fromInteger.toInteger) n) + if (member (i, j2) edges || member (j2, i) edges) + then rewrite (i, j1) edges + else return $ swap (i, j1) (i, j2) edges + +delineate :: Map.Map a (Set.Set b) -> [(a, b)] +delineate m = [ (i, j) | + (i, js) <- Map.toList m, + j <- Set.toList js ] + +member :: (Int, Int) -> Map.Map Int (Set.Set Int) -> Bool +member (i, j) m = Set.member j (Map.findWithDefault Set.empty i m) + +swap :: (Ord a, Ord b) + => (a, b) -> (a, b) + -> Map.Map a (Set.Set b) + -> Map.Map a (Set.Set b) +swap (k1, v1) (k2, v2) m = + let set1 = Map.findWithDefault Set.empty k1 m in + let set2 = Set.insert v2 $ Set.delete v1 set1 in + let m2 = Map.insert k2 set2 $ Map.delete k1 m in m2 + +{-| + Like 'wattsStrogatzGraph', but uses a newly initialized random number generator. + + See 'System.Random.MWC.withSystemRandom' for details on how the generator is + initialized. + + By using this function, you don't have to initialize the generator by yourself, + however generator initialization is slow, so reusing the generator is recommended. + + Usage example: + + > wattsStrogatzGraph' 1000 10 0.6 +-} +wattsStrogatzGraph' :: Int -- ^ n, The number of nodes + -> Int -- ^ k, the size of the neighborhood / degree (should be even) + -> Double -- ^ \beta, The probability of a forward edge getting rewritten + -> IO GraphInfo -- ^ The resulting graph (IO required for randomness) +wattsStrogatzGraph' n k p = + withSystemRandom . asGenIO $ \gen -> wattsStrogatzGraph gen n k p + +selectWithProbability :: GenIO -- ^ The random generator state + -> Double -- ^ The probability to select each list element + -> [a] -- ^ The list to filter + -> IO [a] -- ^ The filtered list +selectWithProbability _ _ [] = return [] +selectWithProbability gen p (x:xs) = do + r <- uniform gen :: IO Double + let v = [ x | r <= p ] + liftM2 (++) (return v) $ selectWithProbability gen p xs diff --git a/Data/Graph/Generators/Regular.hs b/Data/Graph/Generators/Regular.hs --- a/Data/Graph/Generators/Regular.hs +++ b/Data/Graph/Generators/Regular.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Safe #-} -{- +{-| Graph generators for simple parametric, regular graphs. Built using NetworkX 1.8.1, see @@ -34,7 +34,7 @@ import Data.Graph.Generators import Data.Graph.Generators.Classic (nullGraph) -{- +{-| Generate a completely connected graph with n nodes. The generated graph contains node labels [0..n-1] @@ -56,7 +56,7 @@ allEdges = [(i, j) | i <- allNodes,j <- allNodes, i < j] in GraphInfo n allEdges -{- +{-| Variant of 'completeGraph' generating self-loops. All generated edges (i,j) satisfy @i <= j@. @@ -72,7 +72,7 @@ allEdges = [(i, j) | i <- allNodes, j <- allNodes, i <= j] in GraphInfo n allEdges -{- +{-| Generate the complete bipartite graph with n1 nodes in the first partition and n2 nodes in the second partition. @@ -97,7 +97,7 @@ allEdges = [(i, j) | i <- nodesP1, j <- nodesP2] in GraphInfo (n1+n2) allEdges -{- +{-| Generates the empty graph with n nodes and zero edges. The nodes are labelled [0..n-1] @@ -107,7 +107,7 @@ emptyGraph :: Int -> GraphInfo emptyGraph n = GraphInfo n [] -{- +{-| Generate the barbell graph, consisting of two complete subgraphs connected by a single path. @@ -123,7 +123,7 @@ -> GraphInfo -- ^ The resulting barbell graph barbellGraph n np = generalizedBarbellGraph n np n -{- +{-| Generate the barbell graph, consisting of two complete subgraphs connected by a single path. @@ -149,7 +149,7 @@ edgesP2 = [(i, j) | i <- nodesP2, j <- nodesP2] in GraphInfo (n1+np+n2) (edgesP1 ++ edgesPath ++ edgesP2) -{- +{-| Generate the cycle graph of size n. Edges are created from lower node IDs to higher node IDs. @@ -164,7 +164,7 @@ let edges = (n-1, 0) : [(i, i+1) | i <- [0..n-2]] in GraphInfo n edges -{- +{-| Generate the path graph of size n, consisting of n nodes that are interconnected in a single path. @@ -178,7 +178,7 @@ let edges = [(i, i+1) | i <- [0..n-2]] in GraphInfo n edges -{- +{-| Generate the star graph with n nodes: One central node (ID 0) connected to n-1 outer nodes, having no interconnections themselves @@ -193,7 +193,7 @@ let edges = [(0,i) | i <- [1..n-1]] in GraphInfo n edges -{- +{-| Generate the wheel graph with n nodes: One central node (ID 0) connected to n-1 outer nodes building a cycle graph. @@ -209,7 +209,7 @@ ++ [(i, i+1) | i <- [1..n-2]] in GraphInfo n edges -{- +{-| Generate the 2D grid graph of dimensions m*n Algorithm courtesy diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,3 +2,11 @@ ============ A Haskell library for creating regular and random graphs in a graph-library agnostic way. + +Generate sample DOT files by using: + +```bash +cabal sandbox init +cabal install --only-dependencies +cabal exec runghc TestGen.hs # See output for location of graphs +``` diff --git a/TestGen.hs b/TestGen.hs new file mode 100644 --- /dev/null +++ b/TestGen.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} + +import System.Environment +import System.Directory +import Data.Graph.Generators(GraphInfo(..)) +import Data.Graph.Generators.Random.ErdosRenyi(erdosRenyiGraph) +import Data.Graph.Generators.Random.WattsStrogatz(wattsStrogatzGraph) +import Data.Graph.Generators.Random.BarabasiAlbert(barabasiAlbertGraph) +import System.Random.MWC(createSystemRandom) +import System.IO + +d = 20 +n = 1000 +p = toDbl d / toDbl n +b = 0.28 +m0 = 10 + +toDbl = fromInteger.toInteger + +sampleDir = "dist/build/samples" + +writeGraph :: FilePath -> GraphInfo -> IO () +writeGraph path (GraphInfo{..}) = + withFile path WriteMode + (\handle -> do + hPutStrLn handle "strict graph {" + mapM (hPutStrLn handle) [ (show x) ++ " -- " ++ (show y) + | (x, y) <- edges ] + hPutStrLn handle "}" + ) + +main :: IO () +main = do + args <- getArgs + gen <- createSystemRandom + eG <- erdosRenyiGraph gen n p + wG <- wattsStrogatzGraph gen n d b + bG <- barabasiAlbertGraph gen n d + createDirectoryIfMissing True "dist/build/samples" + writeGraph (sampleDir ++ "/ErdosRenyiGraph.dot") eG + writeGraph (sampleDir ++ "/WattsStrogatz.dot") wG + writeGraph (sampleDir ++ "/BarabasiAlbertGraph.dot") bG + putStrLn "Sample DOT files have been generated in ./dist/build/samples" + + diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,10 @@ ** 0.1.x +0.1.2.0 --> 0.1.2.1 +=============== + +* Fix wrong haddock syntax leading to unused function docs + 0.1.1.0 --> 0.1.2.0 =============== diff --git a/graph-generators.cabal b/graph-generators.cabal --- a/graph-generators.cabal +++ b/graph-generators.cabal @@ -1,5 +1,5 @@ name: graph-generators -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Functions for generating structured or random FGL graphs description: Generators for graphs. Supports classic (constant-sized) graphs, deterministic Generators @@ -33,14 +33,30 @@ Data.Graph.Generators.Regular, Data.Graph.Generators.FGL, Data.Graph.Generators.Random.ErdosRenyi, + Data.Graph.Generators.Random.WattsStrogatz, Data.Graph.Generators.Random.BarabasiAlbert -- other-modules: -- other-extensions: - build-depends: base >= 4.2 && < 4.8, containers >= 0.3, mwc-random >= 0.10, fgl >= 5.0, + build-depends: base >= 4.2 && < 5.0, containers >= 0.3, mwc-random >= 0.10, fgl >= 5.0, multiset >= 0.2 -- hs-source-dirs: default-language: Haskell2010 +Executable TestGen + Main-Is: TestGen.hs + other-modules: Data.Graph.Generators, + Data.Graph.Generators.Classic, + Data.Graph.Generators.Regular, + Data.Graph.Generators.FGL, + Data.Graph.Generators.Random.ErdosRenyi, + Data.Graph.Generators.Random.WattsStrogatz, + Data.Graph.Generators.Random.BarabasiAlbert + -- other-extensions: + build-depends: base >= 4.2.0.1 && < 5.0, directory, containers >= 0.3, mwc-random >= 0.10, fgl >= 5.0, + multiset >= 0.2 + -- hs-source-dirs: + default-language: Haskell2010 + Test-Suite test-graph-generators type: exitcode-stdio-1.0 main-is: GraphGeneratorsTest.hs