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