Commit | Line | Data |
---|---|---|
967c39ef MM |
1 | module RandomizedMonad ( |
2 | Randomized, | |
3 | runRandom, runRandomStd, runRandomNewStd, | |
4 | mrandomR, mrandom, | |
5 | withProb, | |
6 | filterRandomized | |
7 | ) where | |
8 | import System.Random | |
9 | ||
10 | -- Needs -XRank2Types | |
11 | newtype Randomized a = Randomized (forall g. RandomGen g => (g -> a)) | |
12 | ||
13 | -- This implementation splits the RandomGen over and over. | |
14 | -- It would also be possible to serialize everything and use a single RandomGen. | |
15 | instance Monad Randomized where | |
16 | ma >>= amb = Randomized (\g -> let | |
17 | (g1, g2) = split g | |
18 | Randomized fa = ma | |
19 | a = fa g1 | |
20 | Randomized fb = amb a | |
21 | in fb g2 | |
22 | ) | |
23 | return x = Randomized (const x) | |
24 | ||
25 | runRandom :: RandomGen g => g -> Randomized a -> a | |
26 | runRandom g (Randomized fa) = fa g | |
27 | ||
28 | -- Conveniences | |
29 | runRandomStd :: Randomized a -> IO a | |
30 | runRandomStd ra = do | |
31 | g <- getStdGen | |
32 | return $ runRandom g ra | |
33 | ||
34 | runRandomNewStd :: Randomized a -> IO a | |
35 | runRandomNewStd ra = do | |
36 | g <- newStdGen | |
37 | return $ runRandom g ra | |
38 | ||
39 | -- Monadic versions of random and randomR (to generate primitive-ish values) | |
40 | mrandomR :: Random a => (a, a) -> Randomized a | |
41 | mrandomR lohi = Randomized (\g -> fst (randomR lohi g)) | |
42 | mrandom :: Random a => Randomized a | |
43 | mrandom = Randomized (\g -> fst (random g)) | |
44 | ||
45 | chooseCase :: Double -> [(Double, a)] -> a -> a | |
46 | chooseCase val ifCs elseR = case ifCs of | |
47 | [] -> elseR | |
48 | (cutoff, theR):ifCt -> if val < cutoff | |
49 | then theR | |
50 | else chooseCase (val - cutoff) ifCt elseR | |
51 | ||
52 | withProb :: [(Double, Randomized a)] -> Randomized a -> Randomized a | |
53 | withProb ifCs elseR = do | |
54 | val <- mrandom | |
55 | chooseCase val ifCs elseR | |
56 | ||
57 | -- Keep trying until we get what we want. | |
58 | filterRandomized :: (a -> Bool) -> Randomized a -> Randomized a | |
59 | filterRandomized f ra = do | |
60 | a <- ra | |
61 | if f a then return a else filterRandomized f ra |