SimpleEA-0.2.1/0000755000000000000000000000000011766564433011356 5ustar0000000000000000SimpleEA-0.2.1/SimpleEA.cabal0000644000000000000000000000172511766564433014006 0ustar0000000000000000name: SimpleEA category: AI build-type: Simple version: 0.2.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: AI author: Erlend Hamberg maintainer: ehamberg@gmail.com stability: experimental tested-with: GHC==7.4.1 homepage: http://www.github.com/ehamberg/simpleea/ cabal-version: >=1.6 Library build-depends: base >=4 && < 5, MonadRandom, mersenne-random-pure64 >= 0.2 && < 0.3 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 SimpleEA-0.2.1/LICENSE0000644000000000000000000000276511766564433012375 0ustar0000000000000000Copyright (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. SimpleEA-0.2.1/Setup.hs0000644000000000000000000000005611766564433013013 0ustar0000000000000000import Distribution.Simple main = defaultMain SimpleEA-0.2.1/AI/0000755000000000000000000000000011766564433011647 5ustar0000000000000000SimpleEA-0.2.1/AI/SimpleEA.hs0000644000000000000000000001526411766564433013652 0ustar0000000000000000{-# 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 import System.Random.Mersenne.Pure64 -- | An individual's fitness is simply a number. type Fitness = Double -- | A genome is a list (e.g. a 'String'). 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 PureMT [Genome a] -- | A recombination operator takes two /parent/ genomes and returns two -- /children/. type RecombinationOp a = (Genome a, Genome a) -> Rand PureMT (Genome a, Genome a) -- | A mutation operator takes a genome and returns (a possibly altered) copy -- of it. type MutationOp a = Genome a -> Rand PureMT (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 -> PureMT -> [[(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 PureMT [[(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 PureMT [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 System.Random.Mersenne.Pure64 >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. It ignores the rest of the population (the second parameter) since the fitness is not relative to the other individuals in the generation. >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 'AI.SimpleEA.Utils'. By first taking the four best genomes (by using the @elite@ function) we make sure that maximum fitness never decreases ('elitism'). >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 is done by finding a crossover point along the length of the genomes and swapping what comes after that point 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) The mutation operator @mutate@ 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 (). >main = do > args <- getArgs > g <- newPureMT > let (p,g') = runRand (randomGenomes 100 20 '0' '1') g > let gs = take 101 $ runEA p numOnes select (crossOver 0.75) (mutate 0.01) g' > 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 -} SimpleEA-0.2.1/AI/SimpleEA/0000755000000000000000000000000011766564433013306 5ustar0000000000000000SimpleEA-0.2.1/AI/SimpleEA/Utils.hs0000644000000000000000000000773411766564433014755 0ustar0000000000000000{- | 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, replicateM) import Control.Monad.Random import Data.List (genericLength, zip4, sortBy, nub, elemIndices, sort) import System.Random.Mersenne.Pure64 (PureMT) 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 a list of @len@ random genomes who has length @genomeLen@ made of -- elements in the range @[from,to]@. randomGenomes :: (RandomGen g, Random a, Enum a) => Int -> Int -> a -> a -> Rand g [Genome a] randomGenomes len genomeLen from to = do l <- replicateM (len*genomeLen) $ getRandomR (from,to) return $ nLists genomeLen 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 :: (RandomGen g) => [(a, Fitness)] -> Rand g 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 PureMT 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"