prepare for QuickCheck
This commit is contained in:
parent
b0c3a7626e
commit
c76d33f291
@ -1,10 +1,10 @@
|
|||||||
module HushGP.PushTests.IntTests where
|
module HushGP.PushTests.IntTests where
|
||||||
|
|
||||||
-- import HushGP.State
|
import HushGP.State
|
||||||
-- import HushGP.Instructions.IntInstructions
|
import HushGP.Instructions.IntInstructions
|
||||||
-- import HushGP.PushTests.GenericTests
|
-- import HushGP.PushTests.GenericTests
|
||||||
-- -- import Control.Lens hiding (uncons)
|
-- -- import Control.Lens hiding (uncons)
|
||||||
-- import Test.QuickCheck
|
import Test.Tasty
|
||||||
|
|
||||||
-- prop_IntAdd :: State -> Property
|
-- prop_IntAdd :: State -> Property
|
||||||
-- prop_IntAdd = aaa1Test int instructionIntAdd (+)
|
-- prop_IntAdd = aaa1Test int instructionIntAdd (+)
|
||||||
|
@ -1,10 +1,12 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell, DeriveGeneric #-}
|
||||||
|
|
||||||
module HushGP.State where
|
module HushGP.State where
|
||||||
|
|
||||||
import Control.Lens hiding (elements)
|
import Control.Lens hiding (elements)
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
import System.Random
|
import System.Random
|
||||||
|
import Test.QuickCheck
|
||||||
|
import GHC.Generics
|
||||||
|
|
||||||
-- | The exec stack must store heterogenous types,
|
-- | The exec stack must store heterogenous types,
|
||||||
-- and we must be able to detect that type at runtime.
|
-- and we must be able to detect that type at runtime.
|
||||||
@ -42,6 +44,7 @@ data Gene
|
|||||||
CrossoverPadding
|
CrossoverPadding
|
||||||
| -- | This is used in best match crossover (bmx in PushArgs).
|
| -- | This is used in best match crossover (bmx in PushArgs).
|
||||||
Gap
|
Gap
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
instance Eq Gene where
|
instance Eq Gene where
|
||||||
GeneInt x == GeneInt y = x == y
|
GeneInt x == GeneInt y = x == y
|
||||||
@ -155,6 +158,29 @@ instance Show Gene where
|
|||||||
show CrossoverPadding = "Crossover Padding"
|
show CrossoverPadding = "Crossover Padding"
|
||||||
show Gap = "Gap"
|
show Gap = "Gap"
|
||||||
|
|
||||||
|
instance CoArbitrary StdGen where
|
||||||
|
coarbitrary _ gen = gen
|
||||||
|
|
||||||
|
instance CoArbitrary Gene
|
||||||
|
|
||||||
|
instance Arbitrary Gene where
|
||||||
|
arbitrary =
|
||||||
|
oneof
|
||||||
|
[ GeneInt <$> arbitrary,
|
||||||
|
GeneFloat <$> arbitrary,
|
||||||
|
GeneBool <$> arbitrary,
|
||||||
|
GeneString <$> arbitrary,
|
||||||
|
GeneChar <$> arbitrary,
|
||||||
|
StateFunc <$> arbitrary,
|
||||||
|
-- PlaceInput <$> arbitrary,
|
||||||
|
GeneVectorInt <$> arbitrary,
|
||||||
|
GeneVectorFloat <$> arbitrary,
|
||||||
|
GeneVectorBool <$> arbitrary,
|
||||||
|
GeneVectorString <$> arbitrary,
|
||||||
|
GeneVectorChar <$> arbitrary,
|
||||||
|
Block <$> arbitrary
|
||||||
|
]
|
||||||
|
|
||||||
-- | The structure that holds all of the values.
|
-- | The structure that holds all of the values.
|
||||||
data State = State
|
data State = State
|
||||||
{ _exec :: [Gene],
|
{ _exec :: [Gene],
|
||||||
@ -172,7 +198,28 @@ data State = State
|
|||||||
_parameter :: [Gene],
|
_parameter :: [Gene],
|
||||||
_input :: Map.Map Int Gene
|
_input :: Map.Map Int Gene
|
||||||
}
|
}
|
||||||
deriving (Show, Eq, Ord)
|
deriving (Show, Eq, Ord, Generic)
|
||||||
|
|
||||||
|
instance CoArbitrary State
|
||||||
|
|
||||||
|
instance Arbitrary State where
|
||||||
|
arbitrary = do
|
||||||
|
arbExec <- arbitrary
|
||||||
|
arbCode <- arbitrary
|
||||||
|
arbInt <- arbitrary
|
||||||
|
arbFloat <- arbitrary
|
||||||
|
arbBool <- arbitrary
|
||||||
|
arbString <- arbitrary
|
||||||
|
arbChar <- arbitrary
|
||||||
|
arbVectorInt <- arbitrary
|
||||||
|
arbVectorFloat <- arbitrary
|
||||||
|
arbVectorBool <- arbitrary
|
||||||
|
arbVectorString <- arbitrary
|
||||||
|
arbVectorChar <- arbitrary
|
||||||
|
arbParameter <- arbitrary
|
||||||
|
-- arbInput <- arbitrary
|
||||||
|
State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
|
||||||
|
-- Thanks hlint lol
|
||||||
|
|
||||||
emptyState :: State
|
emptyState :: State
|
||||||
emptyState =
|
emptyState =
|
||||||
|
Loading…
x
Reference in New Issue
Block a user