convert loop to use PushData
This commit is contained in:
parent
76493bc362
commit
0c0d57dd8d
@ -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
|
||||
|
@ -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 ::
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user