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…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user