rowan.a.tl/HushGP
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactored names of genes for consistency

Browse Source
This commit is contained in:
Taylor 2025-01-16 12:38:18 -06:00
parent 5a94db7f1e
commit 920ea92cb9
2 changed files with 36 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/Push.hs
View File

@ -9,20 +9,20 @@ import qualified Data.Map as Map
-- One solution is for the exec stack to be a list of [Gene]. -- One solution is for the exec stack to be a list of [Gene].
-- The parameter stack could be singular [Gene] or multiple [atomic] types. -- The parameter stack could be singular [Gene] or multiple [atomic] types.
data Gene data Gene
= IntGene Int = GeneInt Int
| FloatGene Float | GeneFloat Float
| BoolGene Bool | GeneBool Bool
| StringGene String | GeneString String
| StateFunc (State -> State) | StateFunc (State -> State)
| PlaceInput String | PlaceInput String
| Close | Close
| Block [Gene] | Block [Gene]
instance Eq Gene where instance Eq Gene where
IntGene x == IntGene y = x == y GeneInt x == GeneInt y = x == y
FloatGene x == FloatGene y = x == y GeneFloat x == GeneFloat y = x == y
BoolGene x == BoolGene y = x == y GeneBool x == GeneBool y = x == y
StringGene x == StringGene y = x == y GeneString x == GeneString y = x == y
PlaceInput x == PlaceInput y = x == y PlaceInput x == PlaceInput y = x == y
Close == Close = True Close == Close = True
StateFunc x == StateFunc y = True -- This line is probably not the best thing to do StateFunc x == StateFunc y = True -- This line is probably not the best thing to do
@ -30,10 +30,10 @@ instance Eq Gene where
_ == _ = False _ == _ = False
instance Show Gene where instance Show Gene where
show (IntGene x) = "Int: " <> show x show (GeneInt x) = "Int: " <> show x
show (FloatGene x) = "Float: " <> show x show (GeneFloat x) = "Float: " <> show x
show (BoolGene x) = "Bool: " <> show x show (GeneBool x) = "Bool: " <> show x
show (StringGene x) = "String: " <> x show (GeneString x) = "String: " <> x
show (StateFunc func) = "Func: unnamed" show (StateFunc func) = "Func: unnamed"
show (PlaceInput x) = "In: " <> x show (PlaceInput x) = "In: " <> x
show Close = "Close" show Close = "Close"
@ -138,7 +138,7 @@ instructionExecDup state = state
instructionExecDoRange :: State -> State instructionExecDoRange :: State -> State
instructionExecDoRange (State (e1 : es) (i0 : i1 : is) fs bs ss ps im) = instructionExecDoRange (State (e1 : es) (i0 : i1 : is) fs bs ss ps im) =
if increment i0 i1 /= 0 if increment i0 i1 /= 0
then State (e1 : Block [IntGene (i1 + increment i0 i1), IntGene i0, StateFunc instructionExecDoRange, e1] : es) (i1 : is) fs bs ss ps im then State (e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionExecDoRange, e1] : es) (i1 : is) fs bs ss ps im
else State (e1 : es) (i1 : is) fs bs ss ps im else State (e1 : es) (i1 : is) fs bs ss ps im
where where
increment :: Int -> Int -> Int increment :: Int -> Int -> Int
@ -152,14 +152,14 @@ instructionExecDoCount :: State -> State
instructionExecDoCount state@(State (e1 : es) (i1 : is) fs bs ss ps im) = instructionExecDoCount state@(State (e1 : es) (i1 : is) fs bs ss ps im) =
if i1 < 1 if i1 < 1
then state then state
else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is} else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is}
instructionExecDoCount state = state instructionExecDoCount state = state
instructionExecDoTimes :: State -> State instructionExecDoTimes :: State -> State
instructionExecDoTimes state@(State (e1 : es) (i1 : is) fs bs ss ps im) = instructionExecDoTimes state@(State (e1 : es) (i1 : is) fs bs ss ps im) =
if i1 < 1 if i1 < 1
then state then state
else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is} else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is}
instructionExecDoTimes state = state instructionExecDoTimes state = state
instructionExecWhile :: State -> State instructionExecWhile :: State -> State
@ -188,10 +188,10 @@ instructionExecWhen state = state
-- Optionally, split this off into independent functions -- Optionally, split this off into independent functions
instructionParameterLoad :: State -> State instructionParameterLoad :: State -> State
instructionParameterLoad (State es is fs bs ss (p : ps) im) = case p of instructionParameterLoad (State es is fs bs ss (p : ps) im) = case p of
(IntGene val) -> State es (val : is) fs bs ss ps im (GeneInt val) -> State es (val : is) fs bs ss ps im
(FloatGene val) -> State es is (val : fs) bs ss ps im (GeneFloat val) -> State es is (val : fs) bs ss ps im
(BoolGene val) -> State es is fs (val : bs) ss ps im (GeneBool val) -> State es is fs (val : bs) ss ps im
(StringGene val) -> State es is fs bs (val : ss) ps im (GeneString val) -> State es is fs bs (val : ss) ps im
instructionParameterLoad state = state instructionParameterLoad state = state
-- Loads a genome into the exec stack -- Loads a genome into the exec stack
@ -212,10 +212,10 @@ interpretExec :: State -> State
interpretExec (State [] is fs bs ss ps im) = State [] is fs bs ss ps im interpretExec (State [] is fs bs ss ps im) = State [] is fs bs ss ps im
interpretExec (State (e : es) is fs bs ss ps im) = interpretExec (State (e : es) is fs bs ss ps im) =
case e of case e of
(IntGene val) -> interpretExec (State es (val : is) fs bs ss ps im) (GeneInt val) -> interpretExec (State es (val : is) fs bs ss ps im)
(FloatGene val) -> interpretExec (State es is (val : fs) bs ss ps im) (GeneFloat val) -> interpretExec (State es is (val : fs) bs ss ps im)
(BoolGene val) -> interpretExec (State es is fs (val : bs) ss ps im) (GeneBool val) -> interpretExec (State es is fs (val : bs) ss ps im)
(StringGene val) -> interpretExec (State es is fs bs (val : ss) ps im) (GeneString val) -> interpretExec (State es is fs bs (val : ss) ps im)
(StateFunc func) -> interpretExec (func (State es is fs bs ss ps im)) (StateFunc func) -> interpretExec (func (State es is fs bs ss ps im))
(Block block) -> interpretExec (State (block ++ es) is fs bs ss ps im) (Block block) -> interpretExec (State (block ++ es) is fs bs ss ps im)
(PlaceInput input) -> interpretExec (State (im Map.! input : es) is fs bs ss ps im) (PlaceInput input) -> interpretExec (State (im Map.! input : es) is fs bs ss ps im)

27
tests/Main.hs
View File

@ -7,21 +7,20 @@ intTestFunc name goal genome startState =
let state = loadProgram genome startState let state = loadProgram genome startState
in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.") in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.")
main :: IO () main :: IO ()
main = do main = do
intTestFunc "instructionIntAdd" [8] [IntGene 6, IntGene 2, StateFunc instructionIntAdd] emptyState intTestFunc "instructionIntAdd" [8] [GeneInt 6, GeneInt 2, StateFunc instructionIntAdd] emptyState
intTestFunc "instructionIntSub" [4] [IntGene 6, IntGene 2, StateFunc instructionIntSub] emptyState intTestFunc "instructionIntSub" [4] [GeneInt 6, GeneInt 2, StateFunc instructionIntSub] emptyState
intTestFunc "instructionIntMul" [12] [IntGene 6, IntGene 2, StateFunc instructionIntMul] emptyState intTestFunc "instructionIntMul" [12] [GeneInt 6, GeneInt 2, StateFunc instructionIntMul] emptyState
intTestFunc "instructionIntDiv" [3] [IntGene 6, IntGene 2, StateFunc instructionIntDiv] emptyState intTestFunc "instructionIntDiv" [3] [GeneInt 6, GeneInt 2, StateFunc instructionIntDiv] emptyState
intTestFunc "instructionExecIf" [6, 5] [BoolGene True, StateFunc instructionExecIf, Block [IntGene 5, IntGene 6], Block [IntGene 7, IntGene 8]] emptyState intTestFunc "instructionExecIf" [6, 5] [GeneBool True, StateFunc instructionExecIf, Block [GeneInt 5, GeneInt 6], Block [GeneInt 7, GeneInt 8]] emptyState
intTestFunc "instructionExecDup" [8] [StateFunc instructionExecDup, IntGene 4, StateFunc instructionIntAdd] emptyState intTestFunc "instructionExecDup" [8] [StateFunc instructionExecDup, GeneInt 4, StateFunc instructionIntAdd] emptyState
intTestFunc "instructionExecDoRange" [12] [IntGene 2, Block [IntGene 4, IntGene 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState intTestFunc "instructionExecDoRange" [12] [GeneInt 2, Block [GeneInt 4, GeneInt 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState
intTestFunc "instructionExecDoCount" [8] [IntGene 2, Block [IntGene 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState intTestFunc "instructionExecDoCount" [8] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState
intTestFunc "instructionIntAdd" [69, 69, 69, 69, 2] [IntGene 2, Block [IntGene 4, StateFunc instructionExecDoTimes], IntGene 69] emptyState intTestFunc "instructionIntAdd" [69, 69, 69, 69, 2] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoTimes], GeneInt 69] emptyState
intTestFunc "instructionExecDoTimes" [70, 70] [BoolGene False, BoolGene True, BoolGene True, StateFunc instructionExecWhile, IntGene 70] emptyState intTestFunc "instructionExecDoTimes" [70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecWhile, GeneInt 70] emptyState
intTestFunc "instructionExecWhile" [70, 70, 70] [BoolGene False, BoolGene True, BoolGene True, StateFunc instructionExecDoWhile, IntGene 70] emptyState intTestFunc "instructionExecWhile" [70, 70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecDoWhile, GeneInt 70] emptyState
intTestFunc "instructionExecDoWhile" [71] [BoolGene True, StateFunc instructionExecWhen, IntGene 71] emptyState intTestFunc "instructionExecDoWhile" [71] [GeneBool True, StateFunc instructionExecWhen, GeneInt 71] emptyState
let loadedState = loadProgram [BoolGene False, StateFunc instructionExecWhen, IntGene 71] emptyState let loadedState = loadProgram [GeneBool False, StateFunc instructionExecWhen, GeneInt 71] emptyState
assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhen passed test." assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhen passed test."