SimpleEA (empty) → 0.1

raw patch · 5 files changed

+359/−0 lines, 5 filesdep +MonadRandomdep +basesetup-changed

Dependencies added: MonadRandom, base

Files

• AI/SimpleEA.hs +192/−0
• AI/SimpleEA/Utils.hs +109/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• SimpleEA.cabal +26/−0

@@ -0,0 +1,192 @@+{-# Language BangPatterns #-}++{- |+Copyright    : 2010-2011 Erlend Hamberg+License      : BSD3+Stability    : experimental+Portability  : portable++A framework for simple evolutionary algorithms. Provided with a function for+evaluating a genome's fitness, a function for probabilistic selection among a+pool of genomes, and recombination and mutation operators, 'runEA' will run an+EA that lazily produces an infinite list of generations.++'AI.SimpleEA.Utils' contains utilitify functions that makes it easier to write+the genetic operators.++-}++module AI.SimpleEA (+    runEA+  , FitnessFunc+  , SelectionFunction+  , RecombinationOp+  , MutationOp+  , Fitness+  , Genome+  -- * Example Program+  -- $SimpleEAExample+) where++import Control.Monad.Random++type Fitness = Double+type Genome a = [a]++-- | A fitness functions assigns a fitness score to a genome. The rest of the+-- individuals of that generation is also provided in case the fitness is+-- in proportion to its neighbours.+type FitnessFunc a       = Genome a -> [Genome a] -> Fitness++-- | A selection function is responsible for selection. It takes pairs of+-- genomes and their fitness and is responsible for returning one or more+-- individuals.+type SelectionFunction a = [(Genome a, Fitness)] -> Rand StdGen [Genome a]++-- | A recombination operator takes two /parent/ genomes and returns two+-- /children/.+type RecombinationOp a = (Genome a, Genome a) -> Rand StdGen (Genome a, Genome a)++-- | A mutation operator takes a genome and returns an altered copy of it.+type MutationOp a        = Genome a -> Rand StdGen (Genome a)++-- | Runs the evolutionary algorithm with the given start population. This will+-- produce an infinite list of generations and 'take' or 'takeWhile' should be+-- used to decide how many generations should be computed. To run a specific+-- number of generations, use 'take':+--+-- > let generations = take 50 $ runEA myFF mySF myROp myMOp myStdGen+--+-- To run until a criterion is met, e.g. that an individual with a fitness of at+-- least 19 is found, 'takeWhile' can be used:+--+-- > let criterion   = any id . map (\i -> snd i >= 19.0)+-- > let generations = takeWhile (not . criterion) $ runEA myFF mySF myROp myMOp myStdGen+++runEA ::+  [Genome a] ->+  FitnessFunc a ->+  SelectionFunction a ->+  RecombinationOp a ->+  MutationOp a ->+  StdGen ->+  [[(Genome a,Fitness)]]+runEA startPop fitFun selFun recOp mutOp g =+  let p = zip startPop (map (`fitFun` startPop) startPop)+  in evalRand (generations p selFun fitFun recOp mutOp) g++generations ::+  [(Genome a, Fitness)] ->+  SelectionFunction a ->+  FitnessFunc a ->+  RecombinationOp a ->+  MutationOp a ->+  Rand StdGen [[(Genome a, Fitness)]]+generations !pop selFun fitFun recOp mutOp = do+    -- first, select parents for the new generation+    newGen <- selFun pop++    -- then create offspring by using the recombination operator+    newGen  <- doRecombinations newGen recOp++    -- mutate genomes using the mutation operator+    newGen <- mapM mutOp newGen++    let fitnessVals = map (`fitFun` newGen) newGen+    nextGens <- generations (zip newGen fitnessVals) selFun fitFun recOp mutOp++    return $ pop : nextGens++doRecombinations :: [Genome a] -> RecombinationOp a -> Rand StdGen [Genome a]+doRecombinations []      _   = return []+doRecombinations [_]     _   = error "odd number of parents"+doRecombinations (a:b:r) rec = do+    (a',b') <- rec (a,b)+    rest    <- doRecombinations r rec+    return $ a':b':rest++{- $SimpleEAExample++The aim of this /OneMax/ EA is to maximize the number of @1@'s in a bitstring.+The fitness of a+bitstring i simply s defined to be the number of @1@'s it contains.++>import AI.SimpleEA+>import AI.SimpleEA.Utils+>+>import Control.Monad.Random+>import Data.List+>import System.Environment (getArgs)+>import Control.Monad (unless)++The @numOnes@ function will function as our 'FitnessFunc' and simply returns the number of @1@'s+in the string.++>numOnes :: FitnessFunc Char+>numOnes g _ = (fromIntegral . length . filter (=='1')) g++The @select@ function is our 'SelectionFunction'. It uses sigma-scaled, fitness-proportionate+selection. 'sigmaScale' is defined in 'SimpleEA.Utils'. By first taking the four+best genomes (by using the @elite@ function) we get elitism, making sure that+maximum fitness never decreases.++>select :: SelectionFunction Char+>select gs = select' (take 4 $ elite gs)+>    where scaled = zip (map fst gs) (sigmaScale (map snd gs))+>          select' gs' =+>              if length gs' >= length gs+>                 then return gs'+>                 else do+>                     p1 <- fitPropSelect scaled+>                     p2 <- fitPropSelect scaled+>                     let newPop = p1:p2:gs'+>                     select' newPop++Crossover consists of finding a crossover point along the length of the genomes+and swapping what comes after between the two genomes. The parameter @p@+determines the likelihood of crossover taking place.++>crossOver :: Double -> RecombinationOp Char+>crossOver p (g1,g2) = do+>    t <- getRandomR (0.0, 1.0)+>    if t < p+>       then do+>           r <- getRandomR (0, length g1-1)+>           return (take r g1 ++ drop r g2, take r g2 ++ drop r g1)+>       else return (g1,g2)++Mutation flips a random bit along the length of the genome with probability @p@.++>mutate :: Double -> MutationOp Char+>mutate p g = do+>    t <- getRandomR (0.0, 1.0)+>    if t < p+>       then do+>           r <- getRandomR (0, length g-1)+>           return (take r g ++ flipBit (g !! r) : drop (r+1) g)+>       else return g+>        where+>              flipBit '0' = '1'+>              flipBit '1' = '0'++The @main@ function creates a list of 100 random genomes (bit-strings) of length+20 and then runs the EA for 100 generations (101 generations including the+random starting population). Average and maximum fitness values and standard+deviation is then calculated for each generation and written to a file if a file+name was provided as a parameter. This data can then be plotted with, e.g.+gnuplot (<http://www.gnuplot.info/>).++>main = do+>    args <- getArgs+>    g <- newStdGen+>    let (g1,g2) = split g+>    let p = take 100 $ randomGenomes 20 '0' '1' g1+>    let gs = take 101 $ runEA p numOnes select (crossOver 0.75) (mutate 0.01) g2+>    let fs = avgFitnesses gs+>    let ms = maxFitnesses gs+>    let ds = stdDeviations gs+>    mapM_ print $ zip5 gs [1..] fs ms ds+>    unless (null args) $ writeFile (head args) $ getPlottingData gs++-}

@@ -0,0 +1,109 @@+{- |++Utilitify functions that makes it easier to write the genetic operators and+functions for doing calculations on the EA data.++-}++module AI.SimpleEA.Utils (+    avgFitnesses+  , maxFitnesses+  , minFitnesses+  , stdDeviations+  , randomGenomes+  , fitPropSelect+  , tournamentSelect+  , sigmaScale+  , rankScale+  , elite+  , getPlottingData+) where++import Control.Monad (liftM)+import Control.Monad.Random+import Data.List (genericLength, zip4, sortBy, nub, elemIndices, sort)+import AI.SimpleEA++-- |Returns the average fitnesses for a list of generations.+avgFitnesses :: [[(Genome a, Fitness)]] -> [Fitness]+avgFitnesses = map (\g -> (sum . map snd) g/genericLength g)++-- |Returns the maximum fitness per generation for a list of generations.+maxFitnesses :: [[(Genome a, Fitness)]] -> [Fitness]+maxFitnesses = map (maximum . map snd)++-- |Returns the minimum fitness per generation for a list of generations.+minFitnesses :: [[(Genome a, Fitness)]] -> [Fitness]+minFitnesses = map (minimum . map snd)++-- |Returns the standard deviation of the fitness values per generation fot a+-- list of generations.+stdDeviations :: [[(Genome a, Fitness)]] -> [Double]+stdDeviations = map (stdDev . map snd)++stdDev :: (Floating a) => [a] -> a+stdDev p =+    sqrt (sum sqDiffs/len)+    where len     = genericLength p+          mean    = sum p/len+          sqDiffs = map (\n -> (n-mean)**2) p++-- |Returns an infinite list of random genomes of length @len@ made of elements+-- in the range @[from,to]@+randomGenomes :: (Random a, Enum a) => Int -> a -> a -> StdGen -> [Genome a]+randomGenomes len from to = do+    l <- randomRs (from,to)+    return $ nLists len l+    where nLists :: Int -> [a] -> [[a]]+          nLists _ [] = []+          nLists n ls = take n ls : nLists n (drop n ls)++-- |Applies sigma scaling to a list of fitness values. In sigma scaling, the+-- standard deviation of the population fitness is used to scale the fitness+-- scores.+sigmaScale :: [Fitness] -> [Fitness]+sigmaScale fs = map (\f_g -> 1+(f_g-f_i)/(2*σ)) fs+    where σ   = stdDev fs+          f_i = sum fs/genericLength fs++-- |Takes a list of fitness values and returns rank scaled values. For a list of /n/ values, this+-- means that the best fitness is scaled to /n/, the second best to /n-1/, and so on.+rankScale :: [Fitness] -> [Fitness]+rankScale fs = map (\n -> max'-fromIntegral n) ranks+    where ranks = (concatMap (`elemIndices` fs) . reverse . nub . sort) fs+          max'  = fromIntegral $ maximum ranks + 1++-- |Fitness-proportionate selection: select a random item from a list of (item,+-- score) where each item's chance of being selected is proportional to its+-- score+fitPropSelect :: [(a, Fitness)] -> Rand StdGen a+fitPropSelect xs = do+    let xs' = zip (map fst xs) (scanl1 (+) $ map snd xs)+    let sumScores = (snd . last) xs'+    rand <- getRandomR (0.0, sumScores)+    return $ (fst . head . dropWhile ((rand >) . snd)) xs'++-- |Performs tournament selection amoing @size@ individuals and returns the winner+tournamentSelect :: [(a, Fitness)] -> Int -> Rand StdGen a+tournamentSelect xs size = do+    let l = length xs+    rs <- liftM (take size . nub) $ getRandomRs (0,l-1)+    let contestants = map (xs!!) rs+    let winner = head $ elite contestants+    return winner++-- |takes a list of (genome,fitness) pairs and returns a list of genomes sorted+-- by fitness (descending)+elite :: [(a, Fitness)] -> [a]+elite = map fst . sortBy (\(_,a) (_,b) -> compare b a)++-- |takes a list of generations and returns a string intended for plotting with+-- gnuplot.+getPlottingData :: [[(Genome a, Fitness)]] -> String+getPlottingData gs = concatMap conc (zip4 ns fs ms ds)+    where ns = [1..] :: [Int]+          fs = avgFitnesses gs+          ms = maxFitnesses gs+          ds = stdDeviations gs+          conc (n, a, m ,s) =+              show n ++ " " ++ show a ++ " " ++ show m ++ " " ++ show s ++ "\n"

@@ -0,0 +1,30 @@+Copyright (c)2011, Erlend Hamberg++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Erlend Hamberg nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+name:               SimpleEA+category:			AI+build-type:         Simple+version:            0.1+synopsis:           Simple evolutionary algorithm framework.+description:        Simple framework for running an evolutionary algorithm by+                    providing selection, recombination, and mutation operators.+license:            BSD3+License-file:       LICENSE+category:           Control+author:             Erlend Hamberg+maintainer:         ehamberg@gmail.com+stability:          experimental+tested-with:        GHC==7.0.1+homepage:           http://www.github.com/ehamberg/simpleea/+cabal-version:       >=1.6+++Library+    build-depends:      base >=4 && < 5, MonadRandom+    ghc-options:        -Wall -fno-warn-name-shadowing -fno-warn-orphans+    exposed-modules:    AI.SimpleEA, AI.SimpleEA.Utils++source-repository head+  type:     git+  location: git://github.com/ehamberg/simpleea.git