src/HushGP/GP.hs

@@ -9,8 +9,6 @@ import HushGP.GP.Individual
 import HushGP.GP.PushArgs
 import HushGP.GP.PushData
 import HushGP.GP.Variation
-import HushGP.GP.Selection
-import HushGP.GP.Simplification
 import HushGP.Genome
 import System.Random
 import System.Random.Shuffle
@@ -48,7 +46,7 @@ gpLoop pushArgs@(PushArgs {trainingData = tData}) = do
 -- the training data (possibly downsampled).
 gpLoop' :: PushArgs -> Int -> Int -> [Individual] -> [PushData] -> IO ()
 gpLoop'
-  pushArgs@(PushArgs {enableDownsampling = enableDS, solutionErrorThreshold = seThresh, downsampleParentsGens = dsParentGens, downsampleParentRate = dsParentRate, trainingData = trData, elitism = isElite, populationSize = popSize, useSimplification = useSimp, errorFunction = errorFunc, maxGenerations = maxGens, testingData = teData})
+  pushArgs@(PushArgs {enableDownsampling = enableDS, solutionErrorThreshold = seThresh, downsampleParentsGens = dsParentGens, downsampleParentRate = dsParentRate, trainingData = tData, elitism = isElite, populationSize = popSize})
   generation
   evaluations
   population
@@ -62,24 +60,23 @@ gpLoop'
         else pure []
     let nextAction
           | ( bestIndPassesDownsample
-                && ( (case totalFitness (updateIndividual (errorFunc epsilonPushArgs indexedTrainingData (plushy bestInd)) bestInd) of (Just x) -> x; _ -> error "Error: Best downsample individual has no fitness!")
+                && ( (case totalFitness (updateIndividual (errorFunction epsilonPushArgs epsilonPushArgs indexedTrainingData (plushy bestInd)) bestInd) of (Just x) -> x; _ -> error "Error: Best downsample individual has no fitness!")
                        <= solutionErrorThreshold epsilonPushArgs
                    )
             )
-              || (not enableDS && ((case totalFitness bestInd of (Just x) -> x; _ -> error "error: Best non-downsample individual has no fitness!") <= seThresh)) =
+              || (not (enableDownsampling epsilonPushArgs) && ((case totalFitness bestInd of (Just x) -> x; _ -> error "error: Best non-downsample individual has no fitness!") <= solutionErrorThreshold epsilonPushArgs)) =
               do
                 print $ "Successful generation: " <> show generation
                 print $ "Successful plushy: " <> show (plushy bestInd)
                 print $ "Successful program: " <> show (plushyToPush pushArgs (plushy bestInd))
-                print $ "Total test error: " <> show (errorFunc epsilonPushArgs teData (plushy bestInd))
-                when useSimp $
+                when (useSimplification epsilonPushArgs) $
                   do
-                    simplifiedPlushy <- autoSimplifyPlushy pushArgs (plushy bestInd)
-                    print $ "Simplified plushy: " <> show simplifiedPlushy
-                    print $ "Simplified program: " <> show (plushyToPush pushArgs simplifiedPlushy)
-                    print $ "Total simplified test error: " <> show (errorFunc epsilonPushArgs teData simplifiedPlushy)
-          | (not enableDS && (generation >= maxGens))
-              || (enableDS && (evaluations >= (maxGens * length population * length indexedTrainingData))) =
+                    let simplifiedPlushy = undefined -- TODO: simplification later
+                    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 indexedTrainingData))) =
               print $ "Best individual: " <> show (plushy bestInd)
           | otherwise = do
               newPop <- if isElite then replicateM (popSize - 1) (newIndividual epsilonPushArgs evaledPop) else replicateM popSize (newIndividual epsilonPushArgs evaledPop)
@@ -89,14 +86,14 @@ gpLoop'
                 ( 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 trData else 0)
+                    + (if bestIndPassesDownsample then length indexedTrainingData - length tData else 0)
                 )
                 ( if isElite
                     then bestInd : newPop
                     else newPop
                 )
                 ( if enableDS && ((generation `mod` dsParentGens) == 0)
-                    then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (seThresh / fromIntegral @Int @Double (length indexedTrainingData))
+                    then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (solutionErrorThreshold pushArgs / fromIntegral @Int @Double (length indexedTrainingData))
                     else indexedTrainingData
                 )
     nextAction
@@ -108,10 +105,10 @@ gpLoop'
           then evaluatePopulation pushArgs indexedTrainingData population
           else []
       evaledPop :: [Individual]
-      evaledPop = evaluatePopulation pushArgs trData population
+      evaledPop = evaluatePopulation pushArgs tData population
       bestInd :: Individual
       bestInd = case uncons evaledPop of Just (x, _) -> x; _ -> error "Error: Population is empty!"
       bestIndPassesDownsample :: Bool
       bestIndPassesDownsample = enableDS && (extractTotalFitness bestInd <= seThresh)
       epsilonPushArgs :: PushArgs
-      epsilonPushArgs = pushArgs {epsilons = Just $ epsilonList evaledPop}
+      epsilonPushArgs = pushArgs {epsilons = Nothing} -- TODO: And this

src/HushGP/GP/Simplification.hs

@@ -1,33 +1,9 @@
 module HushGP.GP.Simplification where
 
-import System.Random.Shuffle
-import System.Random
 import Control.Monad
-import Data.List
 import HushGP.State
 import HushGP.GP.PushArgs
 
-import Debug.Trace
-
--- | Takes a list of Genes (a plushy), chunks it up into sizes of 1 (type is [[Gene]]).
--- and a list of indices for replacement (gets sorted before replacement).
-deleteAtMultiple :: [Int] -> [Gene] -> [Gene]
-deleteAtMultiple idxs = deleteAtMultiple' 0 (sort idxs)
-
--- | Internals of replaceAtMultiple. Takes a chunked plushy and replaces indices
--- that match the current index as specified at the idx.
-deleteAtMultiple' :: Int -> [Int] -> [Gene] -> [Gene]
-deleteAtMultiple' _ [] plushy = plushy
-deleteAtMultiple' _ _ [] = []
-deleteAtMultiple' curr (idx:idxs) (plushyPiece:plushy) =
-  if curr == idx then deleteAtMultiple' (curr + 1) idxs plushy else plushyPiece : deleteAtMultiple' (curr + 1) (idx:idxs) plushy
-
--- | Deletes a random amount of genes from the passed plushy based on ant int.
-deleteRandomAmt :: Int -> [Gene] -> IO [Gene]
-deleteRandomAmt k plushy = do
-  randomIndicies <- take k . shuffle' [0..(length plushy - 1)] (length plushy) <$> initStdGen
-  pure $ deleteAtMultiple randomIndicies plushy
-
 -- | Simplifies a Plushy by randomly deleting instructions and seeing how it impacts
 -- performance. Removes genes that have zero to negative performance impact.
 autoSimplifyPlushy :: PushArgs -> [Gene] -> IO [Gene]
@@ -35,23 +11,9 @@ autoSimplifyPlushy pushArgs@PushArgs{simplificationVerbose = simpVerbose, errorF
   when simpVerbose (print ("simplification start plushy length: " <> show (length plushy)))
   autoSimplifyPlushy' pushArgs (eFunc pushArgs tData plushy) 0 plushy
 
--- | Internals for autosimplification. Keeps track of the amount of steps.
 autoSimplifyPlushy' :: PushArgs -> [Double] -> Int -> [Gene] -> IO [Gene]
-autoSimplifyPlushy' pushArgs@PushArgs{simplificationVerbose = simpVerbose, simplificationSteps = simpSteps, simplificationMaxAmt = simpK, errorFunction = eFunc, trainingData = tData} initialErrors step plushy
+autoSimplifyPlushy' pushArgs@PushArgs{simplificationSteps = simpSteps} initialErrors step plushy
   | step < simpSteps = do
-      randAmt <- fst . uniformR (1 :: Int, simpK) <$> initStdGen
-      newPlushy <- deleteRandomAmt randAmt plushy
-      let newPlushyErrors = eFunc pushArgs tData newPlushy
-      let isBetter = newPlushyErrors <= initialErrors
-      print "-----------------------------------------"
-      print $ "k: " <> show randAmt
-      print $ "step: " <> show step
-      print $ "newPlushy: " <> show newPlushy
-      print $ "plushy: " <> show plushy
-      print $ "isBetter: " <> show isBetter
-      print $ "initialErrors: " <> show initialErrors
-      print $ "newErrors: " <> show newPlushyErrors
-      autoSimplifyPlushy' pushArgs initialErrors (succ step) (if isBetter then newPlushy else plushy)
-  | otherwise = do
-      when simpVerbose (print ("simplification end plushy length: " <> show (length plushy)))
-      pure plushy
+      newPlushy <- undefined
+      undefined
+  | otherwise = undefined

src/HushGP/Problems/IntegerRegression.hs

@@ -19,30 +19,10 @@ testPlushy = [
     -- GeneFloat 3.2
   ]
 
-intSolutionPlushy :: [Gene]
-intSolutionPlushy =
-  [ PlaceInput 0
-  , PlaceInput 0
-  , PlaceInput 0
-  , StateFunc (instructionIntMul, "instructionIntMul")
-  , StateFunc (instructionIntMul, "instructionIntMul")
-  -- , GeneInt 2
-  -- , PlaceInput 0
-  , GeneBool True -- A useless gene
-  -- , StateFunc (instructionIntMul, "instructionIntMul")
-  -- , GeneInt 6
-  -- , StateFunc (instructionIntAdd, "instructionIntAdd")
-  -- , StateFunc (instructionIntAdd, "instructionIntAdd")
-  -- , GeneInt 5 -- Also a useless gene
-  , GeneFloat 4.3
-  , GeneString "hello"
-  ]
-
 -- | The target function for this run. The function the gp
 -- is trying to evolve.
 targetFunction :: Integer -> Integer
--- targetFunction x = (x * x * x) + (2 * x) + 6
-targetFunction x = x * x * x
+targetFunction x = (x * x * x) + (2 * x)
 
 -- | The training data for the model.
 intTrainData :: [PushData]
@@ -111,10 +91,7 @@ intPushArgs = defaultPushArgs
     variation = [("umad", 1.0), ("crossover", 0.0)],
     elitism = False,
     enableDownsampling = False,
-    downsampleRate = 0.5,
-    simplificationVerbose = True,
-    simplificationMaxAmt = 4,
-    simplificationSteps = 200
+    downsampleRate = 0.5
   }
 
 main :: IO ()