module Tests.Internals.TestMultiobjective where import Test.HUnit import Control.Monad (forM_) import Data.Function (on) import Data.List (sortBy) import qualified Data.Set as Set import Moo.GeneticAlgorithm.Types import Moo.GeneticAlgorithm.Continuous import Moo.GeneticAlgorithm.Multiobjective.Types import Moo.GeneticAlgorithm.Multiobjective.NSGA2 import Moo.GeneticAlgorithm.Constraints import System.Random.Mersenne.Pure64 (pureMT) dummyGenome :: [Objective] -> MultiPhenotype Double dummyGenome ovs = (ovs, ovs) testMultiobjective = TestList [ "domination predicate" ~: do let problems = [Minimizing, Maximizing, Minimizing] let worst = dummyGenome [100, 0, 100] let good1 = dummyGenome [0, 50, 50] let good23 = dummyGenome [50, 100, 0] let best = dummyGenome [0, 100, 0] assertEqual "good dominates worst" True (domination problems good1 worst) assertEqual "good23 doesn't dominate good1" False (domination problems good23 good1) assertEqual "good1 doesn't dominate good23" False (domination problems good1 good23) assertEqual "best dominates good23" True (domination problems best good23) assertEqual "worst doesn't dominate best" False (domination problems worst best) , "constraint-domination predicate" ~: do let problems = [Minimizing] let constraints = [head .>=. 2, head .>=. 4] let feasible = dummyGenome [4] let worse = dummyGenome [5] -- also feasible let infeasible = dummyGenome [3] let infeasible2 = dummyGenome [1] let dominates = constrainedDomination constraints numberOfViolations problems assertEqual "feasible dominates infeasible" [True, True, False] $ [ feasible `dominates` infeasible , feasible `dominates` infeasible2 , infeasible `dominates` feasible ] assertEqual "less-infeasible dominates more-infeasible" [True,False] $ [ infeasible `dominates` infeasible2 , infeasible2 `dominates` infeasible ] assertEqual "better dominates worse" [True, False] $ [ feasible `dominates` worse , worse `dominates` feasible ] , "non-dominated sort" ~: do let dominatesFn = domination [Minimizing, Minimizing] let genomes = [ ([1], [2, 2]), ([2], [3, 2]), ([2,2], [2,3]) , ([3], [1,1.5]), ([3,3], [1.5, 0.5]), ([4], [0,0::Double])] assertEqual "non-dominated fronts" [[[4]],[[3],[3,3]],[[1]],[[2],[2,2]]] (map (map fst) $ nondominatedSort dominatesFn genomes) , "non-dominated sort (singleton fronts)" ~: do let dominates1 = domination [Maximizing] let genomes1 = map (\x -> ([x],[x])) [3,1,2] assertEqual "singleton fronts" [[3],[2],[1]] (map (map (head . fst)) $ nondominatedSort dominates1 genomes1) , "calculate crowding distance" ~: do let inf = 1.0/0.0 :: Double assertEqual "two points" [inf, inf] $ crowdingDistances [[1],[2]] assertEqual "4 points" [inf, 2.5, inf, 2.0] $ crowdingDistances [[1.0], [2.0], [4.0], [3.5]] assertEqual "4 points 2D" [inf, 2.0, inf, 0.75, 2.0] $ crowdingDistances [[3,1], [1.75,1.75], [1,3], [2,2], [2.125,2.125]] , "rank with crowding" ~: do let dominatesFn = domination [Minimizing, Minimizing] let gs = map (\x -> ([], x)) [[2,1],[1,2],[3,1],[1.9,1.9],[1,3]] let rs = concat $ rankAllSolutions dominatesFn gs let inf = 1.0/0.0 :: Double assertEqual "non-dom ranks" [1,1,1,2,2] (map rs'nondominationRank rs) assertEqual "in-front crowding distance" [inf, inf, 2.0, inf, inf] (map rs'localCrowdingDistnace rs) , "calculate all objectives for all genomes" ~: do let genomes = [[8, 2], [2.0, 1.0], [1.0, 2.0], [4,4]] let objectives = [(Minimizing, sum), (Maximizing, product)] :: [(ProblemType, [Double] -> Double)] let correct = [([8.0,2.0],[10.0,16.0]),([2.0,1.0],[3.0,2.0]) ,([1.0,2.0],[3.0,2.0]),([4.0,4.0],[8.0,16.0])] assertEqual "two objective functions" correct $ evalAllObjectives objectives genomes , "NSGA-II ranking with crowding" ~: do let dominatesFn = domination [Minimizing, Minimizing] let mp = [ (Minimizing, (!!0)) , (Minimizing, (!!1)) ] :: [(ProblemType, [Double] -> Double)] let gs = [ [5,1], [1,5], [2,4], [3,3] -- first front , [6,6] -- third front , [6,2], [5,3], [4,4], [2,6] -- second front ] :: [[Double]] let expected7 = [(([5.0,1.0],[5.0,1.0]),1.0) ,(([1.0,5.0],[1.0,5.0]),1.0) -- order is preserved in the first front: ,(([2.0,4.0],[2.0,4.0]),1.0) -- [2,4] is more crowded than [3,3] ,(([3.0,3.0],[3.0,3.0]),1.0) -- but it doesn't matter for full fronts ,(([6.0,2.0],[6.0,2.0]),2.0) ,(([2.0,6.0],[2.0,6.0]),2.0) -- is front boundary point, and goes before [4,4] ,(([4.0,4.0],[4.0,4.0]),2.0) -- is less crowded than [5,3] -- [5,3] is more crowded and is truncated -- [6,6] is in the third front and is truncated ] let result7 = nsga2Ranking dominatesFn mp 7 gs assertEqual "7 solutions" expected7 result7 , "NSGA-II ranking (output length)" ~: do let dominatesFn = domination [Minimizing, Minimizing] let mp = [ (Minimizing, (!!0)) , (Minimizing, (!!1)) ] :: [(ProblemType, [Double] -> Double)] let gs = [ [5,1], [1,5], [2,4], [3,3] -- first front , [6,6] -- third front , [6,2], [5,3], [4,4], [2,6] -- second front ] :: [[Double]] forM_ [0..(length gs)] $ \n -> do assertEqual (show n ++ " solutions") n $ length (nsga2Ranking dominatesFn mp n gs) assertEqual "max # of solutions" (length gs) $ length (nsga2Ranking dominatesFn mp maxBound gs) , "two NSGA-II steps" ~: do let mp = [ (Minimizing, (!!0)) , (Minimizing, (!!1)) ] :: [(ProblemType, [Double] -> Double)] let gs = [ [5,1], [1,5], [2,4], [3,3] -- first front , [6,6] -- third front , [6,2], [5,3], [4,4], [2,6] -- second front ] :: [[Double]] let expected = [([1.0,5.0],1.0),([5.0,1.0],1.0),([1.0,5.0],1.0) ,([5.0,1.0],1.0),([3.0,3.0],1.0),([3.0,3.0],1.0) ,([2.0,4.0],1.0),([2.0,4.0],1.0),([1.0,5.0],1.0)] let result = flip evalRand (pureMT 1) $ loop (Generations 1) (stepNSGA2bt mp noCrossover noMutation) gs assertEqual "solutions and ranking" (Set.fromList expected) (Set.fromList result) ]