prepare for QuickCheck

This commit is contained in:
Rowan Torbitzky-Lane 2025-03-07 15:23:10 -06:00
parent b0c3a7626e
commit c76d33f291
2 changed files with 52 additions and 5 deletions

View File

@ -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 (+)

View File

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