GA 0.2 → 1.0

raw patch · 10 files changed

+483/−371 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Changelog +17/−6
• GA.cabal +1/−1
• GA.hs +227/−47
• README +25/−19
• examples/Makefile +2/−2
• examples/example1.hs +0/−101
• examples/example2.hs +0/−95
• examples/example3.hs +0/−100
• examples/hello.hs +119/−0
• examples/theNumber.hs +92/−0

@@ -1,13 +1,15 @@ Changelog for GA, a Haskell library for working with genetic algorithms: ------------------------------------------------------------------------ -v0.1 (Aug. 31st 2011):+v1.0 (Sept. 27th 2011): -* initial release-* support for:-	- evolution of arbitrary entities (see Entity type class)-	- checkpointing between generations with automatic restore from checkpoint-* two toy examples+* reorganize examples+* minor code cleanup+* support for user-defined:+  - checking of progress (mustContinue)+  - print progress per generation (showProgress)+*  bug fixes:+  - double pop/archive entities  v0.2 (Sept. 19th 2011): @@ -19,3 +21,12 @@   progress to stdout (requires liftIO) * implemented random search * code cleanup and reorganization++v0.1 (Aug. 31st 2011):++* initial release+* support for:+	- evolution of arbitrary entities (see Entity type class)+	- checkpointing between generations with automatic restore from checkpoint+* two toy examples+

@@ -1,5 +1,5 @@ Name:                GA-Version:             0.2+Version:             1.0 Synopsis:            Genetic algorithm library License:             BSD3 License-file:        LICENSE

@@ -1,12 +1,155 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} --- |GA, a Haskell library for working with genetic algoritms+-- | GA, a Haskell library for working with genetic algoritms. -- -- Aug. 2011 - Sept. 2011, by Kenneth Hoste ----- version: 0.2-module GA (Entity(..), +-- 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')+--++module GA (Entity(..),+           ScoredEntity, +           Archive,             GAConfig(..),             evolve,             evolveVerbose,@@ -14,7 +157,7 @@  import Control.Monad (zipWithM) import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.List (sortBy, nub)+import Data.List (sortBy, nub, nubBy) import Data.Maybe (catMaybes, fromJust, isJust) import Data.Ord (comparing) import System.Directory (createDirectoryIfMissing, doesFileExist)@@ -36,6 +179,18 @@                    in (head xs:hs, ts)     | otherwise = ([],xs) +-- |A scored entity.+type ScoredEntity e s = (Maybe s, e)++-- |Archive of scored entities.+type Archive e s = [ScoredEntity e s]++-- |Scored generation (population and archive).+type Generation e s = ([e], Archive e s)++-- |Universe of entities.+type Universe e = [e]+ -- |Configuration for genetic algorithm. data GAConfig = GAConfig {     -- |population size@@ -73,10 +228,12 @@ -- -- * monad to operate in (m) ----- Minimal implementation includes genRandom, crossover, mutation, --- and either score', score or scorePop.+-- Minimal implementation should include 'genRandom', 'crossover', 'mutation', +-- and either 'score'', 'score' or 'scorePop'. ---class (Eq e, Read e, Show e, +-- The 'isPerfect', 'showGeneration' and 'hasConverged' functions are optional.+--+class (Eq e, Ord e, Read e, Show e,         Ord s, Read s, Show s,         Monad m)    => Entity e s d p m @@ -138,15 +295,27 @@                -> Bool -- ^ whether or not scored entity is perfect   isPerfect _ = False ---- |A possibly scored entity.-type ScoredEntity e s = (Maybe s, e)---- |Scored generation (population and archive).-type Generation e s = ([e],[ScoredEntity e s])+  -- |Show progress made in this generation.+  --+  -- Default implementation shows best entity.+  showGeneration :: Int -- ^ generation index+               -> Generation e s -- ^ generation (population and archive)+               -> String -- ^ string describing this generation+  showGeneration gi (_,archive) = "best entity (gen. " +                                ++ show gi ++ "): " ++ (show e) +                                ++ " [fitness: " ++ show fitness ++ "]"+    where+      (Just fitness, e) = head archive --- |Universe of entities.-type Universe e = [e]+  -- |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.+  hasConverged :: [Archive e s] -- ^ archives so far+               -> Bool -- ^ whether or not convergence was detected+  hasConverged _ = False  -- |Initialize: generate initial population. initPop :: (Entity e s d p m) => p -- ^ pool for generating random entities@@ -265,13 +434,16 @@     let -- new population: crossovered + mutated entities         newPop = crossEnts ++ mutEnts         -- new archive: best entities so far-        newArchive = take an $ nub $ sortBy (comparing fst) $ combo+        newArchive = take an +                   $ nubBy (\x y -> comparing snd x y == EQ) +                   $ sortBy (comparing fst) combo         newUniverse = nub $ universe ++ pop     return (newUniverse, (newPop,newArchive))  -- |Evolution: evaluate generation and continue. evolution :: (Entity e s d p m) => GAConfig -- ^ configuration for GA                                 -> Universe e -- ^ known entities +                                -> [Archive e s] -- ^ previous archives                                 -> Generation e s -- ^ current generation                                 -> (   Universe e                                     -> Generation e s @@ -280,14 +452,15 @@                                    ) -- ^ function that evolves a generation                                 -> [(Int,Int)] -- ^ gen indicies and seeds                                 -> m (Generation e s) -- ^evolved generation-evolution cfg universe gen step ((_,seed):gss) = do+evolution cfg universe pastArchives gen step ((_,seed):gss) = do     (universe',nextGen) <- step universe gen seed      let (Just fitness, e) = (head $ snd nextGen)-    if isPerfect (e,fitness)+        newArchive = snd nextGen+    if hasConverged pastArchives || isPerfect (e,fitness)       then return nextGen-      else evolution cfg universe' nextGen step gss+      else evolution cfg universe' (newArchive:pastArchives) nextGen step gss -- no more gen. indices/seeds => quit-evolution _ _ gen _              []    = return gen+evolution _ _ _ gen _ [] = return gen  -- |Generate file name for checkpoint. chkptFileName :: GAConfig -- ^ configuration for generation algorithm@@ -307,10 +480,10 @@  -- |Checkpoint a single generation. checkpointGen :: (Entity e s d p m) => GAConfig -- ^ configuraton for GA-                                  -> Int -- ^ generation index-                                  -> Int -- ^ random seed for generation-                                  -> Generation e s -- ^ current generation-                                  -> IO() -- ^ writes to file+                                    -> Int -- ^ generation index+                                    -> Int -- ^ random seed for generation+                                    -> Generation e s -- ^ current generation+                                    -> IO() -- ^ writes to file checkpointGen cfg index seed (pop,archive) = do     let txt = show $ (pop,archive)         fn = chkptFileName cfg (index,seed)@@ -320,9 +493,10 @@     writeFile fn txt  -- |Evolution: evaluate generation, (maybe) checkpoint, continue.-evolutionChkpt :: (Entity e s d p m, +evolutionVerbose :: (Entity e s d p m,                     MonadIO m) => GAConfig -- ^ configuration for GA                               -> Universe e -- ^ universe of known entities+                              -> [Archive e s] -- ^ previous archives                               -> Generation e s -- ^ current generation                               -> (   Universe e                                    -> Generation e s @@ -331,27 +505,29 @@                                  ) -- ^ function that evolves a generation                               -> [(Int,Int)] -- ^ gen indicies and seeds                               -> m (Generation e s) -- ^ evolved generation-evolutionChkpt cfg universe gen step ((gi,seed):gss) = do+evolutionVerbose cfg universe pastArchives gen step ((gi,seed):gss) = do     (universe',newPa@(_,archive')) <- step universe gen seed     let (Just fitness, e) = head archive'     -- checkpoint generation if desired     liftIO $ if (getWithCheckpointing cfg)       then checkpointGen cfg gi seed newPa       else return () -- skip checkpoint-    liftIO $ putStrLn $ "best entity (gen. " -                     ++ show gi ++ "): " ++ (show e) -                     ++ " [fitness: " ++ show fitness ++ "]"+    liftIO $ putStrLn $ showGeneration gi newPa     -- check for perfect entity-    if isPerfect (e, fitness)+    if hasConverged pastArchives || isPerfect (e,fitness)        then do -               liftIO $ putStrLn $ "perfect entity found, "-                                ++ "finished after " ++ show gi -                                ++ " generations!"+               liftIO $ putStrLn $ if isPerfect (e,fitness)+                                     then    "perfect entity found, "+                                          ++ "finished after " ++ show gi +                                          ++ " generations!"+                                     else    "no progress for 3 generations, "+                                          ++ "stopping after " ++ show gi+                                          ++ " generations!"                return newPa-       else evolutionChkpt cfg universe' newPa step gss+       else evolutionVerbose cfg universe' (archive':pastArchives) newPa step gss  -- no more gen. indices/seeds => quit-evolutionChkpt _ _ gen _ [] = do +evolutionVerbose _ _ _ gen _ [] = do      liftIO $ putStrLn $ "done evolving!"     return gen @@ -387,7 +563,7 @@                              -> GAConfig -- ^ configuration for GA                              -> p -- ^ random entities pool                              -> d -- ^ dataset required to score entities-                             -> m [ScoredEntity e s] -- ^ best entities+                             -> m (Archive e s) -- ^ best entities evolve g cfg pool dataset = do     -- initialize     (pop, cCnt, mCnt, aSize, @@ -398,7 +574,7 @@     -- do the evolution     let rescoreArchive = getRescoreArchive cfg     (_,resArchive) <- evolution -                       cfg [] (pop,[]) +                       cfg [] [] (pop,[])                         (evolutionStep pool dataset                                        (cCnt,mCnt,aSize)                                        (crossPar,mutPar) @@ -425,15 +601,17 @@     fn = chkptFileName cfg (gi,seed) restoreFromChkpt _ [] = return Nothing --- |Do the evolution (supports checkpointing). +-- |Do the evolution, verbosely. ----- Requires support for liftIO in monad used.-evolveVerbose :: (Entity e s d p m, -                  MonadIO m) => StdGen -- ^ random generator+-- Prints progress to stdout, and supports checkpointing. +--+-- Note: requires support for liftIO in monad used.+evolveVerbose :: (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 [ScoredEntity e s] -- ^ best entities+                             -> m (Archive e s) -- ^ best entities evolveVerbose g cfg pool dataset = do     -- initialize     (pop, cCnt, mCnt, aSize, @@ -452,8 +630,8 @@         genSeeds' = filter ((>gi) . fst) genSeeds         rescoreArchive = getRescoreArchive cfg     -- do the evolution-    (_,resArchive) <- evolutionChkpt -                        cfg [] gen +    (_,resArchive) <- evolutionVerbose +                        cfg [] [] gen                          (evolutionStep pool dataset                                         (cCnt,mCnt,aSize)                                         (crossPar,mutPar) @@ -462,16 +640,18 @@     -- return best entity      return resArchive --- |Random search.+-- |Random searching. -- -- Useful to compare with results from genetic algorithm. randomSearch :: (Entity e s d p m) => StdGen -- ^ random generator                                    -> Int -- ^ number of random entities                                    -> p -- ^ random entity pool                                    -> d -- ^ scoring dataset-                                   -> m [ScoredEntity e s] -- ^ best ents+                                   -> m (Archive e s) -- ^ scored entities (sorted) randomSearch g n pool dataset = do     let seed = fst $ random g :: Int     es <- initPop pool n seed     scores <- scoreAll dataset [] es-    return $ zip scores es+    return $ nubBy (\x y -> comparing snd x y == EQ) +           $ sortBy (comparing fst)+           $ zip scores es

@@ -1,7 +1,7 @@ GA, a Haskell library for working with genetic algorithms --------------------------------------------------------- -version 0.2, Sept. 2011, written by Kenneth Hoste (kenneth.hoste@gmail.com)+version 1.0, Sept. 2011, written by Kenneth Hoste (kenneth.hoste@gmail.com) see http://hackage.haskell.org/package/GA  * DESCRIPTION@@ -30,29 +30,35 @@  This release includes two toy examples that show how to use the GA module. -A first example evolves the string "Hello World!". The string that the-genetic algorithm should generate is supplied by the user in this example,-which is of course not representative of a real world problem that could -be solved using genetic algorithms. However, it does serve well as a toy -example.--The code in example1.hs illustrates how you can define the "genRandom", -"crossover", "mutation" and "score'" functions that are required to run -the genetic algorithm using the 'evolve' function.--It also shows the use of a 'pool' that can be used to generate random-entities (a list of characters, in this particular case), and user-supplied-data that can be used to evaluate the fitness of entities (in this case,-the string "Hello World!").--The second example (see example2.hs) evolves an integer number that has+The first example (see theNumber.hs) evolves an integer number that has 8 integer divisors, and for which the sum of its divisors equals 96. Although using a genetic algorithm is probably not the best way to find  such an integer (it would be easier/faster to just go over integer values-one by one starting from e.g. 8), but again, it serves well as a toy example.+one by one starting from e.g. 8), but it serves well as a toy example.  This example shows how the pool and score data do not have to be used; it suffices to supply '()' as values to the evolve function, and to simply ignore the respective arguments passed to the Entity typeclass functions.+We use the score' function in this example, because the scoring itself+doesn't operate in a monad. -The third example reimplements the first example, but inside the IO monad.+A second example evolves the string "Hello World!". The string that the+genetic algorithm should generate is supplied by the user in this example,+and is printed to a file where the GA will read it from during scoring.+This is of course not representative of a real world problem that could +be solved using genetic algorithms, but again, it does serve well as a toy +example.++The code in hello.hs illustrates how you can define the "genRandom", +"crossover", "mutation" and "score" functions that are required to run +the genetic algorithm using the 'evolveVerbose' function. It also shows+an example of defining the "isPerfect" function to determine whether a+perfect entity was observed (and thus evolution can stop).++This example demonstrates the use of a 'pool' that can be used to generate +random entities (a list of characters, in this particular case), and +user-supplied data that can be used to evaluate the fitness of entities (in +this case, the name of the file where the target string was written to).++It also shows how the GA module support operating in a monad, in this case +the IO monad, and illustrates the usefulness of the 'randomSearch' function.

@@ -1,7 +1,7 @@-all: example1 example2 example3+all: theNumber hello  %: %.hs 	ghc --make -Wall $@  clean:-	rm -f *.hi *.o example1 example2 example3+	rm -f *.hi *.o theNumber hello

@@ -1,101 +0,0 @@-{--- - Example for GA package- - see http://hackage.haskell.org/package/GA- -- - Evolve the string "Hello World!"---}--{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances #-}--import Control.Monad.Identity (Identity(..))-import Data.Char (chr,ord)-import Data.List (foldl')-import System.Random (mkStdGen, random, randoms)--import GA (Entity(..), GAConfig(..), evolve)---- 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] Identity 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' x e = Just $ fromIntegral $ d + 100*l-    where-      e' = map ord e-      x' = map ord x-      d = sum' $ map abs $ zipWith (-) e' x'-      l = abs $ (length x) - (length e)--  -- 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-            charsPool = map chr [32..126]-        -- Do the evolution!-        -- Note: if either of the last two arguments is unused, -        --       just use () as a value-            (Identity es) = evolve g cfg charsPool "Hello World!"-            e = snd $ head es :: String-        -        putStrLn $ "best entity: " ++ (show e)

@@ -1,95 +0,0 @@-{--- - Example for GA package- - see http://hackage.haskell.org/package/GA- -- - Evolve a single integer number to match the following features as closely as possible- -   * 8 integer divisors- -   * sum of divisors is 96---}--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances #-}--import Control.Monad.Identity (Identity(..))-import Data.List (foldl')-import System.Random (mkStdGen, random)--import GA (Entity(..), GAConfig(..), evolve)------- HELPER FUNCTIONS------- find all divisors of a number-divisors :: Int -> [Int]-divisors n = concat $ map divsFor [1..(sqrt' n)]-  where-    divsFor x = if n `mod` x == 0-                     then [x, n `div` x]-                     else []---- "integer" square root-sqrt' :: Int -> Int-sqrt' n = floor (sqrt $ fromIntegral n :: Float)---- efficient sum-sum' :: (Num a) => [a] -> a-sum' = foldl' (+) 0------- GA TYPE CLASS IMPLEMENTATION-----type Number = Int--instance Entity Number Double () () Identity where- -  -- generate a random entity, i.e. a random integer value -  genRandom _ seed = return $ (fst $ random $ mkStdGen seed) `mod` 10000--  -- crossover operator: sum, (abs value of) difference or (rounded) mean-  crossover _ _ seed e1 e2 = return $ Just $ case seed `mod` 3 of-                                                  0 -> e1+e2-                                                  1 -> abs (e1-e2)-                                                  2 -> (e1+e2) `div` 2-                                                  _ -> error "crossover: unknown case"--  -- mutation operator: add or subtract random value (max. 10)-  mutation _ _ seed e = return $ Just $ if seed `mod` 2 == 0-                                        then e +(1 + seed `mod` 10)-                                        else abs (e - (1 + seed `mod` 10))--  -- score: how closely does the given number match the criteria?-  -- NOTE: lower is better-  score' _ e = Just $ fromIntegral $ s + n-    where-      ds = divisors e-      s = abs $ (-) 96 $ sum' ds-      n = abs $ (-) 8 $ length ds--  -- whether or not a scored entity is perfect-  isPerfect (_,s) = s == 0.0---main :: IO() -main = do-        let cfg = GAConfig -                    20 -- population size-                    10 -- archive size (best entities to keep track of)-                    100 -- 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--        -- Do the evolution!-        -- two last parameters (pool for generating new entities and -        -- extra data to score an entity) are unused in this example-            (Identity es) = evolve g cfg () ()-            e = snd $ head es :: Int-        -        putStrLn $ "best entity: " ++ (show e)

@@ -1,100 +0,0 @@-{--- - 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 GA (Entity(..), GAConfig(..), evolveVerbose)---- 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 x e = return $ Just $ fromIntegral $ d + 100*l-    where-      e' = map ord e-      x' = map ord x-      d = sum' $ map abs $ zipWith (-) e' x'-      l = abs $ (length x) - (length e)--  -- 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-            charsPool = map chr [32..126]-        -- Do the evolution!-        -- Note: if either of the last two arguments is unused, just use () as a value-        es <- evolveVerbose g cfg charsPool "Hello World!"-        let e = snd $ head es :: String-        -        putStrLn $ "best entity: " ++ (show e)

@@ -0,0 +1,119 @@+{--+ - 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')

@@ -0,0 +1,92 @@+{--+ - Example for GA package+ - see http://hackage.haskell.org/package/GA+ -+ - Evolve a single integer number to match the following features as closely as possible+ -   * 8 integer divisors+ -   * sum of divisors is 96+--}++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}++import Control.Monad.Identity (Identity(..))+import Data.List (foldl')+import System.Random (mkStdGen, random)++import GA (Entity(..), GAConfig(..), evolve)++--+-- HELPER FUNCTIONS+--++-- find all divisors of a number+divisors :: Int -> [Int]+divisors n = concat $ map divsFor [1..(sqrt' n)]+  where+    divsFor x = if n `mod` x == 0+                     then [x, n `div` x]+                     else []++-- "integer" square root+sqrt' :: Int -> Int+sqrt' n = floor (sqrt $ fromIntegral n :: Float)++-- efficient sum+sum' :: (Num a) => [a] -> a+sum' = foldl' (+) 0++--+-- GA TYPE CLASS IMPLEMENTATION+--++type Number = Int++instance Entity Number Double () () Identity where+ +  -- generate a random entity, i.e. a random integer value +  genRandom _ seed = return $ (fst $ random $ mkStdGen seed) `mod` 10000++  -- crossover operator: sum, (abs value of) difference or (rounded) mean+  crossover _ _ seed e1 e2 = return $ Just $ case seed `mod` 3 of+                                                  0 -> e1+e2+                                                  1 -> abs (e1-e2)+                                                  2 -> (e1+e2) `div` 2+                                                  _ -> error "crossover: unknown case"++  -- mutation operator: add or subtract random value (max. 10)+  mutation _ _ seed e = return $ Just $ if seed `mod` 2 == 0+                                        then e +(1 + seed `mod` 10)+                                        else abs (e - (1 + seed `mod` 10))++  -- score: how closely does the given number match the criteria?+  -- NOTE: lower is better+  score' _ e = Just $ fromIntegral $ s + n+    where+      ds = divisors e+      s = abs $ (-) 96 $ sum' ds+      n = abs $ (-) 8 $ length ds+++main :: IO() +main = do+        let cfg = GAConfig +                    20 -- population size+                    10 -- archive size (best entities to keep track of)+                    100 -- 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++        -- Do the evolution!+        -- two last parameters (pool for generating new entities and +        -- extra data to score an entity) are unused in this example+            (Identity es) = evolve g cfg () ()+            e = snd $ head es :: Int+        +        putStrLn $ "best entity: " ++ (show e)