{-# LANGUAGE MultiParamTypeClasses, Rank2Types, GADTs, FlexibleInstances #-}
module Moo.GeneticAlgorithm.Multiobjective.Types
( SingleObjectiveProblem
, MultiObjectiveProblem
, MultiPhenotype
, evalAllObjectives
, takeObjectiveValues
) where
import Moo.GeneticAlgorithm.Types
import Data.List (transpose)
type SingleObjectiveProblem fn = ( ProblemType , fn )
type MultiObjectiveProblem fn = [SingleObjectiveProblem fn]
type MultiPhenotype a = (Genome a, [Objective])
instance a1 ~ a2 => GenomeState (MultiPhenotype a1) a2 where
takeGenome :: MultiPhenotype a1 -> Genome a2
takeGenome = MultiPhenotype a1 -> Genome a2
forall a b. (a, b) -> a
fst
takeObjectiveValues :: MultiPhenotype a -> [Objective]
takeObjectiveValues :: MultiPhenotype a -> [Objective]
takeObjectiveValues = MultiPhenotype a -> [Objective]
forall a b. (a, b) -> b
snd
evalAllObjectives
:: forall fn gt a . (ObjectiveFunction fn a, GenomeState gt a)
=> MultiObjectiveProblem fn
-> [gt]
-> [MultiPhenotype a]
evalAllObjectives :: MultiObjectiveProblem fn -> [gt] -> [MultiPhenotype a]
evalAllObjectives MultiObjectiveProblem fn
problems [gt]
genomes =
let rawgenomes :: [Genome a]
rawgenomes = (gt -> Genome a) -> [gt] -> [Genome a]
forall a b. (a -> b) -> [a] -> [b]
map gt -> Genome a
forall gt a. GenomeState gt a => gt -> Genome a
takeGenome [gt]
genomes
pops_per_objective :: [Population a]
pops_per_objective = ((ProblemType, fn) -> Population a)
-> MultiObjectiveProblem fn -> [Population a]
forall a b. (a -> b) -> [a] -> [b]
map (\(ProblemType
_, fn
f) -> fn -> [Genome a] -> Population a
forall f a.
ObjectiveFunction f a =>
f -> [Genome a] -> Population a
evalObjective fn
f [Genome a]
rawgenomes) MultiObjectiveProblem fn
problems
ovs_per_objective :: [[Objective]]
ovs_per_objective = (Population a -> [Objective]) -> [Population a] -> [[Objective]]
forall a b. (a -> b) -> [a] -> [b]
map ((Phenotype a -> Objective) -> Population a -> [Objective]
forall a b. (a -> b) -> [a] -> [b]
map Phenotype a -> Objective
forall a. Phenotype a -> Objective
takeObjectiveValue) [Population a]
pops_per_objective
ovs_per_genome :: [[Objective]]
ovs_per_genome = [[Objective]] -> [[Objective]]
forall a. [[a]] -> [[a]]
transpose [[Objective]]
ovs_per_objective
in [Genome a] -> [[Objective]] -> [MultiPhenotype a]
forall a b. [a] -> [b] -> [(a, b)]
zip [Genome a]
rawgenomes [[Objective]]
ovs_per_genome