GA
Description
GA, a Haskell library for working with genetic algoritms.
Aug. 2011 - Sept. 2011, by Kenneth Hoste
version: 1.0
Major features:
- flexible user-friendly API for working with genetic algorithms
- Entity type class to let user define entity definition, scoring, etc.
- abstraction over monad, resulting in a powerful yet simple interface
- support for scoring entire population at once
- support for checkpointing each generation, and restoring from last checkpoint
- convergence detection, as defined by user
- also available: random searching, user-defined progress output
- illustrative toy examples included
Hello world example:
-- Example for GA package
-- see http://hackage.haskell.org/package/GA
--
-- Evolve the string "Hello World!"
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
import Data.Char (chr,ord)
import Data.List (foldl')
import System.Random (mkStdGen, random, randoms)
import System.IO(IOMode(..), hClose, hGetContents, openFile)
import GA (Entity(..), GAConfig(..),
evolveVerbose, randomSearch)
-- efficient sum
sum' :: (Num a) => [a] -> a
sum' = foldl' (+) 0
--
-- GA TYPE CLASS IMPLEMENTATION
--
type Sentence = String
type Target = String
type Letter = Char
instance Entity Sentence Double Target [Letter] IO where
-- generate a random entity, i.e. a random string
-- assumption: max. 100 chars, only 'printable' ASCII (first 128)
genRandom pool seed = return $ take n $ map ((!!) pool) is
where
g = mkStdGen seed
n = (fst $ random g) `mod` 101
k = length pool
is = map (flip mod k) $ randoms g
-- crossover operator: mix (and trim to shortest entity)
crossover _ _ seed e1 e2 = return $ Just e
where
g = mkStdGen seed
cps = zipWith (\x y -> [x,y]) e1 e2
picks = map (flip mod 2) $ randoms g
e = zipWith (!!) cps picks
-- mutation operator: use next or previous letter randomly and add random characters (max. 9)
mutation pool p seed e = return $ Just $ (zipWith replace tweaks e)
++ addChars
where
g = mkStdGen seed
k = round (1 / p) :: Int
tweaks = randoms g :: [Int]
replace i x = if (i `mod` k) == 0
then if even i
then if x > (minBound :: Char) then pred x else succ x
else if x < (maxBound :: Char) then succ x else pred x
else x
is = map (flip mod $ length pool) $ randoms g
addChars = take (seed `mod` 10) $ map ((!!) pool) is
-- score: distance between current string and target
-- sum of 'distances' between letters, large penalty for additional/short letters
-- NOTE: lower is better
score fn e = do
h <- openFile fn ReadMode
x <- hGetContents h
length x `seq` hClose h
let e' = map ord e
x' = map ord x
d = sum' $ map abs $ zipWith (-) e' x'
l = abs $ (length x) - (length e)
return $ Just $ fromIntegral $ d + 100*l
-- whether or not a scored entity is perfect
isPerfect (_,s) = s == 0.0
main :: IO()
main = do
let cfg = GAConfig
100 -- population size
25 -- archive size (best entities to keep track of)
300 -- maximum number of generations
0.8 -- crossover rate (% of entities by crossover)
0.2 -- mutation rate (% of entities by mutation)
0.0 -- parameter for crossover (not used here)
0.2 -- parameter for mutation (% of replaced letters)
False -- whether or not to use checkpointing
False -- don't rescore archive in each generation
g = mkStdGen 0 -- random generator
-- pool of characters to pick from: printable ASCII characters
charsPool = map chr [32..126]
fileName = "goal.txt"
-- write string to file, pretend that we don't know what it is
-- goal is to let genetic algorithm evolve this string
writeFile fileName "Hello World!"
-- Do the evolution!
-- Note: if either of the last two arguments is unused, just use () as a value
es <- evolveVerbose g cfg charsPool fileName
let e = snd $ head es :: String
putStrLn $ "best entity (GA): " ++ (show e)
-- Compare with random search with large budget
-- 100k random entities, equivalent to 1000 generations of GA
es' <- randomSearch g 100000 charsPool fileName
let e' = snd $ head es' :: String
putStrLn $ "best entity (random search): " ++ (show e')
- class (Eq e, Ord e, Read e, Show e, Ord s, Read s, Show s, Monad m) => Entity e s d p m | e -> s, e -> d, e -> p, e -> m where
- genRandom :: p -> Int -> m e
- crossover :: p -> Float -> Int -> e -> e -> m (Maybe e)
- mutation :: p -> Float -> Int -> e -> m (Maybe e)
- score' :: d -> e -> Maybe s
- score :: d -> e -> m (Maybe s)
- scorePop :: d -> [e] -> [e] -> m (Maybe [Maybe s])
- isPerfect :: (e, s) -> Bool
- showGeneration :: Int -> Generation e s -> String
- hasConverged :: [Archive e s] -> Bool
- type ScoredEntity e s = (Maybe s, e)
- type Archive e s = [ScoredEntity e s]
- data GAConfig = GAConfig {}
- evolve :: Entity e s d p m => StdGen -> GAConfig -> p -> d -> m (Archive e s)
- evolveVerbose :: (Entity e s d p m, MonadIO m) => StdGen -> GAConfig -> p -> d -> m (Archive e s)
- randomSearch :: Entity e s d p m => StdGen -> Int -> p -> d -> m (Archive e s)
Documentation
class (Eq e, Ord e, Read e, Show e, Ord s, Read s, Show s, Monad m) => Entity e s d p m | e -> s, e -> d, e -> p, e -> m whereSource
Type class for entities that represent a candidate solution.
Five parameters:
- data structure representing an entity (e)
- score type (s), e.g. Double
- data used to score an entity, e.g. a list of numbers (d)
- some kind of pool used to generate random entities, e.g. a Hoogle database (p)
- monad to operate in (m)
Minimal implementation should include genRandom, crossover, mutation,
and either score', score or scorePop.
The isPerfect, showGeneration and hasConverged functions are optional.
Methods
Arguments
| :: p | pool for generating random entities |
| -> Int | random seed |
| -> m e | random entity |
Generate a random entity. [required]
Arguments
| :: p | entity pool |
| -> Float | crossover parameter |
| -> Int | random seed |
| -> e | first entity |
| -> e | second entity |
| -> m (Maybe e) | entity resulting from crossover |
Crossover operator: combine two entities into a new entity. [required]
Arguments
| :: p | entity pool |
| -> Float | mutation parameter |
| -> Int | random seed |
| -> e | entity to mutate |
| -> m (Maybe e) | mutated entity |
Mutation operator: mutate an entity into a new entity. [required]
Arguments
| :: d | dataset for scoring entities |
| -> e | entity to score |
| -> Maybe s | entity score |
Score an entity (lower is better), pure version. [optional]
Overridden if score or scorePop are implemented.
Arguments
| :: d | dataset for scoring entities |
| -> e | entity to score |
| -> m (Maybe s) | entity score |
Score an entity (lower is better), monadic version. [optional]
Default implementation hoists score' into monad, overriden if scorePop is implemented.
Arguments
| :: d | dataset to score entities |
| -> [e] | universe of known entities |
| -> [e] | population of entities to score |
| -> m (Maybe [Maybe s]) | scores for population entities |
Score an entire population of entites. [optional]
Default implementation returns Nothing, and triggers indivual of entities.
Arguments
| :: (e, s) | scored entity |
| -> Bool | whether or not scored entity is perfect |
Determines whether a score indicates a perfect entity. [optional]
Default implementation returns always False.
Arguments
| :: Int | generation index |
| -> Generation e s | generation (population and archive) |
| -> String | string describing this generation |
Show progress made in this generation.
Default implementation shows best entity.
Determine whether evolution should continue or not, based on lists of archive fitnesses of previous generations.
Note: most recent archives are at the head of the list.
Default implementation always returns False.
type ScoredEntity e s = (Maybe s, e)Source
A scored entity.
type Archive e s = [ScoredEntity e s]Source
Archive of scored entities.
Configuration for genetic algorithm.
Constructors
| GAConfig | |
Fields
| |
Arguments
| :: Entity e s d p m | |
| => StdGen | random generator |
| -> GAConfig | configuration for GA |
| -> p | random entities pool |
| -> d | dataset required to score entities |
| -> m (Archive e s) | best entities |
Do the evolution!
Arguments
| :: (Entity e s d p m, MonadIO m) | |
| => StdGen | random generator |
| -> GAConfig | configuration for GA |
| -> p | random entities pool |
| -> d | dataset required to score entities |
| -> m (Archive e s) | best entities |
Do the evolution, verbosely.
Prints progress to stdout, and supports checkpointing.
Note: requires support for liftIO in monad used.