finish up adding selection methods

HushGP.cabal

@@ -80,7 +80,7 @@ library
 
     -- Other library packages from which modules are imported.
     build-depends:
-        base, containers, lens, split, QuickCheck, regex-tdfa, template-haskell, random, parallel, random-shuffle
+        base, containers, lens, split, QuickCheck, regex-tdfa, template-haskell, random, parallel, random-shuffle, dsp
 
     -- Directories containing source files.
     hs-source-dirs:   src

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 HushGP.GP.Individual
 import Data.Map qualified as Map
 
 -- | The structure holding the arguments for the various aspects
@@ -62,7 +61,7 @@ data PushArgs = PushArgs
     maxInitialPlushySize :: Int,
     -- | Maximum amount of generations allowed in an evolutionary run.
     maxGenerations :: Int,
-    -- | Type of parent selection to use. Think "lexicase" and "tournament" for now.
+    -- | Type of parent selection to use. Options are: "tournament","lexicase","epsilonLexicase".
     parentSelectionAlgo :: String,
     -- |Size of the population in the evolutionary run.
     populationSize :: Int,

src/HushGP/GP/Selection.hs

@@ -1,6 +1,8 @@
 module HushGP.GP.Selection where
 
+import Numeric.Statistics.Median (medianFast)
 import Data.List
+import Data.Maybe
 import System.Random
 import System.Random.Shuffle
 import HushGP.GP.PushArgs
@@ -31,11 +33,73 @@ lexicaseSelection PushArgs{initialCases = iCases} pop = do
         Just (x, _) -> x
         _ -> error "Error: Population in lexicaseSelection cannot be empty!"
 
+-- |The internals of lexicaseSelection selection. Loops for each of the survivors each lexicase loop.
 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' ()
+  else lexicaseSelection'
+    (filter (\ind -> (extractFitnessCases ind !! case uncons cases of Just (x, _) -> x; _ -> error "Error: cases list is empty!") == minErrorForCase) survivors)
+    (drop 1 cases)
+    initialCases
   where
     minErrorForCase :: Double
     minErrorForCase = minimum $ map ((\x -> x !! case uncons cases of Just (y, _) -> y; _ -> error "Error: cases is empty!") . extractFitnessCases) survivors
+
+-- |Calculates the median absolute deviation for a list of fractional numbers.
+medianAbsoluteDeviation :: forall a. (Fractional a, Ord a) => [a] -> a
+medianAbsoluteDeviation xs = medianFast $ map (\x -> abs (x - medianVal)) xs
+  where
+    medianVal :: a
+    medianVal = medianFast xs
+
+-- | Calculates the epsilon list of a given population. Used in epsilon lexicase selection.
+epsilonList :: [Individual] -> [Double]
+epsilonList pop = epsilonList' [] 0 errorList errorLength
+  where
+  errorList :: [[Double]]
+  errorList = map extractFitnessCases pop
+  errorLength :: Int
+  errorLength = length $ extractFitnessCases (case uncons pop of Just (x, _) -> x; _ -> error "Error: pop is empty in epsilonList!")
+
+-- | Internals for the epsilonList function.
+epsilonList' :: [Double] -> Int -> [[Double]] -> Int -> [Double]
+epsilonList' epsilons index errorList errorLength =
+  if index == errorLength
+  then epsilons
+  else epsilonList' (medianAbsoluteDeviation (map (!! index) errorList) : epsilons) (succ index) errorList errorLength
+
+-- |Selects an individual from the population using epsilon-lexicase selection.
+-- Epsilon lexicase selection follows the same process as lexicase selection except,
+-- for a test case, only individuals with an error outside of a predefined epsilon are filtered.
+epsilonLexicaseSelection :: PushArgs -> [Individual] -> IO Individual
+epsilonLexicaseSelection PushArgs{epsilons = eps} pop = do
+  startCases <- shuffle' [0..lehp] lehp <$> initStdGen
+  epsilonLexicaseSelection' (fromMaybe (error "Error: epsilons list is empty!") eps) pop startCases
+  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 epsilonLexicaseSelection cannot be empty!"
+
+-- |Internals for epsilon lexicase selection.
+epsilonLexicaseSelection' :: [Double] -> [Individual] -> [Int] -> IO Individual
+epsilonLexicaseSelection' eps survivors cases =
+  if null cases || null (drop 1 survivors)
+  then randElem survivors  
+  else epsilonLexicaseSelection' eps (filter (\x -> (abs (extractFitnessCases x !! headCases cases) - minErrorForCase) <= epsilon) survivors) (drop 1 cases)
+  where
+    minErrorForCase :: Double
+    minErrorForCase = minimum $ map ((\x -> x !! headCases cases) . extractFitnessCases) survivors
+    epsilon :: Double
+    epsilon = eps !! headCases cases
+
+-- |Select the selection method the user specified in the passed PushArgs.
+selectParent :: PushArgs -> [Individual] -> IO Individual
+selectParent pushArgs@PushArgs{parentSelectionAlgo = selAlgo} pop =
+  case selAlgo of
+    "tournament" -> tournamentSelection pushArgs pop
+    "lexicase" -> lexicaseSelection pushArgs pop
+    "epsilonLexicase" -> epsilonLexicaseSelection pushArgs pop
+    _ -> error "Error: selection strategy not found!"

src/HushGP/Utility.hs

@@ -1,8 +1,9 @@
 module HushGP.Utility where
 
+import Data.List
 import Control.Monad
-import HushGP.State
 import System.Random
+import HushGP.State
 
 -- | Generates a single random instruction from a list of instructions.
 randomInstruction :: [Gene] -> IO Gene
@@ -27,3 +28,6 @@ mapIndexed' count f (x : xs) = f count x : mapIndexed' (count + 1) f xs
 -- | Returns a random element from a passed list. No generator required.
 randElem :: [a] -> IO a
 randElem xs = (xs !!) . fst . uniformR (0, length xs - 1) <$> initStdGen
+
+headCases :: [Int] -> Int
+headCases xs = case uncons xs of Just (y, _) -> y; _ -> error "Error: cases is empty!"