add new files

HushGP.cabal

@@ -60,11 +60,14 @@ library
                     , HushGP.PushTests.IntTests
                     , HushGP.PushTests.GenericTests
                     , HushGP.PushTests.UtilTests
+                    , HushGP.PushTests.GP.Selection
                     , HushGP.GP
                     , HushGP.GP.PushArgs
                     , HushGP.GP.Variation
                     , HushGP.GP.Downsample
                     , HushGP.GP.PushData
+                    , HushGP.GP.Selection
+                    , HushGP.GP.Individual
                     , HushGP.Problems.IntegerRegression
                     , HushGP.Tools.Metrics
 

TODO.md

@@ -6,6 +6,7 @@
 - [X] Implement all functions as seen in propeller
 - [X] Implement all functions as seen in the specification
 - [ ] Implement Linear Algebra functions as specified in the previous papers
+  - [ ] These are in a separate branch, just need merging now
 - [X] Add a function to sort a vector forward and backwards
 - [X] Disambiguate isEmpty and stackIsEmpty
 - [X] Rename Logical to Bool
@@ -18,6 +19,7 @@
 - [X] Move utility functions to their own file
 - [ ] Make add/sub/mult/div/mod instructions generic
 - [ ] Use template haskell to (mostly) generate functions from generic ones (Split files based on the arity of their functions)
+- [ ] Add more special functions like sqrt, pow
 
 ## PushGP TODO
 - [X] Implement a Plushy genome translator
@@ -31,10 +33,11 @@
 - [ ] Need to make genomes serializable (Check pysh json files)
 - [ ] Add Memory
 - [ ] Add history stack(s), like a call stack
-- [ ] Implement interpreter options (could probably just place this into a map)
+- [ ] Implement interpreter options (PushArgs would work well)
   - Should probably place this in a separate file
-- [ ] Implement different forms of downsampling
+- [X] Implement different forms of downsampling
 - [ ] Implement concurrent execution of creating random plushies and evaluating individuals
 - [X] Devise a good way to implement ERCs
 - [ ] Implement random simplification of genomes
   - [ ] Find a way to multi-thread this
+- [ ] Look at using `uniformShuffleList` over System.Random.Shuffle

src/HushGP/GP.hs

@@ -11,6 +11,7 @@ import HushGP.GP.PushArgs
 import HushGP.GP.PushData
 import HushGP.GP.Variation
 import HushGP.Genome
+import HushGP.GP.Individual
 
 -- import Debug.Trace (trace, traceStack)
 

src/HushGP/GP/Downsample.hs

@@ -4,12 +4,12 @@ import System.Random.Shuffle
 import System.Random
 import Data.List
 import Data.Maybe
-import HushGP.Genome
 import HushGP.Utility
 import HushGP.GP.PushData
 import HushGP.GP.PushArgs
 import HushGP.Tools.Metrics
 import HushGP.Instructions.Utility
+import HushGP.GP.Individual
 
 -- |Sets the index of the passed training data.
 assignIndicesToData :: [PushData] -> [PushData]

src/HushGP/GP/Individual.hs

@@ -0,0 +1,24 @@
+module HushGP.GP.Individual where
+
+import HushGP.State
+
+-- | 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)
+
+instance Ord Individual where
+  ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1
+
+-- | Extracts the fitnessCases from an Individual. Errors if the field is empty.
+extractFitnessCases :: Individual -> [Double]
+extractFitnessCases Individual {fitnessCases = Nothing} = error "Error: fitnessCases is empty!"
+extractFitnessCases Individual {fitnessCases = Just xs} = xs
+
+extractTotalFitness :: Individual -> Double
+extractTotalFitness Individual {totalFitness = Nothing} = error "Error: totalFitness is empty!"
+extractTotalFitness Individual {totalFitness = Just x} = x

src/HushGP/GP/PushArgs.hs

@@ -3,6 +3,7 @@ module HushGP.GP.PushArgs where
 import HushGP.State
 import HushGP.Instructions
 import HushGP.GP.PushData
+import HushGP.GP.Individual
 import Data.Map qualified as Map
 
 -- | The structure holding the arguments for the various aspects
@@ -96,7 +97,11 @@ data PushArgs = PushArgs
     epsilons :: Maybe [Double],
     -- | Used with the CaseMaxminAuto downsampling strategy. Tells downsampling to stop when
     -- the maximum minimum distance is too far away.
-    caseDelta :: Double
+    caseDelta :: Double,
+    -- | Used in lexicase selection. If initialCases is present will use those before randomly
+    -- selecting from the population for initial cases. Can raise a value into the IO monad using
+    -- `pure @IO`
+    initialCases :: Maybe [Int]
   }
 
 -- | The default values for which all runs of Hush derive
@@ -143,5 +148,6 @@ defaultPushArgs = PushArgs {
     umadRate = 0.1,
     variation = Map.fromList [("umad", 1.0)],
     epsilons = Nothing,
-    caseDelta = 0
+    caseDelta = 0,
+    initialCases = Nothing
   }

src/HushGP/GP/Selection.hs

@@ -0,0 +1,32 @@
+module HushGP.GP.Selection where
+
+import Data.List
+import System.Random
+import System.Random.Shuffle
+import HushGP.GP.PushArgs
+import HushGP.GP.Individual
+
+-- | Tournament selection based off tournament size from PushArgs and a population.
+-- Takes the individual with the lowest total error in the tournament.
+tournamentSelection :: PushArgs -> [Individual] -> IO Individual
+tournamentSelection PushArgs{tournamentSize = tSize} pop = do
+  shuffledPop <- shuffle' pop (length pop) <$> initStdGen
+  let tournSet = take tSize shuffledPop
+  pure $ minimum tournSet
+
+-- |Selects an individual from the population using lexicase selection.
+-- Lexicase parent selection filters the population by considering one random training case at a time,
+-- eliminating any individuals with errors for the current case that are worse than the best error in the selection pool,
+-- until a single individual remains. This is the top level function.
+lexicaseSelection :: PushArgs -> [Individual] -> IO Individual
+lexicaseSelection PushArgs{initialCases = iCases} pop = do
+  startCases <- maybe (shuffle' [0..lehp] lehp <$> initStdGen) (pure @IO) iCases
+  undefined
+  where
+    lehp :: Int -- length of the extracted fitness cases of the head of the passed population.
+    lehp = length $ extractFitnessCases $
+      case uncons pop of
+        Just (x, _) -> x
+        _ -> error "Error: Population in lexicaseSelection cannot be empty!"
+
+-- lexicaseSelection' :: 

src/HushGP/GP/Variation.hs

@@ -1,7 +1,7 @@
 module HushGP.GP.Variation where
 
-import HushGP.Genome
 import HushGP.GP.PushArgs
+import HushGP.GP.Individual
 
 newIndividual :: PushArgs -> [Individual] -> Individual
 newIndividual = error "Implement this later"

src/HushGP/Genome.hs

@@ -7,31 +7,11 @@ import HushGP.GP.PushArgs
 import HushGP.Instructions.Opens
 import HushGP.State
 import HushGP.Utility
+import HushGP.GP.Individual
 
 -- 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)
-
-instance Ord Individual where
-  ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1
-
--- | Extracts the fitnessCases from an Individual. Errors if the field is empty.
-extractFitnessCases :: Individual -> [Double]
-extractFitnessCases Individual {fitnessCases = Nothing} = error "Error: fitnessCases is empty!"
-extractFitnessCases Individual {fitnessCases = Just xs} = xs
-
-extractTotalFitness :: Individual -> Double
-extractTotalFitness Individual {totalFitness = Nothing} = error "Error: totalFitness is empty!"
-extractTotalFitness Individual {totalFitness = Just x} = x
-
 -- | Makes a random individual based on the variables in a passed PushArgs.
 makeRandomIndividual :: PushArgs -> IO Individual
 makeRandomIndividual pushArgs = do

src/HushGP/PushTests/GP/Selection.hs

@@ -0,0 +1,22 @@
+module HushGP.PushTests.GP.Selection where
+
+import Data.List
+import HushGP.GP.Individual
+import HushGP.State
+import HushGP.Utility
+
+-- | One of the steps in the lexicase selection process for selecting initial survivors.
+tempFunc0 :: [[Individual]]
+tempFunc0 = groupBy (\x y -> fitnessCases x == fitnessCases y) testInds
+
+-- \| Another step forward in the lexicase selection process.
+survivors :: IO [Individual]
+survivors = mapM randElem tempFunc0
+
+-- | A list of individuals used for testing.
+testInds :: [Individual]
+testInds =
+  [ Individual{plushy = [Close], totalFitness = Just 1000, fitnessCases = Just [500,500]}
+  , Individual{plushy = [Close], totalFitness = Just 1000, fitnessCases = Just [400,600]}
+  , Individual{plushy = [Close], totalFitness = Just 900, fitnessCases = Just [500,400]}
+  ]

src/HushGP/Utility.hs

@@ -23,3 +23,7 @@ mapIndexed = mapIndexed' 0
 mapIndexed' :: Int -> (Int -> a -> b) -> [a] -> [b]
 mapIndexed' _ _ [] = []
 mapIndexed' count f (x : xs) = f count x : mapIndexed' (count + 1) f xs
+
+-- | Returns a random element from a passed list. No generator required.
+randElem :: [a] -> IO a
+randElem xs = (xs !!) . fst . uniformR (0, length xs - 1) <$> initStdGen