diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index 5879ee0..7cdd5d8 100644 --- a/src/HushGP/GP.hs +++ b/src/HushGP/GP.hs @@ -9,6 +9,7 @@ import HushGP.Genome import HushGP.State import HushGP.GP.Variation import HushGP.GP.Downsample +import HushGP.Utility -- import Debug.Trace (trace, traceStack) @@ -21,7 +22,7 @@ generatePopulation pushArgs = do -- | Evaluates a population of plushies with the error function passed in via PushArgs and sorts them. -- TODO: Need to make this runnable in parallel too. -evaluatePopulation :: PushArgs -> ([[Gene]], [Gene]) -> [Individual] -> [Individual] +evaluatePopulation :: PushArgs -> ([[Gene]], [Gene], [Int]) -> [Individual] -> [Individual] evaluatePopulation pushArgs passedTrainingData population = sort $ zipWith updateIndividual (map (errorFunction pushArgs pushArgs passedTrainingData . plushy) population) population -- | A helper function used in evaluatePopulation. Takes a [Double] as the error scores and an individual. @@ -29,19 +30,21 @@ evaluatePopulation pushArgs passedTrainingData population = sort $ zipWith updat updateIndividual :: [Double] -> Individual -> Individual updateIndividual errors ind = ind {totalFitness = Just (sum errors), fitnessCases = Just errors} --- | The start of the gp loop. TODO: Make this more accurate later. +-- | The start of the gp loop. Generates the population and then calls +-- gpLoop' with modifications to the variables if needed. gpLoop :: PushArgs -> IO () gpLoop pushArgs = do unEvaledPopulation <- generatePopulation pushArgs - -- let evaledPop = evaluatePopulation pushArgs unEvaledPopulation - -- print evaledPop - print "placeholder for now" + let indexedTrainingData = makeIndexedTrainingData (trainingData pushArgs) + gpLoop' pushArgs 0 0 unEvaledPopulation indexedTrainingData + -- print "do this later" + -- | The guts of the GP loop. Where the work gets done after the initialization happens -- 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]) -> IO () +gpLoop' :: PushArgs -> Int -> Int -> [Individual] -> ([[Gene]], [Gene], [Int]) -> IO () gpLoop' pushArgs generation evaluations population indexedTrainingData = do print "Put information about each generation here." when bestIndPassesDownsample $ print $ "Semi Success Generation: " <> show generation @@ -56,17 +59,18 @@ 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 (fst indexedTrainingData)))) = - print "Incomplete Run, saving the best so far." + | (not (enableDownsampling epsilonPushArgs) && (generation >= maxGenerations epsilonPushArgs)) || (enableDownsampling epsilonPushArgs && (evaluations >= (maxGenerations epsilonPushArgs * length population * length (tfst 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 (fst indexedTrainingData) - length (fst $ trainingData pushArgs)) else 0) + (if bestIndPassesDownsample then length (fst indexedTrainingData) - length (fst $ 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 $ fst indexedTrainingData)) else indexedTrainingData) + (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)) + (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)) + else indexedTrainingData) nextAction where - -- \| This will have downsampling added to it later. - loopTrainData :: ([[Gene]], [Gene]) - loopTrainData = indexedTrainingData -- \| This will have downsampling functionality added later. parentReps :: [Individual] parentReps = [] diff --git a/src/HushGP/GP/Downsample.hs b/src/HushGP/GP/Downsample.hs index 06dc43e..65960ed 100644 --- a/src/HushGP/GP/Downsample.hs +++ b/src/HushGP/GP/Downsample.hs @@ -3,5 +3,7 @@ module HushGP.GP.Downsample where import HushGP.State import HushGP.Genome -updateCaseDistances :: [Individual] -> ([[Gene]], [Gene]) -> ([[Gene]], [Gene]) -> String -> Double -> ([[Gene]], [Gene]) +updateCaseDistances :: [Individual] -> ([[Gene]], [Gene], [Int]) -> ([[Gene]], [Gene], [Int]) -> String -> Double -> ([[Gene]], [Gene], [Int]) updateCaseDistances evaledPop downsampleData trainingData informedDownsamplingType solutionThreshold = undefined + +-- assignIndiciesToData :: diff --git a/src/HushGP/GP/PushArgs.hs b/src/HushGP/GP/PushArgs.hs index 9f0eddb..d108041 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]) -> [Gene] -> [Double], + errorFunction :: PushArgs -> ([[Gene]], [Gene], [Int]) -> [Gene] -> [Double], -- | Type of informed downsampling. "solved", "elite", "soft". informedDownsamplingType :: String, -- | List of instructions to use in the evolutionary run. diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs index 7abe7c2..2e88c13 100644 --- a/src/HushGP/Problems/IntegerRegression.hs +++ b/src/HushGP/Problems/IntegerRegression.hs @@ -57,8 +57,8 @@ 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 = +intErrorFunction :: PushArgs -> ([[Gene]], [Gene], [Int]) -> [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) intPushArgs :: PushArgs @@ -76,7 +76,8 @@ intPushArgs = defaultPushArgs tournamentSize = 5, umadRate = 0.1, variation = Map.fromList [("umad", 1.0), ("crossover", 0.0)], - elitism = False + elitism = False, + enableDownsampling = False } main :: IO () diff --git a/src/HushGP/Utility.hs b/src/HushGP/Utility.hs index 384710c..3157f45 100644 --- a/src/HushGP/Utility.hs +++ b/src/HushGP/Utility.hs @@ -13,3 +13,24 @@ randomInstruction instructions = do -- | Generates a list of random instructions from a list of instructions passed in. randomInstructions :: Int -> [Gene] -> IO [Gene] randomInstructions amt instructions = replicateM amt (randomInstruction instructions) + +-- |Utility function: Used for indexed training data. Takes the first element of triple. +tfst :: (a, b, c) -> a +tfst (x, _, _) = x + +-- |Utility function: Used for indexed training data. Takes the second element of triple. +tsnd :: (a, b, c) -> b +tsnd (_, x, _) = x + +-- |Utility function: Used for indexed training data. Takes the third element of triple. +-- The third element in the context of indexed training data represents the index assigned. +thrd :: (a, b, c) -> c +thrd (_, _, x) = x + +-- |Utility function: Converts a tuple to a triple with a passed value. +tupleToTriple :: (a, b) -> c -> (a, b, c) +tupleToTriple (x, y) z = (x, y, z) + +-- |Utility function: Converts the training data passed in to an indexed representation +makeIndexedTrainingData :: ([[Gene]], [Gene]) -> ([[Gene]], [Gene], [Int]) +makeIndexedTrainingData (inputs, outputs) = (inputs, outputs, [0..(length inputs)])