packages feed

simple-genetic-algorithm (empty) → 0.1.0.0

raw patch · 5 files changed

+236/−0 lines, 5 filesdep +basedep +deepseqdep +parallelsetup-changed

Dependencies added: base, deepseq, parallel, random

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Alexander Alexeev++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexander Alexeev nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ simple-genetic-algorithm.cabal view
@@ -0,0 +1,41 @@+-- Initial simple-genetic-algorithm.cabal generated by cabal init.  For +-- further documentation, see http://haskell.org/cabal/users-guide/++name:                simple-genetic-algorithm+version:             0.1.0.0+synopsis:            Simple parallel genetic algorithm implementation+description:         Simple parallel genetic algorithm implementation+homepage:            http://eax.me/haskell-genetic-algorithm/+license:             BSD3+license-file:        LICENSE+author:              Alexander Alexeev+maintainer:          mail@eax.me+-- copyright:           +category:            AI+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+    type:     git+    location: git@github.com:afiskon/simple-genetic-algorithm.git++library+  exposed-modules:     GA.Simple+  ghc-options:         -O2 -Wall -fno-warn-missing-signatures+  build-depends:       base >=4.6 && < 4.7,+                       random >= 1.0 && < 1.1,+                       parallel >= 3.2 && < 3.3+  hs-source-dirs:      src+  default-language:    Haskell2010++executable ga-sin-example+  ghc-options:         -O2 -Wall -fno-warn-missing-signatures -threaded -rtsopts+  main-is:             MainSin.hs+  build-depends:       base >= 4.6 && < 4.7,+                       random >= 1.0 && < 1.1,+                       deepseq >= 1.3 && < 1.4,+                       parallel >= 3.2 && < 3.3+  hs-source-dirs:      src+  default-language:    Haskell2010+
+ src/GA/Simple.hs view
@@ -0,0 +1,104 @@+-- | Simple parallel genetic algorithm implementation.+module GA.Simple (+    Chromosome(..),+    runGA,+    runGAIO,+    zeroGeneration,+    nextGeneration+  ) where++import System.Random+import qualified Data.List as L+import Control.Parallel.Strategies++-- | Chromosome representation+class NFData a => Chromosome a where+    -- | Crossover function+    crossover :: RandomGen g => g -> a -> a -> ([a],g)+    -- | Mutation function+    mutation :: RandomGen g => g -> a -> (a,g)+    -- | Fitness function. fitness x > fitness y means that x is better than y +    fitness :: a -> Double++-- | Pure GA implementation+runGA   :: (RandomGen g, Chromosome a)+        => g                        -- ^ Random number generator+        -> Int                      -- ^ Population size+        -> Double                   -- ^ Mutation probability [0, 1]+        -> (g -> (a, g))            -- ^ Random chromosome generator (hint: use closures)+        -> (a -> Int -> Bool)       -- ^ Stopping criteria, 1st arg - best chromosome, 2nd arg - generation number+        -> a                        -- ^ Best chromosome+runGA gen ps mp rnd stopf =+    let (pop, gen') = zeroGeneration gen rnd ps in+    runGA' gen' pop ps mp stopf 0++runGA' gen pop ps mp stopf gnum =+    let best = head pop in+    if stopf best gnum+        then best+        else+            let (pop', gen') = nextGeneration gen pop ps mp in+            runGA' gen' pop' ps mp stopf (gnum+1)++-- | Non-pure GA implementation+runGAIO :: Chromosome a+        => Int                      -- ^ Population size+        -> Double                   -- ^ Mutation probability [0, 1]+        -> (StdGen -> (a, StdGen))  -- ^ Random chromosome generator (hint: use closures)+        -> (a -> Int -> IO Bool)    -- ^ Stopping criteria, 1st arg - best chromosome, 2nd arg - generation number+        -> IO a                     -- ^ Best chromosome+runGAIO ps mp rnd stopf = do+    gen <- newStdGen+    let (pop, gen') = zeroGeneration gen rnd ps+    runGAIO' gen' pop ps mp stopf 0++runGAIO' gen pop ps mp stopf gnum = do+    let best = head pop+    stop <- stopf best gnum+    if stop+        then return best+        else do+            let (pop', gen') = nextGeneration gen pop ps mp+            runGAIO' gen' pop' ps mp stopf (gnum+1)++-- | Generate zero generation. Use this function only if you are going to implement your own runGA.+zeroGeneration  :: (RandomGen g)+                => g                -- ^ Random number generator+                -> (g -> (a, g))    -- ^ Random chromosome generator (hint: use closures)+                -> Int              -- ^ Population size+                -> ([a],g)          -- ^ Zero generation and new RNG+zeroGeneration initGen rnd ps =+    L.foldl'+        (\(xs,gen) _ -> let (c, gen') = rnd gen in ((c:xs),gen'))+        ([], initGen) [1..ps]++-- | Generate next generation (in parallel) using mutation and crossover.+--   Use this function only if you are going to implement your own runGA.+nextGeneration  :: (RandomGen g, Chromosome a)+                => g                -- ^ Random number generator+                -> [a]              -- ^ Current generation+                -> Int              -- ^ Population size+                -> Double           -- ^ Mutation probability+                -> ([a], g)         -- ^ Next generation ordered by fitness (best - first) and new RNG+nextGeneration gen pop ps mp =+    let (gen':gens) = L.unfoldr (Just . split) gen+        chunks = L.zip gens $ init $ L.tails pop+        results = map (\(g, (x:ys)) -> [ (t, fitness t) | t <- nextGeneration' [ (x, y) | y <- ys ] g mp [] ]) chunks+                    `using` parList rdeepseq+        lst = take ps $ L.sortBy (\(_, fx) (_, fy) -> fy `compare` fx) $ concat results+    in ( map fst lst, gen' )++nextGeneration' [] _ _ acc = acc+nextGeneration' ((p1,p2):ps) g0 mp acc =+    let (children0, g1) = crossover g0 p1 p2+        (children1, g2) = L.foldl'+                             (\(xs, g) x -> let (x', g') = mutate g x mp in (x':xs, g'))+                             ([],g1) children0+    in+    nextGeneration' ps g2 mp (children1 ++ acc)++mutate :: (RandomGen g, Chromosome a) => g -> a -> Double -> (a, g)+mutate gen x mp =+    let (r, gen') = randomR (0.0, 1.0) gen in+    if r <= mp  then mutation gen' x+                else (x, gen')
+ src/MainSin.hs view
@@ -0,0 +1,59 @@+-- | Example: sin() function interpolation on [0, pi/2]+module Main where++import GA.Simple+import System.Random+import Text.Printf+import Data.List as L+import Control.DeepSeq++data SinInt = SinInt [Double]++instance NFData SinInt where+    rnf (SinInt xs) = rnf xs `seq` ()++instance Show SinInt where+    show (SinInt []) = "<empty SinInt>"+    show (SinInt (x:xs)) =+        let start = printf "%.5f" x+            end = concat $ zipWith (\c p -> printf "%+.5f" c ++ "X^" ++ show p) xs [1 :: Int ..]+        in start ++ end++polynomialOrder = 4 :: Int++err :: SinInt -> Double+err (SinInt xs) =+    let f x = snd $ L.foldl' (\(mlt,s) coeff -> (mlt*x, s + coeff*mlt)) (1,0) xs+    in maximum [ abs $ sin x - f x | x <- [0.0,0.001 .. pi/2]]++instance Chromosome SinInt where+    crossover g (SinInt xs) (SinInt ys) =+        ( [ SinInt (L.zipWith (\x y -> (x+y)/2) xs ys) ], g)++    mutation g (SinInt xs) =+        let (idx, g') = randomR (0, length xs - 1) g+            (dx, g'') = randomR (-10.0, 10.0) g'+            t = xs !! idx+            xs' = take idx xs ++ [t + t*dx] ++ drop (idx+1) xs+        in (SinInt xs', g'')++    fitness int =+        let max_err = 1000.0 in+        max_err - (min (err int) max_err)++randomSinInt gen = +    let (lst, gen') =+            L.foldl'+                (\(xs, g) _ -> let (x, g') = randomR (-10.0,10.0) g in (x:xs,g') )+                ([], gen) [0..polynomialOrder]+    in (SinInt lst, gen')++stopf best gnum = do+    let e = err best+    putStrLn $ "Generation: " ++ printf "%02d" gnum ++ ", Error: " ++ printf "%.8f" e+    return $ e < 0.0002 || gnum > 20++main = do+    int <- runGAIO 64 0.1 randomSinInt stopf+    putStrLn ""+    putStrLn $ "Result: " ++ show int