module AI.SimpleEA.Utils (
avgFitnesses
, maxFitnesses
, minFitnesses
, stdDeviations
, randomGenomes
, fitPropSelect
, tournamentSelect
, sigmaScale
, rankScale
, elite
, getPlottingData
) where
import Control.Monad (liftM, replicateM)
import Control.Monad.Random
import Data.List (genericLength, zip4, sortBy, nub, elemIndices, sort)
import System.Random.Mersenne.Pure64 (PureMT)
import AI.SimpleEA
avgFitnesses :: [[(Genome a, Fitness)]] -> [Fitness]
avgFitnesses = map (\g -> (sum . map snd) g/genericLength g)
maxFitnesses :: [[(Genome a, Fitness)]] -> [Fitness]
maxFitnesses = map (maximum . map snd)
minFitnesses :: [[(Genome a, Fitness)]] -> [Fitness]
minFitnesses = map (minimum . map snd)
stdDeviations :: [[(Genome a, Fitness)]] -> [Double]
stdDeviations = map (stdDev . map snd)
stdDev :: (Floating a) => [a] -> a
stdDev p =
sqrt (sum sqDiffs/len)
where len = genericLength p
mean = sum p/len
sqDiffs = map (\n -> (nmean)**2) p
randomGenomes :: (RandomGen g, Random a, Enum a) => Int -> Int -> a -> a -> Rand g [Genome a]
randomGenomes len genomeLen from to = do
l <- replicateM (len*genomeLen) $ getRandomR (from,to)
return $ nLists genomeLen l
where nLists :: Int -> [a] -> [[a]]
nLists _ [] = []
nLists n ls = take n ls : nLists n (drop n ls)
sigmaScale :: [Fitness] -> [Fitness]
sigmaScale fs = map (\f_g -> 1+(f_gf_i)/(2*σ)) fs
where σ = stdDev fs
f_i = sum fs/genericLength fs
rankScale :: [Fitness] -> [Fitness]
rankScale fs = map (\n -> max'fromIntegral n) ranks
where ranks = (concatMap (`elemIndices` fs) . reverse . nub . sort) fs
max' = fromIntegral $ maximum ranks + 1
fitPropSelect :: (RandomGen g) => [(a, Fitness)] -> Rand g a
fitPropSelect xs = do
let xs' = zip (map fst xs) (scanl1 (+) $ map snd xs)
let sumScores = (snd . last) xs'
rand <- getRandomR (0.0, sumScores)
return $ (fst . head . dropWhile ((rand >) . snd)) xs'
tournamentSelect :: [(a, Fitness)] -> Int -> Rand PureMT a
tournamentSelect xs size = do
let l = length xs
rs <- liftM (take size . nub) $ getRandomRs (0,l1)
let contestants = map (xs!!) rs
let winner = head $ elite contestants
return winner
elite :: [(a, Fitness)] -> [a]
elite = map fst . sortBy (\(_,a) (_,b) -> compare b a)
getPlottingData :: [[(Genome a, Fitness)]] -> String
getPlottingData gs = concatMap conc (zip4 ns fs ms ds)
where ns = [1..] :: [Int]
fs = avgFitnesses gs
ms = maxFitnesses gs
ds = stdDeviations gs
conc (n, a, m ,s) =
show n ++ " " ++ show a ++ " " ++ show m ++ " " ++ show s ++ "\n"