GAExample.hs

import Control.Applicative
import Control.Monad.State
import Data.List
import Data.Ord
import System.Random
import Text.Printf
import qualified Data.Sequence as S

gaRandomGen :: State GA StdGen
gaRandomGen = do
    GA g <- get
    let (g1, g2) = split g
    put $ GA g1
    return g2

gaRandom :: Random a => State GA a
gaRandom = fst . random <$> gaRandomGen

gaRandomR :: Random a => (a, a) -> State GA a
gaRandomR range = fst . randomR range <$> gaRandomGen

data GA = GA StdGen

tournament 
  :: (Floating a, Ord a1, RealFrac a, Fractional a, Random a) =>
     Int -> a -> S.Seq a1 -> State GA a1
tournament n p pop = do
    winner <- (\w -> min (n - 1) (floor (log w / log (1-p)))) <$> gaRandom
    (flip S.index) winner <$> S.sort <$> seqChoose n pop

seqChoose k xs = go k xs S.empty
    where
        go k xs acc
            | k == 0        = return acc
            | xs == S.empty = return acc
            | otherwise     = do
                r <- gaRandomR (0, S.length xs - 1)
                go (k - 1) (S.drop r xs) (acc S.|> S.index xs r)

t2 = do
    g <- newStdGen
    let a = evalState (tournament 5 0.9 (S.fromList [1..10])) (GA g)
    return ()