module Moo.GeneticAlgorithm.Niching
    ( fitnessSharing
    ) where


import Moo.GeneticAlgorithm.Types


-- | A popular niching method proposed by D. Goldberg and

-- J. Richardson in 1987. The shared fitness of the individual is inversely

-- protoptional to its niche count.

-- The method expects the objective function to be non-negative.

--

-- An extension for minimization problems is implemented by

-- making the fitnes proportional to its niche count (rather than

-- inversely proportional).

--

-- Reference: Chen, J. H., Goldberg, D. E., Ho, S. Y., & Sastry,

-- K. (2002, July). Fitness inheritance in multiobjective

-- optimization. In Proceedings of the Genetic and Evolutionary

-- Computation Conference (pp. 319-326). Morgan Kaufmann Publishers

-- Inc..

fitnessSharing ::
    (Phenotype a -> Phenotype a -> Double)  -- ^ distance function

    -> Double                        -- ^ niche radius

    -> Double                        -- ^ niche compression exponent @alpha@ (usually 1)

    -> ProblemType                   -- ^ type of the optimization problem

    -> Population a
    -> Population a
fitnessSharing :: (Phenotype a -> Phenotype a -> Double)
-> Double -> Double -> ProblemType -> Population a -> Population a
fitnessSharing Phenotype a -> Phenotype a -> Double
dist Double
r Double
alpha ProblemType
Maximizing Population a
phenotypes =
    let ms :: [Double]
ms = (Phenotype a -> Double) -> Population a -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Phenotype a -> Phenotype a -> Double)
-> Double -> Double -> Population a -> Phenotype a -> Double
forall a.
DistanceFunction a
-> Double -> Double -> Population a -> Phenotype a -> Double
nicheCount Phenotype a -> Phenotype a -> Double
dist Double
r Double
alpha Population a
phenotypes) Population a
phenotypes
    in  (Phenotype a -> Double -> Phenotype a)
-> Population a -> [Double] -> Population a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Genome a
genome, Double
value) Double
m -> (Genome a
genome, Double
valueDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
m)) Population a
phenotypes [Double]
ms
fitnessSharing Phenotype a -> Phenotype a -> Double
dist Double
r Double
alpha ProblemType
Minimizing Population a
phenotypes =
    let ms :: [Double]
ms = (Phenotype a -> Double) -> Population a -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Phenotype a -> Phenotype a -> Double)
-> Double -> Double -> Population a -> Phenotype a -> Double
forall a.
DistanceFunction a
-> Double -> Double -> Population a -> Phenotype a -> Double
nicheCount Phenotype a -> Phenotype a -> Double
dist Double
r Double
alpha Population a
phenotypes) Population a
phenotypes
    in  (Phenotype a -> Double -> Phenotype a)
-> Population a -> [Double] -> Population a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Genome a
genome, Double
value) Double
m -> (Genome a
genome, Double
valueDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
m)) Population a
phenotypes [Double]
ms


type DistanceFunction a = Phenotype a -> Phenotype a -> Double


nicheCount :: DistanceFunction a
           -> Double -> Double
           -> Population a -> Phenotype a -> Double
nicheCount :: DistanceFunction a
-> Double -> Double -> Population a -> Phenotype a -> Double
nicheCount DistanceFunction a
dist Double
r Double
alpha Population a
population Phenotype a
phenotype =
    [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Phenotype a -> Double) -> Population a -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (DistanceFunction a -> Double -> Double -> DistanceFunction a
forall a.
DistanceFunction a -> Double -> Double -> DistanceFunction a
sharing DistanceFunction a
dist Double
r Double
alpha Phenotype a
phenotype) Population a
population


sharing :: DistanceFunction a
        -> Double -> Double
        -> DistanceFunction a
sharing :: DistanceFunction a -> Double -> Double -> DistanceFunction a
sharing DistanceFunction a
dist Double
r Double
alpha Phenotype a
pi Phenotype a
pj =
    let dij :: Double
dij = DistanceFunction a
dist Phenotype a
pi Phenotype a
pj
    in  if Double
dij Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
r
        then Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
dijDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
r)Double -> Double -> Double
forall a. Floating a => a -> a -> a
**Double
alpha
        else Double
0.0