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.
:: p | pool for generating random entities |
-> Int | random seed |
-> m e | random entity |
Generate a random entity. [required]
:: 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]
:: 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]
:: 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.
:: 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.
:: 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.
:: (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.
:: 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.
GAConfig | |
|
:: 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!
:: (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.