79 lines
2.5 KiB
Haskell
79 lines
2.5 KiB
Haskell
{-
|
|
Helpers for random generation.
|
|
-}
|
|
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 _ _ = 0
|
|
|
|
takeOneMore :: RandomGen g => ([a],[a]) -> State g ([a],[a])
|
|
takeOneMore ( _,[]) = 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 0 _ = return []
|
|
takeN i xs = fst <$> takeNMore i ([],xs)
|
|
|
|
-- | 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
|
|
|
|
-- | Randomly shuffle the tail of a list, not safe.
|
|
shuffleTail :: RandomGen g => [a] -> State g [a]
|
|
shuffleTail (x:xs) = (x :) <$> shuffle xs
|
|
shuffleTail _ = undefined
|
|
|
|
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)))
|