less IO functions, pre-loop done, next is the main loop

This commit is contained in:
Rowan Torbitzky-Lane 2025-02-20 01:49:38 -06:00
parent 4fbd42f9ff
commit 0ebfb13e04
2 changed files with 32 additions and 13 deletions

View File

@ -1,23 +1,37 @@
-- | The main file containing information about the GP loop and various population transformation functions.
module HushGP.GP where module HushGP.GP where
import HushGP.State
import HushGP.Genome import HushGP.Genome
import HushGP.GP.PushArgs import HushGP.GP.PushArgs
import Control.Monad
import Control.Parallel.Strategies import Control.Parallel.Strategies
import Control.Monad
import Data.List (sort)
-- import Debug.Trace (trace, traceStack) -- import Debug.Trace (trace, traceStack)
-- | Using a PushArgs object, generates a population of the specified size with the -- | Using a PushArgs object, generates a population of the specified size with the
-- specified instructions in parallel. -- specified instructions in parallel.
generatePopulation :: PushArgs -> [Individual] generatePopulation :: PushArgs -> IO [Individual]
generatePopulation pushArgs = generatePopulation pushArgs = do
replicate (populationSize pushArgs) (makeRandomIndividual pushArgs) `using` rpar pop <- replicateM (populationSize pushArgs) (makeRandomIndividual pushArgs)
return (pop `using` evalList rpar) -- Does this work? Need to test this with the HEC viewing tool.
evaluatePopulation :: PushArgs -> [Individual] -> IO [Individual] -- | Evaluates a population of plushies with the error function passed in via PushArgs and sorts them.
evaluatePopulation pushArgs population = map (fmap (errorFunction pushArgs pushArgs (trainingData pushArgs)) . plushy) population -- 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
-- | 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}
-- | The start of the gp loop. TODO: Make this more accurate later. -- | The start of the gp loop. TODO: Make this more accurate later.
gpLoop :: PushArgs -> IO () gpLoop :: PushArgs -> IO ()
gpLoop pushArgs = do gpLoop pushArgs = do
let unEvaledPopulation = generatePopulation pushArgs unEvaledPopulation <- generatePopulation pushArgs
print "gamer" let evaledPop = evaluatePopulation pushArgs unEvaledPopulation
print evaledPop
-- | The guts of the GP loop. Where the work gets done after the initialization happens
-- in the main gpLoop function.
-- gpLoop'

View File

@ -13,14 +13,19 @@ import HushGP.GP.PushArgs
-- | The structure for an individual containing the genome, the totalFitness, and -- | The structure for an individual containing the genome, the totalFitness, and
-- the individual fitness cases for lexicase. -- the individual fitness cases for lexicase.
data Individual = Individual { data Individual = Individual {
plushy :: IO [Gene], plushy :: [Gene],
totalFitness :: Maybe Double, totalFitness :: Maybe Double,
fitnessCases :: Maybe [Double] fitnessCases :: Maybe [Double]
} } deriving (Show, Eq)
instance Ord Individual where
ind0 <= ind1 = totalFitness ind0 <= totalFitness ind1
-- | Makes a random individual based on the variables in a passed PushArgs. -- | Makes a random individual based on the variables in a passed PushArgs.
makeRandomIndividual :: PushArgs -> Individual makeRandomIndividual :: PushArgs -> IO Individual
makeRandomIndividual pushArgs = Individual {plushy = makeRandomPlushy pushArgs, totalFitness = Nothing, fitnessCases = Nothing} makeRandomIndividual pushArgs = do
randomPlushy <- makeRandomPlushy pushArgs
return Individual {plushy = randomPlushy, totalFitness = Nothing, fitnessCases = Nothing}
-- | Makes a random plushy from variables in a passed PushArgs. -- | Makes a random plushy from variables in a passed PushArgs.
makeRandomPlushy :: PushArgs -> IO [Gene] makeRandomPlushy :: PushArgs -> IO [Gene]