TestCrossover.hs

module Tests.Internals.TestCrossover where


import Test.HUnit
import System.Random.Mersenne.Pure64 (pureMT)
import Data.List (group, transpose)


import Moo.GeneticAlgorithm.Types
import Moo.GeneticAlgorithm.Crossover
import Moo.GeneticAlgorithm.Random



testCrossover =
    TestList
    [ "do N crossovers" ~: do
        let genomes = [[1,1,1,1],[0,0,0,0]] :: [[Int]]
        let result4 = flip evalRand (pureMT 1) $
                      doNCrossovers 4 genomes (onePointCrossover 0.5)
        let expected4 = [[1,0,0,0],[0,1,1,1],[1,1,0,0],[0,0,1,1]]
        assertEqual "4 crossovers" expected4 result4
        let genesums4 = map sum . transpose $ result4
        assertEqual "gene-sums (4 genomes)" [2,2,2,2] genesums4
        let result3 = flip evalRand (pureMT 1) $
                      doNCrossovers 3 genomes (onePointCrossover 0.5)
        let expected3 = [[1,0,0,0],[0,1,1,1],[1,1,0,0]]
        assertEqual "3 crossovers" expected3 result3
    , "do all crossovers" ~: do
        let genomes = [[1,1,1,1],[0,0,0,0]] :: [[Int]]
        let result = flip evalRand (pureMT 1) $
                     doCrossovers genomes (onePointCrossover 0.5)
        let expected = [[1,1,0,0],[0,0,1,1]]
        assertEqual "all crossovers (2 genomes)" expected result
        let genesums2 = map sum . transpose $ result
        assertEqual "gene-sums (2 genomes)" [1,1,1,1] genesums2
        let genomes3 = [[1,1,1,1],[0,0,0,0],[2,2,2,2]] :: [[Int]]
        -- genes from the last "celibate" genome are lost
        let result3 = filter (==2) . concat . map concat . flip map [0..100] $
                      \i -> flip evalRand (pureMT i) $
                      doCrossovers genomes (onePointCrossover 1.0)
        assertEqual "discard last genomes without a pair" [] result3
    , "simple crossover" ~: do
        let ones = replicate 8 1
        let zeros = replicate 8 0
        let genomes = [ones, zeros]
        let n = 1000
        assertEqual "exactly one crossover point" True $
                    all (<=2) . map (length . group) $
                        flip evalRand (pureMT 1) (doNCrossovers n genomes (onePointCrossover 1))
    , "simple crossover" ~: do
        let ones = replicate 8 1
        let zeros = replicate 8 0
        let genomes = [ones, zeros]
        let n = 1000
        assertEqual "exactly one crossover point" True $
                    all (<=2) . map (length . group) $
                        flip evalRand (pureMT 1) (doNCrossovers n genomes (onePointCrossover 1))
    , "two-point crossover" ~: do
        let ones = replicate 8 1
        let zeros = replicate 8 0
        let genomes = [ones, zeros]
        let n = 1000
        assertEqual "exactly two crossover point" True $
                    all (<=3) . map (length . group) $
                        flip evalRand (pureMT 1) (doNCrossovers n genomes (twoPointCrossover 1))
    , "uniform crossover" ~: do
        assertEqual "change all points"
                    ([[0,0,0,0,0,0,0,0,0,0],[1,1,1,1,1,1,1,1,1,1]],[]) $
                    flip evalRand (pureMT 1) $
                             (uniformCrossover 1) [replicate 10 1,replicate 10 (0::Int)]
        assertEqual "change nothing"
                    ([[1,1,1,1,1,1,1,1,1,1],[0,0,0,0,0,0,0,0,0,0]],[]) $
                    flip evalRand (pureMT 1) $
                             (uniformCrossover 0) [replicate 10 1,replicate 10 (0::Int)]
        let n = 1000
        let mu = 0.5*n
        let sigma = sqrt(n*0.5*(1-0.5))  -- normal approx to binomial distribution
        let genomes = [ replicate (round n) 1
                      , replicate (round n) 0]
        let xover = uniformCrossover 0.5 :: CrossoverOp Double
        let mkChildren = doNCrossovers 1000 genomes xover :: Rand [Genome Double]
        let children = flip evalRand (pureMT 1) mkChildren :: [Genome Double]
        assertEqual "change approximately half" True $
                    all (\s -> (s >= mu - 4*sigma && s <= mu + 4*sigma)) . map sum $
                        children
    ]