From 1293e27b696bff2dabedf055adabda0fb4901bf7 Mon Sep 17 00:00:00 2001
From: Rowan Torbitzky-Lane <rowan.a.tl@protonmail.com>
Date: Sat, 1 Mar 2025 23:21:43 -0600
Subject: [PATCH] selection and individual, remove cyclic dependencies for
 PushArgs

---
 src/HushGP/GP/Downsample.hs |  2 +-
 src/HushGP/GP/Individual.hs | 24 ++++++++++++++++++++++++
 src/HushGP/GP/PushArgs.hs   | 10 ++++++++--
 src/HushGP/GP/Selection.hs  | 32 ++++++++++++++++++++++++++++++++
 src/HushGP/GP/Variation.hs  |  2 +-
 5 files changed, 66 insertions(+), 4 deletions(-)
 create mode 100644 src/HushGP/GP/Individual.hs
 create mode 100644 src/HushGP/GP/Selection.hs

diff --git a/src/HushGP/GP/Downsample.hs b/src/HushGP/GP/Downsample.hs
index 3844b16..b54742e 100644
--- a/src/HushGP/GP/Downsample.hs
+++ b/src/HushGP/GP/Downsample.hs
@@ -4,12 +4,12 @@ import System.Random.Shuffle
 import System.Random
 import Data.List
 import Data.Maybe
-import HushGP.Genome
 import HushGP.Utility
 import HushGP.GP.PushData
 import HushGP.GP.PushArgs
 import HushGP.Tools.Metrics
 import HushGP.Instructions.Utility
+import HushGP.GP.Individual
 
 -- |Sets the index of the passed training data.
 assignIndicesToData :: [PushData] -> [PushData]
diff --git a/src/HushGP/GP/Individual.hs b/src/HushGP/GP/Individual.hs
new file mode 100644
index 0000000..b31ca5e
--- /dev/null
+++ b/src/HushGP/GP/Individual.hs
@@ -0,0 +1,24 @@
+module HushGP.GP.Individual where
+
+import HushGP.State
+
+-- | The structure for an individual containing the genome, the totalFitness, and
+-- the individual fitness cases for lexicase.
+data Individual = Individual
+  { plushy :: [Gene],
+    totalFitness :: Maybe Double,
+    fitnessCases :: Maybe [Double]
+  }
+  deriving (Show, Eq)
+
+instance Ord Individual where
+  ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1
+
+-- | Extracts the fitnessCases from an Individual. Errors if the field is empty.
+extractFitnessCases :: Individual -> [Double]
+extractFitnessCases Individual {fitnessCases = Nothing} = error "Error: fitnessCases is empty!"
+extractFitnessCases Individual {fitnessCases = Just xs} = xs
+
+extractTotalFitness :: Individual -> Double
+extractTotalFitness Individual {totalFitness = Nothing} = error "Error: totalFitness is empty!"
+extractTotalFitness Individual {totalFitness = Just x} = x
diff --git a/src/HushGP/GP/PushArgs.hs b/src/HushGP/GP/PushArgs.hs
index 922176a..892c7ea 100644
--- a/src/HushGP/GP/PushArgs.hs
+++ b/src/HushGP/GP/PushArgs.hs
@@ -3,6 +3,7 @@ module HushGP.GP.PushArgs where
 import HushGP.State
 import HushGP.Instructions
 import HushGP.GP.PushData
+import HushGP.GP.Individual
 import Data.Map qualified as Map
 
 -- | The structure holding the arguments for the various aspects
@@ -96,7 +97,11 @@ data PushArgs = PushArgs
     epsilons :: Maybe [Double],
     -- | Used with the CaseMaxminAuto downsampling strategy. Tells downsampling to stop when
     -- the maximum minimum distance is too far away.
-    caseDelta :: Double
+    caseDelta :: Double,
+    -- | Used in lexicase selection. If initialCases is present will use those before randomly
+    -- selecting from the population for initial cases. Can raise a value into the IO monad using
+    -- `pure @IO`
+    initialCases :: Maybe [Int]
   }
 
 -- | The default values for which all runs of Hush derive
@@ -143,5 +148,6 @@ defaultPushArgs = PushArgs {
     umadRate = 0.1,
     variation = Map.fromList [("umad", 1.0)],
     epsilons = Nothing,
-    caseDelta = 0
+    caseDelta = 0,
+    initialCases = Nothing
   }
diff --git a/src/HushGP/GP/Selection.hs b/src/HushGP/GP/Selection.hs
new file mode 100644
index 0000000..21a89da
--- /dev/null
+++ b/src/HushGP/GP/Selection.hs
@@ -0,0 +1,32 @@
+module HushGP.GP.Selection where
+
+import Data.List
+import System.Random
+import System.Random.Shuffle
+import HushGP.GP.PushArgs
+import HushGP.GP.Individual
+
+-- | Tournament selection based off tournament size from PushArgs and a population.
+-- Takes the individual with the lowest total error in the tournament.
+tournamentSelection :: PushArgs -> [Individual] -> IO Individual
+tournamentSelection PushArgs{tournamentSize = tSize} pop = do
+  shuffledPop <- shuffle' pop (length pop) <$> initStdGen
+  let tournSet = take tSize shuffledPop
+  pure $ minimum tournSet
+
+-- |Selects an individual from the population using lexicase selection.
+-- Lexicase parent selection filters the population by considering one random training case at a time,
+-- eliminating any individuals with errors for the current case that are worse than the best error in the selection pool,
+-- until a single individual remains. This is the top level function.
+lexicaseSelection :: PushArgs -> [Individual] -> IO Individual
+lexicaseSelection PushArgs{initialCases = iCases} pop = do
+  startCases <- maybe (shuffle' [0..lehp] lehp <$> initStdGen) (pure @IO) iCases
+  undefined
+  where
+    lehp :: Int -- length of the extracted fitness cases of the head of the passed population.
+    lehp = length $ extractFitnessCases $
+      case uncons pop of
+        Just (x, _) -> x
+        _ -> error "Error: Population in lexicaseSelection cannot be empty!"
+
+-- lexicaseSelection' :: 
diff --git a/src/HushGP/GP/Variation.hs b/src/HushGP/GP/Variation.hs
index a3439e9..08f974b 100644
--- a/src/HushGP/GP/Variation.hs
+++ b/src/HushGP/GP/Variation.hs
@@ -1,7 +1,7 @@
 module HushGP.GP.Variation where
 
-import HushGP.Genome
 import HushGP.GP.PushArgs
+import HushGP.GP.Individual
 
 newIndividual :: PushArgs -> [Individual] -> Individual
 newIndividual = error "Implement this later"