finish int regression framework, time for the rest of pieces

This commit is contained in:
Rowan Torbitzky-Lane 2025-02-15 23:46:40 -06:00
parent b88a4944f9
commit 090a402f06
5 changed files with 77 additions and 15 deletions

View File

@ -1,3 +1,14 @@
module HushGP.GP where module HushGP.GP where
import HushGP.State
import HushGP.Genome
import HushGP.GP.PushArgs
-- import Debug.Trace (trace, traceStack) -- 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

View File

@ -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 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. -- Arg 3: [Gene] is the plushy representation of a program.
-- Returns the error list for a given set of inputs of type [Double]. -- 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". -- | Type of informed downsampling. "solved", "elite", "soft".
informedDownsamplingType :: String, informedDownsamplingType :: String,
-- | List of instructions to use in the evolutionary run. -- | 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. -- | For tournament selection, amount of individuals in each tournament.
tournamentSize :: Int, tournamentSize :: Int,
-- | Training data for the gp, must be provided. -- | 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. -- | 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). -- | Addition rate for UMAD (deletion rate derived from this).
umadRate :: Float, umadRate :: Float,
-- | Genetic operators and probabilities for their use, should sum to one -- | Genetic operators and probabilities for their use, should sum to one

View File

@ -6,6 +6,7 @@ import Data.Map qualified as Map
import HushGP.Instructions.Opens import HushGP.Instructions.Opens
import HushGP.State import HushGP.State
import HushGP.Utility import HushGP.Utility
import HushGP.GP.PushArgs
-- import HushGP.Instructions -- import HushGP.Instructions
-- import Debug.Trace -- import Debug.Trace
@ -31,8 +32,8 @@ import HushGP.Utility
-- | Makes a random plushy from variables in a passed argMap and -- | Makes a random plushy from variables in a passed argMap and
-- a passed list of instructions. -- a passed list of instructions.
makeRandomPlushy :: Map.Map String String -> [Gene] -> IO [Gene] makeRandomPlushy :: PushArgs -> [Gene] -> IO [Gene]
makeRandomPlushy argMap = randomInstructions (read @Int (argMap Map.! "maxInitialPlushySize")) makeRandomPlushy pushArgs = randomInstructions (maxInitialPlushySize pushArgs)
-- | A utility function to generate an amount based on an int rather than -- | A utility function to generate an amount based on an int rather than
-- from an argmap. -- from an argmap.

View File

@ -105,6 +105,14 @@ absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst
notEmptyStack :: Lens' State [a] -> State -> Bool notEmptyStack :: Lens' State [a] -> State -> Bool
notEmptyStack accessor state = not . null $ view accessor state 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 -- bool utility
-- |A template function to make bool comparisons concise. -- |A template function to make bool comparisons concise.

View File

@ -1,12 +1,23 @@
module HushGP.Problems.IntegerRegression where module HushGP.Problems.IntegerRegression where
import Data.List.Split
import Data.List
import Data.Map qualified as Map
import HushGP.State import HushGP.State
import HushGP.Instructions import HushGP.Instructions
import Data.List.Split
import HushGP.GP.PushArgs import HushGP.GP.PushArgs
import HushGP.Genome import HushGP.Genome
import HushGP.Push 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 -- | The target function for this run. The function the gp
-- is trying to evolve. -- is trying to evolve.
@ -21,7 +32,7 @@ trainData = (chunksOf 1 $ map GeneInt [-10..10], map (GeneInt . targetFunction)
testData :: ([[Gene]], [Gene]) testData :: ([[Gene]], [Gene])
testData = (chunksOf 1 $ map GeneInt $ [-20..(-11)] <> [11..21], map (GeneInt . targetFunction) ([-20..(-11)] <> [11..21])) 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 :: [Gene]
runInstructions = runInstructions =
[ [
@ -32,10 +43,41 @@ runInstructions =
] ]
<> allIntInstructions <> allIntInstructions
-- |The error function for a single set of inputs and outputs. -- | Takes the head of the stack and returns it. If there is no head, returns an
intErrorFunction :: PushArgs -> ([Gene], Gene) -> [Gene] -> [Double] -- error amount.
intErrorFunction args (inputData, outputData) plushy = errorHead :: [Integer] -> Integer
head $ _int $ interpretExec loadedState errorHead xs =
where case uncons xs of
loadedState :: State Just (x, _) -> x
loadedState = (loadProgram (plushyToPush plushy) emptyState){_input = Map.fromList (zip [0..] inputData)} _ -> 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