[Haskell-cafe] Inductive graphs memory usage
Andre Nathan
andre at digirati.com.br
Thu Jul 10 16:57:22 EDT 2008
Hello
I'm trying to create a directed graph using the Data.Graph.Inductive.
The graph is a random graph using the G(n, p) model, that is, each of
the n nodes is linked to every other node with probability p.
I'm seeing a large increase of memory usage when n grows (this is using
p = 0.1):
n = 1000 -> 96MB
n = 2000 -> 283MB
n = 3000 -> 760MB
So, I'm probably doing something very stupid :) The code is below. Is
there anything I could do to optimize memory usage here?
module Main where
import Control.Monad
import Data.Graph.Inductive
import System.Random
createEdges :: Int -> Double -> IO [LEdge Int]
createEdges n prob = foldM create [] [1..n]
where create es i = foldM (flip $ link i) es [i, i-1 .. 1]
link i j es | i == j = return es -- no self-loops
| otherwise = do
es' <- maybeCreateEdge i j prob es
es'' <- maybeCreateEdge j i prob es'
return es''
maybeCreateEdge :: Node -> Node -> Double -> [LEdge Int]
-> IO [LEdge Int]
maybeCreateEdge i j prob es = do
r <- randomDouble
return $ if r < prob then (i, j, 0):es else es
randomDouble :: IO Double
randomDouble = getStdRandom $ random
main :: IO ()
main = do
let (n, p) = (3000, 0.1)
es <- createEdges n p
let g = mkGraph [(i, 0) | i <- [1..n]] es :: Gr Int Int
return ()
Thanks,
Andre
More information about the Haskell-Cafe
mailing list