Add source files, commit before reverting pictures to lists

src/Dodge/RandomHelp.hs

@@ -0,0 +1,66 @@
+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,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)))