GA-1.0: Genetic algorithm library

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')

Synopsis

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

genRandomSource

Arguments

:: p

pool for generating random entities

-> Int

random seed

-> m e

random entity

Generate a random entity. [required]

crossoverSource

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]

mutationSource

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]

score'Source

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.

scoreSource

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.

scorePopSource

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.

isPerfectSource

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.

showGenerationSource

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.

hasConvergedSource

Arguments

:: [Archive e s]

archives so far

-> Bool

whether or not convergence was detected

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.

data GAConfig Source

Configuration for genetic algorithm.

Constructors

GAConfig 

Fields

getPopSize :: Int

population size

getArchiveSize :: Int

size of archive (best entities so far)

getMaxGenerations :: Int

maximum number of generations to evolve

getCrossoverRate :: Float

fraction of entities generated by crossover (tip: >= 0.80)

getMutationRate :: Float

fraction of entities generated by mutation (tip: <= 0.20)

getCrossoverParam :: Float

parameter for crossover (semantics depend on crossover operator)

getMutationParam :: Float

parameter for mutation (semantics depend on mutation operator)

getWithCheckpointing :: Bool

enable/disable built-in checkpointing mechanism

getRescoreArchive :: Bool

rescore archive in each generation?

evolveSource

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!

evolveVerboseSource

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.

randomSearchSource

Arguments

:: Entity e s d p m 
=> StdGen

random generator

-> Int

number of random entities

-> p

random entity pool

-> d

scoring dataset

-> m (Archive e s)

scored entities (sorted)

Random searching.

Useful to compare with results from genetic algorithm.