68 lines
2.3 KiB
Haskell
68 lines
2.3 KiB
Haskell
module Dodge.RandomHelp where
|
|
|
|
import Geometry
|
|
import Geometry.Data
|
|
|
|
import System.Random
|
|
import Control.Monad.State
|
|
import Data.List
|
|
|
|
randomRanges :: (Random a,RandomGen g) => [a] -> State g a
|
|
randomRanges xs = join $ takeOne $ f xs
|
|
where f (x:y:ys) = (state (randomR (x,y))) : (f ys)
|
|
f _ = []
|
|
|
|
takeOne :: RandomGen g => [a] -> State g a
|
|
takeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (xs !! i))
|
|
|
|
takeOneWeighted :: (RandomGen g, Random b, Ord b, Num b) => [b] -> [a] -> State g a
|
|
takeOneWeighted ws xs = state (randomR (0, sum ws))
|
|
>>= (\w -> return (xs !! (i w ws)))
|
|
where i y (z:zs) | y <= z = 0
|
|
| otherwise = 1 + i (y-z) zs
|
|
i y _ = 0
|
|
|
|
takeOneMore :: RandomGen g => ([a],[a]) -> State g ([a],[a])
|
|
takeOneMore (xs,[]) = error "trying to takeOneMore from empty list"
|
|
takeOneMore (xs,ys) = do
|
|
i <- state $ randomR (0,length ys - 1)
|
|
let (zs, w:ws) = splitAt i ys
|
|
return (w:xs, zs ++ ws)
|
|
|
|
takeNMore :: RandomGen g => Int -> ([a],[a]) -> State g ([a],[a])
|
|
takeNMore n p = foldr (const ((=<<) takeOneMore)) (return p) [1..n]
|
|
|
|
takeN :: RandomGen g => Int -> [a] -> State g [a]
|
|
takeN i xs = fmap fst $ takeNMore i ([],xs)
|
|
|
|
-- to randomly shuffle a list
|
|
shuffle :: RandomGen g => [a] -> State g [a]
|
|
shuffle xs = do
|
|
let l = length xs
|
|
rands <- forM [0..l-1] $ \i -> state $ randomR (0,i)
|
|
let f ys rand = let (as,b:bs) = splitAt rand ys
|
|
in (as ++ bs, b)
|
|
let (_,zs) = mapAccumR f xs rands
|
|
return zs
|
|
|
|
randomSelectionFromList :: RandomGen g => Float -> [a] -> State g [a]
|
|
randomSelectionFromList p = filterM $ const $ randProb p
|
|
|
|
randProb :: RandomGen g => Float -> State g Bool
|
|
randProb p = do p1 <- state $ randomR (0,1)
|
|
return (p1 < p)
|
|
|
|
randInCirc :: RandomGen g => Float -> State g Point2
|
|
randInCirc maxRad = do rad <- state $ randomR (0,maxRad)
|
|
ang <- state $ randomR (0,2*pi)
|
|
return $ rad *.* unitVectorAtAngle ang
|
|
|
|
randInRect :: RandomGen g => Float -> Float -> State g Point2
|
|
randInRect w h = do x <- state $ randomR (0,w)
|
|
y <- state $ randomR (0,h)
|
|
return (x,y)
|
|
|
|
maybeTakeOne :: RandomGen g => [a] -> State g (Maybe a)
|
|
maybeTakeOne [] = return Nothing
|
|
maybeTakeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (Just (xs !! i)))
|