{-|
Module      : IT.ITEA
Description : Interaction-Transformation Evolutionary Algorithm
Copyright   : (c) Fabricio Olivetti de Franca, 2020
License     : GPL-3
Maintainer  : fabricio.olivetti@gmail.com
Stability   : experimental
Portability : POSIX

Generic implementation of Interaction-Transformation Evolutionary Algorithm
for any instance of IT expression.

To run itea you just need to call 'itea mutFun pop0', 
where 'mutFun' is a mutation function of the type 'Mutation',
a 'fitness' function of type 'Fitness',
and 'pop0' is the initial 'Population' of solutions.
This function will result in an infinite list of populations, with
the /i/-th element being the population of the /i/-th generation.

This library also provides some generic mutation function builders.
-}
module IT.ITEA where

import IT
import IT.Algorithms
import IT.Random

import Control.Monad.Extra (iterateM)
import GHC.Conc (numCapabilities)

import Control.Monad.State
import Control.Parallel.Strategies
import Data.Maybe
import System.Random
import Data.List (nub)
import qualified Data.Sequence as Seq

-- * ITEA

-- | Creates a stream of generations the /i/-th 
-- element corresponds to the population of the /i/-th generation.
itea :: Mutation -> Fitness -> Population -> Rnd [Population]
itea :: Mutation -> Fitness -> Population -> Rnd [Population]
itea Mutation
f Fitness
g Population
p0 = let n :: Int
n = Population -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Population
p0
                      in  (Population -> StateT StdGen Identity Population)
-> Population -> Rnd [Population]
forall (m :: * -> *) a. Monad m => (a -> m a) -> a -> m [a]
iterateM (Mutation
-> Fitness
-> Int
-> Population
-> StateT StdGen Identity Population
step Mutation
f Fitness
g Int
n) Population
p0

-- | Generate an Initial Population at Random
initialPop :: Int                -- ^ maxTerms
           -> Int                -- ^ nPop
           -> Rnd Term       -- ^ random term generator
           -> Fitness          -- ^ fitness function
           -> Rnd Population
initialPop :: Int
-> Int -> Rnd Term -> Fitness -> StateT StdGen Identity Population
initialPop Int
maxTerms Int
nPop Rnd Term
rndTerm Fitness
fit = 
  do Population
pop <- (() -> StateT StdGen Identity Solution)
-> [()] -> StateT StdGen Identity Population
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse () -> StateT StdGen Identity Solution
rndIndividual ([()] -> StateT StdGen Identity Population)
-> [()] -> StateT StdGen Identity Population
forall a b. (a -> b) -> a -> b
$ Int -> () -> [()]
forall a. Int -> a -> [a]
replicate Int
nPop ()
     Int
-> (Solution -> Rnd Expr)
-> Fitness
-> Population
-> StateT StdGen Identity Population
parRndMap Int
nPop (Mutation
forall (m :: * -> *) a. Monad m => a -> m a
return Mutation -> (Solution -> Expr) -> Solution -> Rnd Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> Expr
_expr) Fitness
fit Population
pop
  where
    rndExpr :: Int -> Rnd Expr
rndExpr = Rnd Term -> Int -> Rnd Expr
sampleExpr Rnd Term
rndTerm
    createSol :: Expr -> Solution
createSol Expr
e = Expr -> [Double] -> Double -> Int -> Double -> [Vector] -> Solution
Sol Expr
e [] Double
0.0 Int
0 Double
0.0 []

    -- return a random list of random expressions
    rndIndividual :: () -> StateT StdGen Identity Solution
rndIndividual () = do Int
n <- Int -> Int -> Rnd Int
sampleRng Int
1 Int
maxTerms
                          Expr -> Solution
createSol (Expr -> Solution) -> (Expr -> Expr) -> Expr -> Solution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
forall a. Eq a => [a] -> [a]
nub (Expr -> Solution) -> Rnd Expr -> StateT StdGen Identity Solution
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rnd Expr
rndExpr Int
n


-- | Tournament Selection
--
-- given the concatenation of the previous population
-- and the mutated children, it will return a sampled
-- selection of these combined population with
-- the same size as the original population.
--
tournamentSeq :: Population -> Int -> Rnd Population
tournamentSeq :: Population -> Int -> StateT StdGen Identity Population
tournamentSeq [] Int
_ = Population -> StateT StdGen Identity Population
forall (m :: * -> *) a. Monad m => a -> m a
return []
tournamentSeq Population
p Int
n = do let p' :: Seq Solution
p'   = Population -> Seq Solution
forall a. [a] -> Seq a
Seq.fromList Population
p
                           npop :: Int
npop = Seq Solution -> Int
forall a. Seq a -> Int
Seq.length Seq Solution
p'
                           chooseOne :: Int -> Int -> Solution
chooseOne Int
ix1 Int
ix2 = Solution -> Solution -> Solution
forall a. Ord a => a -> a -> a
min (Seq Solution
p' Seq Solution -> Int -> Solution
forall a. Seq a -> Int -> a
`Seq.index` Int
ix1) (Seq Solution
p' Seq Solution -> Int -> Solution
forall a. Seq a -> Int -> a
`Seq.index` Int
ix2)
                       [Int]
ixs1 <- Int -> Rnd Int -> StateT StdGen Identity [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Int -> Rnd Int
sampleTo (Int
npopInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                       [Int]
ixs2 <- Int -> Rnd Int -> StateT StdGen Identity [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Int -> Rnd Int
sampleTo (Int
npopInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                       Population -> StateT StdGen Identity Population
forall (m :: * -> *) a. Monad m => a -> m a
return (Population -> StateT StdGen Identity Population)
-> Population -> StateT StdGen Identity Population
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Solution) -> [Int] -> [Int] -> Population
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Solution
chooseOne [Int]
ixs1 [Int]
ixs2

-- | For small population, do not convert to Finger Tree to avoid overhead
tournament :: Population -> Int -> Rnd Population
tournament :: Population -> Int -> StateT StdGen Identity Population
tournament [] Int
_ = Population -> StateT StdGen Identity Population
forall (m :: * -> *) a. Monad m => a -> m a
return []
tournament Population
p Int
n = do let npop :: Int
npop = Population -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Population
p
                        chooseOne :: Int -> Int -> Solution
chooseOne Int
ix1 Int
ix2 = Solution -> Solution -> Solution
forall a. Ord a => a -> a -> a
min (Population
p Population -> Int -> Solution
forall a. [a] -> Int -> a
!! Int
ix1) (Population
p Population -> Int -> Solution
forall a. [a] -> Int -> a
!! Int
ix2)
                    [Int]
ixs1 <- Int -> Rnd Int -> StateT StdGen Identity [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Int -> Rnd Int
sampleTo (Int
npopInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                    [Int]
ixs2 <- Int -> Rnd Int -> StateT StdGen Identity [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Int -> Rnd Int
sampleTo (Int
npopInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                    Population -> StateT StdGen Identity Population
forall (m :: * -> *) a. Monad m => a -> m a
return (Population -> StateT StdGen Identity Population)
-> Population -> StateT StdGen Identity Population
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Solution) -> [Int] -> [Int] -> Population
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Solution
chooseOne [Int]
ixs1 [Int]
ixs2

-- | Perform one iteration of ITEA
step :: Mutation -> Fitness -> Int -> Population -> Rnd Population
step :: Mutation
-> Fitness
-> Int
-> Population
-> StateT StdGen Identity Population
step Mutation
mutFun Fitness
fitFun Int
nPop Population
pop = do
  let tourn :: Population -> Int -> StateT StdGen Identity Population
tourn = if Int
nPop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 then Population -> Int -> StateT StdGen Identity Population
tournamentSeq else Population -> Int -> StateT StdGen Identity Population
tournament
      mutf :: Solution -> Rnd Expr
mutf Solution
s = Mutation
mutFun (Solution -> Expr
_expr Solution
s)
  Population
children <- Fitness -> [Expr] -> Population
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Fitness
fitFun ([Expr] -> Population)
-> StateT StdGen Identity [Expr]
-> StateT StdGen Identity Population
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Solution -> Rnd Expr)
-> Population -> StateT StdGen Identity [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Solution -> Rnd Expr
mutf Population
pop
  if Population -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Population
children
     then Population -> Int -> StateT StdGen Identity Population
tourn Population
pop Int
nPop
     else Population -> Int -> StateT StdGen Identity Population
tourn (Population
pop Population -> Population -> Population
forall a. Semigroup a => a -> a -> a
<> Population
children) Int
nPop

-- | EXPERIMENTAL: step function with parallel evaluation 
stepPar :: Mutation -> Fitness -> Int -> Population -> Rnd Population
stepPar :: Mutation
-> Fitness
-> Int
-> Population
-> StateT StdGen Identity Population
stepPar Mutation
mutFun Fitness
fitFun Int
nPop Population
pop = do
  let tourn :: Population -> Int -> StateT StdGen Identity Population
tourn  = if Int
nPop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 then Population -> Int -> StateT StdGen Identity Population
tournamentSeq else Population -> Int -> StateT StdGen Identity Population
tournament
      mutf :: Solution -> Rnd Expr
mutf Solution
s = Mutation
mutFun (Solution -> Expr
_expr Solution
s)
  Population
children  <- Int
-> (Solution -> Rnd Expr)
-> Fitness
-> Population
-> StateT StdGen Identity Population
parRndMap Int
nPop Solution -> Rnd Expr
mutf Fitness
fitFun Population
pop
  if Population -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Population
children
   then Population -> Int -> StateT StdGen Identity Population
tourn Population
pop Int
nPop
   else Population -> Int -> StateT StdGen Identity Population
tourn (Population
pop Population -> Population -> Population
forall a. Semigroup a => a -> a -> a
<> Population
children) Int
nPop

-- * Parallel random functions

-- | Runs in parallel the composition of a function that generates random effects with
-- a function that maybe returns a result.
--parRndMap :: NFData c => Int -> (a -> Rnd b) -> (b -> Maybe c) -> [a] -> Rnd [c]
--parRndMap :: Int -> Mutation -> (Solution -> Maybe Expr) -> [Solution] -> Rnd [Solution]
parRndMap :: Int -> (Solution -> Rnd Expr) -> (Expr -> Maybe Solution) -> [Solution] -> Rnd [Solution]
parRndMap :: Int
-> (Solution -> Rnd Expr)
-> Fitness
-> Population
-> StateT StdGen Identity Population
parRndMap Int
nPop Solution -> Rnd Expr
rndf Fitness
randFun Population
pop = (StdGen -> (Population, StdGen))
-> StateT StdGen Identity Population
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state StdGen -> (Population, StdGen)
stFun
  where
    stFun :: StdGen -> (Population, StdGen)
stFun StdGen
seed = let seeds :: [StdGen]
seeds         = Int -> StdGen -> [StdGen]
genNseeds (Int
nPopInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) StdGen
seed
                     rndpop :: [(StdGen, Solution)]
rndpop        = [StdGen] -> Population -> [(StdGen, Solution)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StdGen]
seeds Population
pop
                     compFun :: (StdGen, Solution) -> Maybe Solution
compFun (StdGen
s,Solution
p) = Fitness
randFun Fitness -> Fitness
forall a b. (a -> b) -> a -> b
$ Rnd Expr -> StdGen -> Expr
forall s a. State s a -> s -> a
evalState (Solution -> Rnd Expr
rndf Solution
p) StdGen
s
                     nSplits :: Int
nSplits       = Int -> Int
numberOfSplits Int
nPop
                     pop' :: Population
pop'          = Int
-> ((StdGen, Solution) -> Maybe Solution)
-> [(StdGen, Solution)]
-> Population
parMaybeMap Int
nSplits (StdGen, Solution) -> Maybe Solution
compFun [(StdGen, Solution)]
rndpop
                 in  (Population
pop', [StdGen] -> StdGen
forall a. [a] -> a
last [StdGen]
seeds)

-- | Calculates the number of splits as twice the number of cores
numberOfSplits :: Int -> Int
numberOfSplits :: Int -> Int
numberOfSplits Int
n = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
numCapabilities

-- | Generates n random seeds.
genNseeds :: Int -> StdGen -> [StdGen]
genNseeds :: Int -> StdGen -> [StdGen]
genNseeds Int
n = Int -> [StdGen] -> [StdGen]
forall a. Int -> [a] -> [a]
take Int
n ([StdGen] -> [StdGen])
-> (StdGen -> [StdGen]) -> StdGen -> [StdGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [StdGen]
genseeds

-- | Generates an infinite list of random seeds.
genseeds :: StdGen -> [StdGen]
genseeds :: StdGen -> [StdGen]
genseeds StdGen
s = let (StdGen
s1, StdGen
s2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
s
             in  StdGen
s1 StdGen -> [StdGen] -> [StdGen]
forall a. a -> [a] -> [a]
: StdGen -> [StdGen]
genseeds StdGen
s2

-- | Runs a computation that may returns a result in parallel.
--parMaybeMap :: NFData b => Int -> (a -> Maybe b) -> [a] -> [b]
parMaybeMap :: Int -> ((StdGen, Solution) -> Maybe Solution) -> [(StdGen, Solution)] -> Population
parMaybeMap :: Int
-> ((StdGen, Solution) -> Maybe Solution)
-> [(StdGen, Solution)]
-> Population
parMaybeMap Int
n (StdGen, Solution) -> Maybe Solution
f [(StdGen, Solution)]
pop = [Maybe Solution] -> Population
forall a. [Maybe a] -> [a]
catMaybes [Maybe Solution]
parmap
  where
    parmap :: [Maybe Solution]
parmap = ((StdGen, Solution) -> Maybe Solution)
-> [(StdGen, Solution)] -> [Maybe Solution]
forall a b. (a -> b) -> [a] -> [b]
map (StdGen, Solution) -> Maybe Solution
f [(StdGen, Solution)]
pop [Maybe Solution] -> Strategy [Maybe Solution] -> [Maybe Solution]
forall a. a -> Strategy a -> a
`using` Int -> Strategy (Maybe Solution) -> Strategy [Maybe Solution]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
n Strategy (Maybe Solution)
forall a. Strategy a
rpar