9
\$\begingroup\$

To get used to Haskell, I wrote a little program using the Diagrams package which generates 100 random dots (larger dots are more likely to be in the center).

Sample output:

Sample dotty output

My questions:

  • Is the program well structured with respect to the IO monad and the random values (see types for randomDot and randomDots)? Should I organize the code differently to keep more code out of the IO monad?

  • Other nitpicks?

module Main (main) where

import Data.Colour.SRGB
import Data.Random.Source
import Diagrams.Backend.SVG.CmdLine
import Diagrams.Prelude
import qualified Data.Random as R

data Dot = Dot { _dotCenter :: R2
               , _radius :: Double
               , _color :: Colour Double 
               } deriving Show

colors :: [Colour Double]
colors = map sRGB24read [
          "bf3131",
          "f5b456",
          "a89178",
          "615b5b",
          "add274",
          "b9a1b9",
          "f0a2bc",
          "eb565c",
          "d15f69",
          "48bdbe",
          "f1ede2"]

-- |Generate a single dot with random location, radius, and color.
randomDot :: Double -> R.RVar Dot
randomDot x = do
  let mu_rad = 15 * exp (-4 * x)
      sigmaSq_rad = 0.3 * mu_rad
      sigmaSq_loc = 8 * exp (2.5*x)
  locX <- R.sample (R.normal 0 sigmaSq_loc)
  locY <- R.sample (R.normal 0 sigmaSq_loc)
  radius <- abs <$> R.sample (R.normal mu_rad sigmaSq_rad)
  color <- R.sample (R.randomElement colors)
  return $ Dot (r2 (locX, locY)) radius color

-- |Recursively generate random dots and check that they do not
-- overlap.
randomDots :: [Dot] -> [Double] -> IO [Dot]
randomDots dots [] = return dots
randomDots dots (x:xs) = do
  dot <- R.sample $ randomDot x
  if any (tooClose dot) dots
  then randomDots dots (x:xs)
  else randomDots (dot:dots) xs

tooClose :: Dot -> Dot -> Bool
tooClose x y = dist < 1.1 * radiusSum
    where
      dist = magnitude $ _dotCenter x ^-^ _dotCenter y
      radiusSum = _radius x + _radius y

dotsToDiagram :: [Dot] -> Diagram B R2
dotsToDiagram = mconcat . map fromDot

fromDot :: Dot -> Diagram B R2
fromDot c = circle (_radius c) # fc (_color c)
                               # lw none
                               # translate (_dotCenter c)

main :: IO ()
main = mainWith . dotsToDiagram =<< randomDots [] [0.01, 0.02..1.0]
\$\endgroup\$
4
\$\begingroup\$

I'd suggest to change the type signature of randomDots to

randomDots :: [Dot] -> [Double] -> R.RVar [Dot]

as there is nothing IO based there. And then change main to

main = mainWith . dotsToDiagram =<< R.sample (randomDots [] [0.01, 0.02..1.0])

Nitpicks: I'd put tooClose before randomDots so that the functions are in logical order, but that's just a matter of personal preferences.

Otherwise I also quite liked the code.

Update: Some further thoughts: Function randomDots is concise, but it also mixes several concepts together. Namely:

  1. it re-runs generation of a dot (until it fits wrt the previous ones);
  2. it checks each generated dot with all previously generated ones.

So I'd suggest to split the function into even smaller ones, each targeting one of these problems. While the resulting code is larger, I believe it's easier to comprehend and more maintainable in the long run:

-- | Runs a monadic action while its result satisfies a given predicate.
iterateWhile :: (Monad m) => (a -> Bool) -> m a -> m a
iterateWhile pred k = loop
  where
    loop = k >>= \x -> if pred x then loop else return x

This function is also available in monad-loops. Then:

-- | Generates a list of values that are independent wrt a given (commutative)
-- predicate.
-- Each monadic action is repeated until its result is independent with all the
-- previous ones.
genIndependent :: (Monad m) => (a -> a -> Bool) -> [m a] -> m [a]
genIndependent pred = foldM step []
  where
    step rs k = liftM (: rs) $ iterateWhile (\x -> any (pred x) rs) k

Both these functions are polymorphic with no coupling with RVar. The final function is then expressed just as

-- |Recursively generate random dots and check that they do not
-- overlap.
randomDots :: [Double] -> R.RVar [Dot]
randomDots = genIndependent tooClose . map (R.sample . randomDot)
\$\endgroup\$
2
\$\begingroup\$

I really like your solution. The only note I would make is that RVar has an Applicative instance which makes writing code in a declarative style a lot easier. It's entirely a matter of taste as to which one you prefer.

-- |Generate a single dot with random location, radius, and color.
randomDot :: Double -> R.RVar Dot
randomDot x = Dot <$> center <*> radius <*> color
  where
    center = r2 <$> (,) <$> loc <*> loc
    loc    = R.sample $ R.normal 0 sigmaSq_loc
    radius = abs <$> R.sample $ R.normal mu_rad sigmaSq_rad
    color  = R.sample $ R.randomElement colors
    mu_rad = 15 * exp (-4 * x)
    sigmaSq_rad = 0.3 * mu_rad
    sigmaSq_loc = 8 * exp (2.5*x)
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.