convert loop to use PushData

This commit is contained in:
Rowan Torbitzky-Lane 2025-02-26 14:26:32 -06:00
parent 76493bc362
commit 0c0d57dd8d
4 changed files with 33 additions and 22 deletions

View File

@ -6,7 +6,6 @@ import Control.Parallel.Strategies
import Data.List (sort, uncons)
import HushGP.GP.PushArgs
import HushGP.Genome
import HushGP.State
import HushGP.GP.Variation
import HushGP.GP.Downsample
import HushGP.GP.PushData
@ -45,7 +44,7 @@ gpLoop pushArgs = do
-- 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], [Int]) -> IO ()
gpLoop' :: PushArgs -> Int -> Int -> [Individual] -> [PushData] -> IO ()
gpLoop' pushArgs generation evaluations population indexedTrainingData = do
print "Put information about each generation here."
when bestIndPassesDownsample $ print $ "Semi Success Generation: " <> show generation
@ -60,15 +59,15 @@ gpLoop' pushArgs generation evaluations population indexedTrainingData = do
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 (tfst indexedTrainingData)))) =
| (not (enableDownsampling epsilonPushArgs) && (generation >= maxGenerations epsilonPushArgs)) || (enableDownsampling epsilonPushArgs && (evaluations >= (maxGenerations epsilonPushArgs * length population * length indexedTrainingData))) =
print $ "Best individual: " <> show (plushy bestInd)
| otherwise = gpLoop' pushArgs (succ generation)
(evaluations + (populationSize pushArgs * length (fst $ trainingData pushArgs)) + (if generation `mod` downsampleParentsGens pushArgs == 0 then length parentReps * (length (tfst indexedTrainingData) - length (fst $ trainingData pushArgs)) else 0) + (if bestIndPassesDownsample then length (tfst indexedTrainingData) - length (fst $ trainingData pushArgs) else 0))
(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 (trainingData pushArgs) else 0))
(if elitism pushArgs
then bestInd : replicate (populationSize epsilonPushArgs - 1) (newIndividual epsilonPushArgs evaledPop)
else replicate (populationSize epsilonPushArgs) (newIndividual epsilonPushArgs evaledPop))
(if enableDownsampling pushArgs && ((generation `mod` downsampleParentsGens pushArgs) == 0)
then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (solutionErrorThreshold pushArgs / fromIntegral @Int @Double (length $ tfst indexedTrainingData))
then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (solutionErrorThreshold pushArgs / fromIntegral @Int @Double (length indexedTrainingData))
else indexedTrainingData)
nextAction
where

View File

@ -2,8 +2,9 @@ module HushGP.GP.Downsample where
import HushGP.State
import HushGP.Genome
import HushGP.GP.PushData
updateCaseDistances :: [Individual] -> ([[Gene]], [Gene], [Int]) -> ([[Gene]], [Gene], [Int]) -> String -> Double -> ([[Gene]], [Gene], [Int])
updateCaseDistances :: [Individual] -> [PushData] -> [PushData] -> String -> Double -> [PushData]
updateCaseDistances evaledPop downsampleData trainingData informedDownsamplingType solutionThreshold = undefined
-- assignIndiciesToData ::

View File

@ -1,14 +1,19 @@
{-# LANGUAGE TemplateHaskell #-}
module HushGP.GP.PushData where
import HushGP.State
import Control.Lens
data PushData = PushData {
inputData :: [Gene],
outputData :: Gene,
downsampleIndex :: Maybe Int,
caseDistances :: Maybe [Double]
_inputData :: [Gene],
_outputData :: Gene,
_downsampleIndex :: Maybe Int,
_caseDistances :: Maybe [Double]
}
-- |Utility function: Sets the index of the passed training data.
makeIndexedTrainingData :: [PushData] -> [PushData]
makeIndexedTrainingData oldData = zipWith (\dat idx -> dat{downsampleIndex = Just idx}) oldData [0..]
makeIndexedTrainingData oldData = zipWith (\dat idx -> dat{_downsampleIndex = Just idx}) oldData [0..]
$(makeLenses ''PushData)

View File

@ -1,8 +1,8 @@
module HushGP.Problems.IntegerRegression where
import Data.List.Split
import Data.List
import Data.Map qualified as Map
import Control.Lens hiding (uncons)
import HushGP.State
import HushGP.Instructions
import HushGP.GP.PushArgs
@ -28,21 +28,21 @@ targetFunction x = (x * x * x) + (2 * x)
-- | The training data for the model.
trainData :: [PushData]
trainData = map (\num -> PushData {
inputData = [GeneInt num],
outputData = (GeneInt . targetFunction) num,
downsampleIndex = Nothing,
caseDistances = Nothing})
_inputData = [GeneInt num],
_outputData = (GeneInt . targetFunction) num,
_downsampleIndex = Nothing,
_caseDistances = Nothing})
[-10..10]
-- | The testing data for the model.
testData :: [PushData]
-- testData = (chunksOf 1 $ map GeneInt $ [-20..(-11)] <> [11..21], map (GeneInt . targetFunction) ([-20..(-11)] <> [11..21]))
testData = map (\num -> PushData {
inputData = [GeneInt num],
outputData = (GeneInt . targetFunction) num,
downsampleIndex = Nothing,
caseDistances = Nothing})
[-20..(-11)] <> [11..21]
_inputData = [GeneInt num],
_outputData = (GeneInt . targetFunction) num,
_downsampleIndex = Nothing,
_caseDistances = Nothing})
([-20..(-11)] <> [11..21])
-- | The instructions used in the evolutionary run.
runInstructions :: [Gene]
@ -68,10 +68,16 @@ loadState :: [Gene] -> [Gene] -> State
loadState plushy vals =
(loadProgram (plushyToPush plushy) emptyState){_input = Map.fromList (zip [0..] vals)}
extractField :: Lens' PushData a -> [PushData] -> [a]
extractField accessor pushData = [ view accessor dataPoint | dataPoint <- pushData ]
-- | The error function for a single set of inputs and outputs.
intErrorFunction :: PushArgs -> [PushData] -> [Gene] -> [Double]
intErrorFunction _args pushData plushy =
map abs $ zipWith (-) (map ((fromIntegral @Integer @Double . (errorHead . _int) . interpretExec) . loadState plushy) pushData) (map (fromIntegral @Integer @Double . extractGeneInt) outputData)
map abs $
zipWith (-)
(map ((fromIntegral @Integer @Double . (errorHead . _int) . interpretExec) . loadState plushy)
(extractField inputData pushData)) (map (fromIntegral @Integer @Double . extractGeneInt) (extractField outputData pushData))
intPushArgs :: PushArgs
intPushArgs = defaultPushArgs