public
anonymous / GAExample.hs
Created

  • Download Gist
GAExample.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
 
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 ()

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.