I love plushy genomes
This commit is contained in:
parent
46fe4fac0f
commit
eab4932d54
@ -6,6 +6,21 @@ import Data.Map qualified as Map
|
||||
import HushGP.Instructions.Opens
|
||||
import HushGP.State
|
||||
import HushGP.Utility
|
||||
import HushGP.Instructions
|
||||
|
||||
tempPlushy :: [Gene]
|
||||
tempPlushy = [
|
||||
StateFunc (instructionIntDiv, "instructionIntDiv"),
|
||||
StateFunc (instructionExecDup, "instructionExecDup"),
|
||||
GeneInt 1,
|
||||
GeneInt 0,
|
||||
StateFunc (instructionIntDiv, "instructionIntDiv"),
|
||||
GeneInt (-15),
|
||||
StateFunc (instructionIntSub, "instructionIntSub"),
|
||||
StateFunc (instructionNoOpBlock, "instructionNoOpBlock"),
|
||||
Close,
|
||||
Close
|
||||
]
|
||||
|
||||
-- | Makes a random plushy from variables in a passed argMap and
|
||||
-- a passed list of instructions.
|
||||
@ -50,23 +65,18 @@ plushyToPush plushy = plushyToPush' (concatMap (\x -> if isOpenerList x then x <
|
||||
|
||||
-- | Internal function used to convert a plushy genome with opens in it into a push genome.
|
||||
plushyToPush' :: [Gene] -> [Gene] -> [Gene]
|
||||
plushyToPush' openPlushy push =
|
||||
if null openPlushy
|
||||
then
|
||||
if any isOpen push
|
||||
plushyToPush' openPlushy push
|
||||
| null openPlushy = if any isOpen push
|
||||
then plushyToPush' [Close] push
|
||||
else push
|
||||
else
|
||||
if firstPlushy == Close
|
||||
then
|
||||
if any isOpen push
|
||||
then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> postOpen else preOpen <> postOpen <> [decOpen (Open (numOpen (push !! openIndex)))])
|
||||
| firstPlushy == Close = if any isOpen push
|
||||
then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> [Block postOpen] else preOpen <> [Block (postOpen <> [decOpen (Open (numOpen (push !! openIndex)))])])
|
||||
else plushyToPush' (drop 1 openPlushy) push
|
||||
else plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy])
|
||||
| otherwise = plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy])
|
||||
where
|
||||
firstPlushy :: Gene
|
||||
firstPlushy =
|
||||
case uncons openPlushy of
|
||||
firstPlushy
|
||||
= case uncons openPlushy of
|
||||
Just (g, _) -> g
|
||||
_ -> error "This shouldn't happen"
|
||||
postOpen :: [Gene]
|
||||
|
@ -31,10 +31,16 @@ import HushGP.Instructions.VectorIntInstructions
|
||||
import HushGP.Instructions.VectorStringInstructions
|
||||
import HushGP.State
|
||||
|
||||
noOpStateFunc :: Gene
|
||||
noOpStateFunc = StateFunc (instructionNoOp, "instructionNoOp")
|
||||
|
||||
noOpStateFuncBlock :: Gene
|
||||
noOpStateFuncBlock = StateFunc (instructionNoOpBlock, "instructionNoOpBlock")
|
||||
|
||||
-- | All of the instructions declared in all the instruction submodules
|
||||
allInstructions :: [Gene]
|
||||
allInstructions =
|
||||
allIntInstructions
|
||||
noOpStateFunc : noOpStateFuncBlock : allIntInstructions
|
||||
<> allFloatInstructions
|
||||
<> allBoolInstructions
|
||||
<> allCharInstructions
|
||||
|
@ -9,6 +9,14 @@ import Data.List.Split
|
||||
|
||||
-- import Debug.Trace
|
||||
|
||||
-- |Does No Operation. Useful for genome stuff :)
|
||||
instructionNoOpBlock :: State -> State
|
||||
instructionNoOpBlock state = state
|
||||
|
||||
-- |Does No Operation. Just evolve fodder.
|
||||
instructionNoOp :: State -> State
|
||||
instructionNoOp state = state
|
||||
|
||||
-- |Duplicates the top of a stack based on a lens.
|
||||
instructionDup :: Lens' State [a] -> State -> State
|
||||
instructionDup accessor state =
|
||||
|
@ -2,6 +2,7 @@ module HushGP.Instructions.Opens where
|
||||
|
||||
import HushGP.State
|
||||
import Data.Map qualified as Map
|
||||
import HushGP.Instructions.GenericInstructions
|
||||
import HushGP.Instructions.ExecInstructions
|
||||
import HushGP.Instructions.StringInstructions
|
||||
import HushGP.Instructions.VectorIntInstructions
|
||||
@ -36,5 +37,6 @@ instructionOpens = Map.fromList [
|
||||
(StateFunc (instructionVectorFloatIterate, "instructionVectorFloatIterate"), 1),
|
||||
(StateFunc (instructionVectorStringIterate, "instructionVectorStringIterate"), 1),
|
||||
(StateFunc (instructionVectorBoolIterate, "instructionVectorBoolIterate"), 1),
|
||||
(StateFunc (instructionVectorCharIterate, "instructionVectorCharIterate"), 1)
|
||||
(StateFunc (instructionVectorCharIterate, "instructionVectorCharIterate"), 1),
|
||||
(StateFunc (instructionNoOpBlock, "instructionNoOpBlock"), 1)
|
||||
]
|
||||
|
Loading…
x
Reference in New Issue
Block a user