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.Instructions.Opens
|
||||||
import HushGP.State
|
import HushGP.State
|
||||||
import HushGP.Utility
|
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
|
-- | Makes a random plushy from variables in a passed argMap and
|
||||||
-- a passed list of instructions.
|
-- 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.
|
-- | Internal function used to convert a plushy genome with opens in it into a push genome.
|
||||||
plushyToPush' :: [Gene] -> [Gene] -> [Gene]
|
plushyToPush' :: [Gene] -> [Gene] -> [Gene]
|
||||||
plushyToPush' openPlushy push =
|
plushyToPush' openPlushy push
|
||||||
if null openPlushy
|
| null openPlushy = if any isOpen push
|
||||||
then
|
|
||||||
if any isOpen push
|
|
||||||
then plushyToPush' [Close] push
|
then plushyToPush' [Close] push
|
||||||
else push
|
else push
|
||||||
else
|
| firstPlushy == Close = if any isOpen push
|
||||||
if firstPlushy == Close
|
then plushyToPush' (drop 1 openPlushy) (if numOpen (push !! openIndex) == 1 then preOpen <> [Block postOpen] else preOpen <> [Block (postOpen <> [decOpen (Open (numOpen (push !! openIndex)))])])
|
||||||
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)))])
|
|
||||||
else plushyToPush' (drop 1 openPlushy) push
|
else plushyToPush' (drop 1 openPlushy) push
|
||||||
else plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy])
|
| otherwise = plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy])
|
||||||
where
|
where
|
||||||
firstPlushy :: Gene
|
firstPlushy :: Gene
|
||||||
firstPlushy =
|
firstPlushy
|
||||||
case uncons openPlushy of
|
= case uncons openPlushy of
|
||||||
Just (g, _) -> g
|
Just (g, _) -> g
|
||||||
_ -> error "This shouldn't happen"
|
_ -> error "This shouldn't happen"
|
||||||
postOpen :: [Gene]
|
postOpen :: [Gene]
|
||||||
|
@ -31,10 +31,16 @@ import HushGP.Instructions.VectorIntInstructions
|
|||||||
import HushGP.Instructions.VectorStringInstructions
|
import HushGP.Instructions.VectorStringInstructions
|
||||||
import HushGP.State
|
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
|
-- | All of the instructions declared in all the instruction submodules
|
||||||
allInstructions :: [Gene]
|
allInstructions :: [Gene]
|
||||||
allInstructions =
|
allInstructions =
|
||||||
allIntInstructions
|
noOpStateFunc : noOpStateFuncBlock : allIntInstructions
|
||||||
<> allFloatInstructions
|
<> allFloatInstructions
|
||||||
<> allBoolInstructions
|
<> allBoolInstructions
|
||||||
<> allCharInstructions
|
<> allCharInstructions
|
||||||
|
@ -9,6 +9,14 @@ import Data.List.Split
|
|||||||
|
|
||||||
-- import Debug.Trace
|
-- 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.
|
-- |Duplicates the top of a stack based on a lens.
|
||||||
instructionDup :: Lens' State [a] -> State -> State
|
instructionDup :: Lens' State [a] -> State -> State
|
||||||
instructionDup accessor state =
|
instructionDup accessor state =
|
||||||
|
@ -2,6 +2,7 @@ module HushGP.Instructions.Opens where
|
|||||||
|
|
||||||
import HushGP.State
|
import HushGP.State
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
|
import HushGP.Instructions.GenericInstructions
|
||||||
import HushGP.Instructions.ExecInstructions
|
import HushGP.Instructions.ExecInstructions
|
||||||
import HushGP.Instructions.StringInstructions
|
import HushGP.Instructions.StringInstructions
|
||||||
import HushGP.Instructions.VectorIntInstructions
|
import HushGP.Instructions.VectorIntInstructions
|
||||||
@ -36,5 +37,6 @@ instructionOpens = Map.fromList [
|
|||||||
(StateFunc (instructionVectorFloatIterate, "instructionVectorFloatIterate"), 1),
|
(StateFunc (instructionVectorFloatIterate, "instructionVectorFloatIterate"), 1),
|
||||||
(StateFunc (instructionVectorStringIterate, "instructionVectorStringIterate"), 1),
|
(StateFunc (instructionVectorStringIterate, "instructionVectorStringIterate"), 1),
|
||||||
(StateFunc (instructionVectorBoolIterate, "instructionVectorBoolIterate"), 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