TODO.md

@@ -43,4 +43,3 @@
   - [ ] Find a way to multi-thread this
 - [ ] Look at using `uniformShuffleList` over System.Random.Shuffle
 - [ ] Impelment selectionCases for lexicase and tournament selection.
-- [X] Make all randomness a float and not an int in Variation

src/HushGP/GP.hs

@@ -68,7 +68,7 @@ gpLoop'
               do
                 print $ "Successful generation: " <> show generation
                 print $ "Successful plushy: " <> show (plushy bestInd)
-                print $ "Successful program: " <> show (plushyToPush pushArgs (plushy bestInd))
+                print $ "Successful program: " <> show (plushyToPush $ plushy bestInd)
                 when (useSimplification epsilonPushArgs) $
                   do
                     let simplifiedPlushy = undefined -- TODO: simplification later

src/HushGP/GP/Individual.hs

@@ -15,11 +15,6 @@ data Individual = Individual
 instance Ord Individual where
   ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1
 
--- |Creates a new individual with all fields set to Nothing besides plushy which gets set to the
--- passed [Gene].
-postVariationInd :: [Gene] -> Individual
-postVariationInd newPlushy = Individual{plushy = newPlushy, totalFitness = Nothing, fitnessCases = Nothing, selectionCases = Nothing}
-
 -- | Extracts the fitnessCases from an Individual. Errors if the field is empty.
 -- Known as :errors in propeller.
 extractFitnessCases :: Individual -> [Double]

src/HushGP/GP/PushArgs.hs

@@ -12,7 +12,7 @@ data PushArgs = PushArgs
     -- | For alternation, std deviation for index when alternating.
     alignmentDeviation :: Double,
     -- | For alternation, probability of switching parents at each location. Should be a value in the range [1,100]
-    alternationRate :: Double,
+    alternationRate :: Int,
     -- | For bmx, rate genes are exchanged.
     bmxExchangeRate :: Float,
     -- | For bmx, max length of a gene.
@@ -29,8 +29,6 @@ data PushArgs = PushArgs
     ssxNotBmx :: Bool,
     -- | Ways to construct a phenotype from a plushy genome, so far only "specified" is implemented. Unused (for now).
     closes :: String,
-    -- | Whether or not to use best match crossover
-    useBMX :: Bool,
     -- | Custom report for each generation if provided.
     customReport :: Maybe (PushArgs -> IO ()),
     -- | If True, keeps running regardless of success.
@@ -67,8 +65,8 @@ data PushArgs = PushArgs
     parentSelectionAlgo :: String,
     -- |Size of the population in the evolutionary run.
     populationSize :: Int,
-    -- | For uniform replacement, rate of item replacement. A number in the bounds of [1,100].
-    replacementRate :: Double,
+    -- | For uniform replacement, rate of item replacement.
+    replacementRate :: Float,
     -- | Whether or not to auto simplify solutions.
     useSimplification :: Bool,
     -- | When auto simplifying, max amt items deleted in a single step.
@@ -89,11 +87,11 @@ data PushArgs = PushArgs
     trainingData :: [PushData],
     -- | Testing data for the gp, must be provided if there is any.
     testingData :: [PushData],
-    -- | Addition rate for UMAD (deletion rate derived from this). Should be an Int [0-100].
-    umadRate :: Double,
+    -- | Addition rate for UMAD (deletion rate derived from this).
+    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 :: [(String,Double)],
+    variation :: Map.Map String Float,
     -- | The epsilons calculated for epsilon lexicase selection. Only used for epsilon lexicase selection.
     epsilons :: Maybe [Double],
     -- | Used with the CaseMaxminAuto downsampling strategy. Tells downsampling to stop when
@@ -110,7 +108,7 @@ data PushArgs = PushArgs
 defaultPushArgs :: PushArgs
 defaultPushArgs = PushArgs {
     alignmentDeviation = 2.0,
-    alternationRate = 0.1,
+    alternationRate = 10,
     bmxExchangeRate = 0.5,
     bmxGeneLengthLimit = 10,
     bmxGapChangeProbability = 0.001,
@@ -118,7 +116,6 @@ defaultPushArgs = PushArgs {
     bmxMaxDistance = 1000000,
     bmxSameGeneCount = False,
     closes = "specified",
-    useBMX = False,
     customReport = Nothing,
     dontEnd = False,
     enableDownsampling = True,
@@ -148,7 +145,7 @@ defaultPushArgs = PushArgs {
     testingData = error "Must supply the testingData yourself",
     trainingData = error "Must supply the trainingData yourself",
     umadRate = 0.1,
-    variation = [("umad", 1.0)],
+    variation = Map.fromList [("umad", 1.0)],
     epsilons = Nothing,
     caseDelta = 0,
     initialCases = Nothing

src/HushGP/GP/Variation.hs

@@ -1,19 +1,16 @@
 module HushGP.GP.Variation where
 
-import Data.List
 import Control.Monad
 import HushGP.State
 import HushGP.GP.PushArgs
 import HushGP.GP.Individual
 import HushGP.Utility
-import HushGP.Genome
-import HushGP.GP.Selection
 
 -- |Performs a uniform crossover on two parents and returns the child.
 -- Padding is placed to left of the shorter genome.
 crossover :: [Gene] -> [Gene] -> IO [Gene]
 crossover plushyA plushyB = do
-  filter (CrossoverPadding /=) <$> zipWithM (\short long -> randZeroToOne >>= (\num -> if num < 0.5 then pure short else pure long)) shorterPadded longer
+  filter (CrossoverPadding /=) <$> zipWithM (\short long -> randOneToOneHundred >>= (\num -> if num < 50 then pure short else pure long)) shorterPadded longer
   where
     shorter :: [Gene]
     shorter = if length plushyA <= length plushyB then plushyA else plushyB
@@ -40,7 +37,7 @@ alternation pushArgs plushyA plushyB = do
 -- This returns the first [Gene] when the loop is complete.
 alternation' :: PushArgs -> Int -> Bool -> [Gene] -> Int -> [Gene] -> [Gene] -> IO [Gene]
 alternation' pushArgs@PushArgs{alternationRate = altRate, alignmentDeviation = alignDeviation} n usePlushyA !resultPlushy iterationBudget plushyA plushyB = do
-  randNum <- randZeroToOne
+  randNum <- randOneToOneHundred
   let nextAction
         | n >= length (if usePlushyA then plushyA else plushyB) || iterationBudget <= 0 = pure resultPlushy
         | randNum < altRate = do
@@ -53,7 +50,7 @@ alternation' pushArgs@PushArgs{alternationRate = altRate, alignmentDeviation = a
 -- Padding is placed to left of the shorter genome.
 tailAlignedCrossover :: [Gene] -> [Gene] -> IO [Gene]
 tailAlignedCrossover plushyA plushyB = do
-  filter (CrossoverPadding /=) <$> zipWithM (\short long -> randZeroToOne >>= (\num -> if num < 0.5 then pure short else pure long)) shorterPadded longer
+  filter (CrossoverPadding /=) <$> zipWithM (\short long -> randOneToOneHundred >>= (\num -> if num < 50 then pure short else pure long)) shorterPadded longer
   where
     shorter :: [Gene]
     shorter = if length plushyA <= length plushyB then plushyA else plushyB
@@ -67,90 +64,8 @@ tailAlignedCrossover plushyA plushyB = do
 -- |Takes the PushArgs for the evolutionary run and a singular plushy.
 -- Returns the added onto plushy. Returns the the passed plushy with
 -- new instructions possibly added before or after each existing instruction.
-uniformAddition :: PushArgs -> [Gene] -> IO [Gene]
-uniformAddition pushArgs plushy = uniformAddition' pushArgs plushy []
-
--- |Guts of uniform addition. Appends to the second [Gene] recursively until the first [Gene]
--- is empty. Ignores Gaps used for bmx if applicable.
-uniformAddition' :: PushArgs -> [Gene] -> [Gene] -> IO [Gene]
-uniformAddition' _ [] newPlushy = pure newPlushy
-uniformAddition' pushArgs@PushArgs{instructionList = iList, umadRate = uRate} (old:oldList) !newList = do
-  frontInstruction <- randomInstruction iList
-  backInstruction <- randomInstruction iList
-  frontZeroToOne <- randZeroToOne
-  backZeroToOne <- randZeroToOne
-  uniformAddition' pushArgs oldList (newList <> [frontInstruction | frontZeroToOne < uRate && not (isGap old)] <> [old] <> [backInstruction | backZeroToOne < uRate && not (isGap old)])
-
--- |Takes the PushArgs for the evolutionary run and a singular plushy.
--- Returns the replacement plushy. Returns the the passed plushy with
--- new instructions possibly replacing each existing instruction.
-uniformReplacement :: PushArgs -> [Gene] -> IO [Gene]
-uniformReplacement pushArgs plushy = uniformAddition' pushArgs plushy []
-
--- |Guts of uniform replacement. Appends to the second [Gene] recursively until the first [Gene]
--- is empty.
-uniformReplacement' :: PushArgs -> [Gene] -> [Gene] -> IO [Gene]
-uniformReplacement' _ [] newPlushy = pure newPlushy
-uniformReplacement' pushArgs@PushArgs{instructionList = iList, replacementRate = rRate} (old:oldList) !newList = do
-  randInstruction <- randomInstruction iList
-  randDecimal <- randZeroToOne
-  uniformReplacement' pushArgs oldList (newList <> if randDecimal < rRate then [randInstruction] else [old])
-
--- |Takes the PushArgs for the evolutionary run and a singular plushy.
--- Returns the deleted plushy. Returns the passed plushy with
--- instructions that were there possibly deleted. Ignores Gaps used for bmx if applicable.
-uniformDeletion :: PushArgs -> [Gene] -> IO [Gene]
-uniformDeletion PushArgs{umadRate = uRate} plushy =
-  if uRate == 0
-  then pure plushy
-  else uniformDeletion' plushy [] adjustedRate
-  where
-    adjustedRate :: Double
-    adjustedRate = 1 / (1 + (1 / uRate))
-
--- |Internals for uniform deletion. The Double is the adjusted rate
--- calculated based on the original umad rate.
-uniformDeletion' :: [Gene] -> [Gene] -> Double -> IO [Gene]
-uniformDeletion' [] newPlushy _ = pure newPlushy
-uniformDeletion' (old:oldList) !newList adjustRate = do
-  randDecimal <- randZeroToOne
-  uniformDeletion' oldList (newList <> [old | randDecimal < adjustRate]) adjustRate
-
--- |Creates a new individual based on the probabilities of the desired
--- crossover methods.
-newIndividual :: PushArgs -> [Individual] -> IO Individual
-newIndividual pushArgs@PushArgs{variation = var} population = do
-  randOp <- randomOperation var 0.0
-  case randOp of
-    "reproduction" -> selectParent pushArgs population
-    "crossover" -> do
-      parent0 <- selectParent pushArgs population
-      parent1 <- selectParent pushArgs population
-      childPlushy <- crossover (plushy parent0) (plushy parent1)
-      pure $ postVariationInd childPlushy
-    "tailAlignedCrossover" -> do
-      parent0 <- selectParent pushArgs population
-      parent1 <- selectParent pushArgs population
-      childPlushy <- tailAlignedCrossover (plushy parent0) (plushy parent1)
-      pure $ postVariationInd childPlushy
-    "umad" -> do
-      parent <- selectParent pushArgs population
-      child <- uniformAddition pushArgs (plushy parent) >>= uniformDeletion pushArgs
-      pure $ postVariationInd child
-    "rumad" -> undefined -- TODO: this tomorrow!
-    _ -> error ("Error: No match for selection operation: " <> randOp)
-  where
-  randDecimal :: IO Double
-  randDecimal = randZeroToOne
-  randomOperation :: [(String, Double)] -> Double -> IO String
-  randomOperation operations acc = do
-    randD <- randDecimal
-    let nextAction
-          | null operations = pure "reproduction"
-          | acc + tempProb >= randD = pure tempOp
-          | otherwise = randomOperation (drop 1 operations) (tempProb + acc)
-    nextAction
-    where
-    (tempOp,tempProb) = case uncons operations of Just (x, _) -> x; _ -> error "Error: operations cannot be empty!"
-      
+uniformAddition :: PushArgs -> [Gene] -> [Gene]
+uniformAddition pushArgs plushy = undefined
 
+newIndividual :: PushArgs -> [Individual] -> Individual
+newIndividual = error "Implement this later"

src/HushGP/Genome.hs

@@ -43,11 +43,6 @@ isOpenerList [instruction] =
     _ -> False
 isOpenerList _ = False
 
--- | Checks if the Gene is a Gap, returns True if it is.
-isGap :: Gene -> Bool
-isGap Gap = True
-isGap _ = False
-
 -- | Gets the amount of blocks to open from a list of genes with a single element.
 getOpenAmountList :: [Gene] -> Int
 getOpenAmountList [instruction] =
@@ -57,14 +52,8 @@ getOpenAmountList [instruction] =
 getOpenAmountList _ = 0
 
 -- | Converts a plushy genome into a push genome.
-plushyToPush :: PushArgs -> [Gene] -> [Gene]
-plushyToPush PushArgs {useBMX = bmx} plushy = plushyToPush' modPlushy []
-  where
-    modPlushy :: [Gene]
-    modPlushy =
-      if bmx
-        then concatMap (filter (not . isGap) . (\x -> if isOpenerList x then x <> [Open (getOpenAmountList x)] else x)) (chunksOf 1 plushy)
-        else concatMap (\x -> if isOpenerList x then x <> [Open (getOpenAmountList x)] else x) (chunksOf 1 plushy)
+plushyToPush :: [Gene] -> [Gene]
+plushyToPush plushy = plushyToPush' (concatMap (\x -> if isOpenerList x then x <> [Open (getOpenAmountList x)] else x) (chunksOf 1 plushy)) []
 
 -- | Internal function used to convert a plushy genome with opens in it into its push phenotype.
 plushyToPush' :: [Gene] -> [Gene] -> [Gene]

src/HushGP/Problems/IntegerRegression.hs

@@ -62,16 +62,16 @@ errorHead xs =
     _ -> 100000000 -- Make this a variable for later?
 
 -- | Loads a plushy and a list of genes into the input state.
-loadState :: PushArgs -> [Gene] -> [Gene] -> State
-loadState pushArgs plushy vals = 
-  (loadProgram (plushyToPush pushArgs plushy) emptyState){_input = Map.fromList (zip [0..] vals)}
+loadState :: [Gene] -> [Gene] -> State
+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 -> [PushData] -> [Gene] -> [Double]
-intErrorFunction pushArgs pushData plushy =
+intErrorFunction _args pushData plushy =
   map abs $
     zipWith (-)
-      (map ((fromIntegral @Integer @Double . (errorHead . _int) . interpretExec) . loadState pushArgs plushy)
+      (map ((fromIntegral @Integer @Double . (errorHead . _int) . interpretExec) . loadState plushy)
       (extractField inputData pushData)) (map (fromIntegral @Integer @Double . extractGeneInt) (extractField outputData pushData))
 
 intPushArgs :: PushArgs
@@ -87,8 +87,8 @@ intPushArgs = defaultPushArgs
     stepLimit = 200,
     parentSelectionAlgo = "lexicase",
     tournamentSize = 5,
-    umadRate = 0.6,
-    variation = [("umad", 1.0), ("crossover", 0.0)],
+    umadRate = 0.1,
+    variation = Map.fromList [("umad", 1.0), ("crossover", 0.0)],
     elitism = False,
     enableDownsampling = False,
     downsampleRate = 0.5

src/HushGP/Utility.hs

@@ -41,10 +41,6 @@ gaussianNoiseFactor = do
   randDecimal1 <- fst . uniformR (0.0 :: Double, 1.0 :: Double) <$> initStdGen
   pure (sqrt ((-2.0) * log randDecimal0) * cos (2.0 * pi * randDecimal1))
 
--- | A random Int between 1 and 100 inclusive.
+-- | A random number between 1 and 100.
 randOneToOneHundred :: IO Int
 randOneToOneHundred = fst . uniformR (1 :: Int, 100 :: Int) <$> initStdGen
-
--- | A random Double between 0.1 and 1.0 inclusive.
-randZeroToOne :: IO Double
-randZeroToOne = fst . uniformR (0.1 :: Double, 1.0 :: Double) <$> initStdGen