Add basis for tests to GA module
This commit is contained in:
		
							parent
							
								
									db55ec0716
								
							
						
					
					
						commit
						84c876f1b5
					
				
							
								
								
									
										26
									
								
								src/GA.hs
									
									
									
									
									
								
							
							
						
						
									
										26
									
								
								src/GA.hs
									
									
									
									
									
								
							@ -4,6 +4,7 @@
 | 
			
		||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 | 
			
		||||
{-# LANGUAGE NoImplicitPrelude #-}
 | 
			
		||||
{-# LANGUAGE OverloadedStrings #-}
 | 
			
		||||
{-# LANGUAGE TemplateHaskell #-}
 | 
			
		||||
{-# LANGUAGE TupleSections #-}
 | 
			
		||||
 | 
			
		||||
module GA where
 | 
			
		||||
@ -20,19 +21,7 @@ import Pretty
 | 
			
		||||
import Protolude
 | 
			
		||||
import Test.QuickCheck hiding (sample, shuffle)
 | 
			
		||||
import Test.QuickCheck.Instances
 | 
			
		||||
 | 
			
		||||
-- 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)
 | 
			
		||||
import Test.QuickCheck.Monadic
 | 
			
		||||
 | 
			
		||||
-- TODO enforce this being > 0
 | 
			
		||||
type N = Int
 | 
			
		||||
@ -98,6 +87,12 @@ newtype Population a = Pop {unPop :: NonEmpty a}
 | 
			
		||||
instance (Arbitrary i) => Arbitrary (Population i) where
 | 
			
		||||
  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.
 | 
			
		||||
-}
 | 
			
		||||
@ -140,6 +135,7 @@ children2 nX i1 i2 = do
 | 
			
		||||
The @k@ best individuals in the population when comparing using the supplied
 | 
			
		||||
function.
 | 
			
		||||
-}
 | 
			
		||||
-- TODO do this without a complete sort
 | 
			
		||||
bestsBy :: (Individual i, Monad m) => N -> (i -> m R) -> Population i -> m [i]
 | 
			
		||||
bestsBy k f =
 | 
			
		||||
  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 tEnd _ t = t >= tEnd
 | 
			
		||||
 | 
			
		||||
return []
 | 
			
		||||
 | 
			
		||||
runTests = $quickCheckAll
 | 
			
		||||
 | 
			
		||||
@ -4,8 +4,10 @@ module Main where
 | 
			
		||||
 | 
			
		||||
import Protolude
 | 
			
		||||
import qualified Seminar
 | 
			
		||||
import qualified GA
 | 
			
		||||
 | 
			
		||||
main :: IO ()
 | 
			
		||||
main = do
 | 
			
		||||
  _ <- Seminar.runTests
 | 
			
		||||
  _ <- GA.runTests
 | 
			
		||||
  return ()
 | 
			
		||||
 | 
			
		||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user