Haskell "Weasel Program" Genetic Algorithm

As part of a university coursework, I had to create an implementation of a variant of the Weasel Program.

The aim of the program is to show the effect of crossover when evolving a population towards a target string. The program first evolves a solution without crossover, then with crossover. The program in Haskell, looks like this:

module Main (main) where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import System.Random

targetStr = "Methinks it is like a weasel"
targetLen = 28
populationSize = 500
replaceProbability = 1 / fromIntegral targetLen

-- Sum the "difference" of two strings' chars.
strDiff :: String -> Int
strDiff input = sum $ zipWith (\a b -> if a == b then 0 else 1) input targetStr

-- Generate a random char (in the range 32d - 127d)
rndChar :: IO Char
rndChar = randomRIO (' ', '~')

-- Generate a string of random chars, of length targetLen
rndString :: IO String
rndString = replicateM targetLen rndChar

-- Replace the input character with a random
-- new character with a probability of (1/length of target)
rndMutateChar :: Char -> IO Char
rndMutateChar input = do
    probability <- randomRIO (0 :: Double, 1)
    if probability <= replaceProbability
        then rndChar
        else return input

-- Randomly mutate the chars of a String
rndMutateStr :: String -> IO String
rndMutateStr = mapM rndMutateChar

-- Take 2 strings and return a new string that is
-- created by randomly picking each char from either
-- string
crossoverStrings :: String -> String -> IO String
crossoverStrings = zipWithM cross
  where
    cross x y = (\b -> if b then x else y) <$> randomIO

-- Generate a list (of the given length) of mutually unique random elements with
-- in the given bounds, using the given generator.
uniqueRandoms :: (Eq a) => (Random a) => (a, a) -> Int -> [a] -> IO [a]
uniqueRandoms bounds targetLen acc
    | length acc == targetLen = return acc
    | otherwise = do
        randVal <- randomRIO bounds
        uniqueRandoms bounds targetLen $ if randVal `notElem` acc
                                            then randVal : acc
                                            else acc

-- Generate a list of unique, random population indices
uniqueRandomIndices :: Int -> IO [Int]
uniqueRandomIndices n = uniqueRandoms (0, populationSize - 1) n []

-- Take 2 individuals, compare using the passed function, returning the
-- first element of the chosen individual (its index)
chooseIndividual :: ((a, b) -> (a, b) -> Bool) -> (a, b) -> (a, b) -> a
chooseIndividual cmp indvA indvB = fst $ if cmp indvA indvB then indvA else indvB

-- choose chooses the more fit individual of form (String, Score)
choose = chooseIndividual (\a b -> snd a <= snd b)
-- chooseR chooses the less fit individual of form (Index, (String, Score))
chooseR = chooseIndividual (\a b -> (snd.snd) a > (snd.snd) b)

-- Takes a new String and a population and replaces the weaker
-- of two randomly chosen individuals with the mutated string.
updatePopulation :: String -> [(String, Int)] -> IO [(String, Int)]
updatePopulation mutatee population = do
    newChildStr <- rndMutateStr mutatee
    replaceIndices <- uniqueRandomIndices 2
    -- Keep hold of the indices, so we can split/merge the population
    let [r1,r2] = map (\i -> (i, population !! i)) replaceIndices
    -- chose the less fit individual to be replaced
    let (start,_:end) = splitAt (chooseR r1 r2) population
    return $ (newChildStr, strDiff newChildStr) : start ++ end

withoutCrossover :: [(String, Int)] -> Int -> IO (String, Int)
withoutCrossover population count = do
    -- pick two random individuals
    indices <- uniqueRandomIndices 2
    let individuals@[x,y] = map (population !!) indices
    -- If we've not evolved the target string yet, carry on
    case find ((== 0) . snd) individuals of
        Just val -> return (fst val, count)
        Nothing  -> do
            -- pick the fitter individual to be the parent
            let parentStr = choose x y
            newPopulation <- updatePopulation parentStr population
            withoutCrossover newPopulation (count + 1)

withCrossover :: [(String, Int)] -> Int -> IO (String, Int)
withCrossover population count = do
    -- pick four random individuals
    indices <- uniqueRandomIndices 4
    let individuals@[a1,a2,b1,b2] = map (population !!) indices
    -- If we've not evolved the target string yet, carry on
    case find ((== 0) . snd) individuals of
        Just val -> return (fst val, count)
        Nothing  -> do
            -- Pick the fitter two of two pairs of individuals to be parents
            let parentA = choose a1 a2
            let parentB = choose b1 b2
            -- create the "crossover" of the two parents
            crossoverStr <- crossoverStrings parentA parentB
            newPopulation <- updatePopulation crossoverStr population
            withCrossover newPopulation (count + 1)

main = do
    -- Create a list of random individuals (just strings)
    individuals <- replicateM populationSize rndString
    let individualFitnesses = map (\i -> (i, strDiff i)) individuals
    -- Now evolve, first without and then with crossover
    result2 <- withoutCrossover individualFitnesses populationSize
    print result2
    result3 <- withCrossover individualFitnesses populationSize
    print result3