diff --git a/Data/Graph/Generators.hs b/Data/Graph/Generators.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE Safe #-} + +module Data.Graph.Generators where + +{- + The information required to build a graph. + + This datastructure is designed to occupy minimal space. + With n being the number of nodes, the edge list contains + tuples (from, to), denoting an edge from node *from* to node + *to* where *from* and *to* are integers less than the number + of nodes. + + Note that for a graph with n nodes, the nodes are labelled + @[0..n-1]@. + + This data structure is library-agnostic and can be converted + to arbitrary representations. +-} +data GraphInfo = GraphInfo { + numNodes :: Int, -- ^ Number of nodes + edges :: [(Int,Int)] -- ^ Edge list + } deriving (Eq, Show) + +{- + The context of a single graph node. + + This data-structure is library-agnostic, however, + it is isomophic to FGL's UContext +-} +data GraphContext = GraphContext { + inEdges :: [Int], -- ^ Nodes having an edge to the current node + nodeLabel :: Int, -- ^ The node identifier of the current node + 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@ +-} +checkGraphInfo :: GraphInfo -> Bool +checkGraphInfo (GraphInfo n edges) = + all (\(i, j) -> 0 <= i && i < n && 0 <= j && j < n) edges diff --git a/Data/Graph/Generators/Classic.hs b/Data/Graph/Generators/Classic.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators/Classic.hs @@ -0,0 +1,313 @@ +{-# LANGUAGE Safe #-} + +{- + Generators for classic non-parametric graphs. + + Built using NetworkX 1.8.1, see +-} + +module Data.Graph.Generators.Classic ( + trivialGraph, + bullGraph, + chvatalGraph, + cubicalGraph, + desarguesGraph, + diamondGraph, + dodecahedralGraph, + fruchtGraph, + heawoodGraph, + houseGraph, + houseXGraph, + icosahedralGraph, + krackhardtKiteGraph, + moebiusKantorGraph, + octahedralGraph, + pappusGraph, + petersenGraph, + sedgewickMazeGraph, + tetrahedralGraph, + truncatedCubeGraph, + truncatedTetrahedronGraph, + tutteGraph + ) where + +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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected + +@ + 0 1 + \ / + 2---3 + \ / + 4 +@ +-} +bullGraph :: GraphInfo +bullGraph = + 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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected + + See +-} +fruchtGraph :: GraphInfo +fruchtGraph = + let edges = [(0,1),(0,6),(0,7),(1,2),(1,7),(2,8),(2,3), + (3,9),(3,4),(4,9),(4,5),(5,10),(5,6), + (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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected + +@ + 1 + / \ + 2---3 + | | + 4---5 +@ + +-} +houseGraph :: GraphInfo +houseGraph = + 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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected + +@ + 1 + / \ + 2---3 + | X | + 4---5 +@ + +-} +houseXGraph :: GraphInfo +houseXGraph = + 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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. + + Nodes are labelled [0..17] +-} +pappusGraph :: GraphInfo +pappusGraph = + let edges = [(0,1),(0,5),(0,17),(1,8),(1,2),(2,3),(2,13),(3,4), + (3,10),(4,5),(4,15),(5,6),(6,11),(6,7),(7,8),(7,14), + (8,9),(9,16),(9,10),(10,11),(11,12),(12,17),(12,13), + (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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +sedgewickMazeGraph :: GraphInfo +sedgewickMazeGraph = + let edges = [(0,2),(0,5),(0,7),(1,7),(2,6), + (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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +petersenGraph :: GraphInfo +petersenGraph = + let edges = [(0,1),(0,4),(0,5),(1,2),(1,6),(2,3), + (2,7),(3,8),(3,4),(4,9),(5,8),(5,7), + (6,8),(6,9),(7,9)] + in GraphInfo 10 edges + +{- + Generate the Heawood Graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +heawoodGraph :: GraphInfo +heawoodGraph = + let edges = [(0,1),(0,13),(0,5),(1,2),(1,10),(2,3), + (2,7),(3,12),(3,4),(4,9),(4,5),(5,6), + (6,11),(6,7),(7,8),(8,9),(8,13),(9,10), + (10,11),(11,12),(12,13)] + in GraphInfo 14 edges + +{- + Generate the Diamond Graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +diamondGraph :: GraphInfo +diamondGraph = + 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, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +dodecahedralGraph :: GraphInfo +dodecahedralGraph = + let edges = [(0,1),(0,10),(0,19),(1,8),(1,2),(2,3), + (2,6),(3,19),(3,4),(4,17),(4,5),(5,6), + (5,15),(6,7),(7,8),(7,14),(8,9),(9,10), + (9,13),(10,11),(11,12),(11,18),(12,16), + (12,13),(13,14),(14,15),(15,16),(16,17), + (17,18),(18,19)] + in GraphInfo 20 edges + +{- + Generate the icosahedral Graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +icosahedralGraph :: GraphInfo +icosahedralGraph = + let edges = [(0,8),(0,1),(0,11),(0,5),(0,7),(1,8),(1,2), + (1,5),(1,6),(2,8),(2,3),(2,6),(2,9),(3,9), + (3,4),(3,10),(3,6),(4,11),(4,10),(4,5),(4,6), + (5,11),(5,6),(7,8),(7,10),(7,11),(7,9),(8,9), + (9,10),(10,11)] + in GraphInfo 12 edges + +{- + Generate the Krackhardt-Kite Graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +krackhardtKiteGraph :: GraphInfo +krackhardtKiteGraph = + let edges = [(0,1),(0,2),(0,3),(0,5),(1,3),(1,4),(1,6),(2,3), + (2,5),(3,4),(3,5),(3,6),(4,6),(5,6),(5,7),(6,7), + (7,8),(8,9)] + in GraphInfo 10 edges + +{- + Generate the Möbius-Kantor Graph. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. +-} +moebiusKantorGraph :: GraphInfo +moebiusKantorGraph = + let edges = [(0,1),(0,5),(0,15),(1,2),(1,12),(2,3),(2,7),(3,4), + (3,14),(4,9),(4,5),(5,6),(6,11),(6,7),(7,8),(8,9), + (8,13),(9,10),(10,11),(10,15),(11,12),(12,13),(13,14),(14,15)] + in GraphInfo 16 edges + +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 + + +chvatalGraph :: GraphInfo +chvatalGraph = + let edges = [(0,1),(0,4),(0,6),(0,9),(1,2),(1,5),(1,7),(2,8),(2,3), + (2,6),(3,9),(3,4),(3,7),(4,8),(4,5),(5,10),(5,11),(6,11), + (6,10),(7,8),(7,11),(8,10),(9,11),(9,10)] + in GraphInfo 12 edges + + +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 + +desarguesGraph :: GraphInfo +desarguesGraph = + let edges = [(0,1),(0,19),(0,5),(1,16),(1,2),(2,11),(2,3),(3,4), + (3,14),(4,9),(4,5),(5,6),(6,15),(6,7),(7,8),(7,18), + (8,9),(8,13),(9,10),(10,19),(10,11),(11,12),(12,17), + (12,13),(13,14),(14,15),(15,16),(16,17),(17,18),(18,19)] + in GraphInfo 20 edges + +tetrahedralGraph :: GraphInfo +tetrahedralGraph = + let edges = [(0,1),(0,2),(0,3),(1,2),(1,3),(2,3)] + in GraphInfo 4 edges + +truncatedCubeGraph :: GraphInfo +truncatedCubeGraph = + let edges = [(0,1),(0,2),(0,4),(1,11),(1,14),(2,3),(2,4),(3,8),(3,6), + (4,5),(5,16),(5,18),(6,8),(6,7),(7,10),(7,12),(8,9),(9,17), + (9,20),(10,11),(10,12),(11,14),(12,13),(13,21),(13,22), + (14,15),(15,19),(15,23),(16,17),(16,18),(17,20),(18,19), + (19,23),(20,21),(21,22),(22,23)] + in GraphInfo 24 edges + +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 + +tutteGraph :: GraphInfo +tutteGraph = + let edges = [(0,1),(0,2),(0,3),(1,26),(1,4),(2,10),(2,11),(3,18),(3,19), + (4,5),(4,33),(5,29),(5,6),(6,27),(6,7),(7,8),(7,14),(8,9), + (8,38),(9,10),(9,37),(10,39),(11,12),(11,39),(12,35),(12,13), + (13,14),(13,15),(14,34),(15,16),(15,22),(16,17),(16,44), + (17,18),(17,43),(18,45),(19,20),(19,45),(20,41),(20,21), + (21,22),(21,23),(22,40),(23,24),(23,27),(24,32),(24,25), + (25,26),(25,31),(26,33),(27,28),(28,32),(28,29),(29,30), + (30,33),(30,31),(31,32),(34,35),(34,38),(35,36),(36,37), + (36,39),(37,38),(40,41),(40,44),(41,42),(42,43),(42,45),(43,44)] + in GraphInfo 46 edges diff --git a/Data/Graph/Generators/FGL.hs b/Data/Graph/Generators/FGL.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators/FGL.hs @@ -0,0 +1,16 @@ +{- + Functions to convert graph-generators 'Data.Graph.Generators.GraphInfo' + to FGL data structures. +-} +module Data.Graph.Generators.FGL ( + graphInfoToUGr + ) where + +import Data.Graph.Generators +import Data.Graph.Inductive + +graphInfoToUGr :: GraphInfo -- ^ The graph to convert + -> UGr -- ^ The resulting FGL graph +graphInfoToUGr (GraphInfo n edges) = + let nodes = [0..n-1] + in mkUGraph nodes edges diff --git a/Data/Graph/Generators/Random/BarabasiAlbert.hs b/Data/Graph/Generators/Random/BarabasiAlbert.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators/Random/BarabasiAlbert.hs @@ -0,0 +1,132 @@ +{- + Random graph generators using the generator algorithm + introduced by A. L. Barabási and R. Albert. + + See. + A. L. Barabási and R. Albert "Emergence of scaling in + random networks", Science 286, pp 509-512, 1999. +-} +module Data.Graph.Generators.Random.BarabasiAlbert ( + -- ** Graph generators + barabasiAlbertGraph, + barabasiAlbertGraph', + -- ** Utility functions + selectNth, + selectRandomElement, + selectNDistinctRandomElements + ) where + +import Control.Monad +import Data.List (foldl') +import System.Random.MWC +import Data.Graph.Generators +import Control.Applicative +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.IntMultiSet (IntMultiSet) +import Debug.Trace +import qualified Data.IntMultiSet as IntMultiSet + +-- | Select the nth element from a multiset occur list, treating it as virtual large list +-- This is significantly faster than building up the entire list and selecting the nth +-- element +selectNth :: Int -> [(Int, Int)] -> Int +selectNth n [] = error $ "Can't select nth element - n is greater than list size (n=" ++ show n ++ ", list empty)" +selectNth n ((a,c):xs) + | n <= c = a + | otherwise = selectNth (n-c) xs + +-- | Select a single random element from the multiset, with precalculated size +-- Note that the given size must be the total multiset size, not the number of +-- distinct elements in said se +selectRandomElement :: GenIO -> (IntMultiSet, Int) -> IO Int +selectRandomElement gen (ms, msSize) = do + let msOccurList = IntMultiSet.toOccurList ms + r <- uniformR (0, msSize - 1) gen + return $ selectNth r msOccurList + +-- | Select n distinct random elements from a multiset, with +-- This function will fail to terminate if there are less than n distinct +-- elements in the multiset. This function accepts a multiset with +-- precomputed size for performance reasons +selectNDistinctRandomElements :: GenIO -> Int -> (IntMultiSet, Int) -> IO [Int] +selectNDistinctRandomElements gen n t@(ms, msSize) + | n == msSize = return . map fst . IntMultiSet.toOccurList $ ms + | msSize < n = error "Can't select n elements from a set with less than n elements" + | otherwise = IntSet.toList <$> selectNDistinctRandomElementsWorker gen n t IntSet.empty + +-- | Internal recursive worker for selectNDistinctRandomElements +-- Precondition: n > num distinct elems in multiset (not checked). +-- Does not terminate if the precondition doesn't apply. +-- This implementation is quite naive and selects elements randomly until +-- the predefined number of elements are set. +selectNDistinctRandomElementsWorker :: GenIO -> Int -> (IntMultiSet, Int) -> IntSet -> IO IntSet +selectNDistinctRandomElementsWorker _ 0 _ current = return current +selectNDistinctRandomElementsWorker gen n t@(ms, msSize) current = do + randomElement <- selectRandomElement gen t + let currentWithRE = IntSet.insert randomElement current + if randomElement `IntSet.member` current + then selectNDistinctRandomElementsWorker gen n t current + else selectNDistinctRandomElementsWorker gen (n-1) t currentWithRE + + +-- | Internal fold state for the Barabasi generator. +-- 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, + because adding the other edge direction is easier than removing duplicates. + + Precondition (not checked): m <= n + + Modeled after NetworkX 1.8.1 barabasi_albert_graph() +-} +barabasiAlbertGraph :: GenIO -- ^ The random number generator to use + -> Int -- ^ The overall number of nodes (n) + -> Int -- ^ The number of edges to create between a new and existing nodes (m) + -> IO GraphInfo -- ^ The resulting graph (IO required for randomness) +barabasiAlbertGraph gen n m = do + -- Implementation concept: Iterate over nodes [m..n] in a state monad, + -- building up the edge list + -- Highly influenced by NetworkX barabasi_albert_graph() + let nodes = [0..n-1] -- Nodes [0..m-1]: Initial nodes + -- (Our state: repeated nodes, current targets, edges) + let initState = (IntMultiSet.empty, [0..m-1], []) + -- Strategy: Fold over the list, using a BarabasiState als fold state + let folder :: BarabasiState -> Int -> IO BarabasiState + folder st curNode = do + let (repeatedNodes, targets, edges) = st + -- Create new edges (for the current node) + let newEdges = map (\t -> (curNode, t)) targets + -- Add nodes to the repeated nodes multiset + let newRepeatedNodes = foldl' (flip IntMultiSet.insert) repeatedNodes targets + let newRepeatedNodes' = IntMultiSet.insertMany curNode m newRepeatedNodes + -- Select the new target set randomly from the repeated nodes + let repeatedNodesWithSize = (newRepeatedNodes, IntMultiSet.size newRepeatedNodes) + newTargets <- selectNDistinctRandomElements gen m repeatedNodesWithSize + return (newRepeatedNodes', newTargets, edges ++ newEdges) + -- From the final state, we only require the edge list + (_, _, 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 + 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: + + > barabasiAlbertGraph' 10 5 +-} +barabasiAlbertGraph' :: Int -- ^ The number of nodes + -> Int -- ^ The number of edges to create between a new and existing nodes (m) + -> IO GraphInfo -- ^ The resulting graph (IO required for randomness) +barabasiAlbertGraph' n m = + withSystemRandom . asGenIO $ \gen -> barabasiAlbertGraph gen n m diff --git a/Data/Graph/Generators/Random/ErdosRenyi.hs b/Data/Graph/Generators/Random/ErdosRenyi.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators/Random/ErdosRenyi.hs @@ -0,0 +1,113 @@ +{- + 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). +-} +module Data.Graph.Generators.Random.ErdosRenyi ( + -- ** Graph generators + erdosRenyiGraph, + erdosRenyiGraph', + -- ** Graph component generators + erdosRenyiContext, + -- ** Utility functions + selectWithProbability + ) + where + +import System.Random.MWC +import Control.Monad +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. + + Example usage, using a truly random generator: + + > import System.Random.MWC + > gen <- withSystemRandom . asGenIO $ return + > +-} +erdosRenyiContext :: 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) +erdosRenyiContext gen n allNodes p = do + let endpoints = selectWithProbability gen p allNodes + inEdges <- endpoints + 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. + + Note that self-loops with also be generated with probability p. + + This algorithm runs in O(n²) and is best suited for non-sparse networks. + + The generated nodes are identified by [0..n-1]. + + Example usage, using a truly random generator: + + > import System.Random.MWC + > gen <- withSystemRandom . asGenIO $ return + > erdosRenyiGraph 10 0.1 + ... + + Modelled after NetworkX 1.8.1 erdos_renyi_graph(). + +-} +erdosRenyiGraph :: GenIO -- ^ The random number generator to use + -> Int -- ^ The number of nodes + -> Double -- ^ The probability for any pair of nodes to be connected + -> IO GraphInfo -- ^ The resulting graph (IO required for randomness) +erdosRenyiGraph gen n p = do + let allNodes = [0..n-1] + -- Outgoing edge targets for any node + let outgoingEdgeTargets = selectWithProbability gen p allNodes + -- Outgoing edge tuples for a single nodes + let singleNodeEdges node = zip (repeat node) <$> outgoingEdgeTargets + 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 + 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: + + > erdosRenyiGraph' 10 0.1 +-} +erdosRenyiGraph' :: Int -- ^ The number of nodes + -> Double -- ^ The probability for any pair of nodes to be connected + -> IO GraphInfo -- ^ The resulting graph (IO required for randomness) +erdosRenyiGraph' n p = + withSystemRandom . asGenIO $ \gen -> erdosRenyiGraph gen n p + +{- + Filter a list by selecting each list element + uniformly with a given probability p + + Although this is mainly used internally, it can be used as general utility function +-} +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/Simple.hs b/Data/Graph/Generators/Simple.hs new file mode 100644 --- /dev/null +++ b/Data/Graph/Generators/Simple.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE Safe #-} + +{- + Graph generators for simple parametric graphs. + + Built using NetworkX 1.8.1, see +-} +module Data.Graph.Generators.Simple ( + completeGraph, + completeGraphWithSelfloops, + completeBipartiteGraph, + emptyGraph, + barbellGraph, + generalizedBarbellGraph, + cycleGraph + ) where + +import Data.Graph.Generators + +{- + Generate a completely connected graph with n nodes. + + The generated graph contains node labels [0..n-1] + + In contrast to 'completeGraphWithSelfloops' this function + does not generate self-loops. + + Contains only one edge between two connected nodes, + use 'Data.Graph.Inductive.Basic.undir' to make it + quasi-undirected. The generated edge (i,j) satisfied @i < j@. +-} +completeGraph :: Int -- ^ The number of nodes in the graph + -> GraphInfo -- ^ The resulting complete graph +completeGraph n = + let allNodes = [0..n-1] + allEdges = [(i,j) | i <- allNodes,j <- allNodes, i < j] + in GraphInfo n allEdges + +{- + Variant of 'completeGraph' generating self-loops. + + The generated edge (i,j) satisfied @i <= j@. + + See 'completeGraph' for a more detailed behaviour description +-} +completeGraphWithSelfloops :: Int -- ^ The number of nodes in the graph + -> GraphInfo -- ^ The resulting complete graph +completeGraphWithSelfloops n = + let allNodes = [0..n-1] + 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. + + Each node in the first partition is connected to each node + in the second partition. + + The first partition nodes are identified by [0..n1-1] + while the nodes in the second partition are identified + by [n1..n1+n2-1] + + Use 'Data.Graph.Inductive.Basic.undir' to also add edges + from the second partition to the first partition. +-} +completeBipartiteGraph :: Int -- ^ The number of nodes in the first partition + -> Int -- ^ The number of nodes in the second partition + -> GraphInfo -- ^ The resulting graph +completeBipartiteGraph n1 n2 = + let nodesP1 = [0..n1-1] + nodesP2 = [n1..n1+n2-1] + 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] +-} +emptyGraph :: Int -> GraphInfo +emptyGraph n = GraphInfo n [] + +{- + Generate the barbell graph, consisting of two complete subgraphs + connected by a single path. + + In contrast to 'generalizedBarbellGraph', this function always + generates identically-sized bells. Therefore this is a special + case of 'generalizedBarbellGraph' +-} +barbellGraph :: Int -- ^ The number of nodes in the complete bells + -> Int -- ^ The number of nodes in the path, + -- i.e the number of nodes outside the bells + -> 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. + + Self-loops are not generated. + + The nodes in the first bell are identified by [0..n1-1] + The nodes in the path are identified by [n1..n1+np-1] + The nodes in the second bell are identified by [n1+np..n1+np+n2-1] + + The path only contains edges +-} +generalizedBarbellGraph :: Int -- ^ The number of nodes in the first bell + -> Int -- ^ The number of nodes in the path, i.e. + -- the number of nodes outside the bells + -> Int -- ^ The number of nodes in the second bell + -> GraphInfo -- ^ The resulting barbell graph +generalizedBarbellGraph n1 np n2 = + let nodesP1 = [0..n1-1] + nodesPath = [n1..n1+np-1] + nodesP2 = [n1+np..n1+np+n2-1] + edgesP1 = [(i, j) | i <- nodesP1, j <- nodesP1, i /= 2] + edgesPath = [(i, i+1) | i <- [n1+np..n1+np+n2]] + 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. +-} +cycleGraph :: Int -- ^ n: Number of nodes in the circle + -> GraphInfo -- ^ The circular graph with n nodes. +cycleGraph n = + let edges = (n-1, 0) : [(i, i+1) | i <- [0..n-2]] + in GraphInfo n edges diff --git a/GraphGeneratorsTest.hs b/GraphGeneratorsTest.hs new file mode 100644 --- /dev/null +++ b/GraphGeneratorsTest.hs @@ -0,0 +1,54 @@ +import Test.Hspec +import Test.QuickCheck +import Control.Exception (evaluate) +import Control.Monad +import Data.Graph.Generators.Classic +import Data.Graph.Generators.Simple +import Data.Graph.Generators.Random.ErdosRenyi +import Data.Graph.Generators.Random.BarabasiAlbert +import Data.Graph.Generators +import Data.Map (Map) +import Data.Maybe (fromJust) +import Data.List (sort) +import qualified Data.Map as Map + +main :: IO () +main = hspec $ do + describe "Classic graphs" $ do + it "should pass the integity check" $ do + trivialGraph `shouldSatisfy` checkGraphInfo + bullGraph `shouldSatisfy` checkGraphInfo + chvatalGraph `shouldSatisfy` checkGraphInfo + cubicalGraph `shouldSatisfy` checkGraphInfo + desarguesGraph `shouldSatisfy` checkGraphInfo + diamondGraph `shouldSatisfy` checkGraphInfo + dodecahedralGraph `shouldSatisfy` checkGraphInfo + fruchtGraph `shouldSatisfy` checkGraphInfo + heawoodGraph `shouldSatisfy` checkGraphInfo + houseGraph `shouldSatisfy` checkGraphInfo + houseXGraph `shouldSatisfy` checkGraphInfo + icosahedralGraph `shouldSatisfy` checkGraphInfo + krackhardtKiteGraph `shouldSatisfy` checkGraphInfo + moebiusKantorGraph `shouldSatisfy` checkGraphInfo + octahedralGraph `shouldSatisfy` checkGraphInfo + pappusGraph `shouldSatisfy` checkGraphInfo + petersenGraph `shouldSatisfy` checkGraphInfo + sedgewickMazeGraph `shouldSatisfy` checkGraphInfo + tetrahedralGraph `shouldSatisfy` checkGraphInfo + truncatedCubeGraph `shouldSatisfy` checkGraphInfo + truncatedTetrahedronGraph `shouldSatisfy` checkGraphInfo + tutteGraph `shouldSatisfy` checkGraphInfo + describe "Simple graphs" $ do + it "should pass the integrity checks" $ do + forM_ [0..10] $ \n -> + completeGraph n `shouldSatisfy` checkGraphInfo + describe "Erdös Renyi random graphs" $ do + it "should pass the integrity checks" $ do + forM_ [0..20] $ \n -> do + gr <- erdosRenyiGraph' n 0.1 + completeGraph n `shouldSatisfy` checkGraphInfo + describe "Barabasi Albert random graphs" $ do + it "should pass the integrity checks" $ do + forM_ [10..20] $ \n -> do + gr <- barabasiAlbertGraph' n 5 + completeGraph n `shouldSatisfy` checkGraphInfo diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +graph-random +============ + +A Haskell library for creating random Data.Graph instances using several pop diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/graph-generators.cabal b/graph-generators.cabal new file mode 100644 --- /dev/null +++ b/graph-generators.cabal @@ -0,0 +1,50 @@ +name: graph-generators +version: 0.1.0.0 +synopsis: Functions for generating structured or random FGL graphs +description: Generators for graphs. + Supports classic (constant-sized) graphs, deterministic Generators + and different random graph generators, based on mwc-random. + + This library uses a library-agnostic and space-efficient graph + representation. Combinators are provided to convert said representation + to other graph representations (currently only FGL, see 'Data.Graph.Generators.FGL') + + Note that this library is in its early development stages. + Don't use it for production code without checking the correctness + of the algorithm implementation.. +homepage: https://github.com/ulikoehler/graph-random +license: Apache-2.0 +license-file: LICENSE +author: Uli Köhler +maintainer: ukoehler@techoverflow.net +-- copyright: +category: Graphs, Algorithms +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/ulikoehler/graph-generators + +library + exposed-modules: Data.Graph.Generators, + Data.Graph.Generators.Classic, + Data.Graph.Generators.Simple, + Data.Graph.Generators.FGL, + Data.Graph.Generators.Random.ErdosRenyi, + 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, + multiset >= 0.2 + -- hs-source-dirs: + default-language: Haskell2010 + +Test-Suite test-graph-generators + type: exitcode-stdio-1.0 + main-is: GraphGeneratorsTest.hs + default-language: Haskell2010 + build-depends: base, Cabal >= 1.9.2, hspec, hspec-expectations, + containers >= 0.3, fgl, QuickCheck, multiset >= 0.2, + mwc-random