module AI.Heukarya.Center(
module G
,module S
,EcoConfig(..)
,EcoUnWritable(..)
,EcoSystem(..)
,initGeneration
,nextGeneration
,evolveGeneration
,evolveCheckGeneration
,readEcoSystem
,writeEcoSystem
,defaultEcoConfig
) where
import Prelude hiding (map)
import System.Random
import AI.Heukarya.Gene as G(Tree,evalTreeGene)
import AI.Heukarya.Jungle
import Data.Text(Text,unpack)
import Data.Sequence(mapWithIndex)
import Data.Sequence as S(Seq)
smap x = mapWithIndex (\_->x)
data EcoConfig = EcoConfig {
num :: Int
,depth :: Int
,maxWinProb :: Double
,mutateProb :: Double
,crossProb :: Double
,outType :: Text
} deriving (Show, Read)
data EcoUnWritable g d = EcoUnWritable {
rndGen :: g
,genes :: [d]
}
defaultEcoConfig = EcoConfig{num=2000, depth=20, maxWinProb=0.6, mutateProb=0.4, crossProb=0.8, outType="Double"}
data EcoSystem g d rep = EcoSystem { ecoUnW :: EcoUnWritable g d ,ecoConfig :: EcoConfig, ecoJungle :: Seq (Tree rep) }
initGeneration unW cfg = EcoSystem
unW{rndGen = g1}
cfg
(genJungle g2 (depth cfg) (genes unW) (outType cfg) (num cfg) )
where
(g1,g2) = split (rndGen unW)
nextGeneration ecoSys@(EcoSystem unW cfg jg) fitness =
EcoSystem unW{rndGen = g1} cfg mutatedJg
where
(g1,g2) = split (rndGen unW)
(g3,g4) = split g2
(g5,g6) = split g4
choicedJg = choiceJungle g3 fitness jg (maxWinProb cfg)
crossedJg = crossJungle g5 (depth cfg) choicedJg (crossProb cfg)
mutatedJg = mutateJungle g6 (depth cfg) (genes unW) crossedJg (mutateProb cfg)
evolveGeneration maxGeneration ecoSys@(EcoSystem unW cfg jg) stopCondict fitnessFunc cnt =
if stopCondict jg || cnt >= maxGeneration then ecoSys else
evolveGeneration
maxGeneration
(nextGeneration ecoSys $ smap fitnessFunc jg)
stopCondict
fitnessFunc
cnt
evolveCheckGeneration maxGeneration filepath checksPer
ecoSys@(EcoSystem unW cfg jg) stopCondict fitnessFunc cnt = do
if cnt `rem` checksPer == 0 then writeEcoSystem filepath ecoSys else return ()
if stopCondict jg || cnt >= maxGeneration
then writeEcoSystem filepath ecoSys >> return ecoSys
else
evolveCheckGeneration
maxGeneration
filepath
checksPer
(nextGeneration ecoSys $ smap fitnessFunc jg)
stopCondict
fitnessFunc
cnt
readEcoSystem filepath unW@(EcoUnWritable g geneList) = do
(cfg,strJg) <- readFile filepath >>= (return.read) :: IO (EcoConfig,Seq (Tree String))
jg <- return $ smap (fmap (\x->head $ filter (\s -> show s == x) geneList)) strJg
return (EcoSystem unW cfg jg)
writeEcoSystem filepath (EcoSystem unW cfg jg) =
writeFile filepath (show $ (cfg,smap (fmap show) jg))