Copyright | (c) Lars Brünjes, 2016 |
---|---|
License | MIT |
Maintainer | brunjlar@gmail.com |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
Extensions |
|
This module provides utilities for working with module Random
.
- pickR' :: MonadRandom m => [a] -> m (a, [a])
- pickR :: MonadRandom m => [a] -> m a
- takeR' :: forall m a. MonadRandom m => Int -> [a] -> m ([a], [a])
- takeR :: MonadRandom m => Int -> [a] -> m [a]
- fisherYates :: forall m a. MonadRandom m => Array Int a -> m (Array Int a)
- shuffleR :: MonadRandom m => [a] -> m [a]
- boxMuller :: forall m a. (Floating a, Random a, Eq a, MonadRandom m) => m a
- boxMuller' :: (Floating a, Random a, Eq a, MonadRandom m) => a -> a -> m a
- roulette :: forall a b m. (Ord b, Fractional b, Random b, MonadRandom m) => Int -> [(a, b)] -> m [a]
Documentation
pickR' :: MonadRandom m => [a] -> m (a, [a]) Source #
Picks a random element of the list and returns that element and the remaining elements.
>>>
evalRand (pickR' "Haskell") (mkStdGen 4712)
('s',"Hakell")
pickR :: MonadRandom m => [a] -> m a Source #
Picks a random element of the list.
>>>
evalRand (pickR "Haskell") (mkStdGen 4712)
's'
takeR' :: forall m a. MonadRandom m => Int -> [a] -> m ([a], [a]) Source #
Takes the specified number of random elements from the list. Returns those elements and the remaining elements.
>>>
evalRand (takeR' 3 "Haskell") (mkStdGen 4712)
("aks","Hell")
takeR :: MonadRandom m => Int -> [a] -> m [a] Source #
Takes the specified number of random elements from the list.
>>>
evalRand (takeR 3 "Haskell") (mkStdGen 4712)
"aks"
fisherYates :: forall m a. MonadRandom m => Array Int a -> m (Array Int a) Source #
Shuffles an array with the Fisher-Yates algorithm.
shuffleR :: MonadRandom m => [a] -> m [a] Source #
Shuffles an list with the Fisher-Yates algorithm.
>>>
evalRand (shuffleR "Haskell") (mkStdGen 4712)
"skalHle"
boxMuller :: forall m a. (Floating a, Random a, Eq a, MonadRandom m) => m a Source #
Uses the Box-Muller transform to sample the standard normal distribution (zero expectation, unit variance).
>>>
evalRand (replicateM 5 boxMuller) (mkStdGen 1234) :: [Float]
[0.61298496,-0.19325614,4.4974413e-2,-0.31926495,-1.1109064]
boxMuller' :: (Floating a, Random a, Eq a, MonadRandom m) => a -> a -> m a Source #
Uses the Box-Muller transform to sample a normal distribution with specified mean and stadard deviation.
>>>
evalRand (replicateM 5 $ boxMuller' 10 2) (mkStdGen 1234) :: [Float]
[11.22597,9.613487,10.089949,9.36147,7.7781873]
roulette :: forall a b m. (Ord b, Fractional b, Random b, MonadRandom m) => Int -> [(a, b)] -> m [a] Source #
Randomly selects the specified number of elements of a weighted list.
>>>
evalRand (roulette 10 [('x', 1 :: Double), ('y', 2)]) (mkStdGen 1000)
"yxxyyyyxxy"