module Evolve (Evolvable, evolve, mutate, score, mutateProbability) where

import qualified System.Random as Random
import Data.List (maximumBy)
import qualified Par
import qualified Control.Monad.State as State
import RandomState (splits)
import Data.Function (on)
import qualified Control.Concurrent.Chan as Chan
import System.Timeout (timeout)
import Control.Exception (evaluate)

class Evolvable e where
  mutate :: Random.RandomGen g => e -> State.State g e
  score :: e -> Double

numChildren :: Int
numChildren = 100

printModCount :: Int
printModCount = 100

scoreTimeout :: Int
scoreTimeout = 1000

mutateProbability :: Double
mutateProbability = 0.005

evolve :: (Evolvable e, Show e) => Chan.Chan e -> e -> IO ()
evolve c e = evolve' 0 c e 0

timeoutScore :: Evolvable e => e -> IO Double
timeoutScore e = maybe (-1) id <$> timeout scoreTimeout (evaluate (score e))

evolve' :: (Evolvable e, Show e) => Int -> Chan.Chan e -> e -> Double -> IO ()
evolve' generation chan startState myScore = do gs <- take numChildren . State.evalState splits <$> Random.newStdGen
                                                childrenScores <- ((myScore, startState) :) <$> Par.mapIO scoreChild gs
                                                let (bestScore, bestChild) = maximumBy (compare `on` fst) childrenScores
                                                if generation `mod` printModCount == 0
                                                  then Chan.writeChan chan bestChild
                                                  else return ()
                                                evolve' (succ generation) chan bestChild bestScore
  where scoreChild g = do let myChild = State.evalState (mutate startState) g
                          realScore <- timeoutScore myChild
                          return (realScore, myChild)