Revert Population to type alias (instead of newtype)
This commit is contained in:
		
							parent
							
								
									84c876f1b5
								
							
						
					
					
						commit
						0044b6cc18
					
				
							
								
								
									
										40
									
								
								src/GA.hs
									
									
									
									
									
								
							
							
						
						
									
										40
									
								
								src/GA.hs
									
									
									
									
									
								
							@ -13,6 +13,7 @@ import Control.Arrow hiding (first)
 | 
				
			|||||||
import qualified Data.List as L
 | 
					import qualified Data.List as L
 | 
				
			||||||
import Data.List.NonEmpty ((<|))
 | 
					import Data.List.NonEmpty ((<|))
 | 
				
			||||||
import qualified Data.List.NonEmpty as NE
 | 
					import qualified Data.List.NonEmpty as NE
 | 
				
			||||||
 | 
					import qualified Data.List.NonEmpty.Extra as NE (appendl, sortOn)
 | 
				
			||||||
import Data.Random
 | 
					import Data.Random
 | 
				
			||||||
import Data.Random.Distribution.Categorical
 | 
					import Data.Random.Distribution.Categorical
 | 
				
			||||||
import Data.Random.Sample
 | 
					import Data.Random.Sample
 | 
				
			||||||
@ -23,6 +24,8 @@ import Test.QuickCheck hiding (sample, shuffle)
 | 
				
			|||||||
import Test.QuickCheck.Instances
 | 
					import Test.QuickCheck.Instances
 | 
				
			||||||
import Test.QuickCheck.Monadic
 | 
					import Test.QuickCheck.Monadic
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- TODO there should be a few shuffles here
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- TODO enforce this being > 0
 | 
					-- TODO enforce this being > 0
 | 
				
			||||||
type N = Int
 | 
					type N = Int
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -50,8 +53,9 @@ class Eq i => Individual i where
 | 
				
			|||||||
  Generates a random population of the given size.
 | 
					  Generates a random population of the given size.
 | 
				
			||||||
  -}
 | 
					  -}
 | 
				
			||||||
  population :: (MonadRandom m) => N -> i -> m (Population i)
 | 
					  population :: (MonadRandom m) => N -> i -> m (Population i)
 | 
				
			||||||
  population 0 _ = undefined
 | 
					  population n i
 | 
				
			||||||
  population n i = Pop . NE.fromList <$> replicateM n (new i)
 | 
					    | n <= 0 = undefined
 | 
				
			||||||
 | 
					    | otherwise = NE.fromList <$> replicateM n (new i)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  mutate :: (MonadRandom m) => i -> m i
 | 
					  mutate :: (MonadRandom m) => i -> m i
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -81,17 +85,12 @@ possible:
 | 
				
			|||||||
> data Population a where
 | 
					> data Population a where
 | 
				
			||||||
>  Pop :: Individual a => NonEmpty a -> Population a
 | 
					>  Pop :: Individual a => NonEmpty a -> Population a
 | 
				
			||||||
-}
 | 
					-}
 | 
				
			||||||
newtype Population a = Pop {unPop :: NonEmpty a}
 | 
					 | 
				
			||||||
  deriving (Foldable, Functor, Semigroup, Show, Traversable)
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
instance (Arbitrary i) => Arbitrary (Population i) where
 | 
					instance (Arbitrary i) => Arbitrary (Population i) where
 | 
				
			||||||
  arbitrary = Pop <$> arbitrary
 | 
					  arbitrary = Pop <$> arbitrary
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-|
 | 
					
 | 
				
			||||||
The population's size (the length of the internally used non-empty list).
 | 
					type Population i = NonEmpty i
 | 
				
			||||||
-}
 | 
					 | 
				
			||||||
size :: Population a -> N
 | 
					 | 
				
			||||||
size = NE.length . unPop
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-|
 | 
					{-|
 | 
				
			||||||
Selects one individual from the population using proportionate selection.
 | 
					Selects one individual from the population using proportionate selection.
 | 
				
			||||||
@ -99,7 +98,7 @@ Selects one individual from the population using proportionate selection.
 | 
				
			|||||||
proportionate1 :: (Individual i, MonadRandom m) => Population i -> m i
 | 
					proportionate1 :: (Individual i, MonadRandom m) => Population i -> m i
 | 
				
			||||||
proportionate1 pop =
 | 
					proportionate1 pop =
 | 
				
			||||||
  sequence ((\i -> (,i) <$> fitness i) <$> pop)
 | 
					  sequence ((\i -> (,i) <$> fitness i) <$> pop)
 | 
				
			||||||
    >>= sample . fromWeightedList . NE.toList . unPop
 | 
					    >>= sample . fromWeightedList . NE.toList
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-|
 | 
					{-|
 | 
				
			||||||
Selects @n@ individuals from the population using proportionate selection.
 | 
					Selects @n@ individuals from the population using proportionate selection.
 | 
				
			||||||
@ -140,7 +139,6 @@ bestsBy :: (Individual i, Monad m) => N -> (i -> m R) -> Population i -> m [i]
 | 
				
			|||||||
bestsBy k f =
 | 
					bestsBy k f =
 | 
				
			||||||
  fmap (NE.take k . fmap fst . NE.sortBy (comparing (Down . snd)))
 | 
					  fmap (NE.take k . fmap fst . NE.sortBy (comparing (Down . snd)))
 | 
				
			||||||
    . traverse (\i -> (i,) <$> f i)
 | 
					    . traverse (\i -> (i,) <$> f i)
 | 
				
			||||||
    . unPop
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-|
 | 
					{-|
 | 
				
			||||||
The @k@ worst individuals in the population.
 | 
					The @k@ worst individuals in the population.
 | 
				
			||||||
@ -215,6 +213,26 @@ Termination after a number of steps.
 | 
				
			|||||||
steps :: N -> Termination i
 | 
					steps :: N -> Termination i
 | 
				
			||||||
steps tEnd _ t = t >= tEnd
 | 
					steps tEnd _ t = t >= tEnd
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- * Helper functions
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					{-|
 | 
				
			||||||
 | 
					Shuffles a non-empty list.
 | 
				
			||||||
 | 
					-}
 | 
				
			||||||
 | 
					shuffle' :: (MonadRandom m) => NonEmpty a -> m (NonEmpty a)
 | 
				
			||||||
 | 
					shuffle' xs@(x :| []) = return xs
 | 
				
			||||||
 | 
					shuffle' xs = do
 | 
				
			||||||
 | 
					  i <- sample . uniform 0 $ NE.length xs - 1
 | 
				
			||||||
 | 
					  -- slightly unsafe (!!) used here so deletion is faster
 | 
				
			||||||
 | 
					  let x = xs NE.!! i
 | 
				
			||||||
 | 
					  xs' <- sample . shuffle $ deleteI i xs
 | 
				
			||||||
 | 
					  return $ x :| xs'
 | 
				
			||||||
 | 
					  where
 | 
				
			||||||
 | 
					    deleteI i xs = fst (NE.splitAt i xs) ++ snd (NE.splitAt (i + 1) xs)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					prop_shuffle_length xs = monadicIO $ do
 | 
				
			||||||
 | 
					  xs' <- lift $ shuffle' xs
 | 
				
			||||||
 | 
					  assert $ length xs' == length xs
 | 
				
			||||||
 | 
					
 | 
				
			||||||
return []
 | 
					return []
 | 
				
			||||||
 | 
					
 | 
				
			||||||
runTests = $quickCheckAll
 | 
					runTests = $quickCheckAll
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user