Rosenbrock.hs

{- Minimize Rosenbrock function using real-valued genetic algorithm.
   Optimal value x* = (1,...,1). F(x*) = 0.
-}

module Tests.Problems.Rosenbrock where

import Test.HUnit

import Text.Printf
import Data.List (intercalate)
import System.IO (hPutStrLn, stderr)
import Control.Monad (replicateM)

import Tests.Common

import Moo.GeneticAlgorithm.Types
import Moo.GeneticAlgorithm.Selection
import Moo.GeneticAlgorithm.Run
import Moo.GeneticAlgorithm.Random

pr _ = return ()
-- pr = hPutStrLn stderr


rosenbrock :: [Double] -> Double
rosenbrock xs = sum . map f $ zip xs (drop 1 xs)
  where
   f (x1, x2) = 100 * (x2 - x1^2)^2 + (x1 - 1)^2


testRosenbrock = TestList
  [ "Rosenbrock 2D GM/UNDX/500 gens" ~: do
      let tolerance = 1e-3  -- solution error
      let maxiters = 500
      let problem = RealMinimize rosenbrock [(-10,10),(-20,20)]  [1,1]
      let solver = solverReal problem 101 11 undx (Generations maxiters)
      (pop, dist) <- runSolverReal problem solver
      let best = takeGenome . head $ bestFirst Minimizing pop
      pr ""
      pr $ "best:    " ++ (intercalate " " (map (printf "%.5f") best))
      pr $ "error:   " ++ (printf "%.5g" dist)
      assertBool ("error >= " ++ show tolerance) (dist < tolerance)
  , "Rosenbrock 2D GM/SBX/min residual, max 500 gens" ~: do
      let tolerance = 1e-6  -- objective residual
      let maxiters = 500
      let problem = RealMinimize rosenbrock [(-20,20),(-20,20)] [1,1]
      let stop = Generations maxiters `Or` IfObjective ((>= -tolerance) . maximum)
      let solver = solverReal problem 101 11 sbx stop
      (pop, dist) <- runSolverReal problem solver
      let best = head $ bestFirst Minimizing pop
      let bestG = takeGenome best
      let bestF = takeObjectiveValue  best
      pr ""
      pr $ "best:    " ++ (intercalate " " (map (printf "%.5f") bestG))
      pr $ "residual: " ++ (printf "%.5g" bestF)
      assertBool ("residual < " ++ show (negate tolerance)) (bestF >= -tolerance)
  , "Rosenbrock 2D GM/BLX-0.5/min residual, max 500 gens" ~: do
      let tolerance = 1e-3  -- solution error
      let maxiters = 500
      let problem = RealMinimize rosenbrock [(-20,20),(-20,20)] [1,1]
      let stop = Generations maxiters
      let solver = solverReal problem 400 11 blxa stop
      (pop, dist) <- runSolverReal problem solver
      let bestG = takeGenome . head $ bestFirst Minimizing pop
      pr ""
      pr $ "best:    " ++ (intercalate " " (map (printf "%.5f") bestG))
      pr $ "error:   " ++ (printf "%.5g" dist)
      assertBool ("error = " ++ show dist ++ " >= " ++ show tolerance) (dist < tolerance)
  , "Rosenbrock 2D GM/UNDX/GensNoChange 10" ~: do
      let maxiters = 5000
      let popsize = 101
      let elite = 11
      let nochange = 10
      let select = tournamentSelect Minimizing 3 (popsize - elite)
      let stop = (GensNoChange nochange (round.(*1e3).maximum) Nothing) `Or` (Generations maxiters)
      let step = nextGeneration Minimizing rosenbrock select elite undx (gauss 1.0 2)
      let log = WriteEvery 1 (\_ p -> [minimum . map takeObjectiveValue $ p])
      let ga = loopWithLog log stop step
      let init = replicateM popsize . replicateM 2 $ getRandomR (-10,10)

      (pop, hist) <- runGA init ga

      let best = takeGenome . head $ bestFirst Minimizing pop
      pr ""
      pr $ "best:    " ++ (intercalate " " (map (printf "%.5f") best))
      let lastbest = take nochange (reverse hist)
      pr $ "last best: "
      mapM_ pr (map show $ reverse lastbest)
      assertBool "false positive on GensNoChange"
                     (all id $ zipWith (==) lastbest (drop 1 lastbest))
  ]