{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GADTs, ExistentialQuantification #-}
module Moo.GeneticAlgorithm.Types
(
Genome
, Objective
, Phenotype
, Population
, GenomeState(..)
, takeObjectiveValue
, ProblemType (..)
, ObjectiveFunction(..)
, SelectionOp
, CrossoverOp
, MutationOp
, noMutation
, noCrossover
, StepGA
, Cond(..)
, PopulationState
, StepResult(..)
) where
import Moo.GeneticAlgorithm.Random
import Control.Parallel.Strategies (parMap, rseq)
type Genome a = [a]
type Objective = Double
type Phenotype a = (Genome a, Objective)
type Population a = [Phenotype a]
class GenomeState gt a where
takeGenome :: gt -> Genome a
instance (a1 ~ a2) => GenomeState (Genome a1) a2 where
takeGenome :: Genome a1 -> Genome a2
takeGenome = Genome a1 -> Genome a2
forall a. a -> a
id
instance (a1 ~ a2) => GenomeState (Phenotype a1) a2 where
takeGenome :: Phenotype a1 -> Genome a2
takeGenome = Phenotype a1 -> Genome a2
forall a b. (a, b) -> a
fst
takeObjectiveValue :: Phenotype a -> Objective
takeObjectiveValue :: Phenotype a -> Objective
takeObjectiveValue = Phenotype a -> Objective
forall a b. (a, b) -> b
snd
data ProblemType = Minimizing | Maximizing deriving (Int -> ProblemType -> ShowS
[ProblemType] -> ShowS
ProblemType -> String
(Int -> ProblemType -> ShowS)
-> (ProblemType -> String)
-> ([ProblemType] -> ShowS)
-> Show ProblemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProblemType] -> ShowS
$cshowList :: [ProblemType] -> ShowS
show :: ProblemType -> String
$cshow :: ProblemType -> String
showsPrec :: Int -> ProblemType -> ShowS
$cshowsPrec :: Int -> ProblemType -> ShowS
Show, ProblemType -> ProblemType -> Bool
(ProblemType -> ProblemType -> Bool)
-> (ProblemType -> ProblemType -> Bool) -> Eq ProblemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProblemType -> ProblemType -> Bool
$c/= :: ProblemType -> ProblemType -> Bool
== :: ProblemType -> ProblemType -> Bool
$c== :: ProblemType -> ProblemType -> Bool
Eq)
class ObjectiveFunction f a where
evalObjective :: f -> [Genome a] -> Population a
instance (a1 ~ a2) =>
ObjectiveFunction (Genome a1 -> Objective) a2 where
evalObjective :: (Genome a1 -> Objective) -> [Genome a2] -> Population a2
evalObjective Genome a1 -> Objective
f [Genome a2]
gs = Strategy (Genome a1, Objective)
-> (Genome a1 -> (Genome a1, Objective))
-> [Genome a1]
-> [(Genome a1, Objective)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Genome a1, Objective)
forall a. Strategy a
rseq (\Genome a1
g -> (Genome a1
g, Genome a1 -> Objective
f Genome a1
g)) [Genome a1]
[Genome a2]
gs
instance (a1 ~ a2) =>
ObjectiveFunction ([Genome a1] -> [Objective]) a2 where
evalObjective :: ([Genome a1] -> [Objective]) -> [Genome a2] -> Population a2
evalObjective [Genome a1] -> [Objective]
f [Genome a2]
gs = [Genome a2] -> [Objective] -> Population a2
forall a b. [a] -> [b] -> [(a, b)]
zip [Genome a2]
gs ([Genome a1] -> [Objective]
f [Genome a1]
[Genome a2]
gs)
instance (a1 ~ a2) =>
ObjectiveFunction ([Genome a1] -> [(Genome a1, Objective)]) a2 where
evalObjective :: ([Genome a1] -> [(Genome a1, Objective)])
-> [Genome a2] -> Population a2
evalObjective [Genome a1] -> [(Genome a1, Objective)]
f [Genome a2]
gs = [Genome a1] -> [(Genome a1, Objective)]
f [Genome a1]
[Genome a2]
gs
type SelectionOp a = Population a -> Rand (Population a)
type CrossoverOp a = [Genome a] -> Rand ([Genome a], [Genome a])
type MutationOp a = Genome a -> Rand (Genome a)
noCrossover :: CrossoverOp a
noCrossover :: CrossoverOp a
noCrossover [Genome a]
genomes = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome a]
genomes, [])
noMutation :: MutationOp a
noMutation :: MutationOp a
noMutation = MutationOp a
forall (m :: * -> *) a. Monad m => a -> m a
return
type StepGA m a = Cond a
-> PopulationState a
-> m (StepResult (Population a))
data Cond a =
Generations Int
| IfObjective ([Objective] -> Bool)
| forall b . Eq b => GensNoChange
{ Cond a -> Int
c'maxgens :: Int
, ()
c'indicator :: [Objective] -> b
, ()
c'counter :: Maybe (b, Int)
}
| Or (Cond a) (Cond a)
| And (Cond a) (Cond a)
type PopulationState a = Either [Genome a] [Phenotype a]
data StepResult a = StopGA a | ContinueGA a deriving (Int -> StepResult a -> ShowS
[StepResult a] -> ShowS
StepResult a -> String
(Int -> StepResult a -> ShowS)
-> (StepResult a -> String)
-> ([StepResult a] -> ShowS)
-> Show (StepResult a)
forall a. Show a => Int -> StepResult a -> ShowS
forall a. Show a => [StepResult a] -> ShowS
forall a. Show a => StepResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepResult a] -> ShowS
$cshowList :: forall a. Show a => [StepResult a] -> ShowS
show :: StepResult a -> String
$cshow :: forall a. Show a => StepResult a -> String
showsPrec :: Int -> StepResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StepResult a -> ShowS
Show)