Revert Population to type alias (instead of newtype)

This commit is contained in:
David Pätzel 2019-10-22 14:32:36 +02:00
parent 84c876f1b5
commit 0044b6cc18

View File

@ -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