-- This file is part of GeneA.
-- 
-- GeneA is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
-- 
-- GeneA is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with GeneA.  If not, see <http://www.gnu.org/licenses/>.

--------------------------------------------------------------------------------
-- |
-- Module: GeneA.Population
-- Maintainer: Douglas Moore <dglmoore@gmail.com>
--
-- The 'GeneA.Population' modules provides a data type that represents
-- populations of 'GeneA.Genetic' instances as well as a mechanism for evolving
-- such populations toward 'Infinite' fitness and several population operations
-- for determining such things as
--
-- * The minimum (maximum) fitness of the population: 'minFitness'
-- ('maxFitness').
--
-- * The total (average) fitness of the population: 'totalFitness'
-- ('avgFitness').
--
-- * The optimal individual of the population: 'optimal'.
--------------------------------------------------------------------------------
module GeneA.Population
  (
  -- * Types
  Population(..)

  -- * Evolving Populations
  ,evolve

  -- * Operations on populations
  ,maxFitness
  ,minFitness
  ,avgFitness
  ,totalFitness
  ,optimal
  ) where

import Control.Monad (replicateM, liftM)
import Control.Monad.State (evalState)
import Prelude hiding (cycle)
import System.Random

import GeneA.Genetic
import GeneA.Prob

-- | 'Population' is a data type representing a population of 'GeneA.Genetic'
-- instances.
--
-- Then underlying data structure is a list. Future iterations may improve this
-- by using a more efficient structure. However, testing seems to suggest that
-- the performance is quite good as is.
data Genetic a => Population a = Population {
  -- | 'Populace' returns the underlying list data structure of a 'Population'.
  populace :: [a]
}

instance (Genetic a, Show a) => Show (Population a) where
  show = show . populace

-- | 'Transition' is a type alias for a random transition from one 'Population'
-- to another. These occur when we perform 'mutateP' the population as well as
-- when we cycle through epochs.
type Transition a = Population a -> Prob (Population a)

-- | 'selectionP' uses the 'GeneA.Genetic.selection' implementation for the
-- the individuals of the population in order to perform a global selection on
-- the population.
--
-- A collection of selection operators can be found in
-- 'GeneA.Genetic.Operators'.
selectionP :: (Genetic a) => Population a -> Prob [(a,a)]
selectionP (Population xs) = selection xs

-- | 'crossoverP' uses the 'GeneA.Genetic.crossover' implementation for the
-- individuals of the population in order to perform the crossovers and
-- repopulate.
--
-- In the future, there will be a few generic crossover algorithms in the
-- 'GeneA.Genetic.Operators' module.
crossoverP :: (Genetic a) => [(a,a)] -> Prob (Population a)
crossoverP = fmap toPop . mapM crossover
  where toPop xs = Population $ collate xs []
        collate [] ys             = ys
        collate ((x,y,z,w):xs) ys = collate xs (x:y:z:w:ys)

-- | 'mutateP' mutates individuals using the 'GeneA.Genetic.mutate'
-- implementation provided as an instance of 'GeneA.Genetic'.
mutateP :: (Genetic a) => Population a -> Prob (Population a)
mutateP = fmap Population . mapM mutate . populace
  
-- | Provide a population size, @n@, as an 'Int', 'mkPopulation' creates a
-- random population of that size within the 'GeneA.Prob' monad.
mkPopulation :: (Genetic a) => Int -> Prob (Population a)
mkPopulation n = fmap Population $ replicateM n mkGenetic

-- | Given a population size, @n@, as an 'Int', and an random number generator
-- as an 'System.Random.StdGen', 'evolve' initializes a random population of
-- individuals and evolves that population toward an optimal solution as defined
-- by the 'GeneA.Genetic.fitness' function provided as an instance of
-- 'GeneA.Genetic'.
evolve :: (Genetic a) => Int -> StdGen -> Population a
evolve n = evalState (mkPopulation n >>= evaluate cycle)

-- | A 'cycle' is simply the application of the 'selectionP', 'crossoverP',
-- 'mutateP' functions to the population in succession.
--
-- At the end of each sequence of applications, we 'evaluate' the population to
-- determine whether the evolution will continue of halt, returning the
-- population as is within the 'Prob' monad.
cycle :: (Genetic a) => Transition a
cycle p = selectionP p >>=
          crossoverP >>=
          mutateP >>=
          evaluate cycle

-- | Evaluation of populations is straight forward. Evolution halts if any of
-- the following three situations occur:
--
-- * an optimal solution has been discovers (as defined by
-- 'GeneA.Genetic.fitness')
--
-- * the population has reached a maximum size of @1000@ individuals
--
-- * the population has died completely
--
-- Otherwise the evolution process continues with a call to 'cycle'.
evaluate :: (Genetic a) => Transition a -> Population a -> Prob (Population a)
evaluate func pop | condition pop = return pop
                  | otherwise     = func pop
  where condition (Population [])   = True
        condition p@(Population xs) | length xs > 1000          = True
                                    | isInfinite (maxFitness p) = True
                                    | otherwise                 = False

-- | 'maxFitness' returns the maximum fitness of the individuals in the
-- population. If the population is dead, an error is thrown.
maxFitness :: (Genetic a) => Population a -> Float
maxFitness (Population xs) = maximum $ map fitness xs

-- | 'minFitness' returns the minimum fitness of the individuals in the
-- population. If the population is dead, an error is thrown.
minFitness :: (Genetic a) => Population a -> Float
minFitness (Population xs) = minimum $ map fitness xs

-- | 'avgFitness' returns the average fitness of the individuals in the
-- population after removing any individuals of @Infinite@ fitness. If the
-- population is dead, an error is thrown.
avgFitness :: (Genetic a) => Population a -> Float
avgFitness (Population xs) = average $ map fitness xs
  where average = uncurry (/) .
                  foldr (\e (s,c) -> (e+s,c+1)) (0,0) .
                  filter (not . isInfinite)

-- | 'totalFitness' returns the total fitness of the individuals in the
-- population. If the population is dead, an error is thrown.
totalFitness :: (Genetic a) => Population a -> Float
totalFitness (Population xs) = sum $ map fitness xs

-- | 'optimal' returns the individual with the greatest fitness. Should there be
-- multiple individuals with that same fitness, it returns the left most
-- individual. Should the population be dead, an error is thrown.
optimal :: (Genetic a) => Population a -> a
optimal (Population xs) = maximum xs
