diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -13,10 +13,6 @@ 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 diff --git a/simple-genetic-algorithm.cabal b/simple-genetic-algorithm.cabal --- a/simple-genetic-algorithm.cabal +++ b/simple-genetic-algorithm.cabal @@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: simple-genetic-algorithm -version: 0.1.0.4 +version: 0.2.0.0 synopsis: Simple parallel genetic algorithm implementation description: Simple parallel genetic algorithm implementation homepage: http://eax.me/haskell-genetic-algorithm/ @@ -18,10 +18,10 @@ source-repository head type: git - location: git@github.com:afiskon/simple-genetic-algorithm.git + location: https://github.com/afiskon/simple-genetic-algorithm library - exposed-modules: GA.Simple + exposed-modules: AI.GeneticAlgorithm.Simple ghc-options: -O2 -Wall -fno-warn-missing-signatures build-depends: base >=4.5 && < 4.8, random >= 1.0 && < 1.1, diff --git a/src/AI/GeneticAlgorithm/Simple.hs b/src/AI/GeneticAlgorithm/Simple.hs new file mode 100644 --- /dev/null +++ b/src/AI/GeneticAlgorithm/Simple.hs @@ -0,0 +1,163 @@ +-- | Simple parallel genetic algorithm implementation. +-- +-- > import AI.GeneticAlgorithm.Simple +-- > import System.Random +-- > import Text.Printf +-- > import Data.List as L +-- > import Control.DeepSeq +-- > +-- > newtype SinInt = SinInt [Double] +-- > +-- > instance NFData SinInt where +-- > rnf (SinInt xs) = rnf xs `seq` () +-- > +-- > instance Show SinInt where +-- > show (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 :: SinInt -> Int -> IO Bool +-- > stopf best gnum = do +-- > let e = err best +-- > _ <- printf "Generation: %02d, Error: %.8f\n" gnum e +-- > return $ e < 0.0002 || gnum > 20 +-- > +-- > main = do +-- > int <- runGAIO 64 0.1 randomSinInt stopf +-- > putStrLn "" +-- > putStrLn $ "Result: " ++ show int + +module AI.GeneticAlgorithm.Simple ( + Chromosome(..), + runGA, + runGAIO, + zeroGeneration, + nextGeneration + ) where + +import System.Random +import qualified Data.List as L +import Control.Parallel.Strategies + +-- | Chromosome interface +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 currying or 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 currying or 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') diff --git a/src/GA/Simple.hs b/src/GA/Simple.hs deleted file mode 100644 --- a/src/GA/Simple.hs +++ /dev/null @@ -1,104 +0,0 @@ --- | 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 interface -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 currying or 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 currying or 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') diff --git a/src/MainSin.hs b/src/MainSin.hs --- a/src/MainSin.hs +++ b/src/MainSin.hs @@ -1,7 +1,4 @@ --- | Example: sin() function interpolation on [0, pi/2] -module Main where - -import GA.Simple +import AI.GeneticAlgorithm.Simple import System.Random import Text.Printf import Data.List as L