From 72c339e8b010be8dd81c27e7d6cc5740cc3c26f9 Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Thu, 6 Mar 2025 00:14:03 -0600 Subject: [PATCH] simplification added --- src/HushGP/GP.hs | 31 +++++++++++++----------- src/HushGP/GP/Simplification.hs | 13 +++++++++- src/HushGP/Problems/IntegerRegression.hs | 27 +++++++++++++++++++-- 3 files changed, 54 insertions(+), 17 deletions(-) diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index 979c489..78c3576 100644 --- a/src/HushGP/GP.hs +++ b/src/HushGP/GP.hs @@ -9,6 +9,8 @@ import HushGP.GP.Individual import HushGP.GP.PushArgs import HushGP.GP.PushData import HushGP.GP.Variation +import HushGP.GP.Selection +import HushGP.GP.Simplification import HushGP.Genome import System.Random import System.Random.Shuffle @@ -46,7 +48,7 @@ gpLoop pushArgs@(PushArgs {trainingData = tData}) = do -- the training data (possibly downsampled). gpLoop' :: PushArgs -> Int -> Int -> [Individual] -> [PushData] -> IO () gpLoop' - pushArgs@(PushArgs {enableDownsampling = enableDS, solutionErrorThreshold = seThresh, downsampleParentsGens = dsParentGens, downsampleParentRate = dsParentRate, trainingData = tData, elitism = isElite, populationSize = popSize}) + pushArgs@(PushArgs {enableDownsampling = enableDS, solutionErrorThreshold = seThresh, downsampleParentsGens = dsParentGens, downsampleParentRate = dsParentRate, trainingData = trData, elitism = isElite, populationSize = popSize, useSimplification = useSimp, errorFunction = errorFunc, maxGenerations = maxGens, testingData = teData}) generation evaluations population @@ -60,23 +62,24 @@ gpLoop' else pure [] 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!") + && ( (case totalFitness (updateIndividual (errorFunc 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)) = + || (not enableDS && ((case totalFitness bestInd of (Just x) -> x; _ -> error "error: Best non-downsample individual has no fitness!") <= seThresh)) = do print $ "Successful generation: " <> show generation print $ "Successful plushy: " <> show (plushy bestInd) print $ "Successful program: " <> show (plushyToPush pushArgs (plushy bestInd)) - when (useSimplification epsilonPushArgs) $ + print $ "Total test error: " <> show (errorFunc epsilonPushArgs teData (plushy bestInd)) + when useSimp $ 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 indexedTrainingData))) = + simplifiedPlushy <- autoSimplifyPlushy pushArgs (plushy bestInd) + print $ "Simplified plushy: " <> show simplifiedPlushy + print $ "Simplified program: " <> show (plushyToPush pushArgs simplifiedPlushy) + print $ "Total simplified test error: " <> show (errorFunc epsilonPushArgs teData simplifiedPlushy) + | (not enableDS && (generation >= maxGens)) + || (enableDS && (evaluations >= (maxGens * length population * length indexedTrainingData))) = print $ "Best individual: " <> show (plushy bestInd) | otherwise = do newPop <- if isElite then replicateM (popSize - 1) (newIndividual epsilonPushArgs evaledPop) else replicateM popSize (newIndividual epsilonPushArgs evaledPop) @@ -86,14 +89,14 @@ gpLoop' ( evaluations + (populationSize pushArgs * length (trainingData pushArgs)) + (if generation `mod` downsampleParentsGens pushArgs == 0 then length parentReps * (length indexedTrainingData - length (trainingData pushArgs)) else 0) - + (if bestIndPassesDownsample then length indexedTrainingData - length tData else 0) + + (if bestIndPassesDownsample then length indexedTrainingData - length trData else 0) ) ( if isElite then bestInd : newPop else newPop ) ( if enableDS && ((generation `mod` dsParentGens) == 0) - then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (solutionErrorThreshold pushArgs / fromIntegral @Int @Double (length indexedTrainingData)) + then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (seThresh / fromIntegral @Int @Double (length indexedTrainingData)) else indexedTrainingData ) nextAction @@ -105,10 +108,10 @@ gpLoop' then evaluatePopulation pushArgs indexedTrainingData population else [] evaledPop :: [Individual] - evaledPop = evaluatePopulation pushArgs tData population + evaledPop = evaluatePopulation pushArgs trData population bestInd :: Individual bestInd = case uncons evaledPop of Just (x, _) -> x; _ -> error "Error: Population is empty!" bestIndPassesDownsample :: Bool bestIndPassesDownsample = enableDS && (extractTotalFitness bestInd <= seThresh) epsilonPushArgs :: PushArgs - epsilonPushArgs = pushArgs {epsilons = Nothing} -- TODO: And this + epsilonPushArgs = pushArgs {epsilons = Just $ epsilonList evaledPop} diff --git a/src/HushGP/GP/Simplification.hs b/src/HushGP/GP/Simplification.hs index 9dc1b2d..960a03e 100644 --- a/src/HushGP/GP/Simplification.hs +++ b/src/HushGP/GP/Simplification.hs @@ -7,6 +7,8 @@ import Data.List import HushGP.State import HushGP.GP.PushArgs +import Debug.Trace + -- | Takes a list of Genes (a plushy), chunks it up into sizes of 1 (type is [[Gene]]). -- and a list of indices for replacement (gets sorted before replacement). deleteAtMultiple :: [Int] -> [Gene] -> [Gene] @@ -37,9 +39,18 @@ autoSimplifyPlushy pushArgs@PushArgs{simplificationVerbose = simpVerbose, errorF autoSimplifyPlushy' :: PushArgs -> [Double] -> Int -> [Gene] -> IO [Gene] autoSimplifyPlushy' pushArgs@PushArgs{simplificationVerbose = simpVerbose, simplificationSteps = simpSteps, simplificationMaxAmt = simpK, errorFunction = eFunc, trainingData = tData} initialErrors step plushy | step < simpSteps = do - newPlushy <- deleteRandomAmt simpK plushy + randAmt <- fst . uniformR (1 :: Int, simpK) <$> initStdGen + newPlushy <- deleteRandomAmt randAmt plushy let newPlushyErrors = eFunc pushArgs tData newPlushy let isBetter = newPlushyErrors <= initialErrors + print "-----------------------------------------" + print $ "k: " <> show randAmt + print $ "step: " <> show step + print $ "newPlushy: " <> show newPlushy + print $ "plushy: " <> show plushy + print $ "isBetter: " <> show isBetter + print $ "initialErrors: " <> show initialErrors + print $ "newErrors: " <> show newPlushyErrors autoSimplifyPlushy' pushArgs initialErrors (succ step) (if isBetter then newPlushy else plushy) | otherwise = do when simpVerbose (print ("simplification end plushy length: " <> show (length plushy))) diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs index b34cdde..bcd06b6 100644 --- a/src/HushGP/Problems/IntegerRegression.hs +++ b/src/HushGP/Problems/IntegerRegression.hs @@ -19,10 +19,30 @@ testPlushy = [ -- GeneFloat 3.2 ] +intSolutionPlushy :: [Gene] +intSolutionPlushy = + [ PlaceInput 0 + , PlaceInput 0 + , PlaceInput 0 + , StateFunc (instructionIntMul, "instructionIntMul") + , StateFunc (instructionIntMul, "instructionIntMul") + -- , GeneInt 2 + -- , PlaceInput 0 + , GeneBool True -- A useless gene + -- , StateFunc (instructionIntMul, "instructionIntMul") + -- , GeneInt 6 + -- , StateFunc (instructionIntAdd, "instructionIntAdd") + -- , StateFunc (instructionIntAdd, "instructionIntAdd") + -- , GeneInt 5 -- Also a useless gene + , GeneFloat 4.3 + , GeneString "hello" + ] + -- | The target function for this run. The function the gp -- is trying to evolve. targetFunction :: Integer -> Integer -targetFunction x = (x * x * x) + (2 * x) +-- targetFunction x = (x * x * x) + (2 * x) + 6 +targetFunction x = x * x * x -- | The training data for the model. intTrainData :: [PushData] @@ -91,7 +111,10 @@ intPushArgs = defaultPushArgs variation = [("umad", 1.0), ("crossover", 0.0)], elitism = False, enableDownsampling = False, - downsampleRate = 0.5 + downsampleRate = 0.5, + simplificationVerbose = True, + simplificationMaxAmt = 4, + simplificationSteps = 200 } main :: IO ()