View difference between Paste ID: gdRKAQxt and

-
+module Main (main) where
 import Data.Char
 import Data.List
 import System.Random
 import Control.Monad
 import Control.Monad.State
 import Data.Function (on)
 targetStr = "Methinks it is like a weasel"
 targetLen = 28
 populationSize = 500
 replaceProbability = 1 / fromIntegral targetLen
 
 getRandom func
   = do (val, gen') <- liftM func get
        put gen'
        return val
 
 strDiff :: String -> Int
 strDiff = sum . zipWith (\ a b -> if a == b then 0 else 1) targetStr
 
 rndString :: State StdGen String
 rndString = replicateM targetLen rndChar
 
 rndChar :: State StdGen Char
 rndChar = getRandom (randomR (' ', '~'))
 
 rndMutateChar :: Char -> State StdGen Char
 rndMutateChar input
   = do roll <- getRandom (randomR (0, 1))
        if (roll :: Double) <= replaceProbability then rndChar else
          return input
 
 rndMutateStr :: String -> State StdGen String
 rndMutateStr = mapM rndMutateChar
 
 crossoverStrings :: String -> String -> State StdGen String
 crossoverStrings str1 str2
   = mapM
       (\ x ->
          do b <- getRandom random
             return (if b then fst x else snd x))
       (zip str1 str2)
 
 uniqueRandoms :: Int -> State StdGen [Int]
 uniqueRandoms = go []
   where go acc targetLen
           | length acc == targetLen = return acc
           | otherwise =
             do randVal <- getRandom (randomR (0, populationSize - 1))
                go (if randVal `notElem` acc then randVal : acc else acc) targetLen
 
 choose a b = fst (if on (<=) snd a b then a else b)
 chooseR a b = fst (if on (>) (snd . snd) a b then a else b)
 
 withoutCrossover ::[(String, Int)] -> Int -> State StdGen (String, Int)
 withoutCrossover population count
   = do [i1, i2] <- liftM (map (population !!)) (uniqueRandoms 2)
        childStr <- rndMutateStr (choose i1 i2)
        let childDiff = strDiff childStr
        if childDiff == 0 then return (childStr, count) else
          do [r1, r2] <- liftM (map (ap (,) (population !!))) (uniqueRandoms 2)
             let (start, _ : end) = splitAt (chooseR r1 r2) population
             let newPopulation = start ++ ((childStr, childDiff) : end)
             withoutCrossover newPopulation (count + 1)
 
 withCrossover ::[(String, Int)] -> Int -> State StdGen (String, Int)
 withCrossover population count
   = do [i1, i2, i3, i4] <- liftM (map (population !!)) (uniqueRandoms 4)
        let parentA = choose i1 i2
        let parentB = choose i3 i4
        crossoverStr <- crossoverStrings parentA parentB
        childStr <- rndMutateStr crossoverStr
        let childDiff = strDiff childStr
        if childDiff == 0 then return (childStr, count + 1) else
          do [r1, r2] <- liftM (map (ap (,) (population !!))) (uniqueRandoms 2)
             let (start, _ : end) = splitAt (chooseR r1 r2) population
             let newPopulation = start ++ ((childStr, childDiff) : end)
             withCrossover newPopulation (count + 1)
 
 main
   = do gen <- newStdGen
        let individuals = replicate populationSize (fst (runState rndString gen))
        let individualFitnesses = map (ap (,) strDiff) individuals
        newStdGen >>= print . fst .
          runState (withoutCrossover individualFitnesses populationSize)
        newStdGen >>= print . fst .
          runState (withCrossover individualFitnesses populationSize)