variation done

src/HushGP/GP.hs

@@ -46,7 +46,7 @@ gpLoop pushArgs@(PushArgs {trainingData = tData}) = do
 -- the training data (possibly downsampled).
 gpLoop' :: PushArgs -> Int -> Int -> [Individual] -> [PushData] -> IO ()
 gpLoop'
-  pushArgs@(PushArgs {enableDownsampling = enableDS, solutionErrorThreshold = seThresh, downsampleParentsGens = dsParentGens, downsampleParentRate = dsParentRate, trainingData = tData})
+  pushArgs@(PushArgs {enableDownsampling = enableDS, solutionErrorThreshold = seThresh, downsampleParentsGens = dsParentGens, downsampleParentRate = dsParentRate, trainingData = tData, elitism = isElite, populationSize = popSize})
   generation
   evaluations
   population
@@ -78,7 +78,8 @@ gpLoop'
           | (not (enableDownsampling epsilonPushArgs) && (generation >= maxGenerations epsilonPushArgs))
               || (enableDownsampling epsilonPushArgs && (evaluations >= (maxGenerations epsilonPushArgs * length population * length indexedTrainingData))) =
               print $ "Best individual: " <> show (plushy bestInd)
-          | otherwise =
+          | otherwise = do
+              newPop <- if isElite then replicateM (popSize - 1) (newIndividual epsilonPushArgs evaledPop) else replicateM popSize (newIndividual epsilonPushArgs evaledPop)
               gpLoop'
                 pushArgs
                 (succ generation)
@@ -87,9 +88,9 @@ gpLoop'
                     + (if generation `mod` downsampleParentsGens pushArgs == 0 then length parentReps * (length indexedTrainingData - length (trainingData pushArgs)) else 0)
                     + (if bestIndPassesDownsample then length indexedTrainingData - length tData else 0)
                 )
-                ( if elitism pushArgs
-                    then bestInd : replicate (populationSize epsilonPushArgs - 1) (newIndividual epsilonPushArgs evaledPop)
-                    else replicate (populationSize epsilonPushArgs) (newIndividual epsilonPushArgs evaledPop)
+                ( if isElite
+                    then bestInd : newPop
+                    else newPop
                 )
                 ( if enableDS && ((generation `mod` dsParentGens) == 0)
                     then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (solutionErrorThreshold pushArgs / fromIntegral @Int @Double (length indexedTrainingData))

src/HushGP/GP/PushArgs.hs

@@ -3,7 +3,6 @@ module HushGP.GP.PushArgs where
 import HushGP.State
 import HushGP.Instructions
 import HushGP.GP.PushData
-import Data.Map qualified as Map
 
 -- | The structure holding the arguments for the various aspects
 -- of the evolutionary run in Hush.

src/HushGP/GP/Variation.hs

@@ -2,6 +2,7 @@ module HushGP.GP.Variation where
 
 import Data.List
 import Control.Monad
+import System.Random
 import HushGP.State
 import HushGP.GP.PushArgs
 import HushGP.GP.Individual
@@ -119,7 +120,7 @@ uniformDeletion' (old:oldList) !newList adjustRate = do
 -- |Creates a new individual based on the probabilities of the desired
 -- crossover methods.
 newIndividual :: PushArgs -> [Individual] -> IO Individual
-newIndividual pushArgs@PushArgs{variation = var} population = do
+newIndividual pushArgs@PushArgs{variation = var, umadRate = uRate} population = do
   randOp <- randomOperation var 0.0
   case randOp of
     "reproduction" -> selectParent pushArgs population
@@ -135,9 +136,37 @@ newIndividual pushArgs@PushArgs{variation = var} population = do
       pure $ postVariationInd childPlushy
     "umad" -> do
       parent <- selectParent pushArgs population
-      child <- uniformAddition pushArgs (plushy parent) >>= uniformDeletion pushArgs
-      pure $ postVariationInd child
-    "rumad" -> undefined -- TODO: this tomorrow!
+      childPlushy <- uniformAddition pushArgs (plushy parent) >>= uniformDeletion pushArgs
+      pure $ postVariationInd childPlushy
+    "alternation" -> do
+      parent0 <- selectParent pushArgs population
+      parent1 <- selectParent pushArgs population
+      childPlushy <- alternation pushArgs (plushy parent0) (plushy parent1)
+      pure $ postVariationInd childPlushy
+    "rumad" -> do -- Responsive umad, deletion rate from computed amount of additions.
+      parent <- selectParent pushArgs population
+      addedChildPlushy <- uniformAddition pushArgs (plushy parent)
+      let effectiveAdditionRate = fromIntegral @Int @Double (length addedChildPlushy - length (plushy parent)) / fromIntegral @Int @Double (length (plushy parent))
+      finalChild <- uniformDeletion pushArgs{umadRate = effectiveAdditionRate} addedChildPlushy
+      pure $ postVariationInd finalChild
+    "vumad" -> do -- variable umad, umad rate chosen randomly from [0, umadRate]
+      rate <- fst . uniformR (0.0 :: Double, uRate) <$> initStdGen
+      parent <- selectParent pushArgs population
+      addedChildPlushy <- uniformAddition pushArgs{umadRate = rate} (plushy parent)
+      deletedChildPlushy <- uniformDeletion pushArgs{umadRate = rate} addedChildPlushy
+      pure $ postVariationInd deletedChildPlushy
+    "uniformAddition" -> do
+      parent <- selectParent pushArgs population
+      childPlushy <- uniformAddition pushArgs (plushy parent)
+      pure $ postVariationInd childPlushy
+    "uniformReplacement" -> do
+      parent <- selectParent pushArgs population
+      childPlushy <- uniformReplacement pushArgs (plushy parent)
+      pure $ postVariationInd childPlushy
+    "uniformDeletion" -> do
+      parent <- selectParent pushArgs population
+      childPlushy <- uniformDeletion pushArgs (plushy parent)
+      pure $ postVariationInd childPlushy
     _ -> error ("Error: No match for selection operation: " <> randOp)
   where
   randDecimal :: IO Double