From 6a45dec26389060c39d84554919f093cf92cbafc Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Mon, 20 Jan 2025 23:21:33 -0600 Subject: [PATCH] added more instructions (NEED TO BE TESTED) --- src/Instructions/CodeInstructions.hs | 114 ++++++++++++++++++++++++ src/Instructions/FloatInstructions.hs | 2 - src/Instructions/LogicalInstructions.hs | 8 ++ 3 files changed, 122 insertions(+), 2 deletions(-) create mode 100644 src/Instructions/CodeInstructions.hs diff --git a/src/Instructions/CodeInstructions.hs b/src/Instructions/CodeInstructions.hs new file mode 100644 index 0000000..6a5721a --- /dev/null +++ b/src/Instructions/CodeInstructions.hs @@ -0,0 +1,114 @@ +module Instructions.CodeInstructions where + +import State +import Instructions.GenericInstructions + +isBlock :: Gene -> Bool +isBlock (Block _) = True +isBlock _ = False + +blockLength :: Gene -> Int +blockLength (Block xs) = length xs +blockLength _ = 1 + +-- I think I can abstract the boilerplate base case check for a lot of these +-- with a different function + +-- empty Blocks are a thing but that shouldn't really matter +extractFirstFromBlock :: Gene -> Gene +extractFirstFromBlock (Block (x : _)) = x +extractFirstFromBlock gene = gene + +extractLastFromBlock :: Gene -> Gene +extractLastFromBlock (Block xs) = last xs +extractLastFromBlock gene = gene + +extractInitFromBlock :: Gene -> Gene +extractInitFromBlock (Block []) = Block [] +extractInitFromBlock (Block xs) = Block (init xs) +extractInitFromBlock gene = gene + +extractTailFromBlock :: Gene -> Gene +extractTailFromBlock (Block xs) = Block (drop 1 xs) +extractTailFromBlock gene = gene + +codeCombine :: Gene -> Gene -> Gene +codeCombine (Block xs) (Block ys) = Block (xs <> ys) +codeCombine (Block xs) ygene = Block (xs <> [ygene]) +codeCombine xgene (Block ys) = Block (xgene : ys) +codeCombine xgene ygene = Block [xgene, ygene] + +instructionCodePop :: State -> State +instructionCodePop state = instructionPop state code + +instructionCodeFromExec :: State -> State +instructionCodeFromExec state@(State {_exec = (e1 : es), _code = cs}) = state {_exec = es, _code = e1 : cs} +instructionCodeFromExec state = state + +instructionCodeIsCodeBlock :: State -> State +instructionCodeIsCodeBlock state@(State {_code = (c : cs), _bool = bs}) = state {_code = cs, _bool = isBlock c : bs} +instructionCodeIsCodeBlock state = state + +instructionCodeIsSingular :: State -> State +instructionCodeIsSingular state@(State {_code = (c : cs), _bool = bs}) = state {_code = cs, _bool = not (isBlock c) : bs} +instructionCodeIsSingular state = state + +instructionCodeLength :: State -> State +instructionCodeLength state@(State {_code = (c : cs), _int = is}) = state {_code = cs, _int = blockLength c : is} +instructionCodeLength state = state + +instructionCodeFirst :: State -> State +instructionCodeFirst state@(State {_code = (c : cs)}) = state {_code = extractFirstFromBlock c : cs} +instructionCodeFirst state = state + +instructionCodeLast :: State -> State +instructionCodeLast state@(State {_code = (c : cs)}) = state {_code = extractLastFromBlock c : cs} +instructionCodeLast state = state + +-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-rest +instructionCodeTail :: State -> State +instructionCodeTail state@(State {_code = (c : cs)}) = state {_code = extractTailFromBlock c : cs} +instructionCodeTail state = state + +-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-but-last +instructionCodeInit :: State -> State +instructionCodeInit state@(State {_code = (c : cs)}) = state {_code = extractInitFromBlock c : cs} +instructionCodeInit state = state + +instructionCodeWrap :: State -> State +instructionCodeWrap state@(State {_code = (c : cs)}) = state {_code = Block [c] : cs} +instructionCodeWrap state = state + +instructionCodeList :: State -> State +instructionCodeList state@(State {_code = (c1 : c2 : cs)}) = state {_code = Block [c1, c2] : cs} +instructionCodeList state = state + +instructionCodeCombine :: State -> State +instructionCodeCombine state@(State {_code = (c1 : c2 : cs)}) = state {_code = codeCombine c1 c2 : cs} +instructionCodeCombine state = state + +instructionCodeDo :: State -> State +instructionCodeDo state@(State {_code = (c1 : cs), _exec = es}) = state {_code = cs, _exec = c1: es} +instructionCodeDo state = state + +instructionCodeDoDup :: State -> State +instructionCodeDoDup state@(State {_code = (c1 : cs), _exec = es}) = state {_code = c1 : cs, _exec = c1 : es} +instructionCodeDoDup state = state + +-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-do-then-pop +instructionCodeDoThenPop :: State -> State +instructionCodeDoThenPop state@(State {_code = c1 : _, _exec = es}) = state {_exec = c1 : StateFunc instructionCodePop : es} +instructionCodeDoThenPop state = state + +instructionCodeDoRange :: State -> State +instructionCodeDoRange state@(State {_code = (c1 : cs), _int = (i0 : i1 : is), _exec = es}) = + if increment i0 i1 /= 0 + then state {_exec = c1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionCodeFromExec, c1, StateFunc instructionCodeDoRange] : es, _int = i1 : is, _code = cs} + else state {_exec = c1: es, _int = i1 : is, _code = cs} + where + increment :: Int -> Int -> Int + increment destIdx currentIdx + | currentIdx < destIdx = 1 + | currentIdx > destIdx = -1 + | otherwise = 0 +instructionCodeDoRange state = state diff --git a/src/Instructions/FloatInstructions.hs b/src/Instructions/FloatInstructions.hs index df86fbb..ede4a47 100644 --- a/src/Instructions/FloatInstructions.hs +++ b/src/Instructions/FloatInstructions.hs @@ -4,8 +4,6 @@ import Data.Fixed (mod') import Instructions.GenericInstructions import State --- stopped here for now: https://erp12.github.io/pyshgp/html/core_instructions.html#bool-invert-first-then-and - instructionFloatFromInt :: State -> State instructionFloatFromInt state@(State {_float = fs, _int = (i : is)}) = state {_float = (fromIntegral i :: Float) : fs, _int = is} instructionFloatFromInt state = state diff --git a/src/Instructions/LogicalInstructions.hs b/src/Instructions/LogicalInstructions.hs index ad07706..e94b66e 100644 --- a/src/Instructions/LogicalInstructions.hs +++ b/src/Instructions/LogicalInstructions.hs @@ -17,6 +17,14 @@ boolTemplate _ state = state instructionBoolAnd :: State -> State instructionBoolAnd = boolTemplate (&&) +instructionBoolInvertFirstThenAnd :: State -> State +instructionBoolInvertFirstThenAnd state@(State {_bool = (b1 : bs)}) = boolTemplate (&&) state {_bool = not b1 : bs} +instructionBoolInvertFirstThenAnd state = state + +instructionBoolInvertSecondThenAnd :: State -> State +instructionBoolInvertSecondThenAnd state@(State {_bool = (b1 : b2 : bs)}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs} +instructionBoolInvertSecondThenAnd state = state + instructionBoolOr :: State -> State instructionBoolOr = boolTemplate (||)