From 58fcf7e46f3040228493ce9b8fc7038fb2a9fe32 Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Thu, 23 Jan 2025 01:42:57 -0600 Subject: [PATCH] instructionExtractCode LOVE IT :))))))))))))) --- src/Instructions/CodeInstructions.hs | 53 +++++++++++++++++++++++++--- test/Main.hs | 19 +++++++--- 2 files changed, 62 insertions(+), 10 deletions(-) diff --git a/src/Instructions/CodeInstructions.hs b/src/Instructions/CodeInstructions.hs index 363673c..39395dc 100644 --- a/src/Instructions/CodeInstructions.hs +++ b/src/Instructions/CodeInstructions.hs @@ -4,6 +4,8 @@ import State import Instructions.GenericInstructions import Instructions.IntInstructions +-- import Debug.Trace + isBlock :: Gene -> Bool isBlock (Block _) = True isBlock _ = False @@ -38,6 +40,15 @@ extractTailFromBlock :: Gene -> Gene extractTailFromBlock (Block xs) = Block (drop 1 xs) extractTailFromBlock gene = gene +-- This function took at least 3 hours to program. +codeAtPoint :: [Gene] -> Int -> Gene +codeAtPoint (gene : _) 0 = gene +codeAtPoint [] _ = Block [] -- Should only happen if an empty block is last Gene in the list of Genes +codeAtPoint ((Block nestedGenes) : genes) index = codeAtPoint (nestedGenes <> genes) (index - 1) +codeAtPoint (_ : genes) index = codeAtPoint genes (index - 1) + +-- This one functions differently than pysh. +-- I like this one because it preserves ordering codeCombine :: Gene -> Gene -> Gene codeCombine (Block xs) (Block ys) = Block (xs <> ys) codeCombine (Block xs) ygene = Block (xs <> [ygene]) @@ -49,6 +60,11 @@ codeMember (Block _) (Block _) = False -- Can't compare two lists with `elem` codeMember (Block xs) ygene = ygene `elem` xs codeMember _ _ = False +-- I love list comprehensions +codeRecursiveSize :: Gene -> Int +codeRecursiveSize (Block xs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- xs] +codeRecursiveSize _ = 1 + instructionCodePop :: State -> State instructionCodePop state = instructionPop state code @@ -150,13 +166,40 @@ instructionCodeMember :: State -> State instructionCodeMember state@(State {_code = (c1 : c2 : cs), _bool = bs}) = state{_code = cs, _bool = codeMember c1 c2 : bs} instructionCodeMember state = state +-- This one doesn't count the recursive Blocks while instructionCodeExtract does -- https://erp12.github.io/pyshgp/html/core_instructions.html#code-nth instructionCodeN :: State -> State -instructionCodeN state@(State {_code = (c1 : cs), _int = (_ : is)}) = - if not $ blockIsNull c1Block - then state {_code = c1Block : cs, _int = is} +instructionCodeN state@(State {_code = ((Block c1) : cs), _int = (i1 : is)}) = + if not $ null c1 + then state {_code = c1 !! index : cs, _int = is} else state where - c1Block :: Gene - c1Block = if not $ isBlock c1 then Block [c1] else c1 + index :: Int + index = abs i1 `mod` length c1 +instructionCodeN state@(State {_code = (c1 : cs), _int = _ : is}) = state {_code = c1 : cs, _int = is} instructionCodeN state = state + +instructionMakeEmptyCodeBlock :: State -> State +instructionMakeEmptyCodeBlock state@(State {_code = cs}) = state {_code = Block [] : cs} + +instructionIsEmptyCodeBlock :: State -> State +instructionIsEmptyCodeBlock state@(State {_code = Block c1 : cs, _bool = bs}) = state{_code = cs, _bool = null c1 : bs} +instructionIsEmptyCodeBlock state@(State {_bool = bs}) = state{_bool = False : bs} + +instructionCodeSize :: State -> State +instructionCodeSize state@(State {_code = c1 : cs, _int = is}) = state{_code = cs, _int = codeRecursiveSize c1 : is} +instructionCodeSize state = state + +-- There's a bug for this instruction in pysh where the last item in the +-- top level Block isn't counted, and if passed 0, then the entire codeblock is returned. +-- I designed this function differently so 0 returns the 0th element, and the last item +-- in the codeblock can be returned. +instructionCodeExtract :: State -> State +instructionCodeExtract state@(State {_code = (block@(Block c1) : cs), _int = i1 : is}) = + let + index = abs i1 `mod` codeRecursiveSize block + in + state{_code = codeAtPoint c1 index : cs, _int = is} + +instructionCodeExtract state@(State {_code = cs, _int = _ : is}) = state{_code = cs, _int = is} +instructionCodeExtract state = state diff --git a/test/Main.hs b/test/Main.hs index 79026f3..20a8736 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,8 +1,8 @@ import Control.Exception (assert) +import Instructions.CodeInstructions import Instructions.ExecInstructions import Instructions.FloatInstructions import Instructions.IntInstructions -import Instructions.CodeInstructions import Push import State @@ -28,7 +28,7 @@ boolTestFunc name goal genome startState = codeTestFunc :: String -> [Gene] -> [Gene] -> State -> IO () codeTestFunc name goal genome startState = let state = loadProgram genome startState - in assert (goal == _code (interpretExec state)) putStrLn (name <> " passed test.") + in assert (goal == _code (interpretExec state)) putStrLn (name <> " passed test.") main :: IO () main = do @@ -107,7 +107,16 @@ main = do intTestFunc "instructionCodeIfTrue" [6] [GeneBool True, StateFunc instructionCodeFromExec, GeneInt 3, StateFunc instructionCodeFromExec, GeneInt 6, StateFunc instructionCodeIf] emptyState intTestFunc "instructionCodeIfFalse" [3] [GeneBool False, StateFunc instructionCodeFromExec, GeneInt 3, StateFunc instructionCodeFromExec, GeneInt 6, StateFunc instructionCodeIf] emptyState intTestFunc "instructionCodeWhen" [6, 3, 6] [GeneInt 6, GeneInt 3, GeneInt 4, GeneInt 2, GeneBool True, StateFunc instructionCodeFromExec, StateFunc instructionIntAdd, StateFunc instructionCodeWhen] emptyState - boolTestFunc "instructionCodeMemberTrue" [True] [StateFunc instructionCodeFromExec, GeneInt 2, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState - boolTestFunc "instructionCodeMemberFalse" [False] [StateFunc instructionCodeFromExec, GeneInt 7, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState + boolTestFunc "instructionCodeMemberTrue" [True] [StateFunc instructionCodeFromExec, GeneInt 2, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState + boolTestFunc "instructionCodeMemberFalse" [False] [StateFunc instructionCodeFromExec, GeneInt 7, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState boolTestFunc "instructionCodeMember2Blocks" [False] [StateFunc instructionCodeFromExec, Block [GeneInt 7, GeneInt 0], StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState - + codeTestFunc "instructionCodeNInBounds" [GeneInt 0] [StateFunc instructionCodeFromExec, Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 0, StateFunc instructionCodeN] emptyState + codeTestFunc "instructionCodeNInBoundsEnd" [GeneInt 5] [StateFunc instructionCodeFromExec, Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 5, StateFunc instructionCodeN] emptyState + codeTestFunc "instructionCodeNModded" [GeneInt 3] [StateFunc instructionCodeFromExec, Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 9, StateFunc instructionCodeN] emptyState + codeTestFunc "instructionMakeEmptyCodeBlock" [Block []] [StateFunc instructionMakeEmptyCodeBlock] emptyState + boolTestFunc "instructionIsEmptyCodeBlockTrue" [True] [StateFunc instructionCodeFromExec, Block [], StateFunc instructionIsEmptyCodeBlock] emptyState + intTestFunc "instructionCodeSize" [8] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], StateFunc instructionCodeSize] emptyState + codeTestFunc "instructionCodeExtractInBounds" [GeneInt 3] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], GeneInt 3, StateFunc instructionCodeExtract] emptyState + codeTestFunc "instructionCodeExtractOutBounds" [GeneInt 3] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], GeneInt 11, StateFunc instructionCodeExtract] emptyState + codeTestFunc "instructionCodeExtractLastEmptyBlock" [Block []] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 7, StateFunc instructionCodeExtract] emptyState + codeTestFunc "instructionCodeExtractBlock" [Block [GeneInt 2, GeneInt 3]] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 1, StateFunc instructionCodeExtract] emptyState