selection and individual, remove cyclic dependencies for PushArgs

This commit is contained in:
Rowan Torbitzky-Lane 2025-03-01 23:21:43 -06:00
parent 5a410dd605
commit 1293e27b69
5 changed files with 66 additions and 4 deletions

View File

@ -4,12 +4,12 @@ import System.Random.Shuffle
import System.Random import System.Random
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import HushGP.Genome
import HushGP.Utility import HushGP.Utility
import HushGP.GP.PushData import HushGP.GP.PushData
import HushGP.GP.PushArgs import HushGP.GP.PushArgs
import HushGP.Tools.Metrics import HushGP.Tools.Metrics
import HushGP.Instructions.Utility import HushGP.Instructions.Utility
import HushGP.GP.Individual
-- |Sets the index of the passed training data. -- |Sets the index of the passed training data.
assignIndicesToData :: [PushData] -> [PushData] assignIndicesToData :: [PushData] -> [PushData]

View File

@ -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

View File

@ -3,6 +3,7 @@ module HushGP.GP.PushArgs where
import HushGP.State import HushGP.State
import HushGP.Instructions import HushGP.Instructions
import HushGP.GP.PushData import HushGP.GP.PushData
import HushGP.GP.Individual
import Data.Map qualified as Map import Data.Map qualified as Map
-- | The structure holding the arguments for the various aspects -- | The structure holding the arguments for the various aspects
@ -96,7 +97,11 @@ data PushArgs = PushArgs
epsilons :: Maybe [Double], epsilons :: Maybe [Double],
-- | Used with the CaseMaxminAuto downsampling strategy. Tells downsampling to stop when -- | Used with the CaseMaxminAuto downsampling strategy. Tells downsampling to stop when
-- the maximum minimum distance is too far away. -- 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 -- | The default values for which all runs of Hush derive
@ -143,5 +148,6 @@ defaultPushArgs = PushArgs {
umadRate = 0.1, umadRate = 0.1,
variation = Map.fromList [("umad", 1.0)], variation = Map.fromList [("umad", 1.0)],
epsilons = Nothing, epsilons = Nothing,
caseDelta = 0 caseDelta = 0,
initialCases = Nothing
} }

View File

@ -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' ::

View File

@ -1,7 +1,7 @@
module HushGP.GP.Variation where module HushGP.GP.Variation where
import HushGP.Genome
import HushGP.GP.PushArgs import HushGP.GP.PushArgs
import HushGP.GP.Individual
newIndividual :: PushArgs -> [Individual] -> Individual newIndividual :: PushArgs -> [Individual] -> Individual
newIndividual = error "Implement this later" newIndividual = error "Implement this later"