{- 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)))