convert loop to use PushData

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

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 :: 

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],
+  _inputData :: [Gene],
-  outputData :: Gene,
+  _outputData :: Gene,
-  downsampleIndex :: Maybe Int,
+  _downsampleIndex :: Maybe Int,
-  caseDistances :: Maybe [Double]
+  _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)

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],
+      _inputData = [GeneInt num],
-      outputData = (GeneInt . targetFunction) num,
+      _outputData = (GeneInt . targetFunction) num,
-      downsampleIndex = Nothing,
+      _downsampleIndex = Nothing,
-      caseDistances = 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],
+      _inputData = [GeneInt num],
-      outputData = (GeneInt . targetFunction) num,
+      _outputData = (GeneInt . targetFunction) num,
-      downsampleIndex = Nothing,
+      _downsampleIndex = Nothing,
-      caseDistances = Nothing})
+      _caseDistances = Nothing})
-    [-20..(-11)] <> [11..21]
+    ([-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