module Stochastic where

import System.Random (RandomGen, Random, randomR, )
import Control.Monad.Trans.State (State, state, evalState, )
import qualified Control.Monad.HT as M


{- | chose a random item from a list -}
-- from RandomName
randomItem :: (RandomGen g) => [a] -> State g a
randomItem x = fmap (x!!) (randomRState (length x - 1))

{- | chose a random item from a list with respect to a non-uniform distribution -}
randomItemProp :: (RandomGen g, Random b, Num b, Ord b) =>
   [(a,b)] -> State g a
randomItemProp props =
   let (keys,ps) = unzip props
       sumps = sum ps
       {- I use M.until in order to get a right open interval,
          only this variant works for both floating point types and integers. -}
   in  do p <- M.until (<sumps) (randomRState sumps)
          return (fst (head (dropWhile ((0<=) . snd)
                    (zip keys (tail (scanl (-) p ps))))))

shuffle :: (RandomGen g) => [a] -> State g [a]
shuffle xs =
   let remove n ys =
          let (yl,y:yr) = splitAt n ys
          in  (y,yl++yr)
       select is = evalState (mapM (state . remove) is) xs
       len = length xs
   in  fmap select (mapM randomRState [len-1,len-2..0])

randomRState :: (RandomGen g, Random a, Num a) => a -> State g a
randomRState upper = state (randomR (0, upper))