src/HushGP/GP.hs

@@ -9,7 +9,6 @@ import HushGP.Genome
 import HushGP.State
 import HushGP.GP.Variation
 import HushGP.GP.Downsample
-import HushGP.Utility
 
 -- import Debug.Trace (trace, traceStack)
 
@@ -22,7 +21,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], [Int]) -> [Individual] -> [Individual]
+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.
@@ -30,21 +29,19 @@ 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. Generates the population and then calls
--- gpLoop' with modifications to the variables if needed.
+-- | The start of the gp loop. TODO: Make this more accurate later.
 gpLoop :: PushArgs -> IO ()
 gpLoop pushArgs = do
   unEvaledPopulation <- generatePopulation pushArgs
-  let indexedTrainingData = makeIndexedTrainingData (trainingData pushArgs)
-  gpLoop' pushArgs 0 0 unEvaledPopulation indexedTrainingData
-  -- print "do this later"
-
+  -- let evaledPop = evaluatePopulation pushArgs unEvaledPopulation
+  -- print evaledPop
+  print "placeholder for now"
 
 -- | 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], [Int]) -> IO ()
+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
@@ -59,18 +56,17 @@ 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)))) =
-          print $ "Best individual: " <> show (plushy bestInd)
+        | (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 (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)
+            (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)
   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 = []
@@ -85,3 +81,4 @@ gpLoop' pushArgs generation evaluations population indexedTrainingData = do
     bestIndPassesDownsample = False -- TODO: fix this later
     epsilonPushArgs :: PushArgs
     epsilonPushArgs = pushArgs {epsilons = Nothing} -- TODO: And this
+--gpLoop' _ _ _ _ _ = error "How did this happen?"

src/HushGP/GP/Downsample.hs

@@ -3,7 +3,5 @@ module HushGP.GP.Downsample where
 import HushGP.State
 import HushGP.Genome
 
-updateCaseDistances :: [Individual] -> ([[Gene]], [Gene], [Int]) -> ([[Gene]], [Gene], [Int]) -> String -> Double -> ([[Gene]], [Gene], [Int])
+updateCaseDistances :: [Individual] -> ([[Gene]], [Gene]) -> ([[Gene]], [Gene]) -> String -> Double -> ([[Gene]], [Gene])
 updateCaseDistances evaledPop downsampleData trainingData informedDownsamplingType solutionThreshold = undefined
-
--- assignIndiciesToData :: 

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], [Int]) -> [Gene] -> [Double],
+    errorFunction :: PushArgs -> ([[Gene]], [Gene]) -> [Gene] -> [Double],
     -- | Type of informed downsampling. "solved", "elite", "soft".
     informedDownsamplingType :: String,
     -- | List of instructions to use in the evolutionary run.

src/HushGP/Instructions/Utility.hs

@@ -171,13 +171,7 @@ findContainer _ _ = Block []
 
 -- |Utility Function: A helper function for instructionCodeDiscrepancy. The full description is there.
 countDiscrepancy :: Gene -> Gene -> Integer
--- countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (toInteger (length xs) - toInteger (length ys))
--- countDiscrepancy (Block xs) (Block ys) = sum [if isBlock (fst tup) && isBlock (snd tup) then uncurry countDiscrepancy tup else if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (toInteger (length xs) - toInteger (length ys))
-countDiscrepancy (Block xs) (Block []) = codeRecursiveSize (Block xs)
-countDiscrepancy (Block []) (Block ys) = codeRecursiveSize (Block ys)
-countDiscrepancy (Block (x:xs)) (Block (y:ys)) = if x == y then 1 + countDiscrepancy (Block xs) (Block ys) else countDiscrepancy (Block xs) (Block ys)
-countDiscrepancy _ (Block ys) = 1 + codeRecursiveSize (Block ys)
-countDiscrepancy (Block xs) _ = 1 + codeRecursiveSize (Block xs)
+countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (toInteger (length xs) - toInteger (length ys))
 countDiscrepancy xgene ygene = if xgene == ygene then 1 else 0
 
 -- |Utility Function: Extracts the first gene from a block. Returns itself if not a block

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], [Int]) -> [Gene] -> [Double]
-intErrorFunction _args (inputData, outputData, _) plushy =
+intErrorFunction :: PushArgs -> ([[Gene]], [Gene]) -> [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,8 +76,7 @@ intPushArgs = defaultPushArgs
     tournamentSize = 5,
     umadRate = 0.1,
     variation = Map.fromList [("umad", 1.0), ("crossover", 0.0)],
-    elitism = False,
-    enableDownsampling = False
+    elitism = False
   }
 
 main :: IO ()

src/HushGP/Utility.hs

@@ -13,24 +13,3 @@ 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)])