{- 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