diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index 9ae5118..6f3f6bf 100644 --- a/src/HushGP/GP.hs +++ b/src/HushGP/GP.hs @@ -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 diff --git a/src/HushGP/GP/Downsample.hs b/src/HushGP/GP/Downsample.hs index 65960ed..cac606d 100644 --- a/src/HushGP/GP/Downsample.hs +++ b/src/HushGP/GP/Downsample.hs @@ -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 :: diff --git a/src/HushGP/GP/PushData.hs b/src/HushGP/GP/PushData.hs index 5926273..6c7aa22 100644 --- a/src/HushGP/GP/PushData.hs +++ b/src/HushGP/GP/PushData.hs @@ -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) diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs index c80523c..520f6fa 100644 --- a/src/HushGP/Problems/IntegerRegression.hs +++ b/src/HushGP/Problems/IntegerRegression.hs @@ -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