{-# 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]


-- | An individual with all objective functions evaluated.

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


-- | Calculate multiple objective per every genome in the population.

evalAllObjectives
    :: forall fn gt a . (ObjectiveFunction fn a, GenomeState gt a)
    => MultiObjectiveProblem fn    -- ^ a list of @problems@

    -> [gt]                        -- ^ a population of @genomes@

    -> [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