{-# LANGUAGE OverloadedStrings #-}
-- |a sort of Eukarya,Jungle, operating 
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.Monad
import Control.DeepSeq
import Control.Parallel.Strategies
import Data.Traversable as T

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

-- |evaluate a Jungle
evalJungle jungle = return.withStrategyParTraversableRdeepseq =<< T.sequence
  (smap evalTreeGene jungle)

-- |generate a Jungle
genJungle :: (Eq len, Num len, RandomGen g, HeukaryaGene m d) 
          => g                 -- ^Random Generator
          -> Int               -- ^depth of Eukkarya's tree structure
          -> [d]               -- ^genes for constructing Eukarya
          -> Text              -- ^Type
          -> len               -- ^the quantity of Eukarya in Jungle
          -> m (Seq (Tree d)) -- ^output Jungle
genJungle g n geneList outType len = do
  return.withStrategyParTraversableRdeepseq =<< T.sequence
    (smap (\ gg -> genEukarya gg n outType geneList) rr)
  where
  rr = randomSeq len g

-- | crossover the Eukaryas in Jungle
crossJungle :: (RandomGen g, HeukaryaGene m d)
            => g                 -- ^Random Generator
            -> Int               -- ^depth of Eukkarya's tree structure
            -> Seq (Tree d)      -- ^input Jungle
            -> Double            -- ^probability of crossover a pair of Heukarya
            -> m (Seq (Tree d)) -- ^output Jungle
crossJungle g n jungle prob = return.withStrategyParTraversableRdeepseq =<< T.sequence  
  (smap (liftM fst) crossed >< smap (liftM 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 return (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

-- |mutating the Eukarya in Jungle
mutateJungle :: (RandomGen g, HeukaryaGene m d)
             => g                -- ^Random Generator
             -> Int              -- ^depth of Eukkarya's tree structure
             -> [d]              -- ^genes for mutating Eukarya
             -> Seq (Tree d)     -- ^input Jungle
             -> Double           -- ^probability of mutating Heukarya
             -> m (Seq (Tree d))     -- ^output Jungle

mutateJungle g n geneList jungle prob = return.withStrategyParTraversableRdeepseq =<< T.sequence
  (smap
  (\(gg,ff,tree) -> if ff < prob then mutateEukarya gg n geneList tree else return 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

-- |choose better Eukarya, one to one competition
choiceJungle :: (Ord n, RandomGen g)
             => g         -- ^Random Generato
             -> Seq n     -- ^Fitness of each Heukarya in Jungle
             -> Seq a     -- ^input Jungle
             -> Double    -- ^probability of Heukarya who has bigger fitness win the competition
             -> Seq a     -- ^output Jungle
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