Add 1-elitism as (unchangeable, for now) default
This commit is contained in:
parent
958bbf25b7
commit
ec84f84aa8
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user