From b57a802f11868e76a22d0d90be6a365e8becba6c Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Fri, 21 Feb 2025 00:50:10 -0600 Subject: [PATCH] more gp loop/formatting --- src/HushGP/GP.hs | 65 +++++++++++++++++++++++++++++++------- src/HushGP/GP/PushArgs.hs | 11 ++++--- src/HushGP/Genome.hs | 58 ++++++++++++++++++---------------- src/HushGP/Instructions.hs | 26 ++++++++------- src/HushGP/State.hs | 4 +-- 5 files changed, 108 insertions(+), 56 deletions(-) diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index 90a4815..57215aa 100644 --- a/src/HushGP/GP.hs +++ b/src/HushGP/GP.hs @@ -1,11 +1,13 @@ -- | The main file containing information about the GP loop and various population transformation functions. module HushGP.GP where -import HushGP.Genome -import HushGP.GP.PushArgs -import Control.Parallel.Strategies import Control.Monad -import Data.List (sort) +import Control.Parallel.Strategies +import Data.List (sort, uncons) +import HushGP.GP.PushArgs +import HushGP.Genome +import HushGP.State + -- import Debug.Trace (trace, traceStack) -- | Using a PushArgs object, generates a population of the specified size with the @@ -17,21 +19,62 @@ generatePopulation pushArgs = do -- | Evaluates a population of plushies with the error function passed in via PushArgs and sorts them. -- TODO: Need to make this runnable in parallel too. -evaluatePopulation :: PushArgs -> [Individual] -> [Individual] -evaluatePopulation pushArgs population = sort $ zipWith updateIndividual (map (errorFunction pushArgs pushArgs (trainingData pushArgs) . plushy) population) population +evaluatePopulation :: PushArgs -> ([[Gene]], [Gene]) -> [Individual] -> [Individual] +evaluatePopulation pushArgs passedTrainingData population = sort $ zipWith updateIndividual (map (errorFunction pushArgs pushArgs passedTrainingData . plushy) population) population -- | A helper function used in evaluatePopulation. Takes a [Double] as the error scores and an individual. -- Updates the error fields in an individual, and returns it. updateIndividual :: [Double] -> Individual -> Individual -updateIndividual errors ind = ind{totalFitness = Just (sum errors), fitnessCases = Just errors} +updateIndividual errors ind = ind {totalFitness = Just (sum errors), fitnessCases = Just errors} -- | The start of the gp loop. TODO: Make this more accurate later. gpLoop :: PushArgs -> IO () gpLoop pushArgs = do unEvaledPopulation <- generatePopulation pushArgs - let evaledPop = evaluatePopulation pushArgs unEvaledPopulation - print evaledPop + -- let evaledPop = evaluatePopulation pushArgs unEvaledPopulation + -- print evaledPop + print "gamer" -- | The guts of the GP loop. Where the work gets done after the initialization happens --- in the main gpLoop function. --- gpLoop' +-- in the main gpLoop function. The first Int holds the generation count. The second Int +-- holds the evaluation count. The list of Individuals is the population. The last parameter is +-- the training data (possibly downsampled). +gpLoop' :: PushArgs -> Int -> Int -> [Individual] -> ([[Gene]], [Gene]) -> IO () +gpLoop' pushArgs generation evaluations population indexedTrainingData = do + print "Put information about each generation here." + when bestIndPassesDownsample $ print $ "Semi Success Generation: " <> show generation + let nextAction | (bestIndPassesDownsample && ((case totalFitness (updateIndividual (errorFunction epsilonPushArgs epsilonPushArgs indexedTrainingData (plushy bestInd)) bestInd) of (Just x) -> x; _ -> error "Error: Best downsample individual has no fitness!") <= solutionErrorThreshold epsilonPushArgs)) || (not (enableDownsampling epsilonPushArgs) && ((case totalFitness bestInd of (Just x) -> x; _ -> error "error: Best non-downsample individual has no fitness!") <= solutionErrorThreshold epsilonPushArgs)) = + do + print $ "Successful generation: " <> show generation + print $ "Successful plushy: " <> show (plushy bestInd) + print $ "Successful program: " <> show (plushyToPush $ plushy bestInd) + when (useSimplification epsilonPushArgs) $ + do + let simplifiedPlushy = undefined -- TODO: simplification later + print "Total test error simplified: " <> undefined -- Implement later + print $ "Simplified plushy: " <> undefined -- show simplifiedPlushy + print $ "Simplified program: " <> undefined -- show plushyToPush simplifiedPlushy + | (not (enableDownsampling epsilonPushArgs) && (generation >= maxGenerations epsilonPushArgs)) || (enableDownsampling epsilonPushArgs && (evaluations >= (maxGenerations epsilonPushArgs * length population * length (fst indexedTrainingData)))) = + print "Incomplete Run, saving the best so far." + | otherwise = gpLoop' pushArgs (succ generation) + (evaluations + (populationSize pushArgs * length (fst $ trainingData pushArgs)) + (if generation `mod` downsampleParentsGens pushArgs == 0 then length parentReps * (length (fst indexedTrainingData) - length (fst $ trainingData pushArgs)) else 0) + (if bestIndPassesDownsample then length (fst indexedTrainingData) - length (fst $ trainingData pushArgs) else 0)) + nextAction + where + -- \| This will have downsampling added to it later. + loopTrainData :: ([[Gene]], [Gene]) + loopTrainData = indexedTrainingData + -- \| This will have downsampling functionality added later. + parentReps :: [Individual] + parentReps = [] + -- \| This will have downsampling functionality added later. + repEvaluatedPop :: [Individual] + repEvaluatedPop = [] + evaledPop :: [Individual] + evaledPop = evaluatePopulation pushArgs indexedTrainingData population + bestInd :: Individual + bestInd = case uncons evaledPop of Just (x, _) -> x; _ -> error "Error: Population is empty!" + bestIndPassesDownsample :: Bool + bestIndPassesDownsample = False -- TODO: fix this later + epsilonPushArgs :: PushArgs + epsilonPushArgs = pushArgs {epsilons = Nothing} -- TODO: And this +gpLoop' _ _ _ _ _ = error "How did this happen?" diff --git a/src/HushGP/GP/PushArgs.hs b/src/HushGP/GP/PushArgs.hs index 3858e25..9f0eddb 100644 --- a/src/HushGP/GP/PushArgs.hs +++ b/src/HushGP/GP/PushArgs.hs @@ -77,7 +77,7 @@ data PushArgs = PushArgs -- | Whether to use mutli-threading. useMultiThreading :: Bool, -- | Max total error for solutions. - solutionErrorThreshold :: Int, + solutionErrorThreshold :: Double, -- | Limit of push interpreter steps in push program evaluation. stepLimit :: Int, -- | For tournament selection, amount of individuals in each tournament. @@ -90,7 +90,9 @@ data PushArgs = PushArgs umadRate :: Float, -- | Genetic operators and probabilities for their use, should sum to one -- Takes a Map of String -> Float where the string is the genetic operator - variation :: Map.Map String Float + variation :: Map.Map String Float, + -- | The epsilons calculated for epsilon lexicase selection. Only used for epsilon lexicase selection. + epsilons :: Maybe [Double] } -- | The default values for which all runs of Hush derive @@ -128,12 +130,13 @@ defaultPushArgs = PushArgs { simplificationSteps = 1000, simplificationVerbose = False, useMultiThreading = False, -- False for now, change to True later. - solutionErrorThreshold = 0, + solutionErrorThreshold = 0.0, ssxNotBmx = False, stepLimit = 1000, tournamentSize = 5, testingData = ([], []), trainingData = ([], []), umadRate = 0.1, - variation = Map.fromList [("umad", 1.0)] + variation = Map.fromList [("umad", 1.0)], + epsilons = Nothing } diff --git a/src/HushGP/Genome.hs b/src/HushGP/Genome.hs index 62a719f..5a8cdbe 100644 --- a/src/HushGP/Genome.hs +++ b/src/HushGP/Genome.hs @@ -3,20 +3,22 @@ module HushGP.Genome where import Data.List import Data.List.Split import Data.Map qualified as Map +import HushGP.GP.PushArgs import HushGP.Instructions.Opens import HushGP.State import HushGP.Utility -import HushGP.GP.PushArgs + -- import HushGP.Instructions -- import Debug.Trace -- | 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) +data Individual = Individual + { plushy :: [Gene], + totalFitness :: Maybe Double, + fitnessCases :: Maybe [Double] + } + deriving (Show, Eq) instance Ord Individual where ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1 @@ -70,29 +72,31 @@ plushyToPush plushy = plushyToPush' (concatMap (\x -> if isOpenerList x then x < -- | Internal function used to convert a plushy genome with opens in it into its push phenotype. plushyToPush' :: [Gene] -> [Gene] -> [Gene] plushyToPush' openPlushy push - | null openPlushy = if any isOpen push + | null openPlushy = + if any isOpen push then plushyToPush' [Close] push else push - | firstPlushy == Close = if any isOpen push - then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> [Block postOpen] else preOpen <> [Block postOpen] <> [decOpen (Open (numOpen (push !! openIndex)))]) - else plushyToPush' (drop 1 openPlushy) push + | firstPlushy == Close = + if any isOpen push + then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> [Block postOpen] else preOpen <> [Block postOpen] <> [decOpen (Open (numOpen (push !! openIndex)))]) + else plushyToPush' (drop 1 openPlushy) push | firstPlushy == Skip = - case uncons openPlushy of - Just (_, _ : xs) -> plushyToPush' xs push - _ -> plushyToPush' (drop 1 openPlushy) push + case uncons openPlushy of + Just (_, _ : xs) -> plushyToPush' xs push + _ -> plushyToPush' (drop 1 openPlushy) push | otherwise = plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy]) where - firstPlushy :: Gene - firstPlushy - = case uncons openPlushy of - Just (g, _) -> g - _ -> error "This shouldn't happen" - postOpen :: [Gene] - postOpen = reverse (takeWhile (not . isOpen) (reverse push)) - openIndex :: Int - openIndex = length push - length postOpen - 1 - numOpen :: Gene -> Int - numOpen (Open n) = n - numOpen _ = 0 - preOpen :: [Gene] - preOpen = take openIndex push + firstPlushy :: Gene + firstPlushy = + case uncons openPlushy of + Just (g, _) -> g + _ -> error "This shouldn't happen" + postOpen :: [Gene] + postOpen = reverse (takeWhile (not . isOpen) (reverse push)) + openIndex :: Int + openIndex = length push - length postOpen - 1 + numOpen :: Gene -> Int + numOpen (Open n) = n + numOpen _ = 0 + preOpen :: [Gene] + preOpen = take openIndex push diff --git a/src/HushGP/Instructions.hs b/src/HushGP/Instructions.hs index ab701c7..79bf7ac 100644 --- a/src/HushGP/Instructions.hs +++ b/src/HushGP/Instructions.hs @@ -40,15 +40,17 @@ noOpStateFuncBlock = StateFunc (instructionNoOpBlock, "instructionNoOpBlock") -- | All of the instructions declared in all the instruction submodules allInstructions :: [Gene] allInstructions = - noOpStateFunc : noOpStateFuncBlock : allIntInstructions - <> allFloatInstructions - <> allBoolInstructions - <> allCharInstructions - <> allCodeInstructions - <> allExecInstructions - <> allStringInstructions - <> allVectorIntInstructions - <> allVectorFloatInstructions - <> allVectorCharInstructions - <> allVectorStringInstructions - <> allVectorBoolInstructions + noOpStateFunc + : noOpStateFuncBlock + : allIntInstructions + <> allFloatInstructions + <> allBoolInstructions + <> allCharInstructions + <> allCodeInstructions + <> allExecInstructions + <> allStringInstructions + <> allVectorIntInstructions + <> allVectorFloatInstructions + <> allVectorCharInstructions + <> allVectorStringInstructions + <> allVectorBoolInstructions diff --git a/src/HushGP/State.hs b/src/HushGP/State.hs index 87a1d92..8dc96d1 100644 --- a/src/HushGP/State.hs +++ b/src/HushGP/State.hs @@ -21,8 +21,8 @@ data Gene | GeneVectorBool [Bool] | GeneVectorString [String] | GeneVectorChar [Char] - -- | State -> State is the function itself. String stores the name of the function. - | StateFunc (State -> State, String) + | -- | State -> State is the function itself. String stores the name of the function. + StateFunc (State -> State, String) | PlaceInput Int | Close | Open Int