[Haskell-cafe] Re: Library design question
Daniel Fischer
daniel.is.fischer at web.de
Fri Sep 19 17:16:47 EDT 2008
Am Freitag, 19. September 2008 22:55 schrieb Andre Nathan:
> 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? :)
Yes. What's IO gotta do with it?
It's much cleaner to pass the PRNG as an explicit argument (or what about
StateT (Graph a b) (State StdGen) ?).
And in addVertex/addEdge, it might be good to check whether the vertex/edge is
already present.
>
> Thanks a lot for the suggestions,
> Andre
>
More information about the Haskell-Cafe
mailing list