From 3815130d09d9545b82164e92967e9018c3b5b2c4 Mon Sep 17 00:00:00 2001
From: Rowan Torbitzky-Lane <rowan.a.tl@protonmail.com>
Date: Sun, 2 Mar 2025 01:56:50 -0600
Subject: [PATCH] almost done with lexicase

---
 src/HushGP/GP/Individual.hs          |  3 ++-
 src/HushGP/GP/Selection.hs           | 13 +++++++++++--
 src/HushGP/PushTests/GP/Selection.hs |  6 +++---
 3 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/src/HushGP/GP/Individual.hs b/src/HushGP/GP/Individual.hs
index b31ca5e..500399b 100644
--- a/src/HushGP/GP/Individual.hs
+++ b/src/HushGP/GP/Individual.hs
@@ -7,7 +7,8 @@ import HushGP.State
 data Individual = Individual
   { plushy :: [Gene],
     totalFitness :: Maybe Double,
-    fitnessCases :: Maybe [Double]
+    fitnessCases :: Maybe [Double],
+    selectionCases :: Maybe [Int]
   }
   deriving (Show, Eq)
 
diff --git a/src/HushGP/GP/Selection.hs b/src/HushGP/GP/Selection.hs
index 21a89da..99fc5de 100644
--- a/src/HushGP/GP/Selection.hs
+++ b/src/HushGP/GP/Selection.hs
@@ -5,6 +5,7 @@ import System.Random
 import System.Random.Shuffle
 import HushGP.GP.PushArgs
 import HushGP.GP.Individual
+import HushGP.Utility
 
 -- | Tournament selection based off tournament size from PushArgs and a population.
 -- Takes the individual with the lowest total error in the tournament.
@@ -21,7 +22,8 @@ tournamentSelection PushArgs{tournamentSize = tSize} pop = do
 lexicaseSelection :: PushArgs -> [Individual] -> IO Individual
 lexicaseSelection PushArgs{initialCases = iCases} pop = do
   startCases <- maybe (shuffle' [0..lehp] lehp <$> initStdGen) (pure @IO) iCases
-  undefined
+  survivors <- mapM randElem (groupBy (\x y -> fitnessCases x == fitnessCases y) pop)
+  lexicaseSelection' survivors startCases startCases
   where
     lehp :: Int -- length of the extracted fitness cases of the head of the passed population.
     lehp = length $ extractFitnessCases $
@@ -29,4 +31,11 @@ lexicaseSelection PushArgs{initialCases = iCases} pop = do
         Just (x, _) -> x
         _ -> error "Error: Population in lexicaseSelection cannot be empty!"
 
--- lexicaseSelection' :: 
+lexicaseSelection' :: [Individual] -> [Int] -> [Int] -> IO Individual
+lexicaseSelection' survivors cases initialCases =
+  if null cases || null (drop 1 survivors)
+  then (\ind -> ind{selectionCases = Just initialCases}) <$> randElem survivors
+  else lexicaseSelection' ()
+  where
+    minErrorForCase :: Double
+    minErrorForCase = minimum $ map ((\x -> x !! case uncons cases of Just (y, _) -> y; _ -> error "Error: cases is empty!") . extractFitnessCases) survivors
diff --git a/src/HushGP/PushTests/GP/Selection.hs b/src/HushGP/PushTests/GP/Selection.hs
index ccb2932..3501f8e 100644
--- a/src/HushGP/PushTests/GP/Selection.hs
+++ b/src/HushGP/PushTests/GP/Selection.hs
@@ -16,7 +16,7 @@ survivors = mapM randElem tempFunc0
 -- | A list of individuals used for testing.
 testInds :: [Individual]
 testInds =
-  [ Individual{plushy = [Close], totalFitness = Just 1000, fitnessCases = Just [500,500]}
-  , Individual{plushy = [Close], totalFitness = Just 1000, fitnessCases = Just [400,600]}
-  , Individual{plushy = [Close], totalFitness = Just 900, fitnessCases = Just [500,400]}
+  [ Individual{plushy = [Close], totalFitness = Just 1000, fitnessCases = Just [500,500], selectionCases = Nothing}
+  , Individual{plushy = [Close], totalFitness = Just 1000, fitnessCases = Just [400,600], selectionCases = Nothing}
+  , Individual{plushy = [Close], totalFitness = Just 900, fitnessCases = Just [500,400], selectionCases = Nothing}
   ]