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