module AI.Heukarya.Jungle (
evalJungle
,genJungle
,crossJungle
,mutateJungle
,choiceJungle
) where
import AI.Heukarya.Gene as G
import Data.Sequence as S
import Data.Text(Text)
import qualified Data.List as L
import Control.DeepSeq
import Control.Parallel.Strategies
withStrategyParTraversableRdeepseq :: NFData a => Seq a -> Seq a
withStrategyParTraversableRdeepseq = withStrategy (parTraversable rdeepseq)
smap x = mapWithIndex (\_->x)
randomSeq 0 _ = S.empty
randomSeq len g = g1 <| (randomSeq (len 1) g2)
where
(g1,g2) = split g
evalJungle jungle = withStrategyParTraversableRdeepseq $
smap evalTreeGene jungle
genJungle :: (Eq len, Num len, RandomGen g, HeukaryaGene d)
=> g
-> Int
-> [d]
-> Text
-> len
-> Seq (Tree d)
genJungle g n geneList outType len = withStrategyParTraversableRdeepseq $
smap (\ gg -> genEukarya gg n outType geneList) rr
where
rr = randomSeq len g
crossJungle :: (RandomGen g, HeukaryaGene d)
=> g
-> Int
-> Seq (Tree d)
-> Double
-> Seq (Tree d)
crossJungle g n jungle prob = withStrategyParTraversableRdeepseq $
smap fst crossed >< smap snd crossed
where
len = S.length jungle
half = floor (fromIntegral len / 2)
crossed = smap (\(gg,ff,eu1,eu2) -> if ff < prob then crossEukarya gg n (eu1,eu2) else (eu1,eu2)) $ S.zip4 rr rf jungle1 jungle2
(g1,g2) = split g
(g3,g4) = split g2
(g5,g6) = split g4
randLen = randomSeq half
rr = randLen g1
rf = smap (abs . fst . random) $ randLen g3 :: Seq Double
permutedJungle = permute (smap (fst . random) $ randomSeq (mod ((fst . random) g5) (100*len)) g6) jungle
jungle1 = S.take half permutedJungle
jungle2 = S.drop half permutedJungle
permute trans seq
| S.null trans = seq
| otherwise = withStrategy (parTraversable rseq) $ permute (S.drop 1 trans) permSeq
where
permSeq = S.mapWithIndex (\i ele ->
let k = mod i len in if k == 0 then seq `S.index` ht else (if k == ht then seq `S.index` 0 else ele)
) seq
ht = mod (trans `S.index` 0) len
len = S.length seq
mutateJungle :: (RandomGen g, HeukaryaGene d)
=> g
-> Int
-> [d]
-> Seq (Tree d)
-> Double
-> Seq (Tree d)
mutateJungle g n geneList jungle prob = withStrategyParTraversableRdeepseq $
smap
(\(gg,ff,tree) -> if ff < prob then mutateEukarya gg n geneList tree else tree) $
S.zip3 rr rf jungle
where
(g1,g2) = split g
randLen = randomSeq (S.length jungle)
rr = randLen g1
rf = smap (abs . fst . random) $ randLen g2 :: Seq Double
choiceJungle :: (Ord n, RandomGen g)
=> g
-> Seq n
-> Seq a
-> Double
-> Seq a
choiceJungle g fitness jungle prob = withStrategy (parTraversable rseq) $ choiced
where
len = S.length jungle
choiced = smap (\(ff,eu1,eu2) -> if ff < prob then maxi eu1 eu2 else mini eu1 eu2) $ S.zip3 rf jungle1 jungle2
(g1,g2) = split g
(g3,g4) = split g2
randLen = randomSeq len
rf = smap (abs . fst . random) $ randLen g1 :: Seq Double
fitnessJungle = S.zip fitness jungle
permutedJungle = permute (smap (fst . random) $ randomSeq (mod ((fst . random) g3) (100*len)) g4) fitnessJungle
jungle1 = permutedJungle
jungle2 = S.reverse permutedJungle
maxi a b = snd $ if fst a > fst b then a else b
mini a b = snd $ if fst a > fst b then b else a