Commit | Line | Data |
---|---|---|
967c39ef MM |
1 | module RandomizedMonad ( |
2 | Randomized, | |
3 | runRandom, runRandomStd, runRandomNewStd, | |
4 | mrandomR, mrandom, | |
5 | withProb, | |
066d7f53 MM |
6 | filterRandomized, |
7 | indRandomArray | |
967c39ef MM |
8 | ) where |
9 | import System.Random | |
066d7f53 MM |
10 | import Data.Array.IArray |
11 | import Data.Ix | |
967c39ef MM |
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 | |
066d7f53 MM |
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) |