| 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 |