From 090a402f0632ba3ae72707b5c1a6c41e1faa56cc Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Sat, 15 Feb 2025 23:46:40 -0600 Subject: [PATCH] finish int regression framework, time for the rest of pieces --- src/HushGP/GP.hs | 11 +++++ src/HushGP/GP/PushArgs.hs | 6 +-- src/HushGP/Genome.hs | 5 +- src/HushGP/Instructions/Utility.hs | 8 +++ src/HushGP/Problems/IntegerRegression.hs | 62 ++++++++++++++++++++---- 5 files changed, 77 insertions(+), 15 deletions(-) diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index d2be570..56c76d2 100644 --- a/src/HushGP/GP.hs +++ b/src/HushGP/GP.hs @@ -1,3 +1,14 @@ module HushGP.GP where +import HushGP.State +import HushGP.Genome +import HushGP.GP.PushArgs -- import Debug.Trace (trace, traceStack) + +-- generatePopulation :: PushArgs -> [Gene] -> IO [[Gene]] +-- generatePopulation pushArgs instructions = do + -- randomPop <- makeRandomPlushy pushArgs + -- replicate (populationSize pushArgs) (makeRandomPlushy pushArgs) + +gpLoop :: PushArgs -> IO () +gpLoop = undefined diff --git a/src/HushGP/GP/PushArgs.hs b/src/HushGP/GP/PushArgs.hs index a8b8536..f604ff3 100644 --- a/src/HushGP/GP/PushArgs.hs +++ b/src/HushGP/GP/PushArgs.hs @@ -49,7 +49,7 @@ data PushArgs = PushArgs -- Arg 2: ([[Gene]], [Gene]) is the input data. Input is the first index and output is the second index. -- Arg 3: [Gene] is the plushy representation of a program. -- Returns the error list for a given set of inputs of type [Double]. - errorFunction :: PushArgs -> [[Gene]] -> [Gene] -> [Double], + errorFunction :: PushArgs -> ([[Gene]], [Gene]) -> [Gene] -> [Double], -- | Type of informed downsampling. "solved", "elite", "soft". informedDownsamplingType :: String, -- | List of instructions to use in the evolutionary run. @@ -83,9 +83,9 @@ data PushArgs = PushArgs -- | For tournament selection, amount of individuals in each tournament. tournamentSize :: Int, -- | Training data for the gp, must be provided. - trainingData :: [[Gene]], + trainingData :: ([[Gene]], [Gene]), -- | Testing data for the gp, must be provided if there is any. - testingData :: [[Gene]], + testingData :: ([[Gene]], [Gene]), -- | Addition rate for UMAD (deletion rate derived from this). umadRate :: Float, -- | Genetic operators and probabilities for their use, should sum to one diff --git a/src/HushGP/Genome.hs b/src/HushGP/Genome.hs index 7618840..cb98df0 100644 --- a/src/HushGP/Genome.hs +++ b/src/HushGP/Genome.hs @@ -6,6 +6,7 @@ import Data.Map qualified as Map import HushGP.Instructions.Opens import HushGP.State import HushGP.Utility +import HushGP.GP.PushArgs -- import HushGP.Instructions -- import Debug.Trace @@ -31,8 +32,8 @@ import HushGP.Utility -- | Makes a random plushy from variables in a passed argMap and -- a passed list of instructions. -makeRandomPlushy :: Map.Map String String -> [Gene] -> IO [Gene] -makeRandomPlushy argMap = randomInstructions (read @Int (argMap Map.! "maxInitialPlushySize")) +makeRandomPlushy :: PushArgs -> [Gene] -> IO [Gene] +makeRandomPlushy pushArgs = randomInstructions (maxInitialPlushySize pushArgs) -- | A utility function to generate an amount based on an int rather than -- from an argmap. diff --git a/src/HushGP/Instructions/Utility.hs b/src/HushGP/Instructions/Utility.hs index bfbc8b6..1ab6f61 100644 --- a/src/HushGP/Instructions/Utility.hs +++ b/src/HushGP/Instructions/Utility.hs @@ -105,6 +105,14 @@ absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst notEmptyStack :: Lens' State [a] -> State -> Bool notEmptyStack accessor state = not . null $ view accessor state +-- |Utility Function: Extracts an int from a GeneInt. +-- How to make this polymorphic???????? A general function for +-- this would be nice. Wrapped in a maybe too? +extractGeneInt :: Gene -> Integer +extractGeneInt (GeneInt x) = x +extractGeneInt _ = error "todo this later??" + + -- bool utility -- |A template function to make bool comparisons concise. diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs index b85b7f0..028d182 100644 --- a/src/HushGP/Problems/IntegerRegression.hs +++ b/src/HushGP/Problems/IntegerRegression.hs @@ -1,12 +1,23 @@ module HushGP.Problems.IntegerRegression where +import Data.List.Split +import Data.List +import Data.Map qualified as Map import HushGP.State import HushGP.Instructions -import Data.List.Split import HushGP.GP.PushArgs import HushGP.Genome import HushGP.Push -import Data.Map qualified as Map +import HushGP.Instructions.Utility +import HushGP.GP + +testPlushy :: [Gene] +testPlushy = [ + PlaceInput 0, + GeneInt 0, + StateFunc (instructionIntAdd, "instructionIntAdd") + -- GeneFloat 3.2 + ] -- | The target function for this run. The function the gp -- is trying to evolve. @@ -21,7 +32,7 @@ trainData = (chunksOf 1 $ map GeneInt [-10..10], map (GeneInt . targetFunction) testData :: ([[Gene]], [Gene]) testData = (chunksOf 1 $ map GeneInt $ [-20..(-11)] <> [11..21], map (GeneInt . targetFunction) ([-20..(-11)] <> [11..21])) --- | The instructions used to +-- | The instructions used in the evolutionary run. runInstructions :: [Gene] runInstructions = [ @@ -32,10 +43,41 @@ runInstructions = ] <> allIntInstructions --- |The error function for a single set of inputs and outputs. -intErrorFunction :: PushArgs -> ([Gene], Gene) -> [Gene] -> [Double] -intErrorFunction args (inputData, outputData) plushy = - head $ _int $ interpretExec loadedState - where - loadedState :: State - loadedState = (loadProgram (plushyToPush plushy) emptyState){_input = Map.fromList (zip [0..] inputData)} +-- | Takes the head of the stack and returns it. If there is no head, returns an +-- error amount. +errorHead :: [Integer] -> Integer +errorHead xs = + case uncons xs of + Just (x, _) -> x + _ -> 100000000 -- Make this a variable for later? + +-- | Loads a plushy and a list of genes into the input state. +loadState :: [Gene] -> [Gene] -> State +loadState plushy vals = + (loadProgram (plushyToPush plushy) emptyState){_input = Map.fromList (zip [0..] vals)} + +-- | The error function for a single set of inputs and outputs. +intErrorFunction :: PushArgs -> ([[Gene]], [Gene]) -> [Gene] -> [Double] +intErrorFunction _args (inputData, outputData) plushy = + map abs $ zipWith (-) (map ((fromIntegral @Integer @Double . (errorHead . _int) . interpretExec) . loadState plushy) inputData) (map (fromIntegral @Integer @Double . extractGeneInt) outputData) + +intArgMap :: PushArgs +intArgMap = defaultPushArgs + { + instructionList = runInstructions, + errorFunction = intErrorFunction, + trainingData = trainData, + testingData = testData, + maxGenerations = 300, + populationSize = 1000, + maxInitialPlushySize = 100, + stepLimit = 200, + parentSelectionAlgo = "lexicase", + tournamentSize = 5, + umadRate = 0.1, + variation = Map.fromList [("umad", 1.0), ("crossover", 0.0)], + elitism = False + } + +main :: IO () +main = gpLoop intArgMap