[Haskell-cafe] Random pattern generation with list comprehensions
Michael Jones
mike at proclivis.com
Sat Dec 20 00:21:19 UTC 2014
Here is some prototype code, and some comments and questions.
getInts and getDoubles use the State Monad approach to generate data. getInts requires putting the generator in the list comprehension. getDouble wraps it in a function.
getLetters just directly generates ints and converts to enums.
This is in an IO monad because the final code will be in the IO monad.
Questions:
- Can anyone see any value in the StateMonad in terms of ways to exploit it?
- Is there a way to get the number of constructors in Letter rather than code the number directly as (0,2)?
- What is the impact of defining the helper functions in let vs. where?
Mike
type GeneratorState = State StdGen
getRandom :: Random a => GeneratorState a
getRandom = do
generator <- get
let (value, newGenerator) = random generator
put newGenerator
return value
data Letter = A | B | C
deriving (Eq, Enum, Show)
runRandomTest = do
let ds = [(i, d, l) | i <- getInts (mkStdGen 0)
| d <- getDoubles
| l <- getLetters ]
print $ take 5 ds
where
getInts :: StdGen -> [Int]
getInts state =
let (val, state') = runState getRandom state in
val:(getInts state')
getDoubles :: [Double]
getDoubles = getDoubles' (mkStdGen 0)
getDoubles' state =
let (val, state') = runState getRandom state in
val:(getDoubles' state')
getLetters :: [Letter]
getLetters = map toEnum $ randomRs (0,2) (mkStdGen 0)
On Dec 15, 2014, at 8:14 AM, Erik Rantapaa <erantapaa at gmail.com> wrote:
>
>
> On Sunday, December 14, 2014 5:22:14 PM UTC-6, Michael Jones wrote:
> The alternative might be to make a State Monad where the State is a tuple with each item holding the state for each generator.
>
> There is a common technique of using `split` and `randoms` (or `randomsR`) to create a pure list of random values which you might find helpful. Here is an example:
>
> {-# LANGUAGE ParallelListComp #-}
>
> import System.Random
>
> main = do
> g <- newStdGen
> let (g1,g2) = split g
> letters = randomRs ('a','z') g1
> numbers = randomRs (15,35) g2 :: [Int]
> pairs = [ (a,n) | (a,n) <- zip letters numbers ]
> pairs2 = [ (a,n) | a <- letters | n <- numbers ]
> print $ take 10 pairs
> print $ take 10 pairs2 -- produces the same list of pairs
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141219/c9d991b3/attachment.html>
More information about the Haskell-Cafe
mailing list