[Haskell-cafe] Re: Library design question
Andre Nathan
andre at digirati.com.br
Fri Sep 19 16:55:19 EDT 2008
On Fri, 2008-09-19 at 10:35 +0200, Christian Maeder wrote:
> I agree. Duncan's version also looks more atomic to me,
[...]
OK, so what I have now is
addVertex :: Int -> a -> Graph a b -> Graph a b
addVertex v l g = Graph adj (numVertices g + 1) (numEdges g)
where adj = Map.insert v (l, Map.empty) (adjacencies g)
addEdge :: Int -> Int -> b -> Graph a b -> Graph a b
addEdge v w l g = Graph adj (numVertices g) (numEdges g + 1)
where adj = Map.insert v (vl, ns') (adjacencies g)
ns' = Map.insert w l ns
(vl, ns) = fromJust $ Map.lookup v (adjacencies g)
Creating a random graph [G(n,p) model] the naive way:
type RandomGraph a b = StateT (Graph a b) IO ()
randomGraph :: Int -> Double -> IO (Graph Int Int)
randomGraph n p = execStateT create Graph.empty
where create = mapM_ (uncurry $ createVertex p) vls
vls = zip [1..n] (repeat 1)
createVertex :: Double -> Int -> a -> RandomGraph a Int
createVertex p v l = do
modify (Graph.addVertex v l)
createEdges v p
createEdges :: Int -> Double -> RandomGraph a Int
createEdges n p = mapM_ (maybeAddEdges n) [1..n-1]
where maybeAddEdges v w = do
maybeAddEdge v w
maybeAddEdge w v
maybeAddEdge v w = do
r <- lift randomDouble
when (r < p) $ modify (addEdge v w 1)
randomDouble :: IO Double
randomDouble = randomIO
So, to reference another thread, does this make anyone cry? :)
Thanks a lot for the suggestions,
Andre
More information about the Haskell-Cafe
mailing list