Add basis for tests to GA module

This commit is contained in:
David Pätzel 2019-10-22 08:14:16 +02:00
parent db55ec0716
commit 84c876f1b5
2 changed files with 15 additions and 13 deletions

View File

@ -4,6 +4,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module GA where module GA where
@ -20,19 +21,7 @@ import Pretty
import Protolude import Protolude
import Test.QuickCheck hiding (sample, shuffle) import Test.QuickCheck hiding (sample, shuffle)
import Test.QuickCheck.Instances import Test.QuickCheck.Instances
import Test.QuickCheck.Monadic
-- TODO using sample here was a quick hack
{-|
Shuffles a non-empty list.
-}
shuffle' :: (MonadRandom m) => NonEmpty a -> m (NonEmpty a)
shuffle' xs = do
i <- sample . uniform 0 $ NE.length xs - 1
let x = xs NE.!! i
xs' <- sample . shuffle $ deleteI i xs
return $ x :| xs'
where
deleteI i xs = fst (NE.splitAt (i - 1) xs) ++ snd (NE.splitAt i xs)
-- TODO enforce this being > 0 -- TODO enforce this being > 0
type N = Int type N = Int
@ -98,6 +87,12 @@ newtype Population a = Pop {unPop :: NonEmpty a}
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).
-}
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.
-} -}
@ -140,6 +135,7 @@ children2 nX i1 i2 = do
The @k@ best individuals in the population when comparing using the supplied The @k@ best individuals in the population when comparing using the supplied
function. function.
-} -}
-- TODO do this without a complete sort
bestsBy :: (Individual i, Monad m) => N -> (i -> m R) -> Population i -> m [i] 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)))
@ -218,3 +214,7 @@ Termination after a number of steps.
-} -}
steps :: N -> Termination i steps :: N -> Termination i
steps tEnd _ t = t >= tEnd steps tEnd _ t = t >= tEnd
return []
runTests = $quickCheckAll

View File

@ -4,8 +4,10 @@ module Main where
import Protolude import Protolude
import qualified Seminar import qualified Seminar
import qualified GA
main :: IO () main :: IO ()
main = do main = do
_ <- Seminar.runTests _ <- Seminar.runTests
_ <- GA.runTests
return () return ()