blob: a34a3827e8258044471100d1cfa81c02ea59f85a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
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)
|
