less IO functions, pre-loop done, next is the main loop
This commit is contained in:
parent
4fbd42f9ff
commit
0ebfb13e04
@ -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'
|
||||||
|
@ -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]
|
||||||
|
Loading…
x
Reference in New Issue
Block a user