Add 1-elitism as (unchangeable, for now) default

This commit is contained in:
David Pätzel 2019-10-18 13:43:18 +02:00
parent 958bbf25b7
commit ec84f84aa8
2 changed files with 5 additions and 3 deletions

View File

@ -174,11 +174,14 @@ step
-> Population i -> Population i
-> m (Population i) -> m (Population i)
step nParents nX pop = do step nParents nX pop = do
iBests <- bests 1 pop
is <- proportionate nParents pop is <- proportionate nParents pop
i :| is' <- children nX is i :| is' <- children nX is
iWorsts <- worst nParents pop iWorsts <- worst nParents pop
let popClean = foldr L.delete (NE.toList . unPop $ pop) iWorsts let popClean = foldr L.delete (NE.toList . unPop $ pop) $ iBests <> iWorsts
return . Pop $ i :| is' <> popClean -- TODO why does this not work? (we should use it!)
-- Pop <$> (shuffle' . NE.nub $ i :| is' <> popClean <> iBests)
return . Pop . NE.nub $ i :| is' <> popClean <> iBests
{-| {-|
Runs the GA, using in each iteration Runs the GA, using in each iteration

View File

@ -20,7 +20,6 @@ main = do
res <- bests 5 pop' res <- bests 5 pop'
sequence_ $ format <$> res sequence_ $ format <$> res
where where
format :: (Individual i, MonadIO m, Pretty i) => i -> m ()
format s = do format s = do
f <- liftIO $ fitness s f <- liftIO $ fitness s
putErrText $ show f <> "\n" <> pretty s putErrText $ show f <> "\n" <> pretty s