From 0fd2c2e5dd52c16031f0f8ecd9c92f887cd906ae Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Sat, 8 Mar 2025 03:40:26 -0600 Subject: [PATCH] more instructions and start of int tests --- src/HushGP/Instructions/FloatInstructions.hs | 6 + .../Instructions/GenericInstructions.hs | 2 +- src/HushGP/Instructions/IntInstructions.hs | 8 +- src/HushGP/PushTests/GenericTests.hs | 55 +++--- src/HushGP/PushTests/IntTests.hs | 173 ++++++++++++------ 5 files changed, 164 insertions(+), 80 deletions(-) diff --git a/src/HushGP/Instructions/FloatInstructions.hs b/src/HushGP/Instructions/FloatInstructions.hs index 4d439d0..a287a31 100644 --- a/src/HushGP/Instructions/FloatInstructions.hs +++ b/src/HushGP/Instructions/FloatInstructions.hs @@ -67,6 +67,12 @@ instructionFloatMod :: State -> State instructionFloatMod state@(State {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 `mod'` f1 : fs else f1 : f2 : fs} instructionFloatMod state = state +-- |Mods the second float from the first float and pushes the result to the float stack. +-- This does truncate. +instructionFloatModOpp :: State -> State +instructionFloatModOpp state@(State {_float = f1 : f2 : fs}) = state {_float = if f2 /= 0 then (f1 `mod'` f2) : fs else f1 : f2 : fs} +instructionFloatModOpp state = state + -- |Takes the top two floats from the float stack and pushes the minimum of the two back on top. instructionFloatMin :: State -> State instructionFloatMin state@(State {_float = f1 : f2 : fs}) = state {_float = min f1 f2 : fs} diff --git a/src/HushGP/Instructions/GenericInstructions.hs b/src/HushGP/Instructions/GenericInstructions.hs index 4cdff42..182a104 100644 --- a/src/HushGP/Instructions/GenericInstructions.hs +++ b/src/HushGP/Instructions/GenericInstructions.hs @@ -135,7 +135,7 @@ instructionShoveDup _ state = state -- |Moves an item from the top of a lens' stack to deep within the lens' stack based on -- the top int from the int stack. instructionShove :: Lens' State [a] -> State -> State -instructionShove accessor state = instructionShoveDup accessor state & accessor .~ drop 1 (view accessor (instructionShoveDup accessor state )) +instructionShove accessor state = state & accessor .~ drop 1 (view accessor (instructionShoveDup accessor state )) -- |Concats two semigroupable items together based on a lens. Not char generic. instructionVectorConcat :: Semigroup a => Lens' State [a] -> State -> State diff --git a/src/HushGP/Instructions/IntInstructions.hs b/src/HushGP/Instructions/IntInstructions.hs index 5eb0bcb..a9dbe96 100644 --- a/src/HushGP/Instructions/IntInstructions.hs +++ b/src/HushGP/Instructions/IntInstructions.hs @@ -61,12 +61,18 @@ instructionIntDivOpp :: State -> State instructionIntDivOpp state@(State {_int = i1 : i2 : is}) = state {_int = if i2 /= 0 then (i1 `div` i2) : is else i1 : i2 : is} instructionIntDivOpp state = state --- |Mods the first float from the second float and pushes the result to the int stack. +-- |Mods the first int from the second int and pushes the result to the int stack. -- This does truncate. instructionIntMod :: State -> State instructionIntMod state@(State {_int = i1 : i2 : is}) = state {_int = if i1 /= 0 then (i2 `mod` i1) : is else i1 : i2 : is} instructionIntMod state = state +-- |Mods the second int from the first int and pushes the result to the int stack. +-- This does truncate. +instructionIntModOpp :: State -> State +instructionIntModOpp state@(State {_int = i1 : i2 : is}) = state {_int = if i2 /= 0 then (i1 `mod` i2) : is else i1 : i2 : is} +instructionIntModOpp state = state + -- |Takes the top two ints from the int stack and pushes the minimum of the two back on top. instructionIntMin :: State -> State instructionIntMin state@(State {_int = i1 : i2 : is}) = state {_int = min i1 i2 : is} diff --git a/src/HushGP/PushTests/GenericTests.hs b/src/HushGP/PushTests/GenericTests.hs index b726e54..fd27dd6 100644 --- a/src/HushGP/PushTests/GenericTests.hs +++ b/src/HushGP/PushTests/GenericTests.hs @@ -1,9 +1,8 @@ module HushGP.PushTests.GenericTests where --- import HushGP.State --- import Control.Lens --- -- import Debug.Trace --- import Test.QuickCheck +import HushGP.State +import Control.Lens +import Test.Tasty.QuickCheck -- -- import HushGP.Instructions.GenericInstructions -- -- The naming scheme: @@ -15,11 +14,14 @@ module HushGP.PushTests.GenericTests where -- -- We may be able to get rid of Lens entirely and use haskell's integrated accessors of type State -> [a] -- -- You can see what I'm talking about if you go into ghci and type: `:info _int` for example --- aaa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a -> a) -> State -> Property --- aaa1Test accessor instruction transformation state = --- case (uncons (view accessor state), uncons (view accessor $ instruction state)) of --- (Just (origx1, origx2 : _), Just (modx1, _)) -> transformation origx2 origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state) + 1 --- _ -> state === instruction state +-- | Test to see if the length difference between the two stacks post execution is off by one. +-- Based on a primitive lens. Should only be used with functions that modify the length of one stack +-- by one. The first Int specifies what size the stacks should differ by. The second Int +-- specifies how many intial items should be in the stack to not be considered a no-op. +diff1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> Int -> Int -> State -> Property +diff1Test accessor instruction stackAmt ltAmt state + | length (view accessor state) < ltAmt = state === instruction state + | otherwise = length (view accessor state) === length (view accessor $ instruction state) + stackAmt -- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property -- aa1Test accessor instruction transformation state = @@ -27,23 +29,26 @@ module HushGP.PushTests.GenericTests where -- (Just (origx1, _), Just (modx1, _)) -> transformation origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state) -- _ -> state === instruction state --- ab1Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> (a -> b) -> State -> Property --- ab1Test accessorFrom accessorTo instruction transformation state = --- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of --- (Just (t1, _), Just (f1, _)) -> --- t1 === transformation f1 .&&. --- length (view accessorTo $ instruction state) === length (view accessorTo state) + 1 .&&. --- length (view accessorFrom $ instruction state) === length (view accessorFrom state) - 1 --- _ -> state === instruction state +-- | Test to see if the length difference between 2 separate stacks post execution if +-- the up/down by a passed amt for the respective stats. Is used to test functions like instructionIntFromFloat. +diff2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> Int -> Int -> Int -> State -> Property +diff2Test accessorFrom accessorTo instruction ltAmt toAmt fromAmt state + | length (view accessorFrom state) < ltAmt = state === instruction state + | otherwise = length (view accessorTo $ instruction state) === length (view accessorTo state) + toAmt .&&. + length (view accessorFrom $ instruction state) === length (view accessorFrom state) - fromAmt + -- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of + -- (Just (_, _), Just (_, _)) -> + -- length (view accessorTo $ instruction state) === length (view accessorTo state) + 1 .&&. + -- length (view accessorFrom $ instruction state) === length (view accessorFrom state) - 1 + -- _ -> state === instruction state --- aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> (a -> a -> b) -> State -> Property --- aab2Test accessorFrom accessorTo instruction transformation state = --- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of --- (Just (t1, _), Just (f1, f2 : _)) -> --- t1 === transformation f1 f2 .&&. --- length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&. --- length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2 --- _ -> state === instruction state +aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> State -> Property +aab2Test accessorFrom accessorTo instruction state = + case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of + (Just (_, _), Just (_, _ : _)) -> + length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&. + length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2 + _ -> state === instruction state -- popTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property -- popTest accessor instruction state = diff --git a/src/HushGP/PushTests/IntTests.hs b/src/HushGP/PushTests/IntTests.hs index 84b0d7f..5d32692 100644 --- a/src/HushGP/PushTests/IntTests.hs +++ b/src/HushGP/PushTests/IntTests.hs @@ -1,8 +1,10 @@ module HushGP.PushTests.IntTests where +import Data.Char import HushGP.State +import HushGP.PushTests.GenericTests import HushGP.Instructions.IntInstructions -import Control.Lens hiding (uncons) +-- import Control.Lens hiding (uncons) import System.Environment import Test.Tasty import Test.Tasty.QuickCheck as QC @@ -10,7 +12,7 @@ import Test.Tasty.QuickCheck as QC main :: IO () main = do setEnv "TASTY_QUICKCHECK_MAX_SIZE" "10" - setEnv "TASTY_QUICKCHECK_VERBOSE" "True" + setEnv "TASTY_QUICKCHECK_VERBOSE" "False" defaultMain intTests -- |Holds the tree for property and unit tests. @@ -22,81 +24,146 @@ propIntTests :: TestTree propIntTests = testGroup "Property Int Tests" [ QC.testProperty "Property Int Add test" prop_IntAdd + , QC.testProperty "Property Int Sub test" prop_IntSub + , QC.testProperty "Property Int SubOpp test" prop_IntSubOpp + , QC.testProperty "Property Int Multiply test" prop_IntMul + , QC.testProperty "Property Int Div test" prop_IntDiv + , QC.testProperty "Property Int Div Opp test" prop_IntDivOpp + , QC.testProperty "Property Int Mod test" prop_IntMod + , QC.testProperty "Property Int Mod Opp test" prop_IntModOpp + , QC.testProperty "Property IntFromFloat test" prop_IntFromFloat + , QC.testProperty "Property IntFromBool test" prop_IntFromBool + , QC.testProperty "Property IntFromChar test" prop_IntFromChar + , QC.testProperty "Property IntFromString test" prop_IntFromString + , QC.testProperty "Property IntMin test" prop_IntMin + , QC.testProperty "Property IntMax test" prop_IntMax + , QC.testProperty "Property IntInc test" prop_IntInc + , QC.testProperty "Property IntDec test" prop_IntDec + , QC.testProperty "Property IntLT test" prop_IntLT + , QC.testProperty "Property IntGT test" prop_IntGT + , QC.testProperty "Property IntLTE test" prop_IntLTE + , QC.testProperty "Property IntGTE test" prop_IntGTE + , QC.testProperty "Property IntDup test" prop_IntDup + , QC.testProperty "Property IntPop test" prop_IntPop + , QC.testProperty "Property IntDupN test" prop_IntDupN + , QC.testProperty "Property IntSwap test" prop_IntSwap + , QC.testProperty "Property IntRot test" prop_IntRot + , QC.testProperty "Property IntFlush test" prop_IntFlush + , QC.testProperty "Property IntEQ test" prop_IntEq + , QC.testProperty "Property IntStackDepth test" prop_IntStackDepth + , QC.testProperty "Property IntYank test" prop_IntYank + , QC.testProperty "Property IntYankDup test" prop_IntYankDup + , QC.testProperty "Property IntShove test" prop_IntShove + , QC.testProperty "Property IntShoveDup test" prop_IntShoveDup + , QC.testProperty "Property IntIsStackEmpty test" prop_IntIsStackEmpty + , QC.testProperty "Property IntDupItems test" prop_IntDupItems ] prop_IntAdd :: State -> Property -prop_IntAdd state@(State {_int = is}) = if length is < 2 then length (view int (instructionIntAdd state)) === length (view int state) else length (view int (instructionIntAdd state)) === length (view int state) - 1 +prop_IntAdd = diff1Test int instructionIntAdd 1 2 --- prop_IntSub :: State -> Property --- prop_IntSub = aaa1Test int instructionIntSub (-) +prop_IntSub :: State -> Property +prop_IntSub = diff1Test int instructionIntSub 1 2 --- prop_IntMul :: State -> Property --- prop_IntMul = aaa1Test int instructionIntMul (*) +prop_IntSubOpp :: State -> Property +prop_IntSubOpp = diff1Test int instructionIntSubOpp 1 2 --- prop_IntDiv :: State -> Property --- prop_IntDiv state@(State {_int = 0 : _}) = state === instructionIntDiv state --- prop_IntDiv state = aaa1Test int instructionIntDiv div state +prop_IntMul :: State -> Property +prop_IntMul = diff1Test int instructionIntMul 1 2 --- prop_IntMod :: State -> Property --- prop_IntMod state@(State {_int = 0 : _}) = state === instructionIntMod state --- prop_IntMod state = aaa1Test int instructionIntMod mod state +prop_IntDiv :: State -> Property +prop_IntDiv state@(State {_int = 0 : _}) = state === instructionIntDiv state +prop_IntDiv state = diff1Test int instructionIntDiv 1 2 state --- prop_IntFromFloat :: State -> Property --- prop_IntFromFloat = ab1Test float int instructionIntFromFloat floor +prop_IntDivOpp :: State -> Property +prop_IntDivOpp state@(State {_int = _ : 0 : _}) = state === instructionIntDivOpp state +prop_IntDivOpp state = diff1Test int instructionIntDivOpp 1 2 state --- prop_IntFromBool :: State -> Property --- prop_IntFromBool = ab1Test bool int instructionIntFromBool (\x -> if x then 1 else 0) +prop_IntMod :: State -> Property +prop_IntMod state@(State {_int = 0 : _}) = state === instructionIntMod state +prop_IntMod state = diff1Test int instructionIntMod 1 2 state --- prop_IntMin :: State -> Property --- prop_IntMin = aaa1Test int instructionIntMin min +prop_IntModOpp :: State -> Property +prop_IntModOpp state@(State {_int = _ : 0 : _}) = state === instructionIntModOpp state +prop_IntModOpp state = diff1Test int instructionIntModOpp 1 2 state --- prop_IntMax :: State -> Property --- prop_IntMax = aaa1Test int instructionIntMax max +prop_IntFromFloat :: State -> Property +prop_IntFromFloat = diff2Test float int instructionIntFromFloat 1 1 1 --- prop_IntInc :: State -> Property --- prop_IntInc = aa1Test int instructionIntInc (+1) +prop_IntFromBool :: State -> Property +prop_IntFromBool = diff2Test bool int instructionIntFromBool 1 1 1 --- prop_IntDec :: State -> Property --- prop_IntDec = aa1Test int instructionIntDec (\x -> x - 1) +prop_IntFromChar :: State -> Property +prop_IntFromChar = diff2Test char int instructionIntFromChar 1 1 1 --- prop_IntLT :: State -> Property --- prop_IntLT = aab2Test int bool instructionIntLT (<) +prop_IntFromString :: State -> Property +prop_IntFromString state@(State {_string = s1 : _}) = if all isDigit s1 then diff2Test string int instructionIntFromString 1 1 1 state else state === instructionIntFromString state +prop_IntFromString state = state === instructionIntFromString state --- prop_IntGT :: State -> Property --- prop_IntGT = aab2Test int bool instructionIntGT (>) +prop_IntMin :: State -> Property +prop_IntMin = diff1Test int instructionIntMin 1 2 --- prop_IntLTE :: State -> Property --- prop_IntLTE = aab2Test int bool instructionIntLTE (<=) +prop_IntMax :: State -> Property +prop_IntMax = diff1Test int instructionIntMax 1 2 --- prop_IntGTE :: State -> Property --- prop_IntGTE = aab2Test int bool instructionIntGTE (>=) +prop_IntInc :: State -> Property +prop_IntInc = diff1Test int instructionIntInc 0 1 --- prop_IntDup :: State -> Property --- prop_IntDup = dupTest int instructionIntDup +prop_IntDec :: State -> Property +prop_IntDec = diff1Test int instructionIntDec 0 1 --- prop_IntPop :: State -> Property --- prop_IntPop = popTest int instructionIntPop +prop_IntLT :: State -> Property +prop_IntLT = diff2Test int bool instructionIntLT 2 1 2 --- prop_IntDupN :: State -> Property --- prop_IntDupN = dupTestN int instructionIntDupN +prop_IntGT :: State -> Property +prop_IntGT = diff2Test int bool instructionIntGT 2 1 2 --- prop_IntSwap :: State -> Property --- prop_IntSwap = swapTest int instructionIntSwap +prop_IntLTE :: State -> Property +prop_IntLTE = diff2Test int bool instructionIntLTE 2 1 2 --- prop_IntRot :: State -> Property --- prop_IntRot = rotTest int instructionIntRot +prop_IntGTE :: State -> Property +prop_IntGTE = diff2Test int bool instructionIntGTE 2 1 2 --- prop_IntFlush :: State -> Property --- prop_IntFlush = flushTest int instructionIntFlush +prop_IntDup :: State -> Property +prop_IntDup = diff1Test int instructionIntDup (-1) 1 --- prop_IntEq :: State -> Property --- prop_IntEq = aab2Test int bool instructionIntEq (==) +prop_IntPop :: State -> Property +prop_IntPop = diff1Test int instructionIntPop 1 1 --- prop_IntStackDepth :: State -> Property --- prop_IntStackDepth = stackDepthTest int instructionIntStackDepth +prop_IntDupN :: State -> Property +prop_IntDupN state@(State {_int = i1 : _ : _}) = diff1Test int instructionIntDupN ((- fromIntegral (max 0 i1)) + 2) 2 state +prop_IntDupN state = state === instructionIntDupN state --- prop_IntYank :: State -> Property --- prop_IntYank = yankTest int instructionIntYank +prop_IntSwap :: State -> Property +prop_IntSwap = diff1Test int instructionIntSwap 0 1 --- -- prop_IntYankDup :: State -> Property --- -- prop_IntYankDup = yankDupTest int instructionIntYankDup +prop_IntRot :: State -> Property +prop_IntRot = diff1Test int instructionIntRot 0 3 + +prop_IntFlush :: State -> Property +prop_IntFlush state@(State {_int = is})= diff1Test int instructionIntFlush (length is) 0 state + +prop_IntEq :: State -> Property +prop_IntEq = diff2Test int bool instructionIntEq 2 1 2 + +prop_IntStackDepth :: State -> Property +prop_IntStackDepth = diff1Test int instructionIntStackDepth (-1) 0 + +prop_IntYank :: State -> Property +prop_IntYank = diff1Test int instructionIntYank 1 2 + +prop_IntYankDup :: State -> Property +prop_IntYankDup = diff1Test int instructionIntYankDup 0 2 + +prop_IntShove :: State -> Property +prop_IntShove = diff1Test int instructionIntShove 1 1 + +prop_IntShoveDup :: State -> Property +prop_IntShoveDup = diff1Test int instructionIntShoveDup 0 1 + +prop_IntIsStackEmpty :: State -> Property +prop_IntIsStackEmpty = diff2Test int bool instructionIntIsStackEmpty 0 1 0 + +prop_IntDupItems :: State -> Property +prop_IntDupItems state@(State {_int = i1 : _ : _})= diff1Test int instructionIntDupItems ((- fromIntegral (max 0 i1)) + 2) 2 state +prop_IntDupItems state = state === instructionIntDupItems state