more gp loop/formatting

src/HushGP/GP.hs

@@ -1,11 +1,13 @@
 -- | The main file containing information about the GP loop and various population transformation functions.
 module HushGP.GP where
 
-import HushGP.Genome
-import HushGP.GP.PushArgs
-import Control.Parallel.Strategies
 import Control.Monad
-import Data.List (sort)
+import Control.Parallel.Strategies
+import Data.List (sort, uncons)
+import HushGP.GP.PushArgs
+import HushGP.Genome
+import HushGP.State
+
 -- import Debug.Trace (trace, traceStack)
 
 -- | Using a PushArgs object, generates a population of the specified size with the
@@ -17,21 +19,62 @@ 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 -> [Individual] -> [Individual]
-evaluatePopulation pushArgs population = sort $ zipWith updateIndividual (map (errorFunction pushArgs pushArgs (trainingData pushArgs) . plushy) population) population
+evaluatePopulation :: PushArgs -> ([[Gene]], [Gene]) -> [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.
 -- Updates the error fields in an individual, and returns it.
 updateIndividual :: [Double] -> Individual -> Individual
-updateIndividual errors ind = ind{totalFitness = Just (sum errors), fitnessCases = Just errors}
+updateIndividual errors ind = ind {totalFitness = Just (sum errors), fitnessCases = Just errors}
 
 -- | The start of the gp loop. TODO: Make this more accurate later.
 gpLoop :: PushArgs -> IO ()
 gpLoop pushArgs = do
   unEvaledPopulation <- generatePopulation pushArgs
-  let evaledPop = evaluatePopulation pushArgs unEvaledPopulation
-  print evaledPop
+  -- let evaledPop = evaluatePopulation pushArgs unEvaledPopulation
+  -- print evaledPop
+  print "gamer"
 
 -- | The guts of the GP loop. Where the work gets done after the initialization happens
--- in the main gpLoop function.
--- gpLoop' 
+-- 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 generation evaluations population indexedTrainingData = do
+  print "Put information about each generation here."
+  when bestIndPassesDownsample $ print $ "Semi Success Generation: " <> show generation
+  let nextAction | (bestIndPassesDownsample && ((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 (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 $ plushy bestInd)
+          when (useSimplification epsilonPushArgs) $
+            do
+              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 (fst indexedTrainingData)))) =
+          print "Incomplete Run, saving the best so far."
+        | 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))
+  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 = []
+    -- \| This will have downsampling functionality added later.
+    repEvaluatedPop :: [Individual]
+    repEvaluatedPop = []
+    evaledPop :: [Individual]
+    evaledPop = evaluatePopulation pushArgs indexedTrainingData population
+    bestInd :: Individual
+    bestInd = case uncons evaledPop of Just (x, _) -> x; _ -> error "Error: Population is empty!"
+    bestIndPassesDownsample :: Bool
+    bestIndPassesDownsample = False -- TODO: fix this later
+    epsilonPushArgs :: PushArgs
+    epsilonPushArgs = pushArgs {epsilons = Nothing} -- TODO: And this
+gpLoop' _ _ _ _ _ = error "How did this happen?"

src/HushGP/GP/PushArgs.hs

@@ -77,7 +77,7 @@ data PushArgs = PushArgs
     -- | Whether to use mutli-threading.
     useMultiThreading :: Bool,
     -- | Max total error for solutions.
-    solutionErrorThreshold :: Int,
+    solutionErrorThreshold :: Double,
     -- | Limit of push interpreter steps in push program evaluation.
     stepLimit :: Int,
     -- | For tournament selection, amount of individuals in each tournament.
@@ -90,7 +90,9 @@ data PushArgs = PushArgs
     umadRate :: Float,
     -- | Genetic operators and probabilities for their use, should sum to one
     -- Takes a Map of String -> Float where the string is the genetic operator
-    variation :: Map.Map String Float
+    variation :: Map.Map String Float,
+    -- | The epsilons calculated for epsilon lexicase selection. Only used for epsilon lexicase selection.
+    epsilons :: Maybe [Double]
   }
 
 -- | The default values for which all runs of Hush derive
@@ -128,12 +130,13 @@ defaultPushArgs = PushArgs {
     simplificationSteps = 1000,
     simplificationVerbose = False,
     useMultiThreading = False, -- False for now, change to True later.
-    solutionErrorThreshold = 0,
+    solutionErrorThreshold = 0.0,
     ssxNotBmx = False,
     stepLimit = 1000,
     tournamentSize = 5,
     testingData = ([], []),
     trainingData = ([], []),
     umadRate = 0.1,
-    variation = Map.fromList [("umad", 1.0)]
+    variation = Map.fromList [("umad", 1.0)],
+    epsilons = Nothing
   }

src/HushGP/Genome.hs

@@ -3,20 +3,22 @@ module HushGP.Genome where
 import Data.List
 import Data.List.Split
 import Data.Map qualified as Map
+import HushGP.GP.PushArgs
 import HushGP.Instructions.Opens
 import HushGP.State
 import HushGP.Utility
-import HushGP.GP.PushArgs
+
 -- import HushGP.Instructions
 -- import Debug.Trace
 
 -- | The structure for an individual containing the genome, the totalFitness, and
 -- the individual fitness cases for lexicase.
-data Individual = Individual {
-  plushy :: [Gene],
-  totalFitness :: Maybe Double,
-  fitnessCases :: Maybe [Double]
-} deriving (Show, Eq)
+data Individual = Individual
+  { plushy :: [Gene],
+    totalFitness :: Maybe Double,
+    fitnessCases :: Maybe [Double]
+  }
+  deriving (Show, Eq)
 
 instance Ord Individual where
   ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1
@@ -70,29 +72,31 @@ plushyToPush plushy = plushyToPush' (concatMap (\x -> if isOpenerList x then x <
 -- | Internal function used to convert a plushy genome with opens in it into its push phenotype.
 plushyToPush' :: [Gene] -> [Gene] -> [Gene]
 plushyToPush' openPlushy push
-  | null openPlushy = if any isOpen push
+  | null openPlushy =
+      if any isOpen push
         then plushyToPush' [Close] push
         else push
-  | firstPlushy == Close = if any isOpen push
-            then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> [Block postOpen] else preOpen <> [Block postOpen] <> [decOpen (Open (numOpen (push !! openIndex)))])
-            else plushyToPush' (drop 1 openPlushy) push
+  | firstPlushy == Close =
+      if any isOpen push
+        then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> [Block postOpen] else preOpen <> [Block postOpen] <> [decOpen (Open (numOpen (push !! openIndex)))])
+        else plushyToPush' (drop 1 openPlushy) push
   | firstPlushy == Skip =
-    case uncons openPlushy of
-      Just (_, _ : xs) -> plushyToPush' xs push
-      _ -> plushyToPush' (drop 1 openPlushy) push
+      case uncons openPlushy of
+        Just (_, _ : xs) -> plushyToPush' xs push
+        _ -> plushyToPush' (drop 1 openPlushy) push
   | otherwise = plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy])
   where
-      firstPlushy :: Gene
-      firstPlushy
-        = case uncons openPlushy of
-            Just (g, _) -> g
-            _ -> error "This shouldn't happen"
-      postOpen :: [Gene]
-      postOpen = reverse (takeWhile (not . isOpen) (reverse push))
-      openIndex :: Int
-      openIndex = length push - length postOpen - 1
-      numOpen :: Gene -> Int
-      numOpen (Open n) = n
-      numOpen _ = 0
-      preOpen :: [Gene]
-      preOpen = take openIndex push
+    firstPlushy :: Gene
+    firstPlushy =
+      case uncons openPlushy of
+        Just (g, _) -> g
+        _ -> error "This shouldn't happen"
+    postOpen :: [Gene]
+    postOpen = reverse (takeWhile (not . isOpen) (reverse push))
+    openIndex :: Int
+    openIndex = length push - length postOpen - 1
+    numOpen :: Gene -> Int
+    numOpen (Open n) = n
+    numOpen _ = 0
+    preOpen :: [Gene]
+    preOpen = take openIndex push

src/HushGP/Instructions.hs

@@ -40,15 +40,17 @@ noOpStateFuncBlock = StateFunc (instructionNoOpBlock, "instructionNoOpBlock")
 -- | All of the instructions declared in all the instruction submodules
 allInstructions :: [Gene]
 allInstructions =
-  noOpStateFunc : noOpStateFuncBlock : allIntInstructions
-    <> allFloatInstructions
-    <> allBoolInstructions
-    <> allCharInstructions
-    <> allCodeInstructions
-    <> allExecInstructions
-    <> allStringInstructions
-    <> allVectorIntInstructions
-    <> allVectorFloatInstructions
-    <> allVectorCharInstructions
-    <> allVectorStringInstructions
-    <> allVectorBoolInstructions
+  noOpStateFunc
+    : noOpStateFuncBlock
+    : allIntInstructions
+      <> allFloatInstructions
+      <> allBoolInstructions
+      <> allCharInstructions
+      <> allCodeInstructions
+      <> allExecInstructions
+      <> allStringInstructions
+      <> allVectorIntInstructions
+      <> allVectorFloatInstructions
+      <> allVectorCharInstructions
+      <> allVectorStringInstructions
+      <> allVectorBoolInstructions

src/HushGP/State.hs

@@ -21,8 +21,8 @@ data Gene
   | GeneVectorBool [Bool]
   | GeneVectorString [String]
   | GeneVectorChar [Char]
-    -- | State -> State is the function itself. String stores the name of the function.
-  | StateFunc (State -> State, String)
+  | -- | State -> State is the function itself. String stores the name of the function.
+    StateFunc (State -> State, String)
   | PlaceInput Int
   | Close
   | Open Int