-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/


-- | Genetic algorithm library
--   
--   This package provides a framework for working with genetic algorithms.
--   A genetic algorithm is an evolutionary technique, inspired by
--   biological evolution, to evolve entities that perform as good as
--   possible in terms of a predefined criterion (the scoring function).
--   Note: lower scores are assumed to indicate better entities. The GA
--   module provides a type class for defining entities and the functions
--   that are required by the genetic algorithm. Checkpointing in between
--   generations is available, as is automatic restoring from the last
--   available checkpoint.
@package GA
@version 1.0


-- | GA, a Haskell library for working with genetic algoritms.
--   
--   Aug. 2011 - Sept. 2011, by Kenneth Hoste
--   
--   version: 1.0
--   
--   Major features:
--   
--   <ul>
--   <li>flexible user-friendly API for working with genetic
--   algorithms</li>
--   <li>Entity type class to let user define entity definition, scoring,
--   etc.</li>
--   <li>abstraction over monad, resulting in a powerful yet simple
--   interface</li>
--   <li>support for scoring entire population at once</li>
--   <li>support for checkpointing each generation, and restoring from last
--   checkpoint</li>
--   <li>convergence detection, as defined by user</li>
--   <li>also available: random searching, user-defined progress
--   output</li>
--   <li>illustrative toy examples included</li>
--   </ul>
--   
--   Hello world example:
--   
--   <pre>
--    -- 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) =&gt; [a] -&gt; 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 -&gt; [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 &gt; (minBound :: Char) then pred x else succ x
--             else if x &lt; (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 &lt;- openFile fn ReadMode
--       x &lt;- 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 &lt;- 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' &lt;- randomSearch g 100000 charsPool fileName
--           let e' = snd $ head es' :: String
--          
--           putStrLn $ "best entity (random search): " ++ (show e')
--   </pre>
module GA

-- | Type class for entities that represent a candidate solution.
--   
--   Five parameters:
--   
--   <ul>
--   <li>data structure representing an entity (e)</li>
--   <li>score type (s), e.g. Double</li>
--   <li>data used to score an entity, e.g. a list of numbers (d)</li>
--   <li>some kind of pool used to generate random entities, e.g. a Hoogle
--   database (p)</li>
--   <li>monad to operate in (m)</li>
--   </ul>
--   
--   Minimal implementation should include <a>genRandom</a>,
--   <a>crossover</a>, <a>mutation</a>, and either <a>score'</a>,
--   <a>score</a> or <a>scorePop</a>.
--   
--   The <a>isPerfect</a>, <a>showGeneration</a> and <a>hasConverged</a>
--   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 | e -> s, e -> d, e -> p, e -> m
genRandom :: Entity e s d p m => p -> Int -> m e
crossover :: Entity e s d p m => p -> Float -> Int -> e -> e -> m (Maybe e)
mutation :: Entity e s d p m => p -> Float -> Int -> e -> m (Maybe e)
score' :: Entity e s d p m => d -> e -> (Maybe s)
score :: Entity e s d p m => d -> e -> m (Maybe s)
scorePop :: Entity e s d p m => d -> [e] -> [e] -> m (Maybe [Maybe s])
isPerfect :: Entity e s d p m => (e, s) -> Bool
showGeneration :: Entity e s d p m => Int -> Generation e s -> String
hasConverged :: Entity e s d p m => [Archive e s] -> Bool

-- | A scored entity.
type ScoredEntity e s = (Maybe s, e)

-- | Archive of scored entities.
type Archive e s = [ScoredEntity e s]

-- | Configuration for genetic algorithm.
data GAConfig
GAConfig :: Int -> Int -> Int -> Float -> Float -> Float -> Float -> Bool -> Bool -> GAConfig

-- | population size
getPopSize :: GAConfig -> Int

-- | size of archive (best entities so far)
getArchiveSize :: GAConfig -> Int

-- | maximum number of generations to evolve
getMaxGenerations :: GAConfig -> Int

-- | fraction of entities generated by crossover (tip: &gt;= 0.80)
getCrossoverRate :: GAConfig -> Float

-- | fraction of entities generated by mutation (tip: &lt;= 0.20)
getMutationRate :: GAConfig -> Float

-- | parameter for crossover (semantics depend on crossover operator)
getCrossoverParam :: GAConfig -> Float

-- | parameter for mutation (semantics depend on mutation operator)
getMutationParam :: GAConfig -> Float

-- | enable/disable built-in checkpointing mechanism
getWithCheckpointing :: GAConfig -> Bool

-- | rescore archive in each generation?
getRescoreArchive :: GAConfig -> Bool

-- | Do the evolution!
evolve :: Entity e s d p m => StdGen -> GAConfig -> p -> d -> m (Archive e s)

-- | Do the evolution, verbosely.
--   
--   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 -> GAConfig -> p -> d -> m (Archive e s)

-- | Random searching.
--   
--   Useful to compare with results from genetic algorithm.
randomSearch :: Entity e s d p m => StdGen -> Int -> p -> d -> m (Archive e s)