diff --git a/HushGP.cabal b/HushGP.cabal index 98afee4..87df5dc 100644 --- a/HushGP.cabal +++ b/HushGP.cabal @@ -19,28 +19,51 @@ version: 0.1.0.0 synopsis: A PushGP implementation in Haskell. -- The package author(s). -author: Taylor +author: Rowan Torbitzky-Lane, Taylor -- An email address to which users can send suggestions, bug reports, and patches. -maintainer: behindthebrain@zoho.eu +maintainer: rowan.a.tl@protonmail.com category: Data build-type: Simple common warnings - ghc-options: -Wall + ghc-options: -Wall -XTemplateHaskell -threaded library -- Import common warning flags. import: warnings -- Modules exported by the library. - exposed-modules: Push - , GP - , State - , Instructions.IntInstructions - , Instructions.ExecInstructions - , Instructions.FloatInstructions + exposed-modules: HushGP.Push + , HushGP.TH + , HushGP.Utility + , HushGP.Genome + , HushGP.State + , HushGP.Instructions + , HushGP.Instructions.IntInstructions + , HushGP.Instructions.ExecInstructions + , HushGP.Instructions.FloatInstructions + , HushGP.Instructions.GenericInstructions + , HushGP.Instructions.BoolInstructions + , HushGP.Instructions.CodeInstructions + , HushGP.Instructions.StringInstructions + , HushGP.Instructions.CharInstructions + , HushGP.Instructions.VectorIntInstructions + , HushGP.Instructions.VectorFloatInstructions + , HushGP.Instructions.VectorStringInstructions + , HushGP.Instructions.VectorBoolInstructions + , HushGP.Instructions.VectorCharInstructions + , HushGP.Instructions.Utility + , HushGP.Instructions.Opens + , HushGP.PushTests + , HushGP.PushTests.IntTests + , HushGP.PushTests.GenericTests + , HushGP.PushTests.UtilTests + , HushGP.GP + , HushGP.GP.PushArgs + , HushGP.Problems.IntegerRegression + -- Modules included in this library but not exported. -- other-modules: @@ -50,7 +73,7 @@ library -- Other library packages from which modules are imported. build-depends: - base, containers + base, containers, lens, split, QuickCheck, regex-tdfa, template-haskell, random, parallel -- Directories containing source files. hs-source-dirs: src @@ -90,7 +113,7 @@ test-suite HushGP-test default-language: GHC2021 -- Modules included in this executable, other than Main. - -- other-modules: + -- other-modules: -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -107,4 +130,35 @@ test-suite HushGP-test -- Test dependencies. build-depends: base, - HushGP + HushGP, + lens, + QuickCheck + +test-suite HushGP-test-old + -- Import common warning flags. + import: warnings + + -- Base language which the package is written in. + default-language: GHC2021 + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- The interface type and version of the test suite. + type: exitcode-stdio-1.0 + + -- Directories containing source files. + hs-source-dirs: test + + -- The entrypoint to the test suite. + main-is: MainOld.hs + + -- Test dependencies. + build-depends: + base, + HushGP, + lens, + diff --git a/Makefile b/Makefile index bd281ee..79a3b29 100644 --- a/Makefile +++ b/Makefile @@ -15,7 +15,7 @@ test: # Runs unit tests. runghc -i./src/ test/Main.hs format: # Formats code using ormolu. - ormolu --mode inplace app/*.hs src/*.hs test/*.hs + ormolu --mode inplace app/*.hs src/HushGP/*.hs test/*.hs hlint: # HLint for lint suggestions. hlint src/*.hs diff --git a/README.md b/README.md index 608cfbe..894f2d3 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,26 @@ # HushGP A PushGP implementation in Haskell +This branch is meant to to go one by one and finish implementing all of +the functions in the pyshgp list. + +https://erp12.github.io/pyshgp/html/core_instructions.html + +# Big Problem + +There is no easy way to determine equality of two functions in Haskell. No comparing names, no nothing. +We coult compare applying two functions to an example state, but that would get tedious and costly quickly. + +The only idea floating in my head at the moment is to attach a string to the `StateFunc` Gene to +track what the functions are. This would require a painful redefinition of the tests, but I think would be +worth it in the grand scheme. Would mean we could also track the functions when outputting them after training. + ## Tasks * [ ] Post minimal core of exec to haskell discourse for advice about speed optimization. * [x] Do test-driven development on this one. * [x] Write tests for every function. * [x] tests/ are just copied from make-grade, need to write for this project. * [ ] Included examples of basic assertions, QuickCheck, Hspec, hspec-quickcheck. -* [ ] Look at Lenses library for abstraction ## Design considerations The biggest design constraint is that for the exec stack (but not data stacks) diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..fe3600d --- /dev/null +++ b/TODO.md @@ -0,0 +1,39 @@ +# TODO + +## Push Language TODO + +- [X] Make all vector functions applicable to string functions and vice versa +- [X] Implement all functions as seen in propeller +- [X] Implement all functions as seen in the specification +- [ ] Implement Linear Algebra functions as specified in the previous papers +- [X] Add a function to sort a vector forward and backwards +- [X] Disambiguate isEmpty and stackIsEmpty +- [X] Rename Logical to Bool +- [X] Make int yank, shove, yankdup, and shovedup generic +- [X] Write haddock documentation for each function +- [X] Refactor all functions to take state as the final parameter +- [X] Standardize the pattern matching parameter names, such as c1 : cs +- [ ] Write unit/quickcheck tests for the generic functions +- [X] Use template haskell to generate function lists +- [X] Move utility functions to their own file +- [ ] Make add/sub/mult/div/mod instructions generic +- [ ] Use template haskell to (mostly) generate functions from generic ones (Split files based on the arity of their functions) + +## PushGP TODO +- [X] Implement a Plushy genome translator + - [X] Implement ~~silent and~~ skip marker(s) as well + ~~[ ] Have close amt of 1,2, and 3~~ + - [X] Need a random genome generator + - I'm only going to implement propeller's :specified version + - Is the best according to the papers + - [X] Need a NoOp that opens blocks +- [ ] Need to make genomes serializable (Check pysh json files) +- [ ] Add Memory +- [ ] Add history stack(s), like a call stack +- [ ] Implement interpreter options (could probably just place this into a map) + - Should probably place this in a separate file +- [ ] Implement different forms of downsampling +- [ ] Implement concurrent execution of creating random plushies and evaluating individuals +- [X] Devise a good way to implement ERCs +- [ ] Implement random simplification of genomes + - [ ] Find a way to multi-thread this diff --git a/src/GP.hs b/src/GP.hs deleted file mode 100644 index 3b0f83a..0000000 --- a/src/GP.hs +++ /dev/null @@ -1,3 +0,0 @@ -module GP where - --- import Debug.Trace (trace, traceStack) diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs new file mode 100644 index 0000000..c3a61c0 --- /dev/null +++ b/src/HushGP/GP.hs @@ -0,0 +1,23 @@ +module HushGP.GP where + +import HushGP.State +import HushGP.Genome +import HushGP.GP.PushArgs +import Control.Monad +import Control.Parallel.Strategies +-- import Debug.Trace (trace, traceStack) + +-- | Using a PushArgs object, generates a population of the specified size with the +-- specified instructions in parallel. +generatePopulation :: PushArgs -> [Individual] +generatePopulation pushArgs = + replicate (populationSize pushArgs) (makeRandomIndividual pushArgs) `using` rpar + +evaluatePopulation :: PushArgs -> [Individual] -> IO [Individual] +evaluatePopulation pushArgs population = map (fmap (errorFunction pushArgs pushArgs (trainingData pushArgs)) . plushy) population + +-- | The start of the gp loop. TODO: Make this more accurate later. +gpLoop :: PushArgs -> IO () +gpLoop pushArgs = do + let unEvaledPopulation = generatePopulation pushArgs + print "gamer" diff --git a/src/HushGP/GP/PushArgs.hs b/src/HushGP/GP/PushArgs.hs new file mode 100644 index 0000000..3858e25 --- /dev/null +++ b/src/HushGP/GP/PushArgs.hs @@ -0,0 +1,139 @@ +module HushGP.GP.PushArgs where + +import HushGP.State +import Data.Map qualified as Map +import HushGP.Instructions + +-- | The structure holding the arguments for the various aspects +-- of the evolutionary run in Hush. +data PushArgs = PushArgs + { + -- | For alternation, std deviation fo index when alternating. + alignmentDeviation :: Int, + -- | For alternation, probability of switching parents at each location. + alternationRate :: Float, + -- | For bmx, rate genes are exchanged. + bmxExchangeRate :: Float, + -- | For bmx, max length of a gene. + bmxGeneLengthLimit :: Int, + -- | For bmx, mutation rate for gaps. + bmxGapChangeProbability :: Float, + -- | For bmx, whether mates selected using reverse case sequences of first parent + bmxIsComplementary :: Bool, + -- | For bmx, don't exchange distance if greater than this + bmxMaxDistance :: Int, + -- | For bmx, only allow exchanges between individual with same number of genes. + bmxSameGeneCount :: Bool, + -- | For bmx, swap segment with same sequence index, not by best match + ssxNotBmx :: Bool, + -- | Ways to construct a phenotype from a plushy genome, so far only "specified" is implemented. Unused (for now). + closes :: String, + -- | Custom report for each generation if provided. + customReport :: Maybe (PushArgs -> IO ()), + -- | If True, keeps running regardless of success. + dontEnd :: Bool, + -- | Whether of not to use downsampling. + enableDownsampling :: Bool, + -- | The downsample function to use. "caseRand", "caseMaxim", "caseMaximAuto". + downsampleFunction :: String, + -- | Proportion of data used in downsample. + downsampleRate :: Float, + -- | Proportion of parents used to evaluate case distances. + downsampleParentRate :: Float, + -- | Amount of generations between parent distance computation + downsampleParentsGens :: Int, + -- | Whether or not to add the best individual to the next generation. + elitism :: Bool, + -- | User must provide their own error function. + -- Arg 1: PushArgs for the current set of arguments. + -- Arg 2: ([[Gene]], [Gene]) is the input data. Input is the first index and output is the second index. + -- Arg 3: [Gene] is the plushy representation of a program. + -- Returns the error list for a given set of inputs of type [Double]. + errorFunction :: PushArgs -> ([[Gene]], [Gene]) -> [Gene] -> [Double], + -- | Type of informed downsampling. "solved", "elite", "soft". + informedDownsamplingType :: String, + -- | List of instructions to use in the evolutionary run. + instructionList :: [Gene], + -- | For motely batch lexicase selection, max size of a batch of cases. + maxMotelyBatchSize :: Int, + -- | Max size of plushy genomes in a population. + maxInitialPlushySize :: Int, + -- | Maximum amount of generations allowed in an evolutionary run. + maxGenerations :: Int, + -- | Type of parent selection to use. Think "lexicase" and "tournament" for now. + parentSelectionAlgo :: String, + -- |Size of the population in the evolutionary run. + populationSize :: Int, + -- | For uniform replacement, rate of item replacement. + replacementRate :: Float, + -- | Whether or not to auto simplify solutions. + useSimplification :: Bool, + -- | When auto simplifying, max amt items deleted in a single step. + simplificationMaxAmt :: Int, + -- | When auto simplifying, number of simplification steps. + simplificationSteps :: Int, + -- | When auto simplifying, whether to print verbose information. + simplificationVerbose :: Bool, + -- | Whether to use mutli-threading. + useMultiThreading :: Bool, + -- | Max total error for solutions. + solutionErrorThreshold :: Int, + -- | Limit of push interpreter steps in push program evaluation. + stepLimit :: Int, + -- | For tournament selection, amount of individuals in each tournament. + tournamentSize :: Int, + -- | Training data for the gp, must be provided. + trainingData :: ([[Gene]], [Gene]), + -- | Testing data for the gp, must be provided if there is any. + testingData :: ([[Gene]], [Gene]), + -- | Addition rate for UMAD (deletion rate derived from this). + umadRate :: Float, + -- | Genetic operators and probabilities for their use, should sum to one + -- Takes a Map of String -> Float where the string is the genetic operator + variation :: Map.Map String Float + } + +-- | The default values for which all runs of Hush derive +-- their args from. +defaultPushArgs :: PushArgs +defaultPushArgs = PushArgs { + alignmentDeviation = 2, + alternationRate = 0.1, + bmxExchangeRate = 0.5, + bmxGeneLengthLimit = 10, + bmxGapChangeProbability = 0.001, + bmxIsComplementary = False, + bmxMaxDistance = 1000000, + bmxSameGeneCount = False, + closes = "specified", + customReport = Nothing, + dontEnd = False, + enableDownsampling = True, + downsampleFunction = "caseMaxim", + downsampleRate = 0.05, + downsampleParentRate = 0.01, + downsampleParentsGens = 10, + elitism = False, + errorFunction = error "Must supply the error function yourself", + informedDownsamplingType = "solved", + instructionList = allInstructions, + maxMotelyBatchSize = 10, + maxInitialPlushySize = 100, + maxGenerations = 1000, + parentSelectionAlgo = "lexicase", + populationSize = 1000, + replacementRate = 0.1, + useSimplification = True, + simplificationMaxAmt = 4, + simplificationSteps = 1000, + simplificationVerbose = False, + useMultiThreading = False, -- False for now, change to True later. + solutionErrorThreshold = 0, + ssxNotBmx = False, + stepLimit = 1000, + tournamentSize = 5, + testingData = ([], []), + trainingData = ([], []), + umadRate = 0.1, + variation = Map.fromList [("umad", 1.0)] + } diff --git a/src/HushGP/Genome.hs b/src/HushGP/Genome.hs new file mode 100644 index 0000000..f57e7ab --- /dev/null +++ b/src/HushGP/Genome.hs @@ -0,0 +1,93 @@ +module HushGP.Genome where + +import Data.List +import Data.List.Split +import Data.Map qualified as Map +import HushGP.Instructions.Opens +import HushGP.State +import HushGP.Utility +import HushGP.GP.PushArgs +-- import HushGP.Instructions +-- import Debug.Trace + +-- | The structure for an individual containing the genome, the totalFitness, and +-- the individual fitness cases for lexicase. +data Individual = Individual { + plushy :: IO [Gene], + totalFitness :: Maybe Double, + fitnessCases :: Maybe [Double] +} + +-- | Makes a random individual based on the variables in a passed PushArgs. +makeRandomIndividual :: PushArgs -> Individual +makeRandomIndividual pushArgs = Individual {plushy = makeRandomPlushy pushArgs, totalFitness = Nothing, fitnessCases = Nothing} + +-- | Makes a random plushy from variables in a passed PushArgs. +makeRandomPlushy :: PushArgs -> IO [Gene] +makeRandomPlushy pushArgs = randomInstructions (maxInitialPlushySize pushArgs) (instructionList pushArgs) + +-- | A utility function to generate an amount based on an int rather than +-- from an argmap. +makeRandomPlushy' :: Int -> [Gene] -> IO [Gene] +makeRandomPlushy' = randomInstructions + +-- | Checks to see if a Gene is an (Open _) constructor. +isOpen :: Gene -> Bool +isOpen (Open _) = True +isOpen _ = False + +-- | Decrements the count of an (Open _) constructor. Acts as id +-- if the gene isn't an open. +decOpen :: Gene -> Gene +decOpen (Open n) = Open (n - 1) +decOpen gene = gene + +-- | Checks to see if the a list of genes with a single element is an opener. +isOpenerList :: [Gene] -> Bool +isOpenerList [instruction] = + case Map.lookup instruction instructionOpens of + Just _ -> True + _ -> False +isOpenerList _ = False + +-- | Gets the amount of blocks to open from a list of genes with a single element. +getOpenAmountList :: [Gene] -> Int +getOpenAmountList [instruction] = + case Map.lookup instruction instructionOpens of + Just amt -> amt + _ -> 0 +getOpenAmountList _ = 0 + +-- | Converts a plushy genome into a push genome. +plushyToPush :: [Gene] -> [Gene] +plushyToPush plushy = plushyToPush' (concatMap (\x -> if isOpenerList x then x <> [Open (getOpenAmountList x)] else x) (chunksOf 1 plushy)) [] + +-- | Internal function used to convert a plushy genome with opens in it into its push phenotype. +plushyToPush' :: [Gene] -> [Gene] -> [Gene] +plushyToPush' openPlushy push + | null openPlushy = if any isOpen push + then plushyToPush' [Close] push + else push + | 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 + | firstPlushy == Skip = + case uncons openPlushy of + Just (_, _ : xs) -> plushyToPush' xs push + _ -> plushyToPush' (drop 1 openPlushy) push + | otherwise = plushyToPush' (drop 1 openPlushy) (push <> [firstPlushy]) + where + firstPlushy :: Gene + firstPlushy + = case uncons openPlushy of + Just (g, _) -> g + _ -> error "This shouldn't happen" + postOpen :: [Gene] + postOpen = reverse (takeWhile (not . isOpen) (reverse push)) + openIndex :: Int + openIndex = length push - length postOpen - 1 + numOpen :: Gene -> Int + numOpen (Open n) = n + numOpen _ = 0 + preOpen :: [Gene] + preOpen = take openIndex push diff --git a/src/HushGP/Instructions.hs b/src/HushGP/Instructions.hs new file mode 100644 index 0000000..ab701c7 --- /dev/null +++ b/src/HushGP/Instructions.hs @@ -0,0 +1,54 @@ +module HushGP.Instructions + ( module HushGP.Instructions.GenericInstructions, + module HushGP.Instructions.IntInstructions, + module HushGP.Instructions.FloatInstructions, + module HushGP.Instructions.StringInstructions, + module HushGP.Instructions.CharInstructions, + module HushGP.Instructions.CodeInstructions, + module HushGP.Instructions.ExecInstructions, + module HushGP.Instructions.BoolInstructions, + module HushGP.Instructions.VectorIntInstructions, + module HushGP.Instructions.VectorFloatInstructions, + module HushGP.Instructions.VectorStringInstructions, + module HushGP.Instructions.VectorBoolInstructions, + module HushGP.Instructions.VectorCharInstructions, + allInstructions, + ) +where + +import HushGP.Instructions.BoolInstructions +import HushGP.Instructions.CharInstructions +import HushGP.Instructions.CodeInstructions +import HushGP.Instructions.ExecInstructions +import HushGP.Instructions.FloatInstructions +import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.IntInstructions +import HushGP.Instructions.StringInstructions +import HushGP.Instructions.VectorBoolInstructions +import HushGP.Instructions.VectorCharInstructions +import HushGP.Instructions.VectorFloatInstructions +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 = + noOpStateFunc : noOpStateFuncBlock : allIntInstructions + <> allFloatInstructions + <> allBoolInstructions + <> allCharInstructions + <> allCodeInstructions + <> allExecInstructions + <> allStringInstructions + <> allVectorIntInstructions + <> allVectorFloatInstructions + <> allVectorCharInstructions + <> allVectorStringInstructions + <> allVectorBoolInstructions diff --git a/src/HushGP/Instructions/BoolInstructions.hs b/src/HushGP/Instructions/BoolInstructions.hs new file mode 100644 index 0000000..ece81d6 --- /dev/null +++ b/src/HushGP/Instructions/BoolInstructions.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.BoolInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility +import HushGP.TH + +-- |If top of int stack /= 0 pushes True to bool stack, else false. +instructionBoolFromInt :: State -> State +instructionBoolFromInt state@(State {_int = i1 : is, _bool = bs}) = state {_int = is, _bool = (i1 /= 0) : bs} +instructionBoolFromInt state = state + +-- |If top of float stack /= 0 pushes True to bool stack, else false. +instructionBoolFromFloat :: State -> State +instructionBoolFromFloat state@(State {_float = f1 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 /= 0) : bs} +instructionBoolFromFloat state = state +-- |Takes the top two bools and Ands them. +instructionBoolAnd :: State -> State +instructionBoolAnd = boolTemplate (&&) + +-- |Takes the top two bools, inverts the first bool and then Ands the modified state. +instructionBoolInvertFirstThenAnd :: State -> State +instructionBoolInvertFirstThenAnd state@(State {_bool = b1 : bs}) = boolTemplate (&&) state {_bool = not b1 : bs} +instructionBoolInvertFirstThenAnd state = state + +-- |Takes the top two bools, inverts the second bool and then Ands the modified state. +instructionBoolInvertSecondThenAnd :: State -> State +instructionBoolInvertSecondThenAnd state@(State {_bool = b1 : b2 : bs}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs} +instructionBoolInvertSecondThenAnd state = state + +-- |Takes the top two bools and Ors them. +instructionBoolOr :: State -> State +instructionBoolOr = boolTemplate (||) + +-- |Takes the xor of the top two bools. +instructionBoolXor :: State -> State +instructionBoolXor = boolTemplate xor + +-- |Pops the top of the bool stack. +instructionBoolPop :: State -> State +instructionBoolPop = instructionPop bool + +-- |Duplicates the top of the bool stack. +instructionBoolDup :: State -> State +instructionBoolDup = instructionDup bool + +-- |Duplicates the top of the bool stack based on the top int from the int stack. +instructionBoolDupN :: State -> State +instructionBoolDupN = instructionDupN bool + +-- |Swaps the top two bools. +instructionBoolSwap :: State -> State +instructionBoolSwap = instructionSwap bool + +-- |Rotates the top three bools. +instructionBoolRot :: State -> State +instructionBoolRot = instructionRot bool + +-- |Sets the bool stack to [] +instructionBoolFlush :: State -> State +instructionBoolFlush = instructionFlush bool + +-- |Tests if the top two bools are equal and pushes the result to the bool stack. +instructionBoolEq :: State -> State +instructionBoolEq = instructionEq bool + +-- |Calculates the size of a stack and pushes the result to the int stack. +instructionBoolStackDepth :: State -> State +instructionBoolStackDepth = instructionStackDepth bool + +-- |Moves an item from deep within the bool stack to the top of the bool stack based on +-- the top int from the int stack +instructionBoolYank :: State -> State +instructionBoolYank = instructionYank bool + +-- |Copies an item from deep within the bool stack to the top of the bool stack based on +-- the top int from the int stack. +instructionBoolYankDup :: State -> State +instructionBoolYankDup = instructionYankDup bool + +-- |Moves an item from the top of the bool stack to deep within the bool stack based on +-- the top int from the int stack. +instructionBoolShove :: State -> State +instructionBoolShove = instructionShove bool + +-- |Copies an item from the top of the bool stack to deep within the bool stack based on +-- the top int from the int stack. +instructionBoolShoveDup :: State -> State +instructionBoolShoveDup = instructionShoveDup bool + +-- |If the bool stack is empty, pushes True to bool stack, else False. +instructionBoolIsStackEmpty :: State -> State +instructionBoolIsStackEmpty = instructionIsStackEmpty bool + +-- |Duplicate the top N items from the bool stack based on the top int from the int stack. +instructionBoolDupItems :: State -> State +instructionBoolDupItems = instructionDupItems bool + +allBoolInstructions :: [Gene] +allBoolInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/CharInstructions.hs b/src/HushGP/Instructions/CharInstructions.hs new file mode 100644 index 0000000..578dafe --- /dev/null +++ b/src/HushGP/Instructions/CharInstructions.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.CharInstructions where + +import Data.Char +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility +import HushGP.TH + +-- |Combines the top two chars into a string and pushes the result to the string stack. +instructionCharConcat :: State -> State +instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state{_char = cs, _string = [c1, c2] : ss} +instructionCharConcat state = state + +-- |Takes the first char from the top string and pushes it to the char stack. +-- If the string is empty, acts as a no-op. +instructionCharFromFirstChar :: State -> State +instructionCharFromFirstChar = instructionVectorFirst char string + +-- |Takes the last char from the top string and pushes it to the char stack. +-- If the string is empty, acts as a no-op. +instructionCharFromLastChar :: State -> State +instructionCharFromLastChar = instructionVectorLast char string + +-- |Takes the Nth char from the top string and pushes it to the char stack +-- based on the top int from the int stack. If the string is empty, acts as a no-op. +instructionCharFromNthChar :: State -> State +instructionCharFromNthChar = instructionVectorNth char string + +-- |Takes the top of the char stack, checks to see if it is whitespace, and then +-- pushes True to the bool stack if so, else false. +instructionCharIsWhitespace :: State -> State +instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs} +instructionCharIsWhitespace state = state + +-- |Takes the top of the char stack, checks to see if it is an alphabetic character, and +-- then pushes True to the bool stack if alphabetic, false if not. +instructionCharIsLetter :: State -> State +instructionCharIsLetter state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isAlpha c1 : bs} +instructionCharIsLetter state = state + +-- |Takes the top of the char stack, checks to see if it is a digit, and then pushes True if it is +-- a digit, False if not. +instructionCharIsDigit :: State -> State +instructionCharIsDigit state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isDigit c1 : bs} +instructionCharIsDigit state = state + +-- |Takes the top of the bool stack, pushes 'T' to the char stack if True, 'F' to the char stack if False. +instructionCharFromBool :: State -> State +instructionCharFromBool state@(State {_char = cs, _bool = b1 : bs}) = state{_char = (if b1 then 'T' else 'F') : cs, _bool = bs} +instructionCharFromBool state = state + +-- |Takes the top of the int stack, pushes the ascii representation of the int to the char stack. +instructionCharFromAsciiInt :: State -> State +instructionCharFromAsciiInt state@(State {_char = cs, _int = i1 : is}) = state{_char = intToAscii i1 : cs, _int = is} +instructionCharFromAsciiInt state = state + +-- |Takes the top of the float stack, pushes the ascii representation of the floored float to the char stack. +instructionCharFromAsciiFloat :: State -> State +instructionCharFromAsciiFloat state@(State {_char = cs, _float = f1 : fs}) = state{_char = intToAscii @Integer (floor f1) : cs, _float = fs} +instructionCharFromAsciiFloat state = state + +-- |Pushes the top string to the char stack split up into individual chars. +-- For example: have the string "hello" and the char stack ['a', 'b', 'c'], the char stack +-- looks like ['h', 'e', 'l', 'l', 'o', 'a', 'b', 'c'] after this instruction executes. +instructionCharsFromString :: State -> State +instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss} +instructionCharsFromString state = state + +-- |Pops the top of the char stack. +instructionCharPop :: State -> State +instructionCharPop = instructionPop char + +-- |Duplicates the top of the char stack. +instructionCharDup :: State -> State +instructionCharDup = instructionDup char + +-- |Duplicates the top of the char stack N times based on the top of +-- int stack. +instructionCharDupN :: State -> State +instructionCharDupN = instructionDupN char + +-- |Swaps the top two chars of the char stack. +instructionCharSwap :: State -> State +instructionCharSwap = instructionSwap char + +-- |Rotates the top three chars of the char stack. +instructionCharRot :: State -> State +instructionCharRot = instructionRot char + +-- |Sets the char stack to []. +instructionCharFlush :: State -> State +instructionCharFlush = instructionFlush char + +-- |Checks to see if the top two chars to equal and pushes the result +-- to the bool stack. +instructionCharEq :: State -> State +instructionCharEq = instructionEq char + +-- |Calculates the stack depth of the char stack. Pushes the result +-- to the int stack. +instructionCharStackDepth :: State -> State +instructionCharStackDepth = instructionStackDepth char + +-- |Moves an item from deep within the char stack to the top of the char stack based on +-- the top int from the int stack. +instructionCharYank :: State -> State +instructionCharYank = instructionYank char + +-- |Copies an item from deep within the char stack to the top of the char stack based on +-- the top int from the int stack. +instructionCharYankDup :: State -> State +instructionCharYankDup = instructionYankDup char + +-- |Pushes True to the bool stack if the char stack is empty. False if not. +instructionCharIsStackEmpty :: State -> State +instructionCharIsStackEmpty = instructionIsStackEmpty char + +-- |Moves an item from the top of the char stack to deep within the char stack based on +-- the top int from the int stack. +instructionCharShove :: State -> State +instructionCharShove = instructionShove char + +-- |Copies an item from the top of the char stack to deep within the char stack based on +-- the top int from the int stack. +instructionCharShoveDup :: State -> State +instructionCharShoveDup = instructionShoveDup char + +-- |Duplicate the top N items from the char stack based on the top int from the int stack. +instructionCharDupItems :: State -> State +instructionCharDupItems = instructionDupItems char + +-- |Takes the top string from the string stack and invidually pushes +-- all chars in said string to the char stack. +instructionCharFromAllString :: State -> State +instructionCharFromAllString = instructionPushAll char string + +allCharInstructions :: [Gene] +allCharInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/CodeInstructions.hs b/src/HushGP/Instructions/CodeInstructions.hs new file mode 100644 index 0000000..65b9b61 --- /dev/null +++ b/src/HushGP/Instructions/CodeInstructions.hs @@ -0,0 +1,352 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.CodeInstructions where + +import Data.List (elemIndex) +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.IntInstructions +import HushGP.Instructions.Utility +import HushGP.TH +-- import Debug.Trace + +-- |Pops the top of the code stack +instructionCodePop :: State -> State +instructionCodePop = instructionPop code + +-- |Checks if the top code item is a Block +instructionCodeIsCodeBlock :: State -> State +instructionCodeIsCodeBlock state@(State {_code = c1 : cs, _bool = bs}) = state {_code = cs, _bool = isBlock c1 : bs} +instructionCodeIsCodeBlock state = state + +-- |Checks if the top code item is not a Block +instructionCodeIsSingular :: State -> State +instructionCodeIsSingular state@(State {_code = c1 : cs, _bool = bs}) = state {_code = cs, _bool = not (isBlock c1) : bs} +instructionCodeIsSingular state = state + +-- |Checks the length of the top code item. If item is a block, counts the size, if not, returns 1 +instructionCodeLength :: State -> State +instructionCodeLength state@(State {_code = c1 : cs, _int = is}) = state {_code = cs, _int = blockLength c1 : is} +instructionCodeLength state = state + +-- CODE.CAR +-- |If the top item on the code stack is a Block, extracts the first item and places it onto the code stack. Acts as a NoOp otherwise. +instructionCodeFirst :: State -> State +instructionCodeFirst state@(State {_code = c1 : cs}) = state {_code = extractFirstFromBlock c1 : cs} +instructionCodeFirst state = state + +-- |If the top item on the code stack is a Block, extracts the last item and places it onto the code stack. Acts as a NoOp otherwise. +instructionCodeLast :: State -> State +instructionCodeLast state@(State {_code = c1 : cs}) = state {_code = extractLastFromBlock c1 : cs} +instructionCodeLast state = state + +-- |If the top item on the code stack is a Block, extracts the tail of said Block and places it onto the code stace. Acts as a NoOp otherwise. +-- CODE.CDR +-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-rest +instructionCodeTail :: State -> State +instructionCodeTail state@(State {_code = c1 : cs}) = state {_code = extractTailFromBlock c1 : cs} +instructionCodeTail state = state + +-- |If the top item on the code stack is a Block, takes the tail of said block starting at an index determined by the int stack +-- and pushes the result to the code stack. +-- Acts as a NoOp if not a Block. +-- https://faculty.hampshire.edu/lspector/push3-description.html#Type +-- This is the CODE.NTHCDR command +instructionCodeTailN :: State -> State +instructionCodeTailN state@(State {_code = Block bc : cs, _int = i1 : is}) = state {_code = Block (drop index bc) : cs, _int = is} + where + index :: Int + index = fromIntegral (abs i1) `mod` length bc +instructionCodeTailN state = state + +-- |If the top item on the code stack is a Block, takes the init of said Block and places the result on top of the code stack. +-- Acts as a NoOp otherwise +-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-but-last +instructionCodeInit :: State -> State +instructionCodeInit state@(State {_code = c1 : cs}) = state {_code = extractInitFromBlock c1 : cs} +instructionCodeInit state = state + +-- |Wraps the top item in the code stack in a Block no matter the type. +instructionCodeWrap :: State -> State +instructionCodeWrap state@(State {_code = c1 : cs}) = state {_code = Block [c1] : cs} +instructionCodeWrap state = state + +-- |Wraps the top two items in the code stack in a Block no matter the type. +instructionCodeList :: State -> State +instructionCodeList state@(State {_code = c1 : c2 : cs}) = state {_code = Block [c1, c2] : cs} +instructionCodeList state = state + +-- |Combines the top two items on the code stack based on whether they are a block or not. +-- Check out the codeCombine utility function for how this works. +instructionCodeCombine :: State -> State +instructionCodeCombine state@(State {_code = c1 : c2 : cs}) = state {_code = codeCombine c1 c2 : cs} +instructionCodeCombine state = state + +-- |Moves the top item from the code stack to the exec stack +instructionCodeDo :: State -> State +instructionCodeDo state@(State {_code = c1 : cs, _exec = es}) = state {_code = cs, _exec = c1 : es} +instructionCodeDo state = state + +-- |Moves the top item from the code stack to the exec stack, doesn't delete the original item from the code stack. +instructionCodeDoDup :: State -> State +instructionCodeDoDup state@(State {_code = c1 : cs, _exec = es}) = state {_code = c1 : cs, _exec = c1 : es} +instructionCodeDoDup state = state + +-- |Places the top code item onto the exec stack (doesn't delete it from the code stack), then places an instructionCodePop onto +-- the exec stack. +-- 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, "instructionCodePop") : es} +instructionCodeDoThenPop state = state + +-- |Evaluates the top item on the code stack for each step along the range i to j. Both i and j are taken from the int stack. +instructionCodeDoRange :: State -> State +instructionCodeDoRange state@(State {_code = c1 : cs, _int = i0 : i1 : is, _exec = es}) = + if increment (fromIntegral i0) (fromIntegral i1) /= 0 + then state {_exec = c1 : Block [GeneInt (i1 + toInteger (increment (fromIntegral i0) (fromIntegral i1))), GeneInt i0, StateFunc (instructionCodeFromExec, "instructionCodeFromExec"), c1, StateFunc (instructionCodeDoRange, "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 + +-- |Evaluates the top item on the code stack for each step along the range i to j. Both i and j are taken from the int stack. +instructionCodeDoCount :: State -> State +instructionCodeDoCount state@(State {_code = c : cs, _int = i1 : is, _exec = es}) = + if i1 < 1 + then state + else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc (instructionCodeFromExec, "instructionCodeFromExec"), c, StateFunc (instructionCodeDoRange, "instructionCodeDoRange")] : es} +instructionCodeDoCount state = state + +-- |Evaluates the top item on the code stack n times, where n comes from the n comes from the top of the int stack. +instructionCodeDoTimes :: State -> State +instructionCodeDoTimes state@(State {_code = c : cs, _int = i1 : is, _exec = es}) = + if i1 < 1 + then state + else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc (instructionCodeFromExec, "instructionCodeFromExec"), Block [StateFunc (instructionIntPop, "instructionIntPop"), c], StateFunc (instructionCodeDoRange, "instructionCodeDoRange")] : es} +instructionCodeDoTimes state = state + +-- |If the top boolean is true, execute the top element of the code stack and skip the second. Otherwise, skip the top element of the code stack and execute the second. +instructionCodeIf :: State -> State +instructionCodeIf state@(State {_code = c1 : c2 : cs, _bool = b1 : bs, _exec = es}) = state{_code = cs, _bool = bs, _exec = (if b1 then c1 else c2) : es} +instructionCodeIf state = state + +-- |Evalutates the top code item if the top bool is true. Otherwise the top code is popped. +instructionCodeWhen :: State -> State +instructionCodeWhen state@(State {_code = c1 : cs, _bool = b1 : bs, _exec = es}) = state{_code = cs, _bool = bs, _exec = if b1 then c1 : es else es} +instructionCodeWhen state = state + +-- |Pushes true to the bool stack if the second to top code item is found within the first code item. Pushes False if not. +instructionCodeMember :: State -> State +instructionCodeMember state@(State {_code = c1 : c2 : cs, _bool = bs}) = state{_code = cs, _bool = codeMember c1 c2 : bs} +instructionCodeMember state = state + +-- |Pushes the nth element from a Block onto the code stack based on an index from the int stack. +-- If the top of the code stack is not a block, the int is still eaten. +-- 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 = (Block c1) : cs, _int = i1 : is}) = + if not $ null c1 + then state {_code = c1 !! index : cs, _int = is} + else state + where + index :: Int + index = fromIntegral (abs i1) `mod` length c1 +instructionCodeN state@(State {_code = c1 : cs, _int = _ : is}) = state {_code = c1 : cs, _int = is} +instructionCodeN state = state + +-- |Makes an empty Block and pushes it to the top of the code stack. +instructionMakeEmptyCodeBlock :: State -> State +instructionMakeEmptyCodeBlock state@(State {_code = cs}) = state {_code = Block [] : cs} + +-- |If the top of the code stack is a Block, pushes True to the bool stack if it is and False if it's not. +-- If the top item of the code stack is not a Block, False gets pushed to the bool stack +instructionIsEmptyCodeBlock :: State -> State +instructionIsEmptyCodeBlock state@(State {_code = Block c1 : cs, _bool = bs}) = state{_code = cs, _bool = null c1 : bs} +instructionIsEmptyCodeBlock state@(State {_code = _ : cs, _bool = bs}) = state{_code = cs, _bool = False : bs} +instructionIsEmptyCodeBlock state = state + +-- |Pushes the size of the top code item to the int stack. If it's a Block, the size is counted recursively. If +-- it's not a Block, 1 gets pushed to the int stack. +instructionCodeSize :: State -> State +instructionCodeSize state@(State {_code = c1 : cs, _int = is}) = state{_code = cs, _int = codeRecursiveSize c1 : is} +instructionCodeSize state = state + +-- |Pushes the size of the top code item recursively counting the nested Blocks. +-- 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 (fromIntegral index) : cs, _int = is} +instructionCodeExtract state@(State {_code = cs, _int = _ : is}) = state{_code = cs, _int = is} +instructionCodeExtract state = state + +-- |Inserts a code item into a block recursively entering the nested Blocks if needed based on the top +-- int from the int stack. If the top code item isn't a Block, coerces the top item into a Block. +instructionCodeInsert :: State -> State +instructionCodeInsert state@(State {_code = block@(Block c1) : c2 : cs, _int = i1 : is}) = + let + index = abs i1 `mod` codeRecursiveSize block + in + state{_code = Block (codeInsertAtPoint c1 c2 (fromIntegral index)) : cs, _int = is} +instructionCodeInsert state@(State {_code = c1 : c2 : cs, _int = i1 : is}) = + let + index = abs i1 `mod` codeRecursiveSize (Block [c1]) + in + state{_code = Block (codeInsertAtPoint [c1] c2 (fromIntegral index)) : cs, _int = is} +instructionCodeInsert state = state + +-- |If the top code item is a Block that is empty, pushes 0 to the int stack if c2 is also an empty Block and -1 if not. +-- If the top code item is a Block that is not empty, pushes the index found of the second code item if found, -1 if not. +-- If neither the top code item or second code item are Blocks, checks equality. If equal, pushes 1 to int stack, pushes 0 if not. +instructionCodeFirstPosition :: State -> State +instructionCodeFirstPosition state@(State {_code = (Block []) : c2 : cs, _int = is}) = state {_code = cs, _int = (if c2 == Block [] then 0 else -1) : is} +instructionCodeFirstPosition state@(State {_code = (Block c1) : c2 : cs, _int = is}) = state {_code = cs, _int = fromIntegral (positionElem c1 c2) : is} + where + positionElem :: [Gene] -> Gene -> Int + positionElem genes gene = + case elemIndex gene genes of + Nothing -> -1 + Just x -> x +instructionCodeFirstPosition state@(State {_code = c1 : c2 : cs, _int = is}) = state {_code = cs, _int = (if c1 == c2 then 0 else -1) : is} +instructionCodeFirstPosition state = state + +-- |If the top of the code stack is a Block, reverses the elements of the Block. Acts as a NoOp otherwise. +instructionCodeReverse :: State -> State +instructionCodeReverse state@(State {_code = (Block c1) : cs}) = state {_code = Block (reverse c1) : cs} +instructionCodeReverse state = state + +-- |Duplicates the top of the code stack. +instructionCodeDup :: State -> State +instructionCodeDup = instructionDup code + +-- |Duplicates the top of the code stack N times based on the top int. +instructionCodeDupN :: State -> State +instructionCodeDupN = instructionDupN code + +-- |Swaps the top two code items. +instructionCodeSwap :: State -> State +instructionCodeSwap = instructionSwap code + +-- |Rotates the top three code items. +instructionCodeRot :: State -> State +instructionCodeRot = instructionRot code + +-- |Sets the code stack to [] +instructionCodeFlush :: State -> State +instructionCodeFlush = instructionFlush code + +-- |Checks if the top code items are equal. Pushes True to the bool stack if so, False if not. +instructionCodeEq :: State -> State +instructionCodeEq = instructionEq code + +-- |Pushes the size of the code stack to the int stack. +instructionCodeStackDepth :: State -> State +instructionCodeStackDepth = instructionStackDepth code + +-- |Moves an item from deep within the code stack to the top of the code stack based on +-- the top int from the int stack. +instructionCodeYank :: State -> State +instructionCodeYank = instructionYank code + +-- |Copies an item from deep within the code stack to the top of the code stack based on +-- the top int from the int stack. +instructionCodeYankDup :: State -> State +instructionCodeYankDup = instructionYankDup code + +-- |If the code stack is empty, pushes True to bool stack, else False. +instructionCodeIsStackEmpty :: State -> State +instructionCodeIsStackEmpty = instructionIsStackEmpty code + +-- |Moves an item from the top of the code stack to deep within the code stack based on +-- the top int from the int stack. +instructionCodeShove :: State -> State +instructionCodeShove = instructionShove code + +-- |Copies an item from the top of the code stack to deep within the code stack based on +-- the top int from the int stack. +instructionCodeShoveDup :: State -> State +instructionCodeShoveDup = instructionShoveDup code + +-- |Takes the top bool from the bool stack and places said GeneBool on the code stack. +instructionCodeFromBool :: State -> State +instructionCodeFromBool = instructionCodeFrom bool GeneBool + +-- |Takes the top int from the int stack and places said GeneInt on the code stack. +instructionCodeFromInt :: State -> State +instructionCodeFromInt = instructionCodeFrom int GeneInt + +-- |Takes the top char from the char stack and places said GeneChar on the code stack. +instructionCodeFromChar :: State -> State +instructionCodeFromChar = instructionCodeFrom char GeneChar + +-- |Takes the top float from the float stack and places said GeneFloat on the code stack. +instructionCodeFromFloat :: State -> State +instructionCodeFromFloat = instructionCodeFrom float GeneFloat + +-- |Takes the top string from the string stack and places said GeneString on the code stack. +instructionCodeFromString :: State -> State +instructionCodeFromString = instructionCodeFrom string GeneString + +-- |Takes the top vectorInt from the vectorInt stack and places said GeneVectorInt on the code stack. +instructionCodeFromVectorInt :: State -> State +instructionCodeFromVectorInt = instructionCodeFrom vectorInt GeneVectorInt + +-- |Takes the top vectorFloat from the vectorFloat stack and places said GeneVectorFloat on the code stack. +instructionCodeFromVectorFloat :: State -> State +instructionCodeFromVectorFloat = instructionCodeFrom vectorFloat GeneVectorFloat + +-- |Takes the top vectorString from the vectorString stack and places said GeneVectorString on the code stack. +instructionCodeFromVectorString :: State -> State +instructionCodeFromVectorString = instructionCodeFrom vectorString GeneVectorString + +-- |Takes the top vectorBool from the vectorBool stack and places said GeneVectorBool on the code stack. +instructionCodeFromVectorBool :: State -> State +instructionCodeFromVectorBool = instructionCodeFrom vectorBool GeneVectorBool + +-- |Takes the top vectorChar from the vectorChar stack and places said GeneVectorChar on the code stack. +instructionCodeFromVectorChar :: State -> State +instructionCodeFromVectorChar = instructionCodeFrom vectorChar GeneVectorChar + +-- |Takes the top gene from the exec stack and places a gene on the code stack. +instructionCodeFromExec :: State -> State +instructionCodeFromExec = instructionCodeFrom exec id + +-- |Pushes the "container" of the second code stack item within +-- the first code stack item onto the code stack. If second item contains the first +-- anywhere (i.e. in any nested list) then the container is the smallest sub-list that +-- contains but is not equal to the first instance. For example, if the top piece of code +-- is "( B ( C ( A ) ) ( D ( A ) ) )" and the second piece of code is "( A )" then +-- this pushes ( C ( A ) ). Pushes an empty list if there is no such container. +instructionCodeContainer :: State -> State +instructionCodeContainer state@(State {_code = c1 : c2 : cs}) = state {_code = findContainer c1 c2 : cs} +instructionCodeContainer state = state + +-- |Pushes a measure of the discrepancy between the top two CODE stack items onto the INTEGER stack. This will be zero if the top two items +-- are equivalent, and will be higher the 'more different' the items are from one another. The calculation is as follows: +-- 1. Construct a list of all of the unique items in both of the lists (where uniqueness is determined by equalp). Sub-lists and atoms all count as items. +-- 2. Initialize the result to zero. +-- 3. For each unique item increment the result by the difference between the number of occurrences of the item in the two pieces of code. +-- 4. Push the result. +instructionCodeDiscrepancy :: State -> State +instructionCodeDiscrepancy state@(State {_code = c1 : c2 : cs, _int = is}) = state {_code = cs, _int = countDiscrepancy c1 c2 : is} +instructionCodeDiscrepancy state = state + +-- |Just a NoOp +instructionCodeNoOp :: State -> State +instructionCodeNoOp state = state + +-- |Duplicates the top N items of the code stack based on the top of the int stack. +instructionCodeDupItems :: State -> State +instructionCodeDupItems = instructionDupItems code + +allCodeInstructions :: [Gene] +allCodeInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/ExecInstructions.hs b/src/HushGP/Instructions/ExecInstructions.hs new file mode 100644 index 0000000..ef69261 --- /dev/null +++ b/src/HushGP/Instructions/ExecInstructions.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.ExecInstructions where + +import HushGP.State +import HushGP.Instructions.IntInstructions +import HushGP.Instructions.GenericInstructions +import HushGP.TH + +-- |Removes the second item from the exec stack if the top of the bool stack is True. +-- Removes the first item from the exec stack if the top of the bool stack is False. +instructionExecIf :: State -> State +instructionExecIf state@(State {_exec = e1 : e2 : es, _bool = b1 : bs}) = + if b1 + then state {_exec = e1 : es, _bool = bs} + else state {_exec = e2 : es, _bool = bs} +instructionExecIf state = state + +-- |Duplicates the top exec instruction (the one after this one on the stack). +instructionExecDup :: State -> State +instructionExecDup = instructionDup exec + +-- |Duplicates the top of the exec stack N times based on the top of +-- int stack (the exec instruction after this one). +instructionExecDupN :: State -> State +instructionExecDupN = instructionDupN exec + +-- |Pops the top of the exec stack (the one after this on on the stack). +instructionExecPop :: State -> State +instructionExecPop = instructionPop exec + +-- |Swaps the top two instructions on the exec stack (the two after this on the exec stack). +instructionExecSwap :: State -> State +instructionExecSwap = instructionSwap exec + +-- |Rotates the top three instructions on the exec stack (the three after this on the exec stack). +instructionExecRot :: State -> State +instructionExecRot = instructionRot exec + +-- |Sets the exec stack to []. This stops the program. +instructionExecFlush :: State -> State +instructionExecFlush = instructionFlush exec + +-- |Checks if the top two exec instructions are True. +instructionExecEq :: State -> State +instructionExecEq = instructionEq exec + +-- |Calculates the size of the exec stack and pushes the result to the int stack. +instructionExecStackDepth :: State -> State +instructionExecStackDepth = instructionStackDepth exec + +-- |Moves an item from deep within the exec stack to the top of the exec stack based on +-- the top int from the int stack. +instructionExecYank :: State -> State +instructionExecYank = instructionYank exec + +-- |Copies an item from deep within the exec stack to the top of the exec stack based on +-- the top int from the int stack. +instructionExecYankDup :: State -> State +instructionExecYankDup = instructionYankDup exec + +-- |Moves an item from the top of the shove stack to deep within the shove stack based on +-- the top int from the int stack. +instructionExecShove :: State -> State +instructionExecShove = instructionShove exec + +-- |Copies an item from the top of the shove stack to deep within the shove stack based on +-- the top int from the int stack. +instructionExecShoveDup :: State -> State +instructionExecShoveDup = instructionShoveDup exec + +-- |If the code stack is empty, pushes True to bool stack, else False. +instructionExecIsStackEmpty :: State -> State +instructionExecIsStackEmpty = instructionIsStackEmpty exec + +-- |Evaluates the top item on the exec stack for each step along the range i to j. Both i and j are +-- taken from the int stack. Differs from code_do_range only in the source of the code and the recursive call. +instructionExecDoRange :: State -> State +instructionExecDoRange state@(State {_exec = e1 : es, _int = i0 : i1 : is}) = + if increment (fromIntegral i0) (fromIntegral i1) /= 0 + then state {_exec = e1 : Block [GeneInt (i1 + toInteger (increment (fromIntegral i0) (fromIntegral i1))), GeneInt i0, StateFunc (instructionExecDoRange, "instructionExecDoRange"), e1] : es, _int = i1 : is} + else state {_exec = e1 : es, _int = i1 : is} + where + increment :: Int -> Int -> Int + increment destIdx currentIdx + | currentIdx < destIdx = 1 + | currentIdx > destIdx = -1 + | otherwise = 0 +instructionExecDoRange state = state + +-- |Evaluates the top item on the exec stack n times, where n comes from the n comes from the top +-- of the int stack. Differs from code.do*count only in the source of the code and the recursive call. +instructionExecDoCount :: State -> State +instructionExecDoCount state@(State {_exec = e1 : es, _int = i1 : is}) = + if i1 < 1 + then state + else state {_exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc (instructionExecDoRange, "instructionExecDoRange"), e1] : es, _int = is} +instructionExecDoCount state = state + +-- |Evaluates the top item on the code stack n times, where n comes from the n comes from the top of the int stack. +instructionExecDoTimes :: State -> State +instructionExecDoTimes state@(State {_exec = e1 : es, _int = i1 : is}) = + if i1 < 1 + then state + else state {_exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc (instructionExecDoRange, "instructionExecDoRange"), Block [StateFunc (instructionIntPop, "instructionIntPop"), e1]] : es, _int = is} +instructionExecDoTimes state = state + +-- |Utility: A shorthand for instructionExecWhile +execWhile :: Gene +execWhile = StateFunc (instructionExecWhile, "instructionExecWhile") + +-- |Evaluates the top item on the exec stack repeated until the top bool is no longer True. +instructionExecWhile :: State -> State +instructionExecWhile state@(State {_exec = _ : es, _bool = []}) = + state {_exec = es} +instructionExecWhile state@(State {_exec = alles@(e1 : es), _bool = b1 : bs}) = + if b1 + then state {_exec = e1 : execWhile : alles, _bool = bs} + else state {_exec = es} +instructionExecWhile state = state + +-- |Evaluates the top item on the exec stack repeated until the top bool is no longer True. +-- Executes at least once. +instructionExecDoWhile :: State -> State +instructionExecDoWhile state@(State {_exec = alles@(e1 : _)}) = + state {_exec = e1 : execWhile : alles} +instructionExecDoWhile state = state + +-- |Pops the next item on the exec stack without evaluating it +-- if the top bool is False. Otherwise, has no effect. +-- Eats the top bool no matter what. +instructionExecWhen :: State -> State +instructionExecWhen state@(State {_exec = _ : es, _bool = b1 : bs}) = + if not b1 + then state {_exec = es, _bool = bs} + else state {_bool = bs} +instructionExecWhen state = state + +-- |The K combinator. Deletes the second to top exec item. +instructionExecK :: State -> State +instructionExecK state@(State {_exec = e1 : _ : es}) = state{_exec = e1 : es} +instructionExecK state = state + +-- |The S combinator. Takes the top three top exec items, pushes a Block of the second and third instruction, +-- then the third instruction, and then the first instruction. +instructionExecS :: State -> State +instructionExecS state@(State {_exec = e1 : e2 : e3 : es}) = state{_exec = e1 : e3 : Block [e2, e3] : es} +instructionExecS state = state + +-- |The Y combinator. Takes the top exec item. Pushes a Block containing the Y combinator instruction and the top exec item. +-- Then pushes that top exec item again. +instructionExecY :: State -> State +instructionExecY state@(State {_exec = e1 : es}) = state{_exec = e1 : Block [StateFunc (instructionExecY, "instructionExecY"), e1] : es} +instructionExecY state = state + +-- |Duplicates the top N items of the exec stack based on the top of the int stack. +instructionExecDupItems :: State -> State +instructionExecDupItems = instructionDupItems exec + +allExecInstructions :: [Gene] +allExecInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/FloatInstructions.hs b/src/HushGP/Instructions/FloatInstructions.hs new file mode 100644 index 0000000..cbfd4b3 --- /dev/null +++ b/src/HushGP/Instructions/FloatInstructions.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.FloatInstructions where + +import Data.Fixed (mod') +import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility +import HushGP.State +import Data.Char +import HushGP.TH + +-- |Converts the top int to a float and pushes the result to the float stack. +instructionFloatFromInt :: State -> State +instructionFloatFromInt state@(State {_float = fs, _int = i1 : is}) = state {_float = (fromIntegral i1 :: Double) : fs, _int = is} +instructionFloatFromInt state = state + +-- |If the top bool True, pushes 1.0 to the float stack. Pushes 0.0 if False. +instructionFloatFromBool :: State -> State +instructionFloatFromBool state@(State {_bool = b1 : bs, _float = fs}) = state {_bool = bs, _float = (if b1 then 1.0 else 0.0) : fs} +instructionFloatFromBool state = state + +-- |Takes the top char and converts it to int representation. That int then gets casted to a float and pushed to the float stack. +instructionFloatFromChar :: State -> State +instructionFloatFromChar state@(State {_char = c1 : cs, _float = fs}) = state {_char = cs, _float = (fromIntegral (ord c1) :: Double) : fs} +instructionFloatFromChar state = state + +-- |Reads the top string and converts it to a float if possible. If not, acts as a NoOp. +instructionFloatFromString :: State -> State +instructionFloatFromString state@(State {_string = s1 : ss, _float = fs}) = + if all (\x -> isDigit x || x == '.') s1 && amtOccurences "." s1 <= 1 + then state{_string = ss, _float = read @Double s1 : fs} + else state +instructionFloatFromString state = state + +-- |Adds the top two floats from the float stack. +instructionFloatAdd :: State -> State +instructionFloatAdd state@(State {_float = f1 : f2 : fs}) = state {_float = f2 + f1 : fs} +instructionFloatAdd state = state + +-- |Subtracts the first float from the second float on the float stack. +instructionFloatSub :: State -> State +instructionFloatSub state@(State {_float = f1 : f2 : fs}) = state {_float = f2 - f1 : fs} +instructionFloatSub state = state + +-- |Subtracts the second float from the first float and pushes the result to the float stack. +instructionFloatSubOpp :: State -> State +instructionFloatSubOpp state@(State {_float = i1 : i2 : is}) = state {_float = i1 - i2 : is} +instructionFloatSubOpp state = state + +-- |Multiplies the top two floats on the float stack. +instructionFloatMul :: State -> State +instructionFloatMul state@(State {_float = f1 : f2 : fs}) = state {_float = f2 * f1 : fs} +instructionFloatMul state = state + +-- |Divides the first float from the second float on the float stack. +instructionFloatDiv :: State -> State +instructionFloatDiv state@(State {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 / f1 : fs else f1 : f2 : fs} +instructionFloatDiv state = state + +-- |Divides the second float from the first float and pushes the result to the float stack. +-- This does truncate. +instructionFloatDivOpp :: State -> State +instructionFloatDivOpp state@(State {_float = i1 : i2 : is}) = state {_float = if i2 /= 0 then (i1 / i2) : is else i1 : i2 : is} +instructionFloatDivOpp state = state + +-- |Mods the first float from the second float on the float stack. +instructionFloatMod :: State -> State +instructionFloatMod state@(State {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 `mod'` f1 : fs else f1 : f2 : fs} +instructionFloatMod state = state + +-- |Takes the top two floats from the float stack and pushes the minimum of the two back on top. +instructionFloatMin :: State -> State +instructionFloatMin state@(State {_float = f1 : f2 : fs}) = state {_float = min f1 f2 : fs} +instructionFloatMin state = state + +-- |Takes the top two floats from the float stack and pushes the maximum of the two back on top. +instructionFloatMax :: State -> State +instructionFloatMax state@(State {_float = f1 : f2 : fs}) = state {_float = max f1 f2 : fs} +instructionFloatMax state = state + +-- |Adds one to the top float from the float stack. +instructionFloatInc :: State -> State +instructionFloatInc state@(State {_float = f1 : fs}) = state {_float = f1 + 1 : fs} +instructionFloatInc state = state + +-- |Subtracts one from the top float from the float stack. +instructionFloatDec :: State -> State +instructionFloatDec state@(State {_float = f1 : fs}) = state {_float = f1 - 1 : fs} +instructionFloatDec state = state + +-- |Takes the top two floats from the float stack and pushes the result of: the top float item < the second float item +instructionFloatLT :: State -> State +instructionFloatLT state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 < f2) : bs} +instructionFloatLT state = state + +-- |Takes the top two floats from the float stack and pushes the result of: the top float item > the second float item +instructionFloatGT :: State -> State +instructionFloatGT state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 > f2) : bs} +instructionFloatGT state = state + +-- |Takes the top two floats from the float stack and pushes the result of: the top float item <= the second float item +instructionFloatLTE :: State -> State +instructionFloatLTE state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 <= f2) : bs} +instructionFloatLTE state = state + +-- |Takes the top two floats from the float stack and pushes the result of: the top float item >= the second float item +instructionFloatGTE :: State -> State +instructionFloatGTE state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 >= f2) : bs} +instructionFloatGTE state = state + +-- |Pops the top float from the float stack. +instructionFloatPop :: State -> State +instructionFloatPop = instructionPop float + +-- |Duplicates the top float on the float stack. +instructionFloatDup :: State -> State +instructionFloatDup = instructionDup float + +-- |Duplicates the top float on the float stack N times based off the top of the int stack. +instructionFloatDupN :: State -> State +instructionFloatDupN = instructionDupN float + +-- |Swaps the top two floats on the float stack. +instructionFloatSwap :: State -> State +instructionFloatSwap = instructionSwap float + +-- |Rotates the top three floats on the float stack. +instructionFloatRot :: State -> State +instructionFloatRot = instructionRot float + +-- |Sets the float stack to [] +instructionFloatFlush :: State -> State +instructionFloatFlush = instructionFlush float + +-- |Checks if the top two floats are equal. Pushes the result to the bool stack. +-- Might override this later to check for equality in a range rather than exact equality. +instructionFloatEq :: State -> State +instructionFloatEq = instructionEq float + +-- |Pushes the depth of the stack to the int stack. +instructionFloatStackDepth :: State -> State +instructionFloatStackDepth = instructionStackDepth float + +-- |Copies an item from deep within the float stack to the top of the float stack based on +-- the top int from the int stack. +instructionFloatYankDup :: State -> State +instructionFloatYankDup = instructionYankDup float + +-- |Moves an item from deep within the float stack to the top of the float stack based on +-- the top int from the int stack. +instructionFloatYank :: State -> State +instructionFloatYank = instructionYank float + +-- |Copies an item from the top of the float stack to deep within the float stack based on +-- the top int from the int stack. +instructionFloatShoveDup :: State -> State +instructionFloatShoveDup = instructionShoveDup float + +-- |Moves an item from the top of the float stack to deep within the float stack based on +-- the top int from the int stack. +instructionFloatShove :: State -> State +instructionFloatShove = instructionShove float + +-- |Pushes True to the bool stack if the float stack is empty. False if not. +instructionFloatIsStackEmpty :: State -> State +instructionFloatIsStackEmpty = instructionIsStackEmpty float + +-- |Pushes the sin of the top float to the float stack. +instructionFloatSin :: State -> State +instructionFloatSin state@(State {_float = f1 : fs}) = state {_float = sin f1 : fs} +instructionFloatSin state = state + +-- |Pushes the cos of the top float to the float stack. +instructionFloatCos :: State -> State +instructionFloatCos state@(State {_float = f1 : fs}) = state {_float = cos f1 : fs} +instructionFloatCos state = state + +-- |Pushes the tan of the top float to the float stack. +instructionFloatTan :: State -> State +instructionFloatTan state@(State {_float = f1 : fs}) = state {_float = tan f1 : fs} +instructionFloatTan state = state + +-- |Duplicate the top N items from the float stack based on the top int from the int stack. +instructionFloatDupItems :: State -> State +instructionFloatDupItems = instructionDupItems float + +allFloatInstructions :: [Gene] +allFloatInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/GenericInstructions.hs b/src/HushGP/Instructions/GenericInstructions.hs new file mode 100644 index 0000000..4d43fa9 --- /dev/null +++ b/src/HushGP/Instructions/GenericInstructions.hs @@ -0,0 +1,566 @@ +module HushGP.Instructions.GenericInstructions where + +import Control.Lens +import HushGP.State +import HushGP.Instructions.Utility +import Data.List (sort, sortBy) +import Data.Ord +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 = + case uncons (view accessor state) of + Nothing -> state + Just (x1,_) -> state & accessor .~ x1 : view accessor state + +-- |Pops the top of the stack based on a lens. +instructionPop :: Lens' State [a] -> State -> State +instructionPop accessor state = state & accessor .~ drop 1 (view accessor state) + +-- |Pushes True if the lens' stack is empty, False if not. +instructionIsStackEmpty :: Lens' State [a] -> State -> State +instructionIsStackEmpty accessor state@(State {_bool = bs}) = state{_bool = null (view accessor state) : bs} + +-- |Duplicates the top of a stack based on a lens and the top of the int stack. +instructionDupN :: forall a. Lens' State [a] -> State -> State +instructionDupN accessor state = + case uncons (view int state) of + Just (i1,is) -> + case uncons (view accessor state{_int = is}) of + Just (a1,as) -> + instructionDupNHelper i1 a1 accessor (state{_int = is} & accessor .~ as) + _ -> state + _ -> state + where + instructionDupNHelper :: Integral b => b -> a -> Lens' State [a] -> State -> State + instructionDupNHelper count instruction internalAccessor internalState = + if count > 0 + then instructionDupNHelper (count - 1) instruction internalAccessor (internalState & accessor .~ (instruction : view accessor internalState)) + else internalState + +-- |Duplicates the top N items on a stack. If n <= 0, nothing happens +-- TODO: Will need to implement a max stack items at some point +instructionDupItems :: Lens' State [a] -> State -> State +instructionDupItems accessor state@(State {_int = i1 : is}) = + if i1 <= 0 + then state{_int = is} + else state{_int = is} & accessor .~ (take (fromIntegral i1) (view accessor state{_int = is}) <> view accessor state{_int = is}) +instructionDupItems _ state = state + +-- |Swaps the top two instructions based on a lens +instructionSwap :: Lens' State [a] -> State -> State +instructionSwap accessor state = + state & accessor .~ swapper (view accessor state) + where + swapper :: [a] -> [a] + swapper (x1 : x2 : xs) = x2 : x1 : xs + swapper xs = xs + +-- |Rotates top 3 integers based on a lens. +-- We could use template haskell to rotate any number of these as +-- an instruction later. +instructionRot :: Lens' State [a] -> State -> State +instructionRot accessor state = + state & accessor .~ rotator (view accessor state) + where + rotator :: [a] -> [a] + rotator (x1 : x2 : x3 : xs) = x3 : x1 : x2 : xs + rotator xs = xs + +-- |Deletes all instructions in a stack based on a lens. +instructionFlush :: Lens' State [a] -> State -> State +instructionFlush accessor state = state & accessor .~ [] + +-- |Checks if the two top instructions are equal based on a lens. +-- Pushes the result to the bool stack. +instructionEq :: forall a. Eq a => Lens' State [a] -> State -> State +instructionEq accessor state = + case uncons $ view accessor state of + Nothing -> state + Just (x1, x2 : _) -> droppedState & bool .~ (x1 == x2) : view bool droppedState + Just _ -> state + where + droppedState :: State + droppedState = state & accessor .~ drop 2 (view accessor state) + +-- |Calculates the stack depth based on a lens and pushes the result to the int stackk. +instructionStackDepth :: Lens' State [a] -> State -> State +instructionStackDepth accessor state@(State {_int = is}) = state{_int = toInteger (length (view accessor state)) : is} + +-- |Copies an item from deep within a lens' stack to the top of the lens' stack based on +-- the top int from the int stack. +instructionYankDup :: Lens' State [a] -> State -> State +instructionYankDup accessor state@(State {_int = i1 : is}) = + if notEmptyStack accessor state + then state{_int = is} & accessor .~ (view accessor state{_int = is} !! max 0 (min (fromIntegral i1) (length (view accessor state{_int = is}) - 1))) : view accessor state{_int = is} + else state +instructionYankDup _ state = state + +-- |Moves an item from deep within a lens' stack to the top of the lens' stack based on +-- the top int from the int stack. +instructionYank :: forall a. Lens' State [a] -> State -> State +instructionYank accessor state@(State {_int = i1 : is}) = + let + myIndex :: Int + myIndex = max 0 (min (fromIntegral i1) (length (view accessor state{_int = is}) - 1)) + item :: a + item = view accessor state{_int = is} !! myIndex + deletedState :: State + deletedState = state{_int = is} & accessor .~ deleteAt myIndex (view accessor state{_int = is}) + in + if notEmptyStack accessor state{_int = is} then deletedState & accessor .~ item : view accessor deletedState else state +instructionYank _ state = state + +-- |Copies an item from the top of a lens' stack to deep within the lens' stack based on +-- the top int from the int stack. +-- In pysh, instructionShoveDup and instructionShove behave differently when indexing in such a way that +-- the duplicated index matters whether or not it's present in the stack at the moment of calculation. +-- I'm not going to keep this behavior. Check out interpysh examples for how pysh handles it. +instructionShoveDup :: Lens' State [a] -> State -> State +instructionShoveDup accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state{_int = is}) of + Just (x,_) -> state{_int = is} & accessor .~ combineTuple x (splitAt (max 0 (min (fromIntegral i1) (length (view accessor state{_int = is}) - 1))) (view accessor state{_int = is})) + _ -> state +instructionShoveDup _ state = state + +-- |Moves an item from the top of a lens' stack to deep within the lens' stack based on +-- the top int from the int stack. +instructionShove :: Lens' State [a] -> State -> State +instructionShove accessor state = instructionShoveDup accessor state & accessor .~ drop 1 (view accessor (instructionShoveDup accessor state )) + +-- |Concats two semigroupable items together based on a lens. Not char generic. +instructionVectorConcat :: Semigroup a => Lens' State [a] -> State -> State +instructionVectorConcat accessor state = + case uncons (view accessor state) of + Just (x1, x2:_) -> droppedState & accessor .~ (x1 <> x2) : view accessor droppedState + _ -> state + where + droppedState :: State + droppedState = state & accessor .~ drop 2 (view accessor state) + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- takes the top item of the primitive stack and prepends it to the first vector in +-- the vector stack if there is one. +instructionVectorConj :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorConj primAccessor vectorAccessor state = + case (uncons (view primAccessor state), uncons (view vectorAccessor state)) of + (Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((p1 : v1) : vs) + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- takes the top item of the primitive stack and appends it to the first vector in +-- the vector stack if there is one. +instructionVectorConjEnd :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorConjEnd primAccessor vectorAccessor state = + case (uncons (view primAccessor state), uncons (view vectorAccessor state)) of + (Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((v1 <> [p1]) : vs) + _ -> state + +-- |Takes the first N items from the first vector on the top of a vector stack and +-- pushes the result to said vector stack. +instructionVectorTakeN :: Lens' State [[a]] -> State -> State +instructionVectorTakeN accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = is} & accessor .~ (take (absNum i1 v1) v1 : vs) + _ -> state +instructionVectorTakeN _ state = state + +-- |Takes the last N items from the first vector on the top of a vector stack and +-- pushes the result to said vector stack. +instructionVectorTakeRN :: Lens' State [[a]] -> State -> State +instructionVectorTakeRN accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = is} & accessor .~ (takeR (absNum i1 v1) v1 : vs) + _ -> state +instructionVectorTakeRN _ state = state + +-- |Takes the sublist of the top vector based on a passed lens. Check out the +-- subList documentation for information on how this works. +instructionSubVector :: Lens' State [[a]] -> State -> State +instructionSubVector accessor state@(State {_int = i1 : i2 : is}) = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = is} & accessor .~ (subList (fromIntegral i1) (fromIntegral i2) v1 : vs) + _ -> state +instructionSubVector _ state = state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- Takes the first item from the top vector and places it onto the passed primitive stack. +instructionVectorFirst :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorFirst primAccessor vectorAccessor state = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> + case uncons v1 of + Just (vp1, _) -> state & primAccessor .~ (vp1 : view primAccessor state) & vectorAccessor .~ vs + _ -> state + _ -> state + +-- |Based on a vector lens, takes the first item from the top vector on the vector stack +-- and creates a vector wrapping that first item, pushing it back onto the stack. +-- Not to be confused with instructionVectorFromFirstPrim. +instructionVectorFromFirstPrim :: Lens' State [[a]] -> State -> State +instructionVectorFromFirstPrim accessor state = + case uncons (view accessor state) of + Just (v1, vs) -> + case uncons v1 of + Just (vp1, _) -> state & accessor .~ ([vp1] : vs) + _ -> state + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- pushes the top item of the primitive stack wrapped in a list to the top of the +-- vector stack. Not to be confused with instructionVectorFromFirstPrim. +instructionVectorFromPrim :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorFromPrim primAccessor vectorAccessor state = + case uncons (view primAccessor state) of + Just (p1, ps) -> state & primAccessor .~ ps & vectorAccessor .~ ([p1] : view vectorAccessor state) + _ -> state + + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- Takes the last item from the top vector and places it onto the passed primitive stack. +instructionVectorLast :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorLast primAccessor vectorAccessor state = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> + case uncons (drop (length v1 - 1) v1) of -- gonna keep this implementation over using last as this can't error + Just (vplast, _) -> state & primAccessor .~ (vplast : view primAccessor state) & vectorAccessor .~ vs + _ -> state + _ -> state + +-- |Based on a vector lens, takes the last item from the top vector on the vector stack +-- and creates a vector wrapping that last item, pushing it back onto the stack. +instructionVectorFromLastPrim :: Lens' State [[a]] -> State -> State +instructionVectorFromLastPrim accessor state = + case uncons (view accessor state) of + Just (v1, vs) -> + case uncons (drop (length v1 - 1) v1) of + Just (vp1, _) -> state & accessor .~ ([vp1] : vs) + _ -> state + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- Takes the Nth item from the top vector and places it onto the passed primitive stack +-- based on an int from the int stack. +instructionVectorNth :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorNth primAccessor vectorAccessor state@(State {_int = i1 : is}) = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> state{_int = is} & primAccessor .~ (v1 !! absNum i1 v1 : view primAccessor state{_int = is}) & vectorAccessor .~ vs + _ -> state +instructionVectorNth _ _ state= state + +-- |Based on a vector lens, takes the Nth item from the top vector on the vector stack +-- and creates a vector wrapping that Nth item, pushing it back onto the stack. N is +-- the top item on the int stack. +instructionVectorFromNthPrim :: Lens' State [[a]] -> State -> State +instructionVectorFromNthPrim accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = is} & accessor .~ ([v1 !! absNum i1 v1] : vs) + _ -> state +instructionVectorFromNthPrim _ state = state + +-- |Takes the top vector, removes the first item of said vector, and pushes the result back to top +-- of the stack, based on a lens. +instructionVectorRest :: Lens' State [[a]] -> State -> State +instructionVectorRest accessor state = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ (drop 1 v1 : vs) + _ -> state + +-- |Takes the top vector, removes the last item of said vector, and pushes the result back to top +-- of the stack, based on a vector lens. +instructionVectorButLast :: Lens' State [[a]] -> State -> State +instructionVectorButLast accessor state = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ (safeInit v1 : vs) + _ -> state + +-- |Based on a vector lens, drops the first N items from the top vector. +-- Pushes the result back to the vector stack. N is pulled from the top +-- of the int stack. +instructionVectorDrop :: Lens' State [[a]] -> State -> State +instructionVectorDrop accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state{_int = is}) of + Just (v1, vs) -> state{_int = is} & accessor .~ (drop (absNum i1 v1) v1 : vs) + _ -> state +instructionVectorDrop _ state = state + +-- |Based on a vector lens, drops the last N items from the top vector. +-- Pushes the result back to the vector stack. N is pulled from the top +-- of the int stack. +instructionVectorDropR :: Lens' State [[a]] -> State -> State +instructionVectorDropR accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state{_int = is}) of + Just (v1, vs) -> state{_int = is} & accessor .~ (dropR (absNum i1 v1) v1 : vs) + _ -> state +instructionVectorDropR _ state = state + +-- |Takes the top vector, pushes the length of that vector to the int stack, based on a vector lens. +instructionLength :: Lens' State [[a]] -> State -> State +instructionLength accessor state@(State {_int = is}) = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = toInteger (length v1) : is} & accessor .~ vs + _ -> state + +-- |Takes the top vector, reverses it, based on a lens. +instructionReverse :: Lens' State [[a]] -> State -> State +instructionReverse accessor state = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ (reverse v1 : vs) + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- takes the vector and individually pushes its indicies to the passed primitive stack. +instructionPushAll :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionPushAll primAccessor vectorAccessor state = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> state & vectorAccessor .~ vs & primAccessor .~ (v1 <> view primAccessor state) + _ -> state + +-- |Based on a vector lens, makes an empty vector and pushes it to the passed stack. +instructionVectorMakeEmpty :: Lens' State [[a]] -> State -> State +instructionVectorMakeEmpty accessor state = state & accessor .~ ([] : view accessor state) + +-- |Based on a vector lens, checks if the top vector is empty. If so, pushes True to the +-- bool stack. If not, pushes False. +instructionVectorIsEmpty :: Lens' State [[a]] -> State -> State +instructionVectorIsEmpty accessor state@(State {_bool = bs}) = + case uncons (view accessor state) of + Just (v1, vs) -> state{_bool = null v1 : bs} & accessor .~ vs + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- If the vector on the top of the vector stack contains the top item on the primitive stack, +-- pushes True to the bool stack. Pushes False otherwise. +instructionVectorContains :: Eq a => Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorContains primAccessor vectorAccessor state@(State {_bool = bs}) = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> state{_bool = (findSubA v1 [p1] /= -1) : bs} & vectorAccessor .~ vs & primAccessor .~ ps + _ -> state + +-- |Based on a vector lens and the two vectors on the top of said stack. +-- If the second vector can be found within the first vector, True is pushed to the +-- bool stack. If not, False is pushed to the bool stack. +instructionVectorContainsVector :: Eq a => Lens' State [[a]] -> State -> State +instructionVectorContainsVector accessor state@(State {_bool = bs}) = + case uncons (view accessor state) of + Just (v1, v2 : vs) -> state & accessor .~ vs & bool .~ ((findSubA v1 v2 /= (-1)) : bs) + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- finds the first index of the top item in the primitive stack inside of the +-- top vector from the vector stack and pushes the result to the int stack. +instructionVectorIndexOf :: Eq a => Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorIndexOf primAccessor vectorAccessor state = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> (state & vectorAccessor .~ vs & primAccessor .~ ps) & int .~ (toInteger (findSubA v1 [p1]) : view int (state & vectorAccessor .~ vs & primAccessor .~ ps)) + _ -> state + +-- |Based on a vector lens and the two vectors on top of said stack. Searches and pushes the +-- index of the second vector inside of the first vector to the int stack. Pushes -1 if not found. +instructionVectorIndexOfVector :: Eq a => Lens' State [[a]] -> State -> State +instructionVectorIndexOfVector accessor state@(State {_int = is}) = + case uncons (view accessor state) of + Just (v1, v2 : vs) -> state & accessor .~ vs & int .~ (toInteger (findSubA v1 v2) : is) + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- finds the amount of times the top item in the primitive stack occurs inside of the +-- top vector from the vector stack and pushes the result to the int stack. +instructionVectorOccurrencesOf :: Eq a => Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorOccurrencesOf primAccessor vectorAccessor state = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> (state & vectorAccessor .~ vs & primAccessor .~ ps) & int .~ (toInteger (amtOccurences v1 [p1]) : view int (state & vectorAccessor .~ vs & primAccessor .~ ps)) + _ -> state + +-- |Based on a vector lens and the top two vectors in said stack, +-- Counts the amount of occurrences of the second vector in the first +-- vector. Pushes the result to the string stack. +instructionVectorOccurrencesOfVector :: Eq a => Lens' State [[a]] -> State -> State +instructionVectorOccurrencesOfVector accessor state@(State {_int = is}) = + case uncons (view accessor state) of + Just (v1, v2 : vs) -> state & accessor .~ vs & int .~ (toInteger (amtOccurences v1 v2) : is) + _ -> state + +-- |This function parses the primitives inside a vector type and pushes that vector split into +-- lists of size one and pushes the result onto the respective vector stack. Based on a vector lens. +instructionVectorParseToPrim :: Lens' State [[a]] -> State -> State +instructionVectorParseToPrim accessor state = + case uncons (view accessor state) of + Just (x1, xs) -> state & accessor .~ (chunksOf 1 x1 <> xs) + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type. +-- Sets the Nth index inside of the top vector from the vector stack to the top value +-- from the primitive stack. N is based on an int from the top of the int stack. +instructionVectorSetNth :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorSetNth primAccessor vectorAccessor state@(State {_int = i1 : is}) = + case (uncons (view vectorAccessor state{_int = is}), uncons (view primAccessor state{_int = is})) of + (Just (v1, vs), Just (p1, ps)) -> state{_int = is} & vectorAccessor .~ (replaceAt (absNum i1 v1) p1 v1 : vs) & primAccessor .~ ps + _ -> state +instructionVectorSetNth _ _ state = state + +-- |Based on two lenses, one of a primitive type and the next of a vector type. +-- Splits the vector on top of the vector stack with the top primitive and pushes the +-- result to the original vector stack. +instructionVectorSplitOn :: Eq a => Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorSplitOn primAccessor vectorAccessor state = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> state & primAccessor .~ ps & vectorAccessor .~ (reverse (splitOn [p1] v1) <> vs) + _ -> state + +-- |Based on a vector lens and top two items of said stack, splits the +-- first vector based on the second vector and pushes the result to the +-- original vector stack. +instructionVectorSplitOnVector :: Eq a => Lens' State [[a]] -> State -> State +instructionVectorSplitOnVector accessor state = + case uncons (view accessor state) of + Just (v1, v2 : vs) -> state & accessor .~ (reverse (splitOn v2 v1) <> vs) + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- replaces Maybe Int occurrences inside of the top vector from the vector stack with two values from +-- the primitive stack. The top of the primitive stack is the old value to be replaced. The second item +-- in the primitive stack is the new value to replace the old one. Nothing replaces all occurrences. +instructionVectorReplace :: Eq a => Lens' State [a] -> Lens' State [[a]] -> Maybe Int -> State -> State +instructionVectorReplace primAccessor vectorAccessor amt state = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, p2 : ps)) -> state & vectorAccessor .~ (replace v1 [p1] [p2] amt: vs) & primAccessor .~ ps + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- replaces N occurrences inside of the top vector from the vector stack with two values from +-- the primitive stack. The top of the primitive stack is the old value to be replaced. The second item +-- in the primitive stack is the new value to replace the old one. N is pulled from the top of the int stack. +instructionVectorReplaceN :: Eq a => Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorReplaceN primAccessor vectorAccessor state@(State {_int = i1 : is}) = instructionVectorReplace primAccessor vectorAccessor (Just (fromIntegral i1)) state{_int = is} +instructionVectorReplaceN _ _ state = state + +-- |Based on a vector lens and the top three vectors on said stack. +-- Inside of the first vector, replaces the number of instances specified +-- by the Maybe Int parameter of the second vector with the third vector. +-- If amt is Nothing, replaces all instances. +instructionVectorReplaceVector :: Eq a => Lens' State [[a]] -> Maybe Int -> State -> State +instructionVectorReplaceVector accessor amt state = + case uncons (view accessor state) of + Just (v1, v2 : v3 : vs) -> state & accessor .~ (replace v1 v2 v3 amt : vs) + _ -> state + +-- |Based on a vector lens, the top three vectors on said stack, and the top int on the int stack. +-- Inside of the first vector, replaces the number of instances specified +-- by the top of the int stack of the second vector with the third vector. +instructionVectorReplaceVectorN :: Eq a => Lens' State [[a]] -> State -> State +instructionVectorReplaceVectorN accessor state@(State {_int = i1 : is}) = instructionVectorReplaceVector accessor (Just (fromIntegral i1)) state{_int = is} +instructionVectorReplaceVectorN _ state = state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- Removes Maybe Int occurrences inside of the top vector from the vector stack where the top +-- item from the primitive stack equals a primitive inside of the vector stack. If Nothing is passed +-- rather than a Just Int, will remove all occurrences. +instructionVectorRemove :: Eq a => Lens' State [a] -> Lens' State [[a]] -> Maybe Int -> State -> State +instructionVectorRemove primAccessor vectorAccessor amt state = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> state & vectorAccessor .~ (replace v1 [p1] [] amt: vs) & primAccessor .~ ps + _ -> state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- Removes N occurrences inside of the top vector from the vector stack where the top +-- item from the primitive stack equals a primitive inside of the vector stack. N is pulled +-- from the top of the int stack. Not to be confused with instructionVectorRemoveNth. +instructionVectorRemoveN :: Eq a => Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorRemoveN primAccessor vectorAccessor state@(State {_int = i1 : is}) = instructionVectorRemove primAccessor vectorAccessor (Just (fromIntegral i1)) state{_int = is} +instructionVectorRemoveN _ _ state = state + +-- |Based on a vector lens. Removes the Nth index of the top vector of the passed +-- vector stack. N is pulled from the top of the int stack. Not to be confused with +-- instructionVectorRemoveN. +instructionVectorRemoveNth :: Lens' State [[a]] -> State -> State +instructionVectorRemoveNth accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state{_int = is}) of + Just (v1, vs) -> state{_int = is} & accessor .~ (deleteAt (absNum i1 v1) v1 : vs) + _ -> state +instructionVectorRemoveNth _ state = state + +-- |Based on a vector lens and the two vectors on top of said stack. +-- Inside of the first vector, removes the number of instances specified +-- by the Maybe Int parameter of the second vector. Nothing removes all instances. +instructionVectorRemoveVector :: Eq a => Lens' State [[a]] -> Maybe Int -> State -> State +instructionVectorRemoveVector accessor amt state = + case uncons (view accessor state) of + Just (v1, v2 : vs) -> state & accessor .~ (replace v1 v2 [] amt : vs) + _ -> state + +-- |Based on a vector lens, the top two vectors on said stack, and the top int on the int stack. +-- Inside of the first vector, removes the number of instances specified +-- by the top of the int stack of the second vector. +instructionVectorRemoveVectorN :: Eq a => Lens' State [[a]] -> State -> State +instructionVectorRemoveVectorN accessor state@(State {_int = i1 : is}) = instructionVectorRemoveVector accessor (Just (fromIntegral i1)) state{_int = is} +instructionVectorRemoveVectorN _ state = state + +-- |Based on two lenses, one of a primitive type and the next of a vector type, +-- iterates over the top vector from the vector stack using the top code from the code stack. +-- Pysh explains this better. +instructionVectorIterate :: Lens' State [a] -> Lens' State [[a]] -> ([a] -> Gene) -> (State -> State) -> String -> State -> State +instructionVectorIterate primAccessor vectorAccessor vectorType typeIterateFunction typeIterateFunctionName state@(State {_exec = e1 : es}) = + case uncons (view vectorAccessor state) of + Just ([], vs) -> state{_exec = es} & vectorAccessor .~ vs + Just ([x], vs) -> state & primAccessor .~ (x : view primAccessor state) & vectorAccessor .~ vs + Just (v1, vs) -> + (case uncons v1 of + Just (nv1, nvs) -> state{_exec = e1 : vectorType nvs : StateFunc (typeIterateFunction, typeIterateFunctionName) : e1 : es} & primAccessor .~ (nv1 : view primAccessor state) & vectorAccessor .~ vs + _ -> state) -- This should never happen + _ -> state +instructionVectorIterate _ _ _ _ _ state = state + +-- |Moves a type from a stack and places it onto the code stack. Based on a primitive stack. +-- The (a -> Gene) is something like GeneBool or GeneInt for example. +instructionCodeFrom :: Lens' State [a] -> (a -> Gene) -> State -> State +instructionCodeFrom accessor geneType state@(State {_code = cs}) = + case uncons (view accessor state) of + Just (x, xs) -> state{_code = geneType x : cs} & accessor .~ xs + _ -> state + +-- |Sorts the top vector in a vector stack, based on a vector lens. +instructionVectorSort :: Ord a => Lens' State [[a]] -> State -> State +instructionVectorSort accessor state = + case uncons (view accessor state) of + Just (x, xs) -> state & accessor .~ (sort x : xs) + _ -> state + +-- |Sorts the top vector in a vector stack in reverse order for a vectorType, based on a vector lens. +instructionVectorSortReverse :: Ord a => Lens' State [[a]] -> State -> State +instructionVectorSortReverse accessor state = + case uncons (view accessor state) of + Just (x, xs) -> state & accessor .~ (sortBy (comparing Data.Ord.Down) x : xs) + _ -> state + +-- |Takes a vector lens, a primitive lens, and the top of the int stack +-- Inserts the top of the primitive stack into a index specified by the +-- top of the int stack into the top vector from the vector stack. +instructionVectorInsert :: Lens' State [a] -> Lens' State [[a]] -> State -> State +instructionVectorInsert primAccessor vectorAccessor state@(State {_int = i1 : is}) = + case (uncons (view vectorAccessor state{_int = is}), uncons (view primAccessor state{_int = is})) of + (Just (v1, vs), Just (p1, ps)) -> state{_int = is} & primAccessor .~ ps & vectorAccessor .~ (combineTuple p1 (splitAt (fromIntegral i1) v1) : vs) + _ -> state +instructionVectorInsert _ _ state = state + +-- |Takes a vector lens and inserts the second vector on the vector stack +-- into the first vector on the vector stack based on an int from the +-- int stack. +instructionVectorInsertVector :: Lens' State [[a]] -> State -> State +instructionVectorInsertVector accessor state@(State {_int = i1 : is}) = + case uncons (view accessor state) of + Just (v1, v2 : vs) -> + state{_int = is} & accessor .~ (combineTupleList v2 (splitAt (fromIntegral i1) v1) : vs) + _ -> state +instructionVectorInsertVector _ state = state diff --git a/src/HushGP/Instructions/IntInstructions.hs b/src/HushGP/Instructions/IntInstructions.hs new file mode 100644 index 0000000..5d49a6f --- /dev/null +++ b/src/HushGP/Instructions/IntInstructions.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.IntInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import Data.Char +import HushGP.TH + +-- |Converts the top float to an int and pushes the result to the int stack. +instructionIntFromFloat :: State -> State +instructionIntFromFloat state@(State {_float = f1 : fs, _int = is}) = state {_float = fs, _int = floor f1 : is} +instructionIntFromFloat state = state + +-- |If the top bool True, pushes 1 to the int stack. Pushes 0 if False. +instructionIntFromBool :: State -> State +instructionIntFromBool state@(State {_bool = b1 : bs, _int = is}) = state {_bool = bs, _int = (if b1 then 1 else 0) : is} +instructionIntFromBool state = state + +-- |Takes the top char and converts it to int representation. The result is pushed to the int stack. +instructionIntFromChar :: State -> State +instructionIntFromChar state@(State {_char = c1 : cs, _int = is}) = state {_char = cs, _int = fromIntegral (ord c1) : is} +instructionIntFromChar state = state + +-- |Reads the top string and converts it to a int if possible. If not, acts as a NoOp. +instructionIntFromString :: State -> State +instructionIntFromString state@(State {_string = s1 : ss, _int = is}) = + if all isDigit s1 + then state{_string = ss, _int = read @Integer s1 : is} + else state +instructionIntFromString state = state + +-- |Adds the top two ints from the int stack and pushes the result to the int stack. +instructionIntAdd :: State -> State +instructionIntAdd state@(State {_int = i1 : i2 : is}) = state {_int = i2 + i1 : is} +instructionIntAdd state = state + +-- |Subtracts the first int from the second int and pushes the result to the int stack. +instructionIntSub :: State -> State +instructionIntSub state@(State {_int = i1 : i2 : is}) = state {_int = i2 - i1 : is} +instructionIntSub state = state + +-- |Subtracts the second int from the first int and pushes the result to the int stack. +instructionIntSubOpp :: State -> State +instructionIntSubOpp state@(State {_int = i1 : i2 : is}) = state {_int = i1 - i2 : is} +instructionIntSubOpp state = state + +-- |Multiplies the top two ints from the int stack and pushes the result to the int stack. +instructionIntMul :: State -> State +instructionIntMul state@(State {_int = i1 : i2 : is}) = state {_int = i2 * i1 : is} +instructionIntMul state = state + +-- |Divides the first float from the second float and pushes the result to the int stack. +-- This does truncate. +instructionIntDiv :: State -> State +instructionIntDiv state@(State {_int = i1 : i2 : is}) = state {_int = if i1 /= 0 then (i2 `div` i1) : is else i1 : i2 : is} +instructionIntDiv state = state + +-- |Divides the second int from the first int and pushes the result to the int stack. +-- This does truncate. +instructionIntDivOpp :: State -> State +instructionIntDivOpp state@(State {_int = i1 : i2 : is}) = state {_int = if i2 /= 0 then (i1 `div` i2) : is else i1 : i2 : is} +instructionIntDivOpp state = state + +-- |Mods the first float from the second float and pushes the result to the int stack. +-- This does truncate. +instructionIntMod :: State -> State +instructionIntMod state@(State {_int = i1 : i2 : is}) = state {_int = if i1 /= 0 then (i2 `mod` i1) : is else i1 : i2 : is} +instructionIntMod state = state + +-- |Takes the top two ints from the int stack and pushes the minimum of the two back on top. +instructionIntMin :: State -> State +instructionIntMin state@(State {_int = i1 : i2 : is}) = state {_int = min i1 i2 : is} +instructionIntMin state = state + +-- |Takes the top two ints from the int stack and pushes the maximum of the two back on top. +instructionIntMax :: State -> State +instructionIntMax state@(State {_int = i1 : i2 : is}) = state {_int = max i1 i2 : is} +instructionIntMax state = state + +-- |Adds one to the top of the int stack and pushes the result back to the int stack. +instructionIntInc :: State -> State +instructionIntInc state@(State {_int = i1 : is}) = state {_int = i1 + 1 : is} +instructionIntInc state = state + +-- |Subtracts one from the top of the int stack and pushes the result back to the int stack. +instructionIntDec :: State -> State +instructionIntDec state@(State {_int = i1 : is}) = state {_int = i1 - 1 : is} +instructionIntDec state = state + +-- |Takes the top two ints from the int stack and pushes the result of: the top int item < the second int item +instructionIntLT :: State -> State +instructionIntLT state@(State {_int = i1 : i2 : is, _bool = bs}) = state {_int = is, _bool = (i1 < i2) : bs} +instructionIntLT state = state + +-- |Takes the top two ints from the int stack and pushes the result of: the top int item > the second int item +instructionIntGT :: State -> State +instructionIntGT state@(State {_int = i1 : i2 : is, _bool = bs}) = state {_int = is, _bool = (i1 > i2) : bs} +instructionIntGT state = state + +-- |Takes the top two ints from the int stack and pushes the result of: the top int item <= the second int item +instructionIntLTE :: State -> State +instructionIntLTE state@(State {_int = i1 : i2 : is, _bool = bs}) = state {_int = is, _bool = (i1 <= i2) : bs} +instructionIntLTE state = state + +-- |Takes the top two ints from the int stack and pushes the result of: the top int item >= the second int item +instructionIntGTE :: State -> State +instructionIntGTE state@(State {_int = i1 : i2 : is, _bool = bs}) = state {_int = is, _bool = (i1 >= i2) : bs} +instructionIntGTE state = state + +-- |Pops the top int from the int stack. +instructionIntDup :: State -> State +instructionIntDup = instructionDup int + +-- |Duplicates the top int on the int stack. +instructionIntPop :: State -> State +instructionIntPop = instructionPop int + +-- |Duplicates the second to top int on the int stack based on the top int +-- and pushes the result to the int stack. +instructionIntDupN :: State -> State +instructionIntDupN = instructionDupN int + +-- |Swaps the top two ints on the int stack. +instructionIntSwap :: State -> State +instructionIntSwap = instructionSwap int + +-- |Rotates the top three ints and pushes the result to the int stack. +instructionIntRot :: State -> State +instructionIntRot = instructionRot int + +-- |Sets the int stack to []. +instructionIntFlush :: State -> State +instructionIntFlush = instructionFlush int + +-- |Checks if the top two floats are equal +instructionIntEq :: State -> State +instructionIntEq = instructionEq int + +-- |Pushes the depth of the int stack to top of the int stack after the caluculation. +instructionIntStackDepth :: State -> State +instructionIntStackDepth = instructionStackDepth int + +-- |Moves an item from deep within the int stack to the top of the int stack based on +-- the top int from the int stack. +instructionIntYank :: State -> State +instructionIntYank = instructionYank int + +-- |Copies an item from deep within the float stack to the top of the float stack based on +-- the top int from the int stack. +instructionIntYankDup :: State -> State +instructionIntYankDup = instructionYankDup int + +-- |Moves an item from the top of the int stack to deep within the int stack based on +-- the top int from the int stack. +instructionIntShove :: State -> State +instructionIntShove = instructionShove int + +-- |Copies an item from the top of the int stack to deep within the int stack based on +-- the top int from the int stack. +instructionIntShoveDup :: State -> State +instructionIntShoveDup = instructionShoveDup int + +-- |Pushes True to the bool stack if the int stack is empty. False if not. +instructionIntIsStackEmpty :: State -> State +instructionIntIsStackEmpty = instructionIsStackEmpty int + +-- |Duplicate the top N items from the int stack based on the top int from the int stack. +instructionIntDupItems :: State -> State +instructionIntDupItems = instructionDupItems int + +allIntInstructions :: [Gene] +allIntInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/Opens.hs b/src/HushGP/Instructions/Opens.hs new file mode 100644 index 0000000..7ac841d --- /dev/null +++ b/src/HushGP/Instructions/Opens.hs @@ -0,0 +1,42 @@ +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 +import HushGP.Instructions.VectorBoolInstructions +import HushGP.Instructions.VectorFloatInstructions +import HushGP.Instructions.VectorStringInstructions +import HushGP.Instructions.VectorCharInstructions + +-- |A Map that takes a Gene and returns how many Blocks it opens. +-- To be used in plushy conversion. +instructionOpens :: Map.Map Gene Int +instructionOpens = Map.fromList [ + (StateFunc (instructionExecIf, "instructionExecIf"), 2), + (StateFunc (instructionExecDup, "instructionExecDup"), 1), + (StateFunc (instructionExecDupN, "instructionExecDupN"), 1), + (StateFunc (instructionExecPop, "instructionExecPop"), 1), + (StateFunc (instructionExecSwap, "instructionExecSwap"), 2), + (StateFunc (instructionExecRot, "instructionExecRot"), 3), + (StateFunc (instructionExecShove, "instructionExecShove"), 1), + (StateFunc (instructionExecShoveDup, "instructionExecShoveDup"), 1), + (StateFunc (instructionExecDoRange, "instructionExecDoRange"), 1), + (StateFunc (instructionExecDoCount, "instructionExecDoCount"), 1), + (StateFunc (instructionExecDoTimes, "instructionExecDoTimes"), 1), + (StateFunc (instructionExecWhile, "instructionExecWhile"), 1), + (StateFunc (instructionExecDoWhile, "instructionExecDoWhile"), 1), + (StateFunc (instructionExecWhen, "instructionExecWhen"), 1), + (StateFunc (instructionExecK, "instructionExecK"), 2), + (StateFunc (instructionExecS, "instructionExecS"), 3), + (StateFunc (instructionExecY, "instructionExecY"), 1), + (StateFunc (instructionStringIterate, "instructionStringIterate"), 1), + (StateFunc (instructionVectorIntIterate, "instructionVectorIntIterate"), 1), + (StateFunc (instructionVectorFloatIterate, "instructionVectorFloatIterate"), 1), + (StateFunc (instructionVectorStringIterate, "instructionVectorStringIterate"), 1), + (StateFunc (instructionVectorBoolIterate, "instructionVectorBoolIterate"), 1), + (StateFunc (instructionVectorCharIterate, "instructionVectorCharIterate"), 1), + (StateFunc (instructionNoOpBlock, "instructionNoOpBlock"), 1) + ] diff --git a/src/HushGP/Instructions/StringInstructions.hs b/src/HushGP/Instructions/StringInstructions.hs new file mode 100644 index 0000000..f192b19 --- /dev/null +++ b/src/HushGP/Instructions/StringInstructions.hs @@ -0,0 +1,330 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.StringInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility +import HushGP.TH + +-- |Concats the top two strings on the string stack and pushes the result. +instructionStringConcat :: State -> State +instructionStringConcat = instructionVectorConcat string + +-- |Swaps the top two strings on the string stack. +instructionStringSwap :: State -> State +instructionStringSwap = instructionSwap string + +-- |Inserts the second string on the string stack into the first string +-- on the string stack based on an int from the int stack. +instructionStringInsertString :: State -> State +instructionStringInsertString = instructionVectorInsertVector string + +-- |Takes the first string from the string stack and pushes the first character +-- back to the string stack as a string. +instructionStringFromFirstChar :: State -> State +instructionStringFromFirstChar = instructionVectorFromFirstPrim string + +-- |Takes the first string from the string stack and pushes the last character +-- back to the string stack as a string. +instructionStringFromLastChar :: State -> State +instructionStringFromLastChar = instructionVectorFromLastPrim string + +-- |Takes the first string from the string stack and pushes the Nth character +-- back to the string stack as a string. N in is the top int of the int stack. +instructionStringFromNthChar :: State -> State +instructionStringFromNthChar = instructionVectorFromNthPrim string + +-- |Takes the first two strings from the top of the string stack. Looks for and pushed the +-- index of the second substring inside of the first substring to the int stack. +-- If not found, returns -1. +instructionStringIndexOfString :: State -> State +instructionStringIndexOfString = instructionVectorIndexOfVector string + +-- |Takes the first two strings from the top of the string stack. Pushes True to the +-- bool stack if the second string is contained within the first string. Pushes False otherwise. +instructionStringContainsString :: State -> State +instructionStringContainsString = instructionVectorContainsVector string + +-- |Takes the first two strings from the top of the string stack. Splits the first string +-- based on the second string and pushes the result to the string stack. +-- pysh reverses this. Check this for propeller +instructionStringSplitOnString :: State -> State +instructionStringSplitOnString = instructionVectorSplitOnVector string + +-- |Takes the first three strings from the top of the string stack. Replaces the first instance of +-- the second string within the first string with the third string. Pushes the result to the string stack. +instructionStringReplaceFirstString :: State -> State +instructionStringReplaceFirstString = instructionVectorReplaceVector string (Just 1) + +-- |Takes the first three strings from the top of the string stack. Replaces the number of instances based on the of the int stack of +-- the second string within the first string with the third string. Pushes the result to the string stack. +instructionStringReplaceNString :: State -> State +instructionStringReplaceNString = instructionVectorReplaceVectorN string + +-- |Takes the first three strings from the top of the string stack. Replaces all instances of +-- the second string within the first string with the third string. Pushes the result to the string stack. +instructionStringReplaceAllString :: State -> State +instructionStringReplaceAllString = instructionVectorReplaceVector string Nothing + +-- |Takes the first two strings from the top of the string stack. Removes the first instance of +-- the second string. Pushes the result to the string stack. +instructionStringRemoveFirstString :: State -> State +instructionStringRemoveFirstString = instructionVectorRemoveVector string (Just 1) + +-- |Takes the first two strings from the top of the string stack. Removes N instances +-- based on the top int from the int stack of the second string. Pushes the result to the string stack. +instructionStringRemoveNString :: State -> State +instructionStringRemoveNString = instructionVectorRemoveVectorN string + +-- |Takes the first two strings from the top of the string stack. Removes all instances of +-- the second string. Pushes the result to the string stack. +instructionStringRemoveAllString :: State -> State +instructionStringRemoveAllString = instructionVectorRemoveVector string Nothing + +-- |Counts the amount of occurrences of the second string in the first +-- string. Pushes the result to the string stack. +instructionStringOccurrencesOfString :: State -> State +instructionStringOccurrencesOfString = instructionVectorOccurrencesOfVector string + +-- |Inserts the top char of the char stack into the top string of the string +-- stack based on an index from the top int of the int stack. +instructionStringInsertChar :: State -> State +instructionStringInsertChar = instructionVectorInsert char string + +-- |Pushes True to the bool stack if the top char on the char stack is within the +-- top string on the string stack. Pushes False otherwise. +instructionStringContainsChar :: State -> State +instructionStringContainsChar = instructionVectorContains char string + +-- |Pushes the first index found of the top char of the char stack within the +-- first string in the string stack to the int stack. +instructionStringIndexOfChar :: State -> State +instructionStringIndexOfChar = instructionVectorIndexOf char string + +-- |Takes the top string from the string stack and the top +-- char from the char stack. Splits the top string based on +-- the top char and pushes the result to the string stack. +instructionStringSplitOnChar :: State -> State +instructionStringSplitOnChar = instructionVectorSplitOn char string + +-- |Takes the top string from the string stack and the two top char from the char stack. +-- Replaces the first instance of the top char with the second char. +instructionStringReplaceFirstChar :: State -> State +instructionStringReplaceFirstChar = instructionVectorReplace char string (Just 1) + +-- |Takes the top string from the string stack and the two top char from the char stack. +-- Replaces N instances of the top char with the second char. N is determined by the +-- top int on the int stack. +instructionStringReplaceNChar :: State -> State +instructionStringReplaceNChar = instructionVectorReplaceN char string + +-- |Takes the top string from the string stack and the two top char from the char stack. +-- Replaces all instances of the top char with the second char. +instructionStringReplaceAllChar :: State -> State +instructionStringReplaceAllChar = instructionVectorReplace char string Nothing + +-- |Takes the top string from the string stack and the top char from the char stack. +-- Removes the first instance of the top char with the second char. +instructionStringRemoveFirstChar :: State -> State +instructionStringRemoveFirstChar = instructionVectorRemove char string (Just 1) + +-- |Takes the top string from the string stack and the top char from the char stack. +-- Removes N instances of the top char with the second char. N is pulled from the top +-- of the int stack. +instructionStringRemoveNChar :: State -> State +instructionStringRemoveNChar = instructionVectorRemoveN char string + +-- |Takes the top string from the string stack and the top char from the char stack. +-- Removes all instances of the top char with the second char. +instructionStringRemoveAllChar :: State -> State +instructionStringRemoveAllChar = instructionVectorRemove char string Nothing + +-- |Takes the top string from the string stack and the top char from the char stack. +-- Counts the amount of occurrences of the top char inside of the top string. Pushes +-- this result to the int stack. +instructionStringOccurrencesOfChar :: State -> State +instructionStringOccurrencesOfChar = instructionVectorOccurrencesOf char string + +-- |Takes the top string from the string stack and reverses it. Pushes the reversed string +-- to the top of the stack. +instructionStringReverse :: State -> State +instructionStringReverse = instructionReverse string + +-- |Takes the top string from the string stack, takes the first N chars from the top string, +-- and pushes the result to the string stack. N is pulled from the top of the int stack. +instructionStringHead :: State -> State +instructionStringHead = instructionVectorTakeN string + +-- |Takes the top string from the string stack, takes the last N chars from the top string, +-- and pushes the result to the string stack. N is pulled from the top of the int stack. +instructionStringTail :: State -> State +instructionStringTail = instructionVectorTakeRN string + +-- |Takes the top string from the string stack and the top char from the char stack. +-- Prepends the top char to the top string. Pushes the result to the string stack. +instructionStringPrependChar :: State -> State +instructionStringPrependChar = instructionVectorConj char string + +-- |Takes the top string from the string stack and the top char from the char stack. +-- Appends the top char to the top string. Pushes the result to the string stack. +instructionStringAppendChar :: State -> State +instructionStringAppendChar = instructionVectorConjEnd char string + +-- |Takes the top string from the string stack and removes the first char +-- from said string. Pushes the result to the string stack. +instructionStringRest :: State -> State +instructionStringRest = instructionVectorRest string + +-- |Takes the top string from the string stack and removes the last char +-- from said string. Pushes the result to the string stack. +instructionStringButLast :: State -> State +instructionStringButLast = instructionVectorButLast string + +-- |Takes the top string from the string stack and drops the first N characters +-- from said string. Pushes the result to the string stack. N is pulled from the top +-- of the int stack. +instructionStringDrop :: State -> State +instructionStringDrop = instructionVectorDrop string + +-- |Takes the top string from the string stack and drops the last N characters +-- from said string. Pushes the result to the string stack. N is pulled from the top +-- of the int stack. +instructionStringButLastN :: State -> State +instructionStringButLastN = instructionVectorDropR string + +-- |Takes the top string from the string stack and calculates the length. The length +-- is then pushed to the int stack. +instructionStringLength :: State -> State +instructionStringLength = instructionLength string + +-- |Makes an empty string and pushes it to the top of the string stack. +instructionStringMakeEmpty :: State -> State +instructionStringMakeEmpty = instructionVectorMakeEmpty string + +-- |Checks to see if the top string is empty on the string stack. +-- Pushes True to the bool stack if empty. Pushes False if not. +instructionStringIsEmptyString :: State -> State +instructionStringIsEmptyString = instructionVectorIsEmpty string + +-- |Removes the Nth char from the top string of the string stack. N is pulled +-- from the top of the int stack. +instructionStringRemoveNth :: State -> State +instructionStringRemoveNth = instructionVectorRemoveNth string + +-- |Sets the Nth char from the top string of the string stack to the top char from +-- the char stack. N is pulled from the top of the int stack. +instructionStringSetNth :: State -> State +instructionStringSetNth = instructionVectorSetNth char string + +-- |Strips the whitespace of the top string on the string stack and pushes the result +-- back to the string stack. +instructionStringStripWhitespace :: State -> State +instructionStringStripWhitespace state@(State {_string = s1 : ss}) = state{_string = strip s1 : ss} +instructionStringStripWhitespace state = state + +-- |Converts the top bool from the bool stack to a string. Pushes the result to +-- the string stack. +instructionStringFromBool :: State -> State +instructionStringFromBool = instructionStringFromLens bool + +-- |Converts the top int from the int stack to a string. Pushes the result to +-- the string stack. +instructionStringFromInt :: State -> State +instructionStringFromInt = instructionStringFromLens int + +-- |Converts the top float from the float stack to a string. Pushes the result to +-- the string stack. +instructionStringFromFloat :: State -> State +instructionStringFromFloat = instructionStringFromLens float + +-- |Converts the top char from the char stack to a string. Pushes the result to +-- the string stack. +instructionStringFromChar :: State -> State +instructionStringFromChar = instructionVectorFromPrim char string + +-- |Removes the top string from the string stack. +instructionStringPop :: State -> State +instructionStringPop = instructionPop string + +-- |Duplicates the top string on the string stack. +instructionStringDup :: State -> State +instructionStringDup = instructionDup string + +-- |Duplicates the top string on the string stack N times based off the top of the int stack. +instructionStringDupN :: State -> State +instructionStringDupN = instructionDupN string + +-- |Rotates the top three strings on the string stack. +instructionStringRot :: State -> State +instructionStringRot = instructionRot string + +-- |Sets the string stack to [] +instructionStringFlush :: State -> State +instructionStringFlush = instructionFlush string + +-- |Checks to see if the top two strings are equal and pushes the result +-- to the bool stack. +instructionStringEq :: State -> State +instructionStringEq = instructionEq string + +-- |Calculates the size of the string stack and pushes the result +-- to the int stack. +instructionStringStackDepth :: State -> State +instructionStringStackDepth = instructionStackDepth string + +-- |Moves an item from deep within the string stack to the top of the string stack based on +-- the top int from the int stack. +instructionStringYank :: State -> State +instructionStringYank = instructionYank string + +-- |Copies an item from deep within the string stack to the top of the string stack based on +-- the top int from the int stack. +instructionStringYankDup :: State -> State +instructionStringYankDup = instructionYankDup string + +-- |Pushes True to the bool stack if the string stack is empty. Pushes False otherwise. +instructionStringIsStackEmpty :: State -> State +instructionStringIsStackEmpty = instructionIsStackEmpty string + +-- |Moves an item from the top of the string stack to deep within the string stack based on +-- the top int from the int stack. +instructionStringShove :: State -> State +instructionStringShove = instructionShove string + +-- |Copies an item from the top of the string stack to deep within the string stack based on +-- the top int from the int stack. +instructionStringShoveDup :: State -> State +instructionStringShoveDup = instructionShoveDup string + +-- |Sorts the top string on the string stack by their ascii value and pushes the result +-- back to the string stack. +instructionStringSort :: State -> State +instructionStringSort = instructionVectorSort string + +-- |Sorts the top string on the string stack backwards by their ascii value and pushes the result +-- back to the string stack. +instructionStringSortReverse :: State -> State +instructionStringSortReverse = instructionVectorSortReverse string + +-- |Duplicate the top N items from the string stack based on the top int from the int stack. +instructionStringDupItems :: State -> State +instructionStringDupItems = instructionDupItems string + +-- |Takes the top string and splits its up into strings of size 1 and pushes all of those +-- strings back onto the string stack. +instructionStringParseToChar :: State -> State +instructionStringParseToChar = instructionVectorParseToPrim string + +-- |Uses the top two ints from the top of the int stack to pull a sub string +-- from the top string on the string stack. Pushes the result back to the +-- string stack. +instructionStringSubString :: State -> State +instructionStringSubString = instructionSubVector string + +-- |Iterates over the top string on the string stack, applying the top instruction of the +-- exec stack along the way. +instructionStringIterate :: State -> State +instructionStringIterate = instructionVectorIterate char string GeneString instructionStringIterate "instructionStringIterate" + +allStringInstructions :: [Gene] +allStringInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/Utility.hs b/src/HushGP/Instructions/Utility.hs new file mode 100644 index 0000000..1ab6f61 --- /dev/null +++ b/src/HushGP/Instructions/Utility.hs @@ -0,0 +1,267 @@ +module HushGP.Instructions.Utility where + +import Control.Lens hiding (index) +import HushGP.State +import Data.Char + +-- generic utility + +-- |Utility Function: Deletes an item from a list at a specified index. +deleteAt :: Int -> [a] -> [a] +deleteAt idx xs = take idx xs <> drop 1 (drop idx xs) + +-- |Utility Function: Combines two tuples containing lists with a value placed between them. +combineTuple :: a -> ([a], [a]) -> [a] +combineTuple val = combineTupleList [val] + +-- |Utility Function: Combines two tuples containing lists with a list placed between them. +combineTupleList :: [a] -> ([a], [a]) -> [a] +combineTupleList val tup = fst tup <> val <> snd tup + +-- |Utility Function: Inserts a value based on an int at a specified index. +insertAt :: Int -> a -> [a] -> [a] +insertAt idx val xs = combineTuple val (splitAt idx xs) + +-- |Utility Function: Replaces a value based on an int at a specified index. +replaceAt :: Int -> a -> [a] -> [a] +replaceAt idx val xs = deleteAt (idx + 1) (insertAt idx val xs) + +-- |Utility Function: Takes two ints as indicies. Sorts them low to high, sets the start to +-- 0 if the lowest start is less than 0 and the end to the length of the list - 1 if the end +-- if larger than the list. Grabs the sub list of adjusted indicies. +subList :: Int -> Int -> [a] -> [a] +subList idx0 idx1 xs = + let + (start, end) = if idx0 <= idx1 then (idx0, idx1) else (idx1, idx0) + adjStart = max 0 start + adjEnd = min end (length xs) + in + take adjEnd (drop adjStart xs) + +-- |Utility Function: Finds the index of the second list inside of the first index. +-- If the sublist passed is larger than the full list, returns -1 +-- If the lists are of equal length, and then contents are equal, returns 0. If not equal, returns -1 +-- Recursively shortens the full list until the sub list is found. +findSubA :: forall a. Eq a => [a] -> [a] -> Int +findSubA fullA subA + | length fullA < length subA = -1 + | length fullA == length subA = if fullA == subA then 0 else -1 + | otherwise = findSubA' fullA subA 0 + where + findSubA' :: [a] -> [a] -> Int -> Int + findSubA' fA sA subIndex + | null fA = -1 + | length sA > length fA = -1 + | sA == take (length sA) fA = subIndex + | otherwise = findSubA' (drop 1 fA) sA (subIndex + 1) + +-- |Utility Function: Replaces a number of instances of old with new in a list. +-- The Maybe Int is the amount of olds to replace with new. Nothing means replace all. +-- Just chain findSubA calls. +-- May not be the most efficient method with the findSubA calls. +replace :: Eq a => [a] -> [a] -> [a] -> Maybe Int -> [a] +replace fullA old new (Just amt) = + if findSubA fullA old /= -1 && amt > 0 + then replace (take (findSubA fullA old) fullA <> new <> drop (findSubA fullA old + length old) fullA) old new (Just $ amt - 1) + else fullA +replace fullA old new Nothing = + if findSubA fullA old /= -1 + then replace (take (findSubA fullA old) fullA <> new <> drop (findSubA fullA old + length old) fullA) old new Nothing + else fullA + +-- |Utility Function: Counts the amount of occurrences of a sub list inside +-- of a larger list. +amtOccurences :: forall a. Eq a => [a] -> [a] -> Int +amtOccurences fullA subA = amtOccurences' fullA subA 0 + where + amtOccurences' :: [a] -> [a] -> Int -> Int + amtOccurences' fA sA count = + if findSubA fA sA /= -1 + then amtOccurences' (replace fA sA mempty (Just 1)) sA (count + 1) + else count + +-- |Utility Function: Takes the last N elements of a list. +takeR :: Int -> [a] -> [a] +takeR amt fullA = drop (length fullA - amt) fullA + +-- |Utility Function: Drops the last N elements of a list. +dropR :: Int -> [a] -> [a] +dropR amt fullA = take (length fullA - amt) fullA + +-- |Utility Function: A safe version of init. If the list is empty, returns the empty list. +-- If the list has items, takes the init of the list. +safeInit :: [a] -> [a] +safeInit [] = [] +safeInit xs = init xs + +-- |Utility Function: An indexing strategy used in parts of Hush. Takes the absolute value +-- of the passed number `mod` the length of the passed list. +absNum :: Integral a => a -> [b] -> Int +absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst + +-- |Utility Function: Checks to see if a list is empty. +-- If the list is empty, returns False. +-- If the list is not empty, returns True. +notEmptyStack :: Lens' State [a] -> State -> Bool +notEmptyStack accessor state = not . null $ view accessor state + +-- |Utility Function: Extracts an int from a GeneInt. +-- How to make this polymorphic???????? A general function for +-- this would be nice. Wrapped in a maybe too? +extractGeneInt :: Gene -> Integer +extractGeneInt (GeneInt x) = x +extractGeneInt _ = error "todo this later??" + + +-- bool utility + +-- |A template function to make bool comparisons concise. +boolTemplate :: (Bool -> Bool -> Bool) -> State -> State +boolTemplate func state@(State {_bool = b1 : b2 : bs}) = state {_bool = func b1 b2 : bs} +boolTemplate _ state = state + +-- |Utility function. Haskell doesn't have its own xor operation. +xor :: Bool -> Bool -> Bool +xor b1 b2 + | b1 && not b2 = True + | not b1 && b2 = True + | otherwise = False + +-- char utility + +-- |Utility: Converts a whole number `mod` 128 to a char. +intToAscii :: Integral a => a -> Char +intToAscii val = chr (abs (fromIntegral val) `mod` 128) + +-- code utility + +-- |Utility function: Checks to see if a gene is a code block. +-- If it is a block, returns true, else returns false +isBlock :: Gene -> Bool +isBlock (Block _) = True +isBlock _ = False + +-- |Utility function: Returns the length of the passed block. +-- If the gene isn't a block, returns 1 +blockLength :: Gene -> Integer +blockLength (Block bxs) = toInteger $ length bxs +blockLength _ = 1 + +-- |Utility function: Returns true if the passed block is empty, false is not. +-- If the passed gene is not a block, returns false +blockIsNull :: Gene -> Bool +blockIsNull (Block bxs) = null bxs +blockIsNull _ = False + +-- |Utility Function: A helper function for instructionCodeContainer. The full description is there. +-- https://faculty.hampshire.edu/lspector/push3-description.html#Type +-- CODE.CONTAINER +findContainer :: Gene -> Gene -> Gene +findContainer (Block fullA) gene + | fromIntegral (length fullA) <= blockLength gene = Block [] + | gene `elem` fullA = Block [] -- Not allowed to be top level + | any isBlock fullA = findContainer' (filter isBlock fullA) gene + | otherwise = Block [] + where + findContainer' :: [Gene] -> Gene -> Gene + findContainer' [] _ = Block [] + findContainer' ((Block bx1) : bxs) g = if g `elem` bx1 then Block bx1 else findContainer' bxs g + findContainer' _ _ = Block [] -- This should never happen +findContainer _ _ = Block [] + +-- |Utility Function: A helper function for instructionCodeDiscrepancy. The full description is there. +countDiscrepancy :: Gene -> Gene -> Integer +countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (toInteger (length xs) - toInteger (length ys)) +countDiscrepancy xgene ygene = if xgene == ygene then 1 else 0 + +-- |Utility Function: Extracts the first gene from a block. Returns itself if not a block +extractFirstFromBlock :: Gene -> Gene +extractFirstFromBlock (Block (bx1 : _)) = bx1 +extractFirstFromBlock gene = gene + +-- |Utility Function: Returns the last gene from a block, [] if the block is empty, and itself if not a block +extractLastFromBlock :: Gene -> Gene +extractLastFromBlock (Block []) = Block [] +extractLastFromBlock (Block bxs) = last bxs +extractLastFromBlock gene = gene + +-- |Utility Function: Calls init on a block. If the block is empty, returns []. If gene isn't a block, returns itself +extractInitFromBlock :: Gene -> Gene +extractInitFromBlock (Block bxs) = Block (safeInit bxs) +extractInitFromBlock gene = gene + +-- |Utility Function: Calls `drop 1` on a block. If gene isn't a block, returns itself +extractTailFromBlock :: Gene -> Gene +extractTailFromBlock (Block bxs) = Block (drop 1 bxs) +extractTailFromBlock _ = Block [] + +-- |Utility Function: Extracts the code at a point in the genome. Recurses into a nested Block if found. The +-- point is based on an int. +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) + +-- |Utility Function: Inserts code at a point in the genome. Recurses into a block if found. The point is based +-- on an integer +codeInsertAtPoint :: [Gene] -> Gene -> Int -> [Gene] +codeInsertAtPoint oldGenes gene 0 = gene : oldGenes +codeInsertAtPoint [] gene _ = [gene] -- This shouldn't happen (lol) +codeInsertAtPoint ((Block genes) : oldGenes) gene index = Block (codeInsertAtPoint genes gene (index - 1)) : oldGenes +codeInsertAtPoint (oldGene : oldGenes) gene index = oldGene : codeInsertAtPoint oldGenes gene (index - 1) + +-- |Utility Function: Combines two genes together into a block. +codeCombine :: Gene -> Gene -> Gene +codeCombine (Block bxs) (Block bys) = Block (bxs <> bys) +codeCombine (Block bxs) ygene = Block (ygene : bxs) +codeCombine xgene (Block bys) = Block (xgene : bys) +codeCombine xgene ygene = Block [xgene, ygene] + +-- |Utility Function: Determines if the second gene is a member of the first gene. +-- If the first gene is a Block and the second gene is also a Block, does a sublist search for the second block in the first block. +-- if the first gene is a Block and the second gene is not, the block is searched for the second gene. +-- If neither of the genes are blocks, returns False. +codeMember :: Gene -> Gene -> Bool +codeMember (Block bxs) (Block bys) = findSubA bxs bys /= (-1) +codeMember (Block bxs) ygene = ygene `elem` bxs +codeMember _ _ = False + +-- |Utility Function: Calculates the size of a Block including counting the nested Blocks recursively +codeRecursiveSize :: Gene -> Integer +codeRecursiveSize (Block bxs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- bxs] +codeRecursiveSize _ = 1 + +-- string utility + +-- |Utility String: Whitespack characters. +-- shamelessly stolen from https://hackage.haskell.org/package/MissingH-1.6.0.1/docs/src/Data.String.Utils.html#strip +wschars :: String +wschars = " \t\r\n" + +-- |Utility Function: Strips a string of its whitespace on both sides. +strip :: String -> String +strip = lstrip . rstrip + +-- |Utility Function: Strips a string of its whitespace on the left side. +lstrip :: String -> String +lstrip s = case s of + [] -> [] + (x:xs) -> if x `elem` wschars + then lstrip xs + else s + +-- |Utility Function: Strips a string of its whitespace on the right side. +-- this is a tad inefficient +rstrip :: String -> String +rstrip = reverse . lstrip . reverse + +-- string utility + +-- |Utility Function: Casts a type based on a lens to a string. Pushes the result +-- to the string stack. +instructionStringFromLens :: Show a => Lens' State [a] -> State -> State +instructionStringFromLens accessor state@(State {_string = ss}) = + case uncons (view accessor state) of + Nothing -> state + Just (x1,_) -> state{_string = show x1 : ss} diff --git a/src/HushGP/Instructions/VectorBoolInstructions.hs b/src/HushGP/Instructions/VectorBoolInstructions.hs new file mode 100644 index 0000000..2f6987d --- /dev/null +++ b/src/HushGP/Instructions/VectorBoolInstructions.hs @@ -0,0 +1,335 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.VectorBoolInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.TH + +-- |Pops the top bool vector from the bool vector stack. +instructionVectorBoolPop :: State -> State +instructionVectorBoolPop = instructionPop vectorBool + +-- |Duplicates the top bool vector from the bool vector stack. +instructionVectorBoolDup :: State -> State +instructionVectorBoolDup = instructionDup vectorBool + +-- |Duplicates the top bool vector from the bool vector stack N times +-- based on the top int from the int stack. +instructionVectorBoolDupN :: State -> State +instructionVectorBoolDupN = instructionDupN vectorBool + +-- |Swaps the top two bool vectors from the bool vector stack. +instructionVectorBoolSwap :: State -> State +instructionVectorBoolSwap = instructionSwap vectorBool + +-- |Rotates the top three bool vectors from the bool vector stack. +instructionVectorBoolRot :: State -> State +instructionVectorBoolRot = instructionRot vectorBool + +-- |Sets the vector bool stack to [] +instructionVectorBoolFlush :: State -> State +instructionVectorBoolFlush = instructionFlush vectorBool + +-- |Pushes True to the bool stack if the top two bool vectors from +-- the vector bool stack are equal. Pushes False otherwise. +instructionVectorBoolEq :: State -> State +instructionVectorBoolEq = instructionEq vectorBool + +-- |Calculates the size of the vector bool stack and pushes that number +-- to the int stack. +instructionVectorBoolStackDepth :: State -> State +instructionVectorBoolStackDepth = instructionStackDepth vectorBool + +-- |Moves an item from deep within the vector bool stack to the top of the vector bool stack based on +-- the top int from the int stack. +instructionVectorBoolYank :: State -> State +instructionVectorBoolYank = instructionYank vectorBool + +-- |Copies an item from deep within the vector bool stack to the top of the vector bool stack based on +-- the top int from the int stack. +instructionVectorBoolYankDup :: State -> State +instructionVectorBoolYankDup = instructionYankDup vectorBool + +-- |Pushes True to the bool stack if the vector bool stack is empty. False if not. +instructionVectorBoolIsStackEmpty :: State -> State +instructionVectorBoolIsStackEmpty = instructionIsStackEmpty vectorBool + +-- |Moves an item from the top of the vector bool stack to deep within the vector bool stack based on +-- the top int from the int stack. +instructionVectorBoolShove :: State -> State +instructionVectorBoolShove = instructionShove vectorBool + +-- |Copies an item from the top of the vector bool stack to deep within the vector bool stack based on +-- the top int from the int stack. +instructionVectorBoolShoveDup :: State -> State +instructionVectorBoolShoveDup = instructionShoveDup vectorBool + +-- |Duplicate the top N items from the vector bool stack based on the top int from the int stack. +instructionVectorBoolDupItems :: State -> State +instructionVectorBoolDupItems = instructionDupItems vectorBool + +-- |Concats the top two vectors on top of the vector bool stack. +instructionVectorBoolConcat :: State -> State +instructionVectorBoolConcat = instructionVectorConcat vectorBool + +-- |Takes the top bool from the bool stack and prepends it to top bool vector +-- on the bool vector stack. +instructionVectorBoolConj :: State -> State +instructionVectorBoolConj = instructionVectorConj bool vectorBool + +-- |Takes the top bool from the bool stack and appends it to top bool vector +-- on the bool vector stack. +instructionVectorBoolConjEnd :: State -> State +instructionVectorBoolConjEnd = instructionVectorConjEnd bool vectorBool + +-- |Takes the first N bools from the top of the bool vector from the bool vector +-- and pushes the result to the bool vector stack. N is pulled from the top of +-- the int stack. +instructionVectorBoolTakeN :: State -> State +instructionVectorBoolTakeN = instructionVectorTakeN vectorBool + +-- |Takes the last N bools from the top of the bool vector from the bool vector +-- and pushes the result to the bool vector stack. N is pulled from the top of +-- the int stack. +instructionVectorBoolTakeRN :: State -> State +instructionVectorBoolTakeRN = instructionVectorTakeRN vectorBool + +-- |Takes a sublist of the top bool vector on top of the vector bool stack. +-- The two ints to determine bounds are pulled from the top of the int stack. +instructionVectorBoolSubVector :: State -> State +instructionVectorBoolSubVector = instructionSubVector vectorBool + +-- |Takes the first bool from the top of the vector bool stack and places +-- it on the bool stack. +instructionVectorBoolFirst :: State -> State +instructionVectorBoolFirst = instructionVectorFirst bool vectorBool + +-- |Takes the first bool from the top of the vector bool stack and places +-- it wrapped in a list on top of the vector bool stack. +instructionVectorBoolFromFirstPrim :: State -> State +instructionVectorBoolFromFirstPrim = instructionVectorFromFirstPrim vectorBool + +-- |Takes the first bool from the top of the bool stack and places it +-- wrapped in a list on top of the vector bool stack. +instructionVectorBoolFromPrim :: State -> State +instructionVectorBoolFromPrim = instructionVectorFromPrim bool vectorBool + +-- |Takes the last bool from the top of the vector bool stack and places +-- it on the bool stack. +instructionVectorBoolLast :: State -> State +instructionVectorBoolLast = instructionVectorLast bool vectorBool + +-- |Takes the last bool from the top bool vector on the vector bool stack and +-- places it on the bool stack. +instructionVectorBoolFromLastPrim :: State -> State +instructionVectorBoolFromLastPrim = instructionVectorFromLastPrim vectorBool + +-- |Takes the Nth bool from the top bool vector and places it onto the bool stack +-- based on an int from the top of the int stack. +instructionVectorBoolNth :: State -> State +instructionVectorBoolNth = instructionVectorNth bool vectorBool + +-- |Takes the Nth bool from the top bool vector on the vector bool stack and +-- creates a vector wrapping that Nth item, pushing it back onto the vector bool stack. +-- N is the top item on the int stack. +instructionVectorBoolFromNthPrim :: State -> State +instructionVectorBoolFromNthPrim = instructionVectorFromNthPrim vectorBool + +-- |Removes the first bool from the top bool vector on the vector bool stack and +-- places the result back onto the vector bool stack. +instructionVectorBoolRest :: State -> State +instructionVectorBoolRest = instructionVectorRest vectorBool + +-- |Removes the last bool from the top bool vector on the vector bool stack and +-- places the result back onto the vector bool stack. +instructionVectorBoolButLast :: State -> State +instructionVectorBoolButLast = instructionVectorButLast vectorBool + +-- |Drops the first N items from the top bool vector and pushes the result +-- back to the vector bool stack. N is pulled from the top of the int stack. +instructionVectorBoolDrop :: State -> State +instructionVectorBoolDrop = instructionVectorDrop vectorBool + +-- |Drops the last N items from the top bool vector and pushes the result +-- back to the vector bool stack. N is pulled from the top of the int stack. +instructionVectorBoolDropR :: State -> State +instructionVectorBoolDropR = instructionVectorDropR vectorBool + +-- |Pushes the length of the top bool vector from the vector bool stack +-- to the top of the int stack. +instructionVectorBoolLength :: State -> State +instructionVectorBoolLength = instructionLength vectorBool + +-- |Reverses the top bool vector from the vector bool stack and pushes the +-- result to the vector bool stack. +instructionVectorBoolReverse :: State -> State +instructionVectorBoolReverse = instructionReverse vectorBool + +-- |Takes the top bool vector from the vector bool stack and pushes the +-- individual bools to the vector bool stack. +instructionVectorBoolPushAll :: State -> State +instructionVectorBoolPushAll = instructionPushAll bool vectorBool + +-- |Makes an empty vector and pushes it to the vector bool stack. +instructionVectorBoolMakeEmpty :: State -> State +instructionVectorBoolMakeEmpty = instructionVectorMakeEmpty vectorBool + +-- |Checks if the top bool vector from the vector bool stack is empty. +-- Pushes True if the bool vector is empty to the bool stack. False otherwise. +instructionVectorBoolIsEmpty :: State -> State +instructionVectorBoolIsEmpty = instructionVectorIsEmpty vectorBool + +-- |If the top bool vector from the vector bool stack contains the top bool from the bool +-- stack, pushes True to the bool stack and pushes False otherwise. +instructionVectorBoolContains :: State -> State +instructionVectorBoolContains = instructionVectorContains bool vectorBool + +-- |If the second to top bool vector can be found within the first bool vector from the +-- vector bool stack, pushes True to the bool stack if is found, else False. +instructionVectorBoolContainsVectorBool :: State -> State +instructionVectorBoolContainsVectorBool = instructionVectorContainsVector vectorBool + +-- |Finds the first index of the top bool in the bool stack inside of the +-- top bool vector from the vector bool stack and pushes the result to the int stack. +instructionVectorBoolIndexOf :: State -> State +instructionVectorBoolIndexOf = instructionVectorIndexOf bool vectorBool + +-- |Searches and pushes the index of the second bool vector inside of the first +-- bool vector to the int stack from the vector bool stack. Pushes -1 if not found. +instructionVectorBoolIndexOfVectorBool :: State -> State +instructionVectorBoolIndexOfVectorBool = instructionVectorIndexOfVector vectorBool + +-- |Finds the amount of times the top bool on the bool stack occurs inside of +-- the top bool vector from the vector bool stack and pushes the result to the +-- int stack. +instructionVectorBoolOccurrencesOf :: State -> State +instructionVectorBoolOccurrencesOf = instructionVectorOccurrencesOf bool vectorBool + +-- |Counts the amount of occurrences of the second bool vector within the first +-- bool vector. Pushes the result to the int stack. +instructionVectorBoolOccurrencesOfVectorBool :: State -> State +instructionVectorBoolOccurrencesOfVectorBool = instructionVectorOccurrencesOfVector vectorBool + +-- |Splits the top bool vector from the vector bool stack into lists of size one and pushes +-- the result back one the vector bool stack. +instructionVectorBoolParseToBool :: State -> State +instructionVectorBoolParseToBool = instructionVectorParseToPrim vectorBool + +-- |Sets the Nth index inside of the top bool vector from the vector bool stack to the +-- top value from the primitive stack. N is pulled from the top of the int stack. +instructionVectorBoolSetNth :: State -> State +instructionVectorBoolSetNth = instructionVectorSetNth bool vectorBool + +-- |Splits the bool vector on top of the vector bool stack with the bool from the top +-- of the bool stack and pushes the result to the original vector stack. +instructionVectorBoolSplitOn :: State -> State +instructionVectorBoolSplitOn = instructionVectorSplitOn bool vectorBool + +-- |Splits the first bool vector based on the second bool vector from the vector +-- bool stack and pushes the result to the vector bool stack. +instructionVectorBoolSplitOnVectorBool :: State -> State +instructionVectorBoolSplitOnVectorBool = instructionVectorSplitOnVector vectorBool + +-- |Replaces the first occurrence of the top bool with the second bool from +-- the bool stack inside of the top bool vector from the vector bool stack. +-- Pushes the modified bool vector to the vector bool stack. +instructionVectorBoolReplaceFirst :: State -> State +instructionVectorBoolReplaceFirst = instructionVectorReplace bool vectorBool (Just 1) + +-- |Replaces all occurrences of the top bool with the second bool from +-- the bool stack inside of the top bool vector from the vector bool stack. +-- Pushes the modified bool vector to the vector bool stack. +instructionVectorBoolReplaceAll :: State -> State +instructionVectorBoolReplaceAll = instructionVectorReplace bool vectorBool Nothing + +-- |Replaces N occurrences of the top bool with the second bool from +-- the bool stack inside of the top bool vector from the vector bool stack. +-- Pushes the modified bool vector to the vector bool stack. N is pulled from +-- the top of the int stack. +instructionVectorBoolReplaceN :: State -> State +instructionVectorBoolReplaceN = instructionVectorReplaceN bool vectorBool + +-- |Replaces the first occurrence of the second bool vector with the third bool vector +-- inside of the first bool vector from the vector bool stack. Pushes the result to the +-- vector bool stack. +instructionVectorBoolReplaceFirstVectorBool :: State -> State +instructionVectorBoolReplaceFirstVectorBool = instructionVectorReplaceVector vectorBool (Just 1) + +-- |Replaces all occurrences of the second bool vector with the third bool vector +-- inside of the first bool vector from the vector bool stack. Pushes the result to the +-- vector bool stack. +instructionVectorBoolReplaceAllVectorBool :: State -> State +instructionVectorBoolReplaceAllVectorBool = instructionVectorReplaceVector vectorBool Nothing + +-- |Replaces N occurrences of the second bool vector with the third bool vector +-- inside of the first bool vector from the vector bool stack. Pushes the result to the +-- vector bool stack. N is pulled from the top of the int stack. +instructionVectorBoolReplaceVectorBoolN :: State -> State +instructionVectorBoolReplaceVectorBoolN = instructionVectorReplaceVectorN vectorBool + +-- |Removes the first occurrence of the top bool from +-- the bool stack inside of the top bool vector from the vector bool stack. +-- Pushes the modified bool vector to the vector bool stack. +instructionVectorBoolRemoveFirst :: State -> State +instructionVectorBoolRemoveFirst = instructionVectorRemove bool vectorBool (Just 1) + +-- |Removes the all occurrences of the top bool from +-- the bool stack inside of the top bool vector from the vector bool stack. +-- Pushes the modified bool vector to the vector bool stack. +instructionVectorBoolRemoveAll :: State -> State +instructionVectorBoolRemoveAll = instructionVectorRemove bool vectorBool Nothing + +-- |Removes N occurrences of the top bool from +-- the bool stack inside of the top bool vector from the vector bool stack. +-- Pushes the modified bool vector to the vector bool stack. N is pulled +-- from the top of the int stack. +instructionVectorBoolRemoveN :: State -> State +instructionVectorBoolRemoveN = instructionVectorRemoveN bool vectorBool + +-- |Removes the first occurrence of the second bool vector +-- inside of the first bool vector from the vector bool stack. Pushes the result to the +-- vector bool stack. +instructionVectorBoolRemoveFirstVectorBool :: State -> State +instructionVectorBoolRemoveFirstVectorBool = instructionVectorRemoveVector vectorBool (Just 1) + +-- |Removes all occurrences of the second bool vector +-- inside of the first bool vector from the vector bool stack. Pushes the result to the +-- vector bool stack. +instructionVectorBoolRemoveAllVectorBool :: State -> State +instructionVectorBoolRemoveAllVectorBool = instructionVectorRemoveVector vectorBool Nothing + +-- |Removes N occurrences of the second bool vector +-- inside of the first bool vector from the vector bool stack. Pushes the result to the +-- vector bool stack. N is pulled from the top of the int stack. +instructionVectorBoolRemoveNVectorBool :: State -> State +instructionVectorBoolRemoveNVectorBool = instructionVectorRemoveVectorN vectorBool + +-- |Iterates over the top bool vector on the vector bool stack, applying the top instruction of the +-- exec stack along the way. +instructionVectorBoolIterate :: State -> State +instructionVectorBoolIterate = instructionVectorIterate bool vectorBool GeneVectorBool instructionVectorBoolIterate "instructionVectorBoolIterate" + +-- |Sorts the top bool vector on the vector bool stack and pushes the result back to the +-- vector bool stack. +instructionVectorBoolSort :: State -> State +instructionVectorBoolSort = instructionVectorSort vectorBool + +-- |Sorts the top bool vector on the vector bool stack, reverses it, and pushes the result back to the +-- vector bool stack. +instructionVectorBoolSortReverse :: State -> State +instructionVectorBoolSortReverse = instructionVectorSortReverse vectorBool + +-- |Inserts the top bool from the bool stack into the top bool vector from the +-- vector bool stack at a specified index and pushes the result to the vector +-- bool stack. The index is pulled from the top of the int stack. +instructionVectorBoolInsert :: State -> State +instructionVectorBoolInsert = instructionVectorInsert bool vectorBool + +-- |Inserts the second bool vector into the first bool vector from the vector bool stack +-- at a specified index and pushes the result to the vector bool stack. The index is +-- pulled from the top of the int stack. +instructionVectorBoolInsertVectorBool :: State -> State +instructionVectorBoolInsertVectorBool = instructionVectorInsertVector vectorBool + +allVectorBoolInstructions :: [Gene] +allVectorBoolInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/VectorCharInstructions.hs b/src/HushGP/Instructions/VectorCharInstructions.hs new file mode 100644 index 0000000..caf52f1 --- /dev/null +++ b/src/HushGP/Instructions/VectorCharInstructions.hs @@ -0,0 +1,335 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.VectorCharInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.TH + +-- |Pops the top char vector from the char vector stack. +instructionVectorCharPop :: State -> State +instructionVectorCharPop = instructionPop vectorChar + +-- |Duplicates the top char vector from the char vector stack. +instructionVectorCharDup :: State -> State +instructionVectorCharDup = instructionDup vectorChar + +-- |Duplicates the top char vector from the char vector stack N times +-- based on the top int from the int stack. +instructionVectorCharDupN :: State -> State +instructionVectorCharDupN = instructionDupN vectorChar + +-- |Swaps the top two char vectors from the char vector stack. +instructionVectorCharSwap :: State -> State +instructionVectorCharSwap = instructionSwap vectorChar + +-- |Rotates the top three char vectors from the char vector stack. +instructionVectorCharRot :: State -> State +instructionVectorCharRot = instructionRot vectorChar + +-- |Sets the vector char stack to [] +instructionVectorCharFlush :: State -> State +instructionVectorCharFlush = instructionFlush vectorChar + +-- |Pushes True to the bool stack if the top two char vectors from +-- the vector char stack are equal. Pushes False otherwise. +instructionVectorCharEq :: State -> State +instructionVectorCharEq = instructionEq vectorChar + +-- |Calculates the size of the vector char stack and pushes that number +-- to the int stack. +instructionVectorCharStackDepth :: State -> State +instructionVectorCharStackDepth = instructionStackDepth vectorChar + +-- |Moves an item from deep within the vector char stack to the top of the vector char stack based on +-- the top int from the int stack. +instructionVectorCharYank :: State -> State +instructionVectorCharYank = instructionYank vectorChar + +-- |Copies an item from deep within the vector char stack to the top of the vector char stack based on +-- the top int from the int stack. +instructionVectorCharYankDup :: State -> State +instructionVectorCharYankDup = instructionYankDup vectorChar + +-- |Pushes True to the bool stack if the vector char stack is empty. False if not. +instructionVectorCharIsStackEmpty :: State -> State +instructionVectorCharIsStackEmpty = instructionIsStackEmpty vectorChar + +-- |Moves an item from the top of the vector char stack to deep within the vector char stack based on +-- the top int from the int stack. +instructionVectorCharShove :: State -> State +instructionVectorCharShove = instructionShove vectorChar + +-- |Copies an item from the top of the vector char stack to deep within the vector char stack based on +-- the top int from the int stack. +instructionVectorCharShoveDup :: State -> State +instructionVectorCharShoveDup = instructionShoveDup vectorChar + +-- |Duplicate the top N items from the vector char stack based on the top int from the int stack. +instructionVectorCharDupItems :: State -> State +instructionVectorCharDupItems = instructionDupItems vectorChar + +-- |Concats the top two vectors on top of the vector char stack. +instructionVectorCharConcat :: State -> State +instructionVectorCharConcat = instructionVectorConcat vectorChar + +-- |Takes the top char from the char stack and prepends it to top char vector +-- on the char vector stack. +instructionVectorCharConj :: State -> State +instructionVectorCharConj = instructionVectorConj char vectorChar + +-- |Takes the top char from the char stack and appends it to top char vector +-- on the char vector stack. +instructionVectorCharConjEnd :: State -> State +instructionVectorCharConjEnd = instructionVectorConjEnd char vectorChar + +-- |Takes the first N chars from the top of the char vector from the char vector +-- and pushes the result to the char vector stack. N is pulled from the top of +-- the int stack. +instructionVectorCharTakeN :: State -> State +instructionVectorCharTakeN = instructionVectorTakeN vectorChar + +-- |Takes the last N chars from the top of the char vector from the char vector +-- and pushes the result to the char vector stack. N is pulled from the top of +-- the int stack. +instructionVectorCharTakeRN :: State -> State +instructionVectorCharTakeRN = instructionVectorTakeRN vectorChar + +-- |Takes a sublist of the top char vector on top of the vector char stack. +-- The two ints to determine bounds are pulled from the top of the int stack. +instructionVectorCharSubVector :: State -> State +instructionVectorCharSubVector = instructionSubVector vectorChar + +-- |Takes the first char from the top of the vector char stack and places +-- it on the char stack. +instructionVectorCharFirst :: State -> State +instructionVectorCharFirst = instructionVectorFirst char vectorChar + +-- |Takes the first char from the top of the vector char stack and places +-- it wrapped in a list on top of the vector char stack. +instructionVectorCharFromFirstPrim :: State -> State +instructionVectorCharFromFirstPrim = instructionVectorFromFirstPrim vectorChar + +-- |Takes the first char from the top of the char stack and places it +-- wrapped in a list on top of the vector char stack. +instructionVectorCharFromPrim :: State -> State +instructionVectorCharFromPrim = instructionVectorFromPrim char vectorChar + +-- |Takes the last char from the top of the vector char stack and places +-- it on the char stack. +instructionVectorCharLast :: State -> State +instructionVectorCharLast = instructionVectorLast char vectorChar + +-- |Takes the last char from the top char vector on the vector char stack and +-- places it on the char stack. +instructionVectorCharFromLastPrim :: State -> State +instructionVectorCharFromLastPrim = instructionVectorFromLastPrim vectorChar + +-- |Takes the Nth char from the top char vector and places it onto the char stack +-- based on an int from the top of the int stack. +instructionVectorCharNth :: State -> State +instructionVectorCharNth = instructionVectorNth char vectorChar + +-- |Takes the Nth char from the top char vector on the vector char stack and +-- creates a vector wrapping that Nth item, pushing it back onto the vector char stack. +-- N is the top item on the int stack. +instructionVectorCharFromNthPrim :: State -> State +instructionVectorCharFromNthPrim = instructionVectorFromNthPrim vectorChar + +-- |Removes the first char from the top char vector on the vector char stack and +-- places the result back onto the vector char stack. +instructionVectorCharRest :: State -> State +instructionVectorCharRest = instructionVectorRest vectorChar + +-- |Removes the last char from the top char vector on the vector char stack and +-- places the result back onto the vector char stack. +instructionVectorCharButLast :: State -> State +instructionVectorCharButLast = instructionVectorButLast vectorChar + +-- |Drops the first N items from the top char vector and pushes the result +-- back to the vector char stack. N is pulled from the top of the int stack. +instructionVectorCharDrop :: State -> State +instructionVectorCharDrop = instructionVectorDrop vectorChar + +-- |Drops the last N items from the top char vector and pushes the result +-- back to the vector char stack. N is pulled from the top of the int stack. +instructionVectorCharDropR :: State -> State +instructionVectorCharDropR = instructionVectorDropR vectorChar + +-- |Pushes the length of the top char vector from the vector char stack +-- to the top of the int stack. +instructionVectorCharLength :: State -> State +instructionVectorCharLength = instructionLength vectorChar + +-- |Reverses the top char vector from the vector char stack and pushes the +-- result to the vector char stack. +instructionVectorCharReverse :: State -> State +instructionVectorCharReverse = instructionReverse vectorChar + +-- |Takes the top char vector from the vector char stack and pushes the +-- individual chars to the vector char stack. +instructionVectorCharPushAll :: State -> State +instructionVectorCharPushAll = instructionPushAll char vectorChar + +-- |Makes an empty vector and pushes it to the vector char stack. +instructionVectorCharMakeEmpty :: State -> State +instructionVectorCharMakeEmpty = instructionVectorMakeEmpty vectorChar + +-- |Checks if the top char vector from the vector char stack is empty. +-- Pushes True if the char vector is empty to the bool stack. False otherwise. +instructionVectorCharIsEmpty :: State -> State +instructionVectorCharIsEmpty = instructionVectorIsEmpty vectorChar + +-- |If the top char vector from the vector char stack contains the top char from the char +-- stack, pushes True to the bool stack and pushes False otherwise. +instructionVectorCharContains :: State -> State +instructionVectorCharContains = instructionVectorContains char vectorChar + +-- |If the second to top char vector can be found within the first char vector from the +-- vector char stack, pushes True to the bool stack if is found, else False. +instructionVectorCharContainsVectorChar :: State -> State +instructionVectorCharContainsVectorChar = instructionVectorContainsVector vectorChar + +-- |Finds the first index of the top char in the char stack inside of the +-- top char vector from the vector char stack and pushes the result to the int stack. +instructionVectorCharIndexOf :: State -> State +instructionVectorCharIndexOf = instructionVectorIndexOf char vectorChar + +-- |Searches and pushes the index of the second char vector inside of the first +-- char vector to the int stack from the vector char stack. Pushes -1 if not found. +instructionVectorCharIndexOfVectorChar :: State -> State +instructionVectorCharIndexOfVectorChar = instructionVectorIndexOfVector vectorChar + +-- |Finds the amount of times the top char on the char stack occurs inside of +-- the top char vector from the vector char stack and pushes the result to the +-- int stack. +instructionVectorCharOccurrencesOf :: State -> State +instructionVectorCharOccurrencesOf = instructionVectorOccurrencesOf char vectorChar + +-- |Counts the amount of occurrences of the second char vector within the first +-- char vector. Pushes the result to the int stack. +instructionVectorCharOccurrencesOfVectorChar :: State -> State +instructionVectorCharOccurrencesOfVectorChar = instructionVectorOccurrencesOfVector vectorChar + +-- |Splits the top char vector from the vector char stack into lists of size one and pushes +-- the result back one the vector char stack. +instructionVectorCharParseToChar :: State -> State +instructionVectorCharParseToChar = instructionVectorParseToPrim vectorChar + +-- |Sets the Nth index inside of the top char vector from the vector char stack to the +-- top value from the primitive stack. N is pulled from the top of the int stack. +instructionVectorCharSetNth :: State -> State +instructionVectorCharSetNth = instructionVectorSetNth char vectorChar + +-- |Splits the char vector on top of the vector char stack with the char from the top +-- of the char stack and pushes the result to the original vector stack. +instructionVectorCharSplitOn :: State -> State +instructionVectorCharSplitOn = instructionVectorSplitOn char vectorChar + +-- |Splits the first char vector based on the second char vector from the vector +-- char stack and pushes the result to the vector char stack. +instructionVectorCharSplitOnVectorChar :: State -> State +instructionVectorCharSplitOnVectorChar = instructionVectorSplitOnVector vectorChar + +-- |Replaces the first occurrence of the top char with the second char from +-- the char stack inside of the top char vector from the vector char stack. +-- Pushes the modified char vector to the vector char stack. +instructionVectorCharReplaceFirst :: State -> State +instructionVectorCharReplaceFirst = instructionVectorReplace char vectorChar (Just 1) + +-- |Replaces all occurrences of the top char with the second char from +-- the char stack inside of the top char vector from the vector char stack. +-- Pushes the modified char vector to the vector char stack. +instructionVectorCharReplaceAll :: State -> State +instructionVectorCharReplaceAll = instructionVectorReplace char vectorChar Nothing + +-- |Replaces N occurrences of the top char with the second char from +-- the char stack inside of the top char vector from the vector char stack. +-- Pushes the modified char vector to the vector char stack. N is pulled from +-- the top of the int stack. +instructionVectorCharReplaceN :: State -> State +instructionVectorCharReplaceN = instructionVectorReplaceN char vectorChar + +-- |Replaces the first occurrence of the second char vector with the third char vector +-- inside of the first char vector from the vector char stack. Pushes the result to the +-- vector char stack. +instructionVectorCharReplaceFirstVectorChar :: State -> State +instructionVectorCharReplaceFirstVectorChar = instructionVectorReplaceVector vectorChar (Just 1) + +-- |Replaces all occurrences of the second char vector with the third char vector +-- inside of the first char vector from the vector char stack. Pushes the result to the +-- vector char stack. +instructionVectorCharReplaceAllVectorChar :: State -> State +instructionVectorCharReplaceAllVectorChar = instructionVectorReplaceVector vectorChar Nothing + +-- |Replaces N occurrences of the second char vector with the third char vector +-- inside of the first char vector from the vector char stack. Pushes the result to the +-- vector char stack. N is pulled from the top of the int stack. +instructionVectorCharReplaceVectorCharN :: State -> State +instructionVectorCharReplaceVectorCharN = instructionVectorReplaceVectorN vectorChar + +-- |Removes the first occurrence of the top char from +-- the char stack inside of the top char vector from the vector char stack. +-- Pushes the modified char vector to the vector char stack. +instructionVectorCharRemoveFirst :: State -> State +instructionVectorCharRemoveFirst = instructionVectorRemove char vectorChar (Just 1) + +-- |Removes the all occurrences of the top char from +-- the char stack inside of the top char vector from the vector char stack. +-- Pushes the modified char vector to the vector char stack. +instructionVectorCharRemoveAll :: State -> State +instructionVectorCharRemoveAll = instructionVectorRemove char vectorChar Nothing + +-- |Removes N occurrences of the top char from +-- the char stack inside of the top char vector from the vector char stack. +-- Pushes the modified char vector to the vector char stack. N is pulled +-- from the top of the int stack. +instructionVectorCharRemoveN :: State -> State +instructionVectorCharRemoveN = instructionVectorRemoveN char vectorChar + +-- |Removes the first occurrence of the second char vector +-- inside of the first char vector from the vector char stack. Pushes the result to the +-- vector char stack. +instructionVectorCharRemoveFirstVectorChar :: State -> State +instructionVectorCharRemoveFirstVectorChar = instructionVectorRemoveVector vectorChar (Just 1) + +-- |Removes all occurrences of the second char vector +-- inside of the first char vector from the vector char stack. Pushes the result to the +-- vector char stack. +instructionVectorCharRemoveAllVectorChar :: State -> State +instructionVectorCharRemoveAllVectorChar = instructionVectorRemoveVector vectorChar Nothing + +-- |Removes N occurrences of the second char vector +-- inside of the first char vector from the vector char stack. Pushes the result to the +-- vector char stack. N is pulled from the top of the int stack. +instructionVectorCharRemoveNVectorChar :: State -> State +instructionVectorCharRemoveNVectorChar = instructionVectorRemoveVectorN vectorChar + +-- |Iterates over the top char vector on the vector char stack, applying the top instruction of the +-- exec stack along the way. +instructionVectorCharIterate :: State -> State +instructionVectorCharIterate = instructionVectorIterate char vectorChar GeneVectorChar instructionVectorCharIterate "instructionVectorCharIterate" + +-- |Sorts the top char vector on the vector char stack and pushes the result back to the +-- vector char stack. +instructionVectorCharSort :: State -> State +instructionVectorCharSort = instructionVectorSort vectorChar + +-- |Sorts the top char vector on the vector char stack, reverses it, and pushes the result back to the +-- vector char stack. +instructionVectorCharSortReverse :: State -> State +instructionVectorCharSortReverse = instructionVectorSortReverse vectorChar + +-- |Inserts the top char from the char stack into the top char vector from the +-- vector char stack at a specified index and pushes the result to the vector +-- char stack. The index is pulled from the top of the int stack. +instructionVectorCharInsert :: State -> State +instructionVectorCharInsert = instructionVectorInsert char vectorChar + +-- |Inserts the second char vector into the first char vector from the vector char stack +-- at a specified index and pushes the result to the vector char stack. The index is +-- pulled from the top of the int stack. +instructionVectorCharInsertVectorChar :: State -> State +instructionVectorCharInsertVectorChar = instructionVectorInsertVector vectorChar + +allVectorCharInstructions :: [Gene] +allVectorCharInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/VectorFloatInstructions.hs b/src/HushGP/Instructions/VectorFloatInstructions.hs new file mode 100644 index 0000000..b1b115a --- /dev/null +++ b/src/HushGP/Instructions/VectorFloatInstructions.hs @@ -0,0 +1,335 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.VectorFloatInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.TH + +-- |Pops the top float vector from the float vector stack. +instructionVectorFloatPop :: State -> State +instructionVectorFloatPop = instructionPop vectorFloat + +-- |Duplicates the top float vector from the float vector stack. +instructionVectorFloatDup :: State -> State +instructionVectorFloatDup = instructionDup vectorFloat + +-- |Duplicates the top float vector from the float vector stack N times +-- based on the top int from the int stack. +instructionVectorFloatDupN :: State -> State +instructionVectorFloatDupN = instructionDupN vectorFloat + +-- |Swaps the top two float vectors from the float vector stack. +instructionVectorFloatSwap :: State -> State +instructionVectorFloatSwap = instructionSwap vectorFloat + +-- |Rotates the top three float vectors from the float vector stack. +instructionVectorFloatRot :: State -> State +instructionVectorFloatRot = instructionRot vectorFloat + +-- |Sets the vector float stack to [] +instructionVectorFloatFlush :: State -> State +instructionVectorFloatFlush = instructionFlush vectorFloat + +-- |Pushes True to the bool stack if the top two float vectors from +-- the vector float stack are equal. Pushes False otherwise. +instructionVectorFloatEq :: State -> State +instructionVectorFloatEq = instructionEq vectorFloat + +-- |Calculates the size of the vector float stack and pushes that number +-- to the int stack. +instructionVectorFloatStackDepth :: State -> State +instructionVectorFloatStackDepth = instructionStackDepth vectorFloat + +-- |Moves an item from deep within the vector float stack to the top of the vector float stack based on +-- the top int from the int stack. +instructionVectorFloatYank :: State -> State +instructionVectorFloatYank = instructionYank vectorFloat + +-- |Copies an item from deep within the vector float stack to the top of the vector float stack based on +-- the top int from the int stack. +instructionVectorFloatYankDup :: State -> State +instructionVectorFloatYankDup = instructionYankDup vectorFloat + +-- |Pushes True to the bool stack if the vector float stack is empty. False if not. +instructionVectorFloatIsStackEmpty :: State -> State +instructionVectorFloatIsStackEmpty = instructionIsStackEmpty vectorFloat + +-- |Moves an item from the top of the vector float stack to deep within the vector float stack based on +-- the top int from the int stack. +instructionVectorFloatShove :: State -> State +instructionVectorFloatShove = instructionShove vectorFloat + +-- |Copies an item from the top of the vector float stack to deep within the vector float stack based on +-- the top int from the int stack. +instructionVectorFloatShoveDup :: State -> State +instructionVectorFloatShoveDup = instructionShoveDup vectorFloat + +-- |Duplicate the top N items from the vector float stack based on the top int from the int stack. +instructionVectorFloatDupItems :: State -> State +instructionVectorFloatDupItems = instructionDupItems vectorFloat + +-- |Concats the top two vectors on top of the vector float stack. +instructionVectorFloatConcat :: State -> State +instructionVectorFloatConcat = instructionVectorConcat vectorFloat + +-- |Takes the top float from the float stack and prepends it to top float vector +-- on the float vector stack. +instructionVectorFloatConj :: State -> State +instructionVectorFloatConj = instructionVectorConj float vectorFloat + +-- |Takes the top float from the float stack and appends it to top float vector +-- on the float vector stack. +instructionVectorFloatConjEnd :: State -> State +instructionVectorFloatConjEnd = instructionVectorConjEnd float vectorFloat + +-- |Takes the first N floats from the top of the float vector from the float vector +-- and pushes the result to the float vector stack. N is pulled from the top of +-- the int stack. +instructionVectorFloatTakeN :: State -> State +instructionVectorFloatTakeN = instructionVectorTakeN vectorFloat + +-- |Takes the last N floats from the top of the float vector from the float vector +-- and pushes the result to the float vector stack. N is pulled from the top of +-- the int stack. +instructionVectorFloatTakeRN :: State -> State +instructionVectorFloatTakeRN = instructionVectorTakeRN vectorFloat + +-- |Takes a sublist of the top float vector on top of the vector float stack. +-- The two ints to determine bounds are pulled from the top of the int stack. +instructionVectorFloatSubVector :: State -> State +instructionVectorFloatSubVector = instructionSubVector vectorFloat + +-- |Takes the first float from the top of the vector float stack and places +-- it on the float stack. +instructionVectorFloatFirst :: State -> State +instructionVectorFloatFirst = instructionVectorFirst float vectorFloat + +-- |Takes the first float from the top of the vector float stack and places +-- it wrapped in a list on top of the vector float stack. +instructionVectorFloatFromFirstPrim :: State -> State +instructionVectorFloatFromFirstPrim = instructionVectorFromFirstPrim vectorFloat + +-- |Takes the first float from the top of the float stack and places it +-- wrapped in a list on top of the vector float stack. +instructionVectorFloatFromPrim :: State -> State +instructionVectorFloatFromPrim = instructionVectorFromPrim float vectorFloat + +-- |Takes the last float from the top of the vector float stack and places +-- it on the float stack. +instructionVectorFloatLast :: State -> State +instructionVectorFloatLast = instructionVectorLast float vectorFloat + +-- |Takes the last float from the top float vector on the vector float stack and +-- places it on the float stack. +instructionVectorFloatFromLastPrim :: State -> State +instructionVectorFloatFromLastPrim = instructionVectorFromLastPrim vectorFloat + +-- |Takes the Nth float from the top float vector and places it onto the float stack +-- based on an int from the top of the int stack. +instructionVectorFloatNth :: State -> State +instructionVectorFloatNth = instructionVectorNth float vectorFloat + +-- |Takes the Nth float from the top float vector on the vector float stack and +-- creates a vector wrapping that Nth item, pushing it back onto the vector float stack. +-- N is the top item on the int stack. +instructionVectorFloatFromNthPrim :: State -> State +instructionVectorFloatFromNthPrim = instructionVectorFromNthPrim vectorFloat + +-- |Removes the first float from the top float vector on the vector float stack and +-- places the result back onto the vector float stack. +instructionVectorFloatRest :: State -> State +instructionVectorFloatRest = instructionVectorRest vectorFloat + +-- |Removes the last float from the top float vector on the vector float stack and +-- places the result back onto the vector float stack. +instructionVectorFloatButLast :: State -> State +instructionVectorFloatButLast = instructionVectorButLast vectorFloat + +-- |Drops the first N items from the top float vector and pushes the result +-- back to the vector float stack. N is pulled from the top of the int stack. +instructionVectorFloatDrop :: State -> State +instructionVectorFloatDrop = instructionVectorDrop vectorFloat + +-- |Drops the last N items from the top float vector and pushes the result +-- back to the vector float stack. N is pulled from the top of the int stack. +instructionVectorFloatDropR :: State -> State +instructionVectorFloatDropR = instructionVectorDropR vectorFloat + +-- |Pushes the length of the top float vector from the vector float stack +-- to the top of the int stack. +instructionVectorFloatLength :: State -> State +instructionVectorFloatLength = instructionLength vectorFloat + +-- |Reverses the top float vector from the vector float stack and pushes the +-- result to the vector float stack. +instructionVectorFloatReverse :: State -> State +instructionVectorFloatReverse = instructionReverse vectorFloat + +-- |Takes the top float vector from the vector float stack and pushes the +-- individual floats to the vector float stack. +instructionVectorFloatPushAll :: State -> State +instructionVectorFloatPushAll = instructionPushAll float vectorFloat + +-- |Makes an empty vector and pushes it to the vector float stack. +instructionVectorFloatMakeEmpty :: State -> State +instructionVectorFloatMakeEmpty = instructionVectorMakeEmpty vectorFloat + +-- |Checks if the top float vector from the vector float stack is empty. +-- Pushes True if the float vector is empty to the bool stack. False otherwise. +instructionVectorFloatIsEmpty :: State -> State +instructionVectorFloatIsEmpty = instructionVectorIsEmpty vectorFloat + +-- |If the top float vector from the vector float stack contains the top float from the float +-- stack, pushes True to the bool stack and pushes False otherwise. +instructionVectorFloatContains :: State -> State +instructionVectorFloatContains = instructionVectorContains float vectorFloat + +-- |If the second to top float vector can be found within the first float vector from the +-- vector float stack, pushes True to the bool stack if is found, else False. +instructionVectorFloatContainsVectorFloat :: State -> State +instructionVectorFloatContainsVectorFloat = instructionVectorContainsVector vectorFloat + +-- |Finds the first index of the top float in the float stack inside of the +-- top float vector from the vector float stack and pushes the result to the int stack. +instructionVectorFloatIndexOf :: State -> State +instructionVectorFloatIndexOf = instructionVectorIndexOf float vectorFloat + +-- |Searches and pushes the index of the second float vector inside of the first +-- float vector to the int stack from the vector float stack. Pushes -1 if not found. +instructionVectorFloatIndexOfVectorFloat :: State -> State +instructionVectorFloatIndexOfVectorFloat = instructionVectorIndexOfVector vectorFloat + +-- |Finds the amount of times the top float on the float stack occurs inside of +-- the top float vector from the vector float stack and pushes the result to the +-- int stack. +instructionVectorFloatOccurrencesOf :: State -> State +instructionVectorFloatOccurrencesOf = instructionVectorOccurrencesOf float vectorFloat + +-- |Counts the amount of occurrences of the second float vector within the first +-- float vector. Pushes the result to the int stack. +instructionVectorFloatOccurrencesOfVectorFloat :: State -> State +instructionVectorFloatOccurrencesOfVectorFloat = instructionVectorOccurrencesOfVector vectorFloat + +-- |Splits the top float vector from the vector float stack into lists of size one and pushes +-- the result back one the vector float stack. +instructionVectorFloatParseToFloat :: State -> State +instructionVectorFloatParseToFloat = instructionVectorParseToPrim vectorFloat + +-- |Sets the Nth index inside of the top float vector from the vector float stack to the +-- top value from the primitive stack. N is pulled from the top of the int stack. +instructionVectorFloatSetNth :: State -> State +instructionVectorFloatSetNth = instructionVectorSetNth float vectorFloat + +-- |Splits the float vector on top of the vector float stack with the float from the top +-- of the float stack and pushes the result to the original vector stack. +instructionVectorFloatSplitOn :: State -> State +instructionVectorFloatSplitOn = instructionVectorSplitOn float vectorFloat + +-- |Splits the first float vector based on the second float vector from the vector +-- float stack and pushes the result to the vector float stack. +instructionVectorFloatSplitOnVectorFloat :: State -> State +instructionVectorFloatSplitOnVectorFloat = instructionVectorSplitOnVector vectorFloat + +-- |Replaces the first occurrence of the top float with the second float from +-- the float stack inside of the top float vector from the vector float stack. +-- Pushes the modified float vector to the vector float stack. +instructionVectorFloatReplaceFirst :: State -> State +instructionVectorFloatReplaceFirst = instructionVectorReplace float vectorFloat (Just 1) + +-- |Replaces all occurrences of the top float with the second float from +-- the float stack inside of the top float vector from the vector float stack. +-- Pushes the modified float vector to the vector float stack. +instructionVectorFloatReplaceAll :: State -> State +instructionVectorFloatReplaceAll = instructionVectorReplace float vectorFloat Nothing + +-- |Replaces N occurrences of the top float with the second float from +-- the float stack inside of the top float vector from the vector float stack. +-- Pushes the modified float vector to the vector float stack. N is pulled from +-- the top of the int stack. +instructionVectorFloatReplaceN :: State -> State +instructionVectorFloatReplaceN = instructionVectorReplaceN float vectorFloat + +-- |Replaces the first occurrence of the second float vector with the third float vector +-- inside of the first float vector from the vector float stack. Pushes the result to the +-- vector float stack. +instructionVectorFloatReplaceFirstVectorFloat :: State -> State +instructionVectorFloatReplaceFirstVectorFloat = instructionVectorReplaceVector vectorFloat (Just 1) + +-- |Replaces all occurrences of the second float vector with the third float vector +-- inside of the first float vector from the vector float stack. Pushes the result to the +-- vector float stack. +instructionVectorFloatReplaceAllVectorFloat :: State -> State +instructionVectorFloatReplaceAllVectorFloat = instructionVectorReplaceVector vectorFloat Nothing + +-- |Replaces N occurrences of the second float vector with the third float vector +-- inside of the first float vector from the vector float stack. Pushes the result to the +-- vector float stack. N is pulled from the top of the int stack. +instructionVectorFloatReplaceVectorFloatN :: State -> State +instructionVectorFloatReplaceVectorFloatN = instructionVectorReplaceVectorN vectorFloat + +-- |Removes the first occurrence of the top float from +-- the float stack inside of the top float vector from the vector float stack. +-- Pushes the modified float vector to the vector float stack. +instructionVectorFloatRemoveFirst :: State -> State +instructionVectorFloatRemoveFirst = instructionVectorRemove float vectorFloat (Just 1) + +-- |Removes the all occurrences of the top float from +-- the float stack inside of the top float vector from the vector float stack. +-- Pushes the modified float vector to the vector float stack. +instructionVectorFloatRemoveAll :: State -> State +instructionVectorFloatRemoveAll = instructionVectorRemove float vectorFloat Nothing + +-- |Removes N occurrences of the top float from +-- the float stack inside of the top float vector from the vector float stack. +-- Pushes the modified float vector to the vector float stack. N is pulled +-- from the top of the int stack. +instructionVectorFloatRemoveN :: State -> State +instructionVectorFloatRemoveN = instructionVectorRemoveN float vectorFloat + +-- |Removes the first occurrence of the second float vector +-- inside of the first float vector from the vector float stack. Pushes the result to the +-- vector float stack. +instructionVectorFloatRemoveFirstVectorFloat :: State -> State +instructionVectorFloatRemoveFirstVectorFloat = instructionVectorRemoveVector vectorFloat (Just 1) + +-- |Removes all occurrences of the second float vector +-- inside of the first float vector from the vector float stack. Pushes the result to the +-- vector float stack. +instructionVectorFloatRemoveAllVectorFloat :: State -> State +instructionVectorFloatRemoveAllVectorFloat = instructionVectorRemoveVector vectorFloat Nothing + +-- |Removes N occurrences of the second float vector +-- inside of the first float vector from the vector float stack. Pushes the result to the +-- vector float stack. N is pulled from the top of the int stack. +instructionVectorFloatRemoveNVectorFloat :: State -> State +instructionVectorFloatRemoveNVectorFloat = instructionVectorRemoveVectorN vectorFloat + +-- |Iterates over the top float vector on the vector float stack, applying the top instruction of the +-- exec stack along the way. +instructionVectorFloatIterate :: State -> State +instructionVectorFloatIterate = instructionVectorIterate float vectorFloat GeneVectorFloat instructionVectorFloatIterate "instructionVectorFloatIterate" + +-- |Sorts the top float vector on the vector float stack and pushes the result back to the +-- vector float stack. +instructionVectorFloatSort :: State -> State +instructionVectorFloatSort = instructionVectorSort vectorFloat + +-- |Sorts the top float vector on the vector float stack, reverses it, and pushes the result back to the +-- vector float stack. +instructionVectorFloatSortReverse :: State -> State +instructionVectorFloatSortReverse = instructionVectorSortReverse vectorFloat + +-- |Inserts the top float from the float stack into the top float vector from the +-- vector float stack at a specified index and pushes the result to the vector +-- float stack. The index is pulled from the top of the int stack. +instructionVectorFloatInsert :: State -> State +instructionVectorFloatInsert = instructionVectorInsert float vectorFloat + +-- |Inserts the second float vector into the first float vector from the vector float stack +-- at a specified index and pushes the result to the vector float stack. The index is +-- pulled from the top of the int stack. +instructionVectorFloatInsertVectorFloat :: State -> State +instructionVectorFloatInsertVectorFloat = instructionVectorInsertVector vectorFloat + +allVectorFloatInstructions :: [Gene] +allVectorFloatInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/VectorIntInstructions.hs b/src/HushGP/Instructions/VectorIntInstructions.hs new file mode 100644 index 0000000..f021ea0 --- /dev/null +++ b/src/HushGP/Instructions/VectorIntInstructions.hs @@ -0,0 +1,335 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.VectorIntInstructions where + +import HushGP.Instructions.GenericInstructions +import HushGP.State +import HushGP.TH + +-- |Pops the top int vector from the int vector stack. +instructionVectorIntPop :: State -> State +instructionVectorIntPop = instructionPop vectorInt + +-- |Duplicates the top int vector from the int vector stack. +instructionVectorIntDup :: State -> State +instructionVectorIntDup = instructionDup vectorInt + +-- |Duplicates the top int vector from the int vector stack N times +-- based on the top int from the int stack. +instructionVectorIntDupN :: State -> State +instructionVectorIntDupN = instructionDupN vectorInt + +-- |Swaps the top two int vectors from the int vector stack. +instructionVectorIntSwap :: State -> State +instructionVectorIntSwap = instructionSwap vectorInt + +-- |Rotates the top three int vectors from the int vector stack. +instructionVectorIntRot :: State -> State +instructionVectorIntRot = instructionRot vectorInt + +-- |Sets the vector int stack to [] +instructionVectorIntFlush :: State -> State +instructionVectorIntFlush = instructionFlush vectorInt + +-- |Pushes True to the bool stack if the top two int vectors from +-- the vector int stack are equal. Pushes False otherwise. +instructionVectorIntEq :: State -> State +instructionVectorIntEq = instructionEq vectorInt + +-- |Calculates the size of the vector int stack and pushes that number +-- to the int stack. +instructionVectorIntStackDepth :: State -> State +instructionVectorIntStackDepth = instructionStackDepth vectorInt + +-- |Moves an item from deep within the vector int stack to the top of the vector int stack based on +-- the top int from the int stack. +instructionVectorIntYank :: State -> State +instructionVectorIntYank = instructionYank vectorInt + +-- |Copies an item from deep within the vector int stack to the top of the vector int stack based on +-- the top int from the int stack. +instructionVectorIntYankDup :: State -> State +instructionVectorIntYankDup = instructionYankDup vectorInt + +-- |Pushes True to the bool stack if the vector int stack is empty. False if not. +instructionVectorIntIsStackEmpty :: State -> State +instructionVectorIntIsStackEmpty = instructionIsStackEmpty vectorInt + +-- |Moves an item from the top of the vector int stack to deep within the vector int stack based on +-- the top int from the int stack. +instructionVectorIntShove :: State -> State +instructionVectorIntShove = instructionShove vectorInt + +-- |Copies an item from the top of the vector int stack to deep within the vector int stack based on +-- the top int from the int stack. +instructionVectorIntShoveDup :: State -> State +instructionVectorIntShoveDup = instructionShoveDup vectorInt + +-- |Duplicate the top N items from the vector int stack based on the top int from the int stack. +instructionVectorIntDupItems :: State -> State +instructionVectorIntDupItems = instructionDupItems vectorInt + +-- |Concats the top two vectors on top of the vector int stack. +instructionVectorIntConcat :: State -> State +instructionVectorIntConcat = instructionVectorConcat vectorInt + +-- |Takes the top int from the int stack and prepends it to top int vector +-- on the int vector stack. +instructionVectorIntConj :: State -> State +instructionVectorIntConj = instructionVectorConj int vectorInt + +-- |Takes the top int from the int stack and appends it to top int vector +-- on the int vector stack. +instructionVectorIntConjEnd :: State -> State +instructionVectorIntConjEnd = instructionVectorConjEnd int vectorInt + +-- |Takes the first N ints from the top of the int vector from the int vector +-- and pushes the result to the int vector stack. N is pulled from the top of +-- the int stack. +instructionVectorIntTakeN :: State -> State +instructionVectorIntTakeN = instructionVectorTakeN vectorInt + +-- |Takes the last N ints from the top of the int vector from the int vector +-- and pushes the result to the int vector stack. N is pulled from the top of +-- the int stack. +instructionVectorIntTakeRN :: State -> State +instructionVectorIntTakeRN = instructionVectorTakeRN vectorInt + +-- |Takes a sublist of the top int vector on top of the vector int stack. +-- The two ints to determine bounds are pulled from the top of the int stack. +instructionVectorIntSubVector :: State -> State +instructionVectorIntSubVector = instructionSubVector vectorInt + +-- |Takes the first int from the top of the vector int stack and places +-- it on the int stack. +instructionVectorIntFirst :: State -> State +instructionVectorIntFirst = instructionVectorFirst int vectorInt + +-- |Takes the first int from the top of the vector int stack and places +-- it wrapped in a list on top of the vector int stack. +instructionVectorIntFromFirstPrim :: State -> State +instructionVectorIntFromFirstPrim = instructionVectorFromFirstPrim vectorInt + +-- |Takes the first int from the top of the int stack and places it +-- wrapped in a list on top of the vector int stack. +instructionVectorIntFromPrim :: State -> State +instructionVectorIntFromPrim = instructionVectorFromPrim int vectorInt + +-- |Takes the last int from the top of the vector int stack and places +-- it on the int stack. +instructionVectorIntLast :: State -> State +instructionVectorIntLast = instructionVectorLast int vectorInt + +-- |Takes the last int from the top int vector on the vector int stack and +-- places it on the int stack. +instructionVectorIntFromLastPrim :: State -> State +instructionVectorIntFromLastPrim = instructionVectorFromLastPrim vectorInt + +-- |Takes the Nth int from the top int vector and places it onto the int stack +-- based on an int from the top of the int stack. +instructionVectorIntNth :: State -> State +instructionVectorIntNth = instructionVectorNth int vectorInt + +-- |Takes the Nth int from the top int vector on the vector int stack and +-- creates a vector wrapping that Nth item, pushing it back onto the vector int stack. +-- N is the top item on the int stack. +instructionVectorIntFromNthPrim :: State -> State +instructionVectorIntFromNthPrim = instructionVectorFromNthPrim vectorInt + +-- |Removes the first int from the top int vector on the vector int stack and +-- places the result back onto the vector int stack. +instructionVectorIntRest :: State -> State +instructionVectorIntRest = instructionVectorRest vectorInt + +-- |Removes the last int from the top int vector on the vector int stack and +-- places the result back onto the vector int stack. +instructionVectorIntButLast :: State -> State +instructionVectorIntButLast = instructionVectorButLast vectorInt + +-- |Drops the first N items from the top int vector and pushes the result +-- back to the vector int stack. N is pulled from the top of the int stack. +instructionVectorIntDrop :: State -> State +instructionVectorIntDrop = instructionVectorDrop vectorInt + +-- |Drops the last N items from the top int vector and pushes the result +-- back to the vector int stack. N is pulled from the top of the int stack. +instructionVectorIntDropR :: State -> State +instructionVectorIntDropR = instructionVectorDropR vectorInt + +-- |Pushes the length of the top int vector from the vector int stack +-- to the top of the int stack. +instructionVectorIntLength :: State -> State +instructionVectorIntLength = instructionLength vectorInt + +-- |Reverses the top int vector from the vector int stack and pushes the +-- result to the vector int stack. +instructionVectorIntReverse :: State -> State +instructionVectorIntReverse = instructionReverse vectorInt + +-- |Takes the top int vector from the vector int stack and pushes the +-- individual ints to the vector int stack. +instructionVectorIntPushAll :: State -> State +instructionVectorIntPushAll = instructionPushAll int vectorInt + +-- |Makes an empty vector and pushes it to the vector int stack. +instructionVectorIntMakeEmpty :: State -> State +instructionVectorIntMakeEmpty = instructionVectorMakeEmpty vectorInt + +-- |Checks if the top int vector from the vector int stack is empty. +-- Pushes True if the int vector is empty to the bool stack. False otherwise. +instructionVectorIntIsEmpty :: State -> State +instructionVectorIntIsEmpty = instructionVectorIsEmpty vectorInt + +-- |If the top int vector from the vector int stack contains the top int from the int +-- stack, pushes True to the bool stack and pushes False otherwise. +instructionVectorIntContains :: State -> State +instructionVectorIntContains = instructionVectorContains int vectorInt + +-- |If the second to top int vector can be found within the first int vector from the +-- vector int stack, pushes True to the bool stack if is found, else False. +instructionVectorIntContainsVectorInt :: State -> State +instructionVectorIntContainsVectorInt = instructionVectorContainsVector vectorInt + +-- |Finds the first index of the top int in the int stack inside of the +-- top int vector from the vector int stack and pushes the result to the int stack. +instructionVectorIntIndexOf :: State -> State +instructionVectorIntIndexOf = instructionVectorIndexOf int vectorInt + +-- |Searches and pushes the index of the second int vector inside of the first +-- int vector to the int stack from the vector int stack. Pushes -1 if not found. +instructionVectorIntIndexOfVectorInt :: State -> State +instructionVectorIntIndexOfVectorInt = instructionVectorIndexOfVector vectorInt + +-- |Finds the amount of times the top int on the int stack occurs inside of +-- the top int vector from the vector int stack and pushes the result to the +-- int stack. +instructionVectorIntOccurrencesOf :: State -> State +instructionVectorIntOccurrencesOf = instructionVectorOccurrencesOf int vectorInt + +-- |Counts the amount of occurrences of the second int vector within the first +-- int vector. Pushes the result to the int stack. +instructionVectorIntOccurrencesOfVectorInt :: State -> State +instructionVectorIntOccurrencesOfVectorInt = instructionVectorOccurrencesOfVector vectorInt + +-- |Splits the top int vector from the vector int stack into lists of size one and pushes +-- the result back one the vector int stack. +instructionVectorIntParseToInt :: State -> State +instructionVectorIntParseToInt = instructionVectorParseToPrim vectorInt + +-- |Sets the Nth index inside of the top int vector from the vector int stack to the +-- top value from the primitive stack. N is pulled from the top of the int stack. +instructionVectorIntSetNth :: State -> State +instructionVectorIntSetNth = instructionVectorSetNth int vectorInt + +-- |Splits the int vector on top of the vector int stack with the int from the top +-- of the int stack and pushes the result to the original vector stack. +instructionVectorIntSplitOn :: State -> State +instructionVectorIntSplitOn = instructionVectorSplitOn int vectorInt + +-- |Splits the first int vector based on the second int vector from the vector +-- int stack and pushes the result to the vector int stack. +instructionVectorIntSplitOnVectorInt :: State -> State +instructionVectorIntSplitOnVectorInt = instructionVectorSplitOnVector vectorInt + +-- |Replaces the first occurrence of the top int with the second int from +-- the int stack inside of the top int vector from the vector int stack. +-- Pushes the modified int vector to the vector int stack. +instructionVectorIntReplaceFirst :: State -> State +instructionVectorIntReplaceFirst = instructionVectorReplace int vectorInt (Just 1) + +-- |Replaces all occurrences of the top int with the second int from +-- the int stack inside of the top int vector from the vector int stack. +-- Pushes the modified int vector to the vector int stack. +instructionVectorIntReplaceAll :: State -> State +instructionVectorIntReplaceAll = instructionVectorReplace int vectorInt Nothing + +-- |Replaces N occurrences of the top int with the second int from +-- the int stack inside of the top int vector from the vector int stack. +-- Pushes the modified int vector to the vector int stack. N is pulled from +-- the top of the int stack. +instructionVectorIntReplaceN :: State -> State +instructionVectorIntReplaceN = instructionVectorReplaceN int vectorInt + +-- |Replaces the first occurrence of the second int vector with the third int vector +-- inside of the first int vector from the vector int stack. Pushes the result to the +-- vector int stack. +instructionVectorIntReplaceFirstVectorInt :: State -> State +instructionVectorIntReplaceFirstVectorInt = instructionVectorReplaceVector vectorInt (Just 1) + +-- |Replaces all occurrences of the second int vector with the third int vector +-- inside of the first int vector from the vector int stack. Pushes the result to the +-- vector int stack. +instructionVectorIntReplaceAllVectorInt :: State -> State +instructionVectorIntReplaceAllVectorInt = instructionVectorReplaceVector vectorInt Nothing + +-- |Replaces N occurrences of the second int vector with the third int vector +-- inside of the first int vector from the vector int stack. Pushes the result to the +-- vector int stack. N is pulled from the top of the int stack. +instructionVectorIntReplaceVectorIntN :: State -> State +instructionVectorIntReplaceVectorIntN = instructionVectorReplaceVectorN vectorInt + +-- |Removes the first occurrence of the top int from +-- the int stack inside of the top int vector from the vector int stack. +-- Pushes the modified int vector to the vector int stack. +instructionVectorIntRemoveFirst :: State -> State +instructionVectorIntRemoveFirst = instructionVectorRemove int vectorInt (Just 1) + +-- |Removes the all occurrences of the top int from +-- the int stack inside of the top int vector from the vector int stack. +-- Pushes the modified int vector to the vector int stack. +instructionVectorIntRemoveAll :: State -> State +instructionVectorIntRemoveAll = instructionVectorRemove int vectorInt Nothing + +-- |Removes N occurrences of the top int from +-- the int stack inside of the top int vector from the vector int stack. +-- Pushes the modified int vector to the vector int stack. N is pulled +-- from the top of the int stack. +instructionVectorIntRemoveN :: State -> State +instructionVectorIntRemoveN = instructionVectorRemoveN int vectorInt + +-- |Removes the first occurrence of the second int vector +-- inside of the first int vector from the vector int stack. Pushes the result to the +-- vector int stack. +instructionVectorIntRemoveFirstVectorInt :: State -> State +instructionVectorIntRemoveFirstVectorInt = instructionVectorRemoveVector vectorInt (Just 1) + +-- |Removes all occurrences of the second int vector +-- inside of the first int vector from the vector int stack. Pushes the result to the +-- vector int stack. +instructionVectorIntRemoveAllVectorInt :: State -> State +instructionVectorIntRemoveAllVectorInt = instructionVectorRemoveVector vectorInt Nothing + +-- |Removes N occurrences of the second int vector +-- inside of the first int vector from the vector int stack. Pushes the result to the +-- vector int stack. N is pulled from the top of the int stack. +instructionVectorIntRemoveNVectorInt :: State -> State +instructionVectorIntRemoveNVectorInt = instructionVectorRemoveVectorN vectorInt + +-- |Iterates over the top int vector on the vector int stack, applying the top instruction of the +-- exec stack along the way. +instructionVectorIntIterate :: State -> State +instructionVectorIntIterate = instructionVectorIterate int vectorInt GeneVectorInt instructionVectorIntIterate "instructionVectorIntIterate" + +-- |Sorts the top int vector on the vector int stack and pushes the result back to the +-- vector int stack. +instructionVectorIntSort :: State -> State +instructionVectorIntSort = instructionVectorSort vectorInt + +-- |Sorts the top int vector on the vector int stack, reverses it, and pushes the result back to the +-- vector int stack. +instructionVectorIntSortReverse :: State -> State +instructionVectorIntSortReverse = instructionVectorSortReverse vectorInt + +-- |Inserts the top int from the int stack into the top int vector from the +-- vector int stack at a specified index and pushes the result to the vector +-- int stack. The index is pulled from the top of the int stack. +instructionVectorIntInsert :: State -> State +instructionVectorIntInsert = instructionVectorInsert int vectorInt + +-- |Inserts the second int vector into the first int vector from the vector int stack +-- at a specified index and pushes the result to the vector int stack. The index is +-- pulled from the top of the int stack. +instructionVectorIntInsertVectorInt :: State -> State +instructionVectorIntInsertVectorInt = instructionVectorInsertVector vectorInt + +allVectorIntInstructions :: [Gene] +allVectorIntInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Instructions/VectorStringInstructions.hs b/src/HushGP/Instructions/VectorStringInstructions.hs new file mode 100644 index 0000000..19f4600 --- /dev/null +++ b/src/HushGP/Instructions/VectorStringInstructions.hs @@ -0,0 +1,335 @@ +{-# LANGUAGE TemplateHaskell #-} +module HushGP.Instructions.VectorStringInstructions where + +import HushGP.State +import HushGP.Instructions.GenericInstructions +import HushGP.TH + +-- |Pops the top string vector from the string vector stack. +instructionVectorStringPop :: State -> State +instructionVectorStringPop = instructionPop vectorString + +-- |Duplicates the top string vector from the string vector stack. +instructionVectorStringDup :: State -> State +instructionVectorStringDup = instructionDup vectorString + +-- |Duplicates the top string vector from the string vector stack N times +-- based on the top int from the int stack. +instructionVectorStringDupN :: State -> State +instructionVectorStringDupN = instructionDupN vectorString + +-- |Swaps the top two string vectors from the string vector stack. +instructionVectorStringSwap :: State -> State +instructionVectorStringSwap = instructionSwap vectorString + +-- |Rotates the top three string vectors from the string vector stack. +instructionVectorStringRot :: State -> State +instructionVectorStringRot = instructionRot vectorString + +-- |Sets the vector string stack to [] +instructionVectorStringFlush :: State -> State +instructionVectorStringFlush = instructionFlush vectorString + +-- |Pushes True to the bool stack if the top two string vectors from +-- the vector string stack are equal. Pushes False otherwise. +instructionVectorStringEq :: State -> State +instructionVectorStringEq = instructionEq vectorString + +-- |Calculates the size of the vector string stack and pushes that number +-- to the int stack. +instructionVectorStringStackDepth :: State -> State +instructionVectorStringStackDepth = instructionStackDepth vectorString + +-- |Moves an item from deep within the vector string stack to the top of the vector string stack based on +-- the top int from the int stack. +instructionVectorStringYank :: State -> State +instructionVectorStringYank = instructionYank vectorString + +-- |Copies an item from deep within the vector string stack to the top of the vector string stack based on +-- the top int from the int stack. +instructionVectorStringYankDup :: State -> State +instructionVectorStringYankDup = instructionYankDup vectorString + +-- |Pushes True to the bool stack if the vector string stack is empty. False if not. +instructionVectorStringIsStackEmpty :: State -> State +instructionVectorStringIsStackEmpty = instructionIsStackEmpty vectorString + +-- |Moves an item from the top of the vector string stack to deep within the vector string stack based on +-- the top int from the int stack. +instructionVectorStringShove :: State -> State +instructionVectorStringShove = instructionShove vectorString + +-- |Copies an item from the top of the vector string stack to deep within the vector string stack based on +-- the top int from the int stack. +instructionVectorStringShoveDup :: State -> State +instructionVectorStringShoveDup = instructionShoveDup vectorString + +-- |Duplicate the top N items from the vector string stack based on the top int from the int stack. +instructionVectorStringDupItems :: State -> State +instructionVectorStringDupItems = instructionDupItems vectorString + +-- |Concats the top two vectors on top of the vector string stack. +instructionVectorStringConcat :: State -> State +instructionVectorStringConcat = instructionVectorConcat vectorString + +-- |Takes the top string from the string stack and prepends it to top string vector +-- on the string vector stack. +instructionVectorStringConj :: State -> State +instructionVectorStringConj = instructionVectorConj string vectorString + +-- |Takes the top string from the string stack and appends it to top string vector +-- on the string vector stack. +instructionVectorStringConjEnd :: State -> State +instructionVectorStringConjEnd = instructionVectorConjEnd string vectorString + +-- |Takes the first N strings from the top of the string vector from the string vector +-- and pushes the result to the string vector stack. N is pulled from the top of +-- the int stack. +instructionVectorStringTakeN :: State -> State +instructionVectorStringTakeN = instructionVectorTakeN vectorString + +-- |Takes the last N strings from the top of the string vector from the string vector +-- and pushes the result to the string vector stack. N is pulled from the top of +-- the int stack. +instructionVectorStringTakeRN :: State -> State +instructionVectorStringTakeRN = instructionVectorTakeRN vectorString + +-- |Takes a sublist of the top string vector on top of the vector string stack. +-- The two ints to determine bounds are pulled from the top of the int stack. +instructionVectorStringSubVector :: State -> State +instructionVectorStringSubVector = instructionSubVector vectorString + +-- |Takes the first string from the top of the vector string stack and places +-- it on the string stack. +instructionVectorStringFirst :: State -> State +instructionVectorStringFirst = instructionVectorFirst string vectorString + +-- |Takes the first string from the top of the vector string stack and places +-- it wrapped in a list on top of the vector string stack. +instructionVectorStringFromFirstPrim :: State -> State +instructionVectorStringFromFirstPrim = instructionVectorFromFirstPrim vectorString + +-- |Takes the first string from the top of the string stack and places it +-- wrapped in a list on top of the vector string stack. +instructionVectorStringFromPrim :: State -> State +instructionVectorStringFromPrim = instructionVectorFromPrim string vectorString + +-- |Takes the last string from the top of the vector string stack and places +-- it on the string stack. +instructionVectorStringLast :: State -> State +instructionVectorStringLast = instructionVectorLast string vectorString + +-- |Takes the last string from the top string vector on the vector string stack and +-- places it on the string stack. +instructionVectorStringFromLastPrim :: State -> State +instructionVectorStringFromLastPrim = instructionVectorFromLastPrim vectorString + +-- |Takes the Nth string from the top string vector and places it onto the string stack +-- based on an int from the top of the int stack. +instructionVectorStringNth :: State -> State +instructionVectorStringNth = instructionVectorNth string vectorString + +-- |Takes the Nth string from the top string vector on the vector string stack and +-- creates a vector wrapping that Nth item, pushing it back onto the vector string stack. +-- N is the top item on the int stack. +instructionVectorStringFromNthPrim :: State -> State +instructionVectorStringFromNthPrim = instructionVectorFromNthPrim vectorString + +-- |Removes the first string from the top string vector on the vector string stack and +-- places the result back onto the vector string stack. +instructionVectorStringRest :: State -> State +instructionVectorStringRest = instructionVectorRest vectorString + +-- |Removes the last string from the top string vector on the vector string stack and +-- places the result back onto the vector string stack. +instructionVectorStringButLast :: State -> State +instructionVectorStringButLast = instructionVectorButLast vectorString + +-- |Drops the first N items from the top string vector and pushes the result +-- back to the vector string stack. N is pulled from the top of the int stack. +instructionVectorStringDrop :: State -> State +instructionVectorStringDrop = instructionVectorDrop vectorString + +-- |Drops the last N items from the top string vector and pushes the result +-- back to the vector string stack. N is pulled from the top of the int stack. +instructionVectorStringDropR :: State -> State +instructionVectorStringDropR = instructionVectorDropR vectorString + +-- |Pushes the length of the top string vector from the vector string stack +-- to the top of the int stack. +instructionVectorStringLength :: State -> State +instructionVectorStringLength = instructionLength vectorString + +-- |Reverses the top string vector from the vector string stack and pushes the +-- result to the vector string stack. +instructionVectorStringReverse :: State -> State +instructionVectorStringReverse = instructionReverse vectorString + +-- |Takes the top string vector from the vector string stack and pushes the +-- individual strings to the vector string stack. +instructionVectorStringPushAll :: State -> State +instructionVectorStringPushAll = instructionPushAll string vectorString + +-- |Makes an empty vector and pushes it to the vector string stack. +instructionVectorStringMakeEmpty :: State -> State +instructionVectorStringMakeEmpty = instructionVectorMakeEmpty vectorString + +-- |Checks if the top string vector from the vector string stack is empty. +-- Pushes True if the string vector is empty to the bool stack. False otherwise. +instructionVectorStringIsEmpty :: State -> State +instructionVectorStringIsEmpty = instructionVectorIsEmpty vectorString + +-- |If the top string vector from the vector string stack contains the top string from the string +-- stack, pushes True to the bool stack and pushes False otherwise. +instructionVectorStringContains :: State -> State +instructionVectorStringContains = instructionVectorContains string vectorString + +-- |If the second to top string vector can be found within the first string vector from the +-- vector string stack, pushes True to the bool stack if is found, else False. +instructionVectorStringContainsVectorString :: State -> State +instructionVectorStringContainsVectorString = instructionVectorContainsVector vectorString + +-- |Finds the first index of the top string in the string stack inside of the +-- top string vector from the vector string stack and pushes the result to the int stack. +instructionVectorStringIndexOf :: State -> State +instructionVectorStringIndexOf = instructionVectorIndexOf string vectorString + +-- |Searches and pushes the index of the second string vector inside of the first +-- string vector to the int stack from the vector string stack. Pushes -1 if not found. +instructionVectorStringIndexOfVectorString :: State -> State +instructionVectorStringIndexOfVectorString = instructionVectorIndexOfVector vectorString + +-- |Finds the amount of times the top string on the string stack occurs inside of +-- the top string vector from the vector string stack and pushes the result to the +-- int stack. +instructionVectorStringOccurrencesOf :: State -> State +instructionVectorStringOccurrencesOf = instructionVectorOccurrencesOf string vectorString + +-- |Counts the amount of occurrences of the second string vector within the first +-- string vector. Pushes the result to the int stack. +instructionVectorStringOccurrencesOfVectorString :: State -> State +instructionVectorStringOccurrencesOfVectorString = instructionVectorOccurrencesOfVector vectorString + +-- |Splits the top string vector from the vector string stack into lists of size one and pushes +-- the result back one the vector string stack. +instructionVectorStringParseToString :: State -> State +instructionVectorStringParseToString = instructionVectorParseToPrim vectorString + +-- |Sets the Nth index inside of the top string vector from the vector string stack to the +-- top value from the primitive stack. N is pulled from the top of the int stack. +instructionVectorStringSetNth :: State -> State +instructionVectorStringSetNth = instructionVectorSetNth string vectorString + +-- |Splits the string vector on top of the vector string stack with the string from the top +-- of the string stack and pushes the result to the original vector stack. +instructionVectorStringSplitOn :: State -> State +instructionVectorStringSplitOn = instructionVectorSplitOn string vectorString + +-- |Splits the first string vector based on the second string vector from the vector +-- string stack and pushes the result to the vector string stack. +instructionVectorStringSplitOnVectorString :: State -> State +instructionVectorStringSplitOnVectorString = instructionVectorSplitOnVector vectorString + +-- |Replaces the first occurrence of the top string with the second string from +-- the string stack inside of the top string vector from the vector string stack. +-- Pushes the modified string vector to the vector string stack. +instructionVectorStringReplaceFirst :: State -> State +instructionVectorStringReplaceFirst = instructionVectorReplace string vectorString (Just 1) + +-- |Replaces all occurrences of the top string with the second string from +-- the string stack inside of the top string vector from the vector string stack. +-- Pushes the modified string vector to the vector string stack. +instructionVectorStringReplaceAll :: State -> State +instructionVectorStringReplaceAll = instructionVectorReplace string vectorString Nothing + +-- |Replaces N occurrences of the top string with the second string from +-- the string stack inside of the top string vector from the vector string stack. +-- Pushes the modified string vector to the vector string stack. N is pulled from +-- the top of the int stack. +instructionVectorStringReplaceN :: State -> State +instructionVectorStringReplaceN = instructionVectorReplaceN string vectorString + +-- |Replaces the first occurrence of the second string vector with the third string vector +-- inside of the first string vector from the vector string stack. Pushes the result to the +-- vector string stack. +instructionVectorStringReplaceFirstVectorString :: State -> State +instructionVectorStringReplaceFirstVectorString = instructionVectorReplaceVector vectorString (Just 1) + +-- |Replaces all occurrences of the second string vector with the third string vector +-- inside of the first string vector from the vector string stack. Pushes the result to the +-- vector string stack. +instructionVectorStringReplaceAllVectorString :: State -> State +instructionVectorStringReplaceAllVectorString = instructionVectorReplaceVector vectorString Nothing + +-- |Replaces N occurrences of the second string vector with the third string vector +-- inside of the first string vector from the vector string stack. Pushes the result to the +-- vector string stack. N is pulled from the top of the int stack. +instructionVectorStringReplaceVectorStringN :: State -> State +instructionVectorStringReplaceVectorStringN = instructionVectorReplaceVectorN vectorString + +-- |Removes the first occurrence of the top string from +-- the string stack inside of the top string vector from the vector string stack. +-- Pushes the modified string vector to the vector string stack. +instructionVectorStringRemoveFirst :: State -> State +instructionVectorStringRemoveFirst = instructionVectorRemove string vectorString (Just 1) + +-- |Removes the all occurrences of the top string from +-- the string stack inside of the top string vector from the vector string stack. +-- Pushes the modified string vector to the vector string stack. +instructionVectorStringRemoveAll :: State -> State +instructionVectorStringRemoveAll = instructionVectorRemove string vectorString Nothing + +-- |Removes N occurrences of the top string from +-- the string stack inside of the top string vector from the vector string stack. +-- Pushes the modified string vector to the vector string stack. N is pulled +-- from the top of the int stack. +instructionVectorStringRemoveN :: State -> State +instructionVectorStringRemoveN = instructionVectorRemoveN string vectorString + +-- |Removes the first occurrence of the second string vector +-- inside of the first string vector from the vector string stack. Pushes the result to the +-- vector string stack. +instructionVectorStringRemoveFirstVectorString :: State -> State +instructionVectorStringRemoveFirstVectorString = instructionVectorRemoveVector vectorString (Just 1) + +-- |Removes all occurrences of the second string vector +-- inside of the first string vector from the vector string stack. Pushes the result to the +-- vector string stack. +instructionVectorStringRemoveAllVectorString :: State -> State +instructionVectorStringRemoveAllVectorString = instructionVectorRemoveVector vectorString Nothing + +-- |Removes N occurrences of the second string vector +-- inside of the first string vector from the vector string stack. Pushes the result to the +-- vector string stack. N is pulled from the top of the int stack. +instructionVectorStringRemoveNVectorString :: State -> State +instructionVectorStringRemoveNVectorString = instructionVectorRemoveVectorN vectorString + +-- |Iterates over the top string vector on the vector string stack, applying the top instruction of the +-- exec stack along the way. +instructionVectorStringIterate :: State -> State +instructionVectorStringIterate = instructionVectorIterate string vectorString GeneVectorString instructionVectorStringIterate "instructionVectorStringIterate" + +-- |Sorts the top string vector on the vector string stack and pushes the result back to the +-- vector string stack. +instructionVectorStringSort :: State -> State +instructionVectorStringSort = instructionVectorSort vectorString + +-- |Sorts the top string vector on the vector string stack, reverses it, and pushes the result back to the +-- vector string stack. +instructionVectorStringSortReverse :: State -> State +instructionVectorStringSortReverse = instructionVectorSortReverse vectorString + +-- |Inserts the top string from the string stack into the top string vector from the +-- vector string stack at a specified index and pushes the result to the vector +-- string stack. The index is pulled from the top of the int stack. +instructionVectorStringInsert :: State -> State +instructionVectorStringInsert = instructionVectorInsert string vectorString + +-- |Inserts the second string vector into the first string vector from the vector string stack +-- at a specified index and pushes the result to the vector string stack. The index is +-- pulled from the top of the int stack. +instructionVectorStringInsertVectorString :: State -> State +instructionVectorStringInsertVectorString = instructionVectorInsertVector vectorString + +allVectorStringInstructions :: [Gene] +allVectorStringInstructions = map StateFunc ($(functionExtractor "instruction")) diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs new file mode 100644 index 0000000..7abe7c2 --- /dev/null +++ b/src/HushGP/Problems/IntegerRegression.hs @@ -0,0 +1,83 @@ +module HushGP.Problems.IntegerRegression where + +import Data.List.Split +import Data.List +import Data.Map qualified as Map +import HushGP.State +import HushGP.Instructions +import HushGP.GP.PushArgs +import HushGP.Genome +import HushGP.Push +import HushGP.Instructions.Utility +import HushGP.GP + +testPlushy :: [Gene] +testPlushy = [ + PlaceInput 0, + GeneInt 0, + StateFunc (instructionIntAdd, "instructionIntAdd") + -- GeneFloat 3.2 + ] + +-- | The target function for this run. The function the gp +-- is trying to evolve. +targetFunction :: Integer -> Integer +targetFunction x = (x * x * x) + (2 * x) + +-- | The training data for the model. +trainData :: ([[Gene]], [Gene]) +trainData = (chunksOf 1 $ map GeneInt [-10..10], map (GeneInt . targetFunction) [-10..11]) + +-- | The testing data for the model. +testData :: ([[Gene]], [Gene]) +testData = (chunksOf 1 $ map GeneInt $ [-20..(-11)] <> [11..21], map (GeneInt . targetFunction) ([-20..(-11)] <> [11..21])) + +-- | The instructions used in the evolutionary run. +runInstructions :: [Gene] +runInstructions = + [ + PlaceInput 0, + Close, + GeneInt 1, + GeneInt 0 + ] + <> allIntInstructions + +-- | Takes the head of the stack and returns it. If there is no head, returns an +-- error amount. +errorHead :: [Integer] -> Integer +errorHead xs = + case uncons xs of + Just (x, _) -> x + _ -> 100000000 -- Make this a variable for later? + +-- | Loads a plushy and a list of genes into the input state. +loadState :: [Gene] -> [Gene] -> State +loadState plushy vals = + (loadProgram (plushyToPush plushy) emptyState){_input = Map.fromList (zip [0..] vals)} + +-- | The error function for a single set of inputs and outputs. +intErrorFunction :: PushArgs -> ([[Gene]], [Gene]) -> [Gene] -> [Double] +intErrorFunction _args (inputData, outputData) plushy = + map abs $ zipWith (-) (map ((fromIntegral @Integer @Double . (errorHead . _int) . interpretExec) . loadState plushy) inputData) (map (fromIntegral @Integer @Double . extractGeneInt) outputData) + +intPushArgs :: PushArgs +intPushArgs = defaultPushArgs + { + instructionList = runInstructions, + errorFunction = intErrorFunction, + trainingData = trainData, + testingData = testData, + maxGenerations = 300, + populationSize = 1000, + maxInitialPlushySize = 100, + stepLimit = 200, + parentSelectionAlgo = "lexicase", + tournamentSize = 5, + umadRate = 0.1, + variation = Map.fromList [("umad", 1.0), ("crossover", 0.0)], + elitism = False + } + +main :: IO () +main = gpLoop intPushArgs diff --git a/src/HushGP/Push.hs b/src/HushGP/Push.hs new file mode 100644 index 0000000..d2a42a6 --- /dev/null +++ b/src/HushGP/Push.hs @@ -0,0 +1,78 @@ +module HushGP.Push where + +import Control.Lens +import Data.Map qualified as Map +import HushGP.State + +-- import Debug.Trace (trace, traceStack) + +-- Each core func should be: (State -> State -> State) +-- but each core function can use abstract helper functions. +-- That is more efficient than checking length. +-- Everntually, this can be part of the apply func to state helpers, +-- which should take the number and type of parameter they have. + +-- This is one of the push genome functions itself, not infrastructure. +-- Optionally, split this off into independent functions +-- instructionParameterLoad :: State -> State +-- instructionParameterLoad state@(State {_parameter = (p : _)}) = case p of +-- (GeneInt val) -> state & int .~ val : view int state +-- (GeneFloat val) -> state & float .~ val : view float state +-- (GeneBool val) -> state & bool .~ val : view bool state +-- (GeneString val) -> state & string .~ val : view string state +-- (GeneChar val) -> state & char .~ val : view char state +-- (GeneVectorInt val) -> state & vectorInt .~ val : view vectorInt state +-- (GeneVectorFloat val) -> state & vectorFloat .~ val : view vectorFloat state +-- (GeneVectorBool val) -> state & vectorBool .~ val : view vectorBool state +-- (GeneVectorString val) -> state & vectorString .~ val : view vectorString state +-- (GeneVectorChar val) -> state & vectorChar .~ val : view vectorChar state +-- (StateFunc _) -> undefined +-- (PlaceInput _) -> undefined +-- Close -> undefined +-- (Block xs) -> state & exec .~ xs <> view exec state +-- instructionParameterLoad state = state + +-- | Loads a genome into the exec stack +loadProgram :: [Gene] -> State -> State +loadProgram newstack state = state & exec .~ newstack + +-- | Takes a Push state, and generates the next push state via: +-- If the first item on the EXEC stack is a single instruction +-- then pop it and execute it. +-- Else if the first item on the EXEC stack is a literal +-- then pop it and push it onto the appropriate stack. +-- Else (the first item must be a list) pop it and push all of the +-- items that it contains back onto the EXEC stack individually, +-- in reverse order (so that the item that was first in the list +-- ends up on top). +-- The empty-stack safety of interpretExec on empty stacks depends on the functions it calls. +interpretExec :: State -> State +interpretExec state@(State {_exec = e : es}) = + case e of + (GeneInt val) -> interpretExec (state & exec .~ es & int .~ val : view int state) + (GeneFloat val) -> interpretExec (state & exec .~ es & float .~ val : view float state) + (GeneBool val) -> interpretExec (state & exec .~ es & bool .~ val : view bool state) + (GeneString val) -> interpretExec (state & exec .~ es & string .~ val : view string state) + (GeneChar val) -> interpretExec (state & exec .~ es & char .~ val : view char state) + (GeneVectorInt val) -> interpretExec (state & exec .~ es & vectorInt .~ val : view vectorInt state) + (GeneVectorFloat val) -> interpretExec (state & exec .~ es & vectorFloat .~ val : view vectorFloat state) + (GeneVectorBool val) -> interpretExec (state & exec .~ es & vectorBool .~ val : view vectorBool state) + (GeneVectorString val) -> interpretExec (state & exec .~ es & vectorString .~ val : view vectorString state) + (GeneVectorChar val) -> interpretExec (state & exec .~ es & vectorChar .~ val : view vectorChar state) + (StateFunc (func, _)) -> interpretExec $ func state {_exec = es} + (Block block) -> interpretExec (state {_exec = block ++ es}) + (PlaceInput val) -> interpretExec (state {_exec = (view input state Map.! val) : es}) + (GeneIntERC (val, _)) -> interpretExec (state & exec .~ es & int .~ val : view int state) + (GeneFloatERC (val, _)) -> interpretExec (state & exec .~ es & float .~ val : view float state) + (GeneBoolERC (val, _)) -> interpretExec (state & exec .~ es & bool .~ val : view bool state) + (GeneStringERC (val, _)) -> interpretExec (state & exec .~ es & string .~ val : view string state) + (GeneCharERC (val, _)) -> interpretExec (state & exec .~ es & char .~ val : view char state) + (GeneVectorIntERC (val, _)) -> interpretExec (state & exec .~ es & vectorInt .~ val : view vectorInt state) + (GeneVectorFloatERC (val, _)) -> interpretExec (state & exec .~ es & vectorFloat .~ val : view vectorFloat state) + (GeneVectorBoolERC (val, _)) -> interpretExec (state & exec .~ es & vectorBool .~ val : view vectorBool state) + (GeneVectorStringERC (val, _)) -> interpretExec (state & exec .~ es & vectorString .~ val : view vectorString state) + (GeneVectorCharERC (val, _)) -> interpretExec (state & exec .~ es & vectorChar .~ val : view vectorChar state) + Close -> undefined -- This should never happen. Will be converted to Blocks in the Plushy -> Exec stack process + (Open _) -> undefined -- This should also never happen. Should be converted in Plushy -> Exec stack process + Skip -> undefined -- This should double also never happen. +interpretExec state = state diff --git a/src/HushGP/PushTests.hs b/src/HushGP/PushTests.hs new file mode 100644 index 0000000..127f41c --- /dev/null +++ b/src/HushGP/PushTests.hs @@ -0,0 +1,10 @@ +module HushGP.PushTests where + +-- ( module HushGP.PushTests.GenericTests, +-- module HushGP.PushTests.IntTests, +-- module HushGP.PushTests.UtilTests, +-- ) + +-- import HushGP.PushTests.GenericTests +-- import HushGP.PushTests.IntTests +-- import HushGP.PushTests.UtilTests diff --git a/src/HushGP/PushTests/GenericTests.hs b/src/HushGP/PushTests/GenericTests.hs new file mode 100644 index 0000000..b726e54 --- /dev/null +++ b/src/HushGP/PushTests/GenericTests.hs @@ -0,0 +1,129 @@ +module HushGP.PushTests.GenericTests where + +-- import HushGP.State +-- import Control.Lens +-- -- import Debug.Trace +-- import Test.QuickCheck +-- -- import HushGP.Instructions.GenericInstructions + +-- -- The naming scheme: +-- -- the letters at the beginning represent what kind of transformation (the word I'm using for a basic function) to the states is happening +-- -- for example: the function aaa1Test relays this arg takes a transformation of two as and turns them into one a +-- -- the numbers represent how many different stacks are used in the function. +-- -- for example: the aaa1Test relays that it takes one stack as input. These stacks are passed in as Lens + +-- -- We may be able to get rid of Lens entirely and use haskell's integrated accessors of type State -> [a] +-- -- You can see what I'm talking about if you go into ghci and type: `:info _int` for example + +-- aaa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a -> a) -> State -> Property +-- aaa1Test accessor instruction transformation state = +-- case (uncons (view accessor state), uncons (view accessor $ instruction state)) of +-- (Just (origx1, origx2 : _), Just (modx1, _)) -> transformation origx2 origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state) + 1 +-- _ -> state === instruction state + +-- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property +-- aa1Test accessor instruction transformation state = +-- case (uncons (view accessor state), uncons (view accessor $ instruction state)) of +-- (Just (origx1, _), Just (modx1, _)) -> transformation origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state) +-- _ -> state === instruction state + +-- ab1Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> (a -> b) -> State -> Property +-- ab1Test accessorFrom accessorTo instruction transformation state = +-- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of +-- (Just (t1, _), Just (f1, _)) -> +-- t1 === transformation f1 .&&. +-- length (view accessorTo $ instruction state) === length (view accessorTo state) + 1 .&&. +-- length (view accessorFrom $ instruction state) === length (view accessorFrom state) - 1 +-- _ -> state === instruction state + +-- aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> (a -> a -> b) -> State -> Property +-- aab2Test accessorFrom accessorTo instruction transformation state = +-- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of +-- (Just (t1, _), Just (f1, f2 : _)) -> +-- t1 === transformation f1 f2 .&&. +-- length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&. +-- length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2 +-- _ -> state === instruction state + +-- popTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property +-- popTest accessor instruction state = +-- if null $ view accessor state +-- then state === instruction state +-- else length (view accessor $ instruction state) === length (view accessor state) - 1 + +-- dupTest :: (Eq a, Show a) => Lens' State [a] -> (State -> State) -> State -> Property +-- dupTest accessor instruction state = +-- case uncons (view accessor state) of +-- Just (origx1, _) -> +-- case uncons (view accessor $ instruction state) of +-- Just (modx1, modx2 : _) -> +-- origx1 === modx1 .&&. origx1 === modx2 .&&. length (view accessor $ instruction state) === length (view accessor state) + 1 +-- _ -> state === instruction state +-- _ -> state === instruction state + +-- -- How to test the int stack in particular? +-- dupTestN :: (Eq a, Show a) => Lens' State [a] -> (State -> State) -> State -> Property +-- dupTestN accessor instruction state = +-- case uncons (view int state) of +-- Just (i1, is) -> +-- let amt = max i1 0 in +-- case uncons (view accessor state{_int = is}) of +-- Just (origx1, _) -> +-- conjoin (map (origx1 ===) (take amt (view accessor $ instruction state))) .&&. +-- length (view accessor $ instruction state) === (length (view accessor state{_int = is}) + amt - 1) +-- _ -> state === instruction state +-- _ -> state === instruction state + +-- swapTest :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property +-- swapTest accessor instruction state = +-- case (uncons (view accessor state), uncons (view accessor $ instruction state)) of +-- (Just (origx1, origx2 : _), Just (modx1, modx2 : _)) -> origx1 === modx2 .&&. origx2 === modx1 +-- _ -> state === instruction state + +-- rotTest :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property +-- rotTest accessor instruction state = +-- case (uncons (view accessor state), uncons (view accessor $ instruction state)) of +-- (Just (origx1, origx2 : origx3 : _), Just (modx1, modx2 : modx3 : _)) -> (origx1, origx2, origx3) === (modx2, modx3, modx1) +-- _ -> state === instruction state + +-- flushTest :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property +-- flushTest accessor instruction state = +-- property $ null $ view accessor $ instruction state + +-- stackDepthTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property +-- stackDepthTest accessor instruction state = +-- case uncons (view int $ instruction state) of +-- Just (x1, _) -> x1 === length (view accessor state) +-- _ -> state === instruction state + +-- yankTest :: forall a. (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property +-- yankTest accessor instruction state@(State {_int = i1 : is}) = +-- let +-- myIndex :: Int +-- myIndex = max 0 (min i1 (length (view accessor state{_int = is}) - 1)) +-- item :: a +-- item = view accessor state{_int = is} !! myIndex +-- in +-- case (uncons (view accessor $ instruction state), uncons is) of +-- (Just (x1, _), Just (_, _)) -> x1 === item +-- _ -> state === instruction state +-- -- .&&. -- unsure how to get this functional +-- -- length (view accessor state{_int = is}) === length (view accessor $ instruction state) +-- yankTest _ instruction state = state === instruction state + +-- -- Might just make this a unit test +-- -- Come back to this later +-- -- yankDupTest :: forall a. (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property +-- -- yankDupTest accessor instruction state@(State {_int = i1 : is}) = +-- -- let +-- -- myIndex :: Int +-- -- myIndex = max 0 (min i1 (length (view accessor state{_int = is}) - 1)) +-- -- item :: a +-- -- item = view accessor state{_int = is} !! myIndex +-- -- in +-- -- case (uncons (view accessor $ instruction state), uncons is) of +-- -- (Just (x1, xs), Just (_, _)) -> x1 === item .&&. (x1 : xs) !! === item +-- -- _ -> state === instruction state +-- -- yankDupTest _ instruction state = state === instruction state + +-- -- shoveTest diff --git a/src/HushGP/PushTests/IntTests.hs b/src/HushGP/PushTests/IntTests.hs new file mode 100644 index 0000000..605911b --- /dev/null +++ b/src/HushGP/PushTests/IntTests.hs @@ -0,0 +1,84 @@ +module HushGP.PushTests.IntTests where + +-- import HushGP.State +-- import HushGP.Instructions.IntInstructions +-- import HushGP.PushTests.GenericTests +-- -- import Control.Lens hiding (uncons) +-- import Test.QuickCheck + +-- prop_IntAdd :: State -> Property +-- prop_IntAdd = aaa1Test int instructionIntAdd (+) + +-- prop_IntSub :: State -> Property +-- prop_IntSub = aaa1Test int instructionIntSub (-) + +-- prop_IntMul :: State -> Property +-- prop_IntMul = aaa1Test int instructionIntMul (*) + +-- prop_IntDiv :: State -> Property +-- prop_IntDiv state@(State {_int = 0 : _}) = state === instructionIntDiv state +-- prop_IntDiv state = aaa1Test int instructionIntDiv div state + +-- prop_IntMod :: State -> Property +-- prop_IntMod state@(State {_int = 0 : _}) = state === instructionIntMod state +-- prop_IntMod state = aaa1Test int instructionIntMod mod state + +-- prop_IntFromFloat :: State -> Property +-- prop_IntFromFloat = ab1Test float int instructionIntFromFloat floor + +-- prop_IntFromBool :: State -> Property +-- prop_IntFromBool = ab1Test bool int instructionIntFromBool (\x -> if x then 1 else 0) + +-- prop_IntMin :: State -> Property +-- prop_IntMin = aaa1Test int instructionIntMin min + +-- prop_IntMax :: State -> Property +-- prop_IntMax = aaa1Test int instructionIntMax max + +-- prop_IntInc :: State -> Property +-- prop_IntInc = aa1Test int instructionIntInc (+1) + +-- prop_IntDec :: State -> Property +-- prop_IntDec = aa1Test int instructionIntDec (\x -> x - 1) + +-- prop_IntLT :: State -> Property +-- prop_IntLT = aab2Test int bool instructionIntLT (<) + +-- prop_IntGT :: State -> Property +-- prop_IntGT = aab2Test int bool instructionIntGT (>) + +-- prop_IntLTE :: State -> Property +-- prop_IntLTE = aab2Test int bool instructionIntLTE (<=) + +-- prop_IntGTE :: State -> Property +-- prop_IntGTE = aab2Test int bool instructionIntGTE (>=) + +-- prop_IntDup :: State -> Property +-- prop_IntDup = dupTest int instructionIntDup + +-- prop_IntPop :: State -> Property +-- prop_IntPop = popTest int instructionIntPop + +-- prop_IntDupN :: State -> Property +-- prop_IntDupN = dupTestN int instructionIntDupN + +-- prop_IntSwap :: State -> Property +-- prop_IntSwap = swapTest int instructionIntSwap + +-- prop_IntRot :: State -> Property +-- prop_IntRot = rotTest int instructionIntRot + +-- prop_IntFlush :: State -> Property +-- prop_IntFlush = flushTest int instructionIntFlush + +-- prop_IntEq :: State -> Property +-- prop_IntEq = aab2Test int bool instructionIntEq (==) + +-- prop_IntStackDepth :: State -> Property +-- prop_IntStackDepth = stackDepthTest int instructionIntStackDepth + +-- prop_IntYank :: State -> Property +-- prop_IntYank = yankTest int instructionIntYank + +-- -- prop_IntYankDup :: State -> Property +-- -- prop_IntYankDup = yankDupTest int instructionIntYankDup diff --git a/src/HushGP/PushTests/UtilTests.hs b/src/HushGP/PushTests/UtilTests.hs new file mode 100644 index 0000000..e0ca4e9 --- /dev/null +++ b/src/HushGP/PushTests/UtilTests.hs @@ -0,0 +1,36 @@ +module HushGP.PushTests.UtilTests where + +-- import HushGP.Instructions.Utility +-- import Test.QuickCheck + +-- prop_DeleteAtTest :: Int -> [Int] -> Property +-- prop_DeleteAtTest idx lst = +-- idx >= 0 && idx < length lst ==> +-- if null lst +-- then length lst === length (deleteAt idx lst) +-- else length lst === length (deleteAt idx lst) + 1 + +-- prop_CombineTupleTest :: Int -> ([Int], [Int]) -> Property +-- prop_CombineTupleTest val tup = +-- length (fst tup) + length (snd tup) === length (combineTuple val tup) - 1 + +-- prop_CombineTupleListTest :: [Int] -> ([Int], [Int]) -> Property +-- prop_CombineTupleListTest lst tup = +-- length (fst tup) + length (snd tup) === length (combineTupleList lst tup) - length lst + +-- -- Could use forAll to only generate valid tests +-- prop_InsertAt :: Int -> Int -> [Int] -> Property +-- prop_InsertAt idx val lst = +-- idx >= 0 && idx < length lst ==> +-- length lst === length (insertAt idx val lst) - 1 .&&. +-- insertAt idx val lst !! idx === val + +-- prop_ReplaceAt :: Int -> Int -> [Int] -> Property +-- prop_ReplaceAt idx val lst = +-- idx >= 0 && idx < length lst ==> +-- length lst === length (replaceAt idx val lst) .&&. +-- replaceAt idx val lst !! idx === val + +-- -- prop_SubList :: Int -> Int -> [Int] -> Property +-- -- prop_SubList idx0 idx1 lst = +-- -- idx diff --git a/src/HushGP/State.hs b/src/HushGP/State.hs new file mode 100644 index 0000000..87a1d92 --- /dev/null +++ b/src/HushGP/State.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE TemplateHaskell #-} + +module HushGP.State where + +import Control.Lens hiding (elements) +import Data.Map qualified as Map +import System.Random + +-- | The exec stack must store heterogenous types, +-- and we must be able to detect that type at runtime. +-- One solution is for the exec stack to be a list of [Gene]. +-- The parameter stack could be singular [Gene] or multiple [atomic] types. +data Gene + = GeneInt Integer + | GeneFloat Double + | GeneBool Bool + | GeneString String + | GeneChar Char + | GeneVectorInt [Integer] + | GeneVectorFloat [Double] + | GeneVectorBool [Bool] + | GeneVectorString [String] + | GeneVectorChar [Char] + -- | State -> State is the function itself. String stores the name of the function. + | StateFunc (State -> State, String) + | PlaceInput Int + | Close + | Open Int + | Skip + | Block [Gene] + | GeneIntERC (Integer, StdGen) + | GeneFloatERC (Double, StdGen) + | GeneBoolERC (Bool, StdGen) + | GeneStringERC (String, StdGen) + | GeneCharERC (Char, StdGen) + | GeneVectorIntERC ([Integer], StdGen) + | GeneVectorFloatERC ([Double], StdGen) + | GeneVectorBoolERC ([Bool], StdGen) + | GeneVectorStringERC ([String], StdGen) + | GeneVectorCharERC ([Char], StdGen) + +instance Eq Gene where + GeneInt x == GeneInt y = x == y + GeneFloat x == GeneFloat y = x == y + GeneBool x == GeneBool y = x == y + GeneString x == GeneString y = x == y + GeneChar x == GeneChar y = x == y + PlaceInput x == PlaceInput y = x == y + GeneVectorInt xs == GeneVectorInt ys = xs == ys + GeneVectorFloat xs == GeneVectorFloat ys = xs == ys + GeneVectorBool xs == GeneVectorBool ys = xs == ys + GeneVectorString xs == GeneVectorString ys = xs == ys + GeneVectorChar xs == GeneVectorChar ys = xs == ys + Close == Close = True + Open x == Open y = x == y + Skip == Skip = True + StateFunc (_, nameX) == StateFunc (_, nameY) = nameX == nameY + Block x == Block y = x == y + GeneIntERC (x, _) == GeneIntERC (y, _) = x == y + GeneFloatERC (x, _) == GeneFloatERC (y, _) = x == y + GeneBoolERC (x, _) == GeneBoolERC (y, _) = x == y + GeneStringERC (x, _) == GeneStringERC (y, _) = x == y + GeneCharERC (x, _) == GeneCharERC (y, _) = x == y + GeneVectorIntERC (x, _) == GeneVectorIntERC (y, _) = x == y + GeneVectorFloatERC (x, _) == GeneVectorFloatERC (y, _) = x == y + GeneVectorBoolERC (x, _) == GeneVectorBoolERC (y, _) = x == y + GeneVectorStringERC (x, _) == GeneVectorStringERC (y, _) = x == y + GeneVectorCharERC (x, _) == GeneVectorCharERC (y, _) = x == y + GeneIntERC (x, _) == GeneInt y = x == y + GeneFloatERC (x, _) == GeneFloat y = x == y + GeneBoolERC (x, _) == GeneBool y = x == y + GeneStringERC (x, _) == GeneString y = x == y + GeneCharERC (x, _) == GeneChar y = x == y + GeneVectorIntERC (x, _) == GeneVectorInt y = x == y + GeneVectorFloatERC (x, _) == GeneVectorFloat y = x == y + GeneVectorBoolERC (x, _) == GeneVectorBool y = x == y + GeneVectorStringERC (x, _) == GeneVectorString y = x == y + GeneVectorCharERC (x, _) == GeneVectorChar y = x == y + _ == _ = False + +instance Ord Gene where + GeneInt x <= GeneInt y = x <= y + GeneFloat x <= GeneFloat y = x <= y + GeneBool x <= GeneBool y = x <= y + GeneString x <= GeneString y = x <= y + GeneChar x <= GeneChar y = x <= y + PlaceInput x <= PlaceInput y = x <= y + GeneVectorInt xs <= GeneVectorInt ys = xs <= ys + GeneVectorFloat xs <= GeneVectorFloat ys = xs <= ys + GeneVectorBool xs <= GeneVectorBool ys = xs <= ys + GeneVectorString xs <= GeneVectorString ys = xs <= ys + GeneVectorChar xs <= GeneVectorChar ys = xs <= ys + Close <= Close = True + Open x <= Open y = x <= y + Skip <= Skip = True + StateFunc (_, nameX) <= StateFunc (_, nameY) = nameX <= nameY + Block x <= Block y = x <= y + GeneIntERC (x, _) <= GeneIntERC (y, _) = x <= y + GeneFloatERC (x, _) <= GeneFloatERC (y, _) = x <= y + GeneBoolERC (x, _) <= GeneBoolERC (y, _) = x <= y + GeneStringERC (x, _) <= GeneStringERC (y, _) = x <= y + GeneCharERC (x, _) <= GeneCharERC (y, _) = x <= y + GeneVectorIntERC (x, _) <= GeneVectorIntERC (y, _) = x <= y + GeneVectorFloatERC (x, _) <= GeneVectorFloatERC (y, _) = x <= y + GeneVectorBoolERC (x, _) <= GeneVectorBoolERC (y, _) = x <= y + GeneVectorStringERC (x, _) <= GeneVectorStringERC (y, _) = x <= y + GeneVectorCharERC (x, _) <= GeneVectorCharERC (y, _) = x <= y + GeneIntERC (x, _) <= GeneInt y = x <= y + GeneFloatERC (x, _) <= GeneFloat y = x <= y + GeneBoolERC (x, _) <= GeneBool y = x <= y + GeneStringERC (x, _) <= GeneString y = x <= y + GeneCharERC (x, _) <= GeneChar y = x <= y + GeneVectorIntERC (x, _) <= GeneVectorInt y = x <= y + GeneVectorFloatERC (x, _) <= GeneVectorFloat y = x <= y + GeneVectorBoolERC (x, _) <= GeneVectorBool y = x <= y + GeneVectorStringERC (x, _) <= GeneVectorString y = x <= y + GeneVectorCharERC (x, _) <= GeneVectorChar y = x <= y + _ <= _ = False + +instance Show Gene where + show (GeneInt x) = "Int: " <> show x + show (GeneFloat x) = "Float: " <> show x + show (GeneBool x) = "Bool: " <> show x + show (GeneString x) = "String: " <> x + show (GeneChar x) = "Char: " <> show x + show (StateFunc (_, funcName)) = "Func: " <> funcName + show (PlaceInput x) = "In: " <> show x + show (GeneVectorInt xs) = "Int Vec: " <> show xs + show (GeneVectorFloat xs) = "Float Vec: " <> show xs + show (GeneVectorBool xs) = "Bool Vec: " <> show xs + show (GeneVectorString xs) = "String Vec: " <> show xs + show (GeneVectorChar xs) = "Char Vec: " <> show xs + show Close = "Close" + show (Open x) = "Open: " <> show x + show Skip = "Skip" + show (Block xs) = "Block: " <> show xs + show (GeneIntERC x) = "Int ERC: " <> show x + show (GeneFloatERC x) = "Float ERC: " <> show x + show (GeneBoolERC x) = "Bool ERC: " <> show x + show (GeneStringERC x) = "String ERC: " <> show x + show (GeneCharERC x) = "Char ERC: " <> show x + show (GeneVectorIntERC x) = "Int Vec ERC: " <> show x + show (GeneVectorFloatERC x) = "Float Vec ERC: " <> show x + show (GeneVectorBoolERC x) = "Bool Vec ERC: " <> show x + show (GeneVectorStringERC x) = "String Vec ERC: " <> show x + show (GeneVectorCharERC x) = "Char Vec ERC: " <> show x + +-- | The structure that holds all of the values. +data State = State + { _exec :: [Gene], + _code :: [Gene], + _int :: [Integer], + _float :: [Double], + _bool :: [Bool], + _string :: [String], + _char :: [Char], + _vectorInt :: [[Integer]], + _vectorFloat :: [[Double]], + _vectorBool :: [[Bool]], + _vectorString :: [[String]], + _vectorChar :: [[Char]], + _parameter :: [Gene], + _input :: Map.Map Int Gene + } + deriving (Show, Eq, Ord) + +emptyState :: State +emptyState = + State + { _exec = [], + _code = [], + _int = [], + _float = [], + _bool = [], + _string = [], + _char = [], + _parameter = [], + _vectorInt = [], + _vectorFloat = [], + _vectorBool = [], + _vectorString = [], + _vectorChar = [], + _input = Map.empty + } + +exampleState :: State +exampleState = + State + { _exec = [], + _code = [], + _int = [32, 56, 88, 91], + _float = [3.23, 9.235, 5.3211, 8.0], + _bool = [True, False], + _string = ["abc", "123"], + _char = ['d', 'e', 'f'], + _parameter = [], + _vectorInt = [[1, 2], [5, 6, 8]], + _vectorFloat = [[1.234, 9.21], [5.42, 6.221, 8.5493]], + _vectorBool = [[True, False], [False, False, True]], + _vectorString = [["this is a sentence", "this is also a sentence"], ["s0", "s1", "s2"]], + _vectorChar = [['z', 'x'], ['r', 'a', 't', 'l']], + _input = Map.empty + } + +-- This must stay at the end of the file. +-- Template haskell seems to be messing with GHC.Generics +$(makeLenses ''State) diff --git a/src/HushGP/TH.hs b/src/HushGP/TH.hs new file mode 100644 index 0000000..a53b10d --- /dev/null +++ b/src/HushGP/TH.hs @@ -0,0 +1,38 @@ +module HushGP.TH where + +import Data.List +import Language.Haskell.TH +import Text.Regex.TDFA + +-- This old code made this all possible :) +-- https://github.com/finnsson/template-helper/blob/master/src/Language/Haskell/Extract.hs + +-- | A way to extract all functions from the file +-- `lines file` pulls all of the lines in one string from the file +-- `lex $ lines file` splits the function into a tuple +-- fst = the function nams, snd = the rest of the line +-- `concatMap lex $ lines file` maps lex onto all of the lines +-- and concats the result into a list +-- `filter (=~pattern) $ map fst $ concatMap lex $ lines file` filters +-- any line that doesn't have the passed pattern to it. "function" is a good pattern +-- for Hush. +-- `nub $ filter (=~pattern) $ map fst $ concatMap lex $ lines file` removes all +-- duplicates from the list. Or sets in this case :) +extractAllFunctions :: String -> Q [String] +extractAllFunctions pattern = do + loc <- location + -- file <- runIO $ readFile pattern + file <- runIO $ readFile $ loc_filename loc + return $ nub $ filter (=~ pattern) $ map fst $ concatMap lex $ lines file + +-- | Extracts all functions from a Q [String] (to be used with extractAllFunctions) +-- funcs has a list of all functions from extractAllFunctions +-- makePair makes a tuple of a passed function holding its name as a string and actual function value +-- in that order. StateFunc :) +-- `ListE $ map makePair funcs` makes a list of these function tuples holding all function +-- names and values. +functionExtractor :: String -> Q Exp +functionExtractor pattern = do + funcs <- extractAllFunctions pattern + let makePair n = TupE [Just $ VarE $ mkName n, Just $ LitE $ StringL n] + return $ ListE $ map makePair funcs diff --git a/src/HushGP/Utility.hs b/src/HushGP/Utility.hs new file mode 100644 index 0000000..384710c --- /dev/null +++ b/src/HushGP/Utility.hs @@ -0,0 +1,15 @@ +module HushGP.Utility where + +import Control.Monad +import HushGP.State +import System.Random + +-- | Generates a single random instruction from a list of instructions. +randomInstruction :: [Gene] -> IO Gene +randomInstruction instructions = do + impureGen <- initStdGen + return $ instructions !! fst (uniformR (0, length instructions - 1) impureGen) + +-- | Generates a list of random instructions from a list of instructions passed in. +randomInstructions :: Int -> [Gene] -> IO [Gene] +randomInstructions amt instructions = replicateM amt (randomInstruction instructions) diff --git a/src/Instructions/ExecInstructions.hs b/src/Instructions/ExecInstructions.hs deleted file mode 100644 index 8aa243e..0000000 --- a/src/Instructions/ExecInstructions.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Instructions.ExecInstructions where - -import State -import Instructions.IntInstructions - -instructionExecIf :: State -> State -instructionExecIf state@(State {exec = (e1 : e2 : es), bool = (b : _)}) = - if b - then state {exec = e1 : es} - else state {exec = e2 : es} -instructionExecIf state = state - -instructionExecDup :: State -> State -instructionExecDup state@(State {exec = alles@(e0 : _)}) = - state {exec = e0 : alles} -instructionExecDup state = state - -instructionExecDoRange :: State -> State -instructionExecDoRange state@(State {exec = (e1 : es), int = (i0 : i1 : is)}) = - if increment i0 i1 /= 0 - then state {exec = e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionExecDoRange, e1] : es, int = i1 : is} - else state {exec = e1 : es, int = i1 : is} - where - increment :: Int -> Int -> Int - increment destIdx currentIdx - | currentIdx < destIdx = 1 - | currentIdx > destIdx = -1 - | otherwise = 0 -instructionExecDoRange state = state - -instructionExecDoCount :: State -> State -instructionExecDoCount state@(State {exec = (e1 : es), int = (i1 : is)}) = - if i1 < 1 - then state - else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is} -instructionExecDoCount state = state - -instructionExecDoTimes :: State -> State -instructionExecDoTimes state@(State {exec = (e1 : es), int = (i1 : is)}) = - if i1 < 1 - then state - else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is} -instructionExecDoTimes state = state - -instructionExecWhile :: State -> State -instructionExecWhile state@(State {exec = (_ : es), bool = []}) = - state {exec = es} -instructionExecWhile state@(State {exec = alles@(e1 : es), bool = (b1 : bs)}) = - if b1 - then state {exec = e1 : StateFunc instructionExecWhile : alles, bool = bs} - else state {exec = es} -instructionExecWhile state = state - -instructionExecDoWhile :: State -> State -instructionExecDoWhile state@(State {exec = alles@(e1 : _)}) = - state {exec = e1 : StateFunc instructionExecWhile : alles} -instructionExecDoWhile state = state - --- Eats the boolean no matter what -instructionExecWhen :: State -> State -instructionExecWhen state@(State {exec = (_ : es), bool = (b1 : bs)}) = - if not b1 - then state {exec = es, bool = bs} - else state {bool = bs} -instructionExecWhen state = state diff --git a/src/Instructions/FloatInstructions.hs b/src/Instructions/FloatInstructions.hs deleted file mode 100644 index 8199988..0000000 --- a/src/Instructions/FloatInstructions.hs +++ /dev/null @@ -1,56 +0,0 @@ -module Instructions.FloatInstructions where - -import State - -instructionFloatAdd :: State -> State -instructionFloatAdd state@(State {float = (f1 : f2 : fs)}) = state {float = f2 + f1 : fs} -instructionFloatAdd state = state - -instructionFloatSub :: State -> State -instructionFloatSub state@(State {float = (f1 : f2 : fs)}) = state {float = f2 - f1 : fs} -instructionFloatSub state = state - -instructionFloatMul :: State -> State -instructionFloatMul state@(State {float = (f1 : f2 : fs)}) = state {float = f2 * f1 : fs} -instructionFloatMul state = state - -instructionFloatDiv :: State -> State -instructionFloatDiv state@(State {float = (f1 : f2 : fs)}) = state {float = if f1 /= 0 then f2 / f1 : fs else f1 : f2 : fs} -instructionFloatDiv state = state - -instructionFloatMin :: State -> State -instructionFloatMin state@(State {float = (f1 : f2 : fs)}) = state {float = min f1 f2 : fs} -instructionFloatMin state = state - -instructionFloatMax :: State -> State -instructionFloatMax state@(State {float = (f1 : f2 : fs)}) = state {float = max f1 f2 : fs} -instructionFloatMax state = state - -instructionFloatInc :: State -> State -instructionFloatInc state@(State {float = (f1 : fs)}) = state {float = f1 + 1 : fs} -instructionFloatInc state = state - -instructionFloatDec :: State -> State -instructionFloatDec state@(State {float = (f1 : fs)}) = state {float = f1 - 1 : fs} -instructionFloatDec state = state - -instructionFloatLT :: State -> State -instructionFloatLT state@(State {float = f1 : f2 : fs, bool = bs}) = state {float = fs, bool = (f1 < f2) : bs} -instructionFloatLT state = state - -instructionFloatGT :: State -> State -instructionFloatGT state@(State {float = f1 : f2 : fs, bool = bs}) = state {float = fs, bool = (f1 > f2) : bs} -instructionFloatGT state = state - -instructionFloatLTE :: State -> State -instructionFloatLTE state@(State {float = f1 : f2 : fs, bool = bs}) = state {float = fs, bool = (f1 <= f2) : bs} -instructionFloatLTE state = state - -instructionFloatGTE :: State -> State -instructionFloatGTE state@(State {float = f1 : f2 : fs, bool = bs}) = state {float = fs, bool = (f1 >= f2) : bs} -instructionFloatGTE state = state - -instructionFloatPop :: State -> State -instructionFloatPop state@(State {float = (_ : fs)}) = state {float = fs} -instructionFloatPop state = state - diff --git a/src/Instructions/IntInstructions.hs b/src/Instructions/IntInstructions.hs deleted file mode 100644 index d12ee6a..0000000 --- a/src/Instructions/IntInstructions.hs +++ /dev/null @@ -1,60 +0,0 @@ -module Instructions.IntInstructions where - -import State --- import Debug.Trace - -instructionIntAdd :: State -> State -instructionIntAdd state@(State {int = (i1 : i2 : is)}) = state {int = i2 + i1 : is} -instructionIntAdd state = state - -instructionIntSub :: State -> State -instructionIntSub state@(State {int = (i1 : i2 : is)}) = state {int = i2 - i1 : is} -instructionIntSub state = state - -instructionIntMul :: State -> State -instructionIntMul state@(State {int = (i1 : i2 : is)}) = state {int = i2 * i1 : is} -instructionIntMul state = state - -instructionIntDiv :: State -> State -instructionIntDiv state@(State {int = (i1 : i2 : is)}) = state {int = if i1 /= 0 then (i2 `div` i1) : is else i1 : i2 : is} -instructionIntDiv state = state - -instructionIntMod :: State -> State -instructionIntMod state@(State {int = (i1 : i2 : is)}) = state {int = i2 `mod` i1 : is} -instructionIntMod state = state - -instructionIntMin :: State -> State -instructionIntMin state@(State {int = (i1 : i2 : is)}) = state {int = min i1 i2 : is} -instructionIntMin state = state - -instructionIntMax :: State -> State -instructionIntMax state@(State {int = (i1 : i2 : is)}) = state {int = max i1 i2 : is} -instructionIntMax state = state - -instructionIntInc :: State -> State -instructionIntInc state@(State {int = (i1 : is)}) = state {int = i1 + 1 : is} -instructionIntInc state = state - -instructionIntDec :: State -> State -instructionIntDec state@(State {int = (i1 : is)}) = state {int = i1 - 1 : is} -instructionIntDec state = state - -instructionIntLT :: State -> State -instructionIntLT state@(State {int = i1 : i2 : is, bool = bs}) = state {int = is, bool = (i1 < i2) : bs} -instructionIntLT state = state - -instructionIntGT :: State -> State -instructionIntGT state@(State {int = i1 : i2 : is, bool = bs}) = state {int = is, bool = (i1 > i2) : bs} -instructionIntGT state = state - -instructionIntLTE :: State -> State -instructionIntLTE state@(State {int = i1 : i2 : is, bool = bs}) = state {int = is, bool = (i1 <= i2) : bs} -instructionIntLTE state = state - -instructionIntGTE :: State -> State -instructionIntGTE state@(State {int = i1 : i2 : is, bool = bs}) = state {int = is, bool = (i1 >= i2) : bs} -instructionIntGTE state = state - -instructionIntPop :: State -> State -instructionIntPop state@(State {int = (_ : is)}) = state {int = is} -instructionIntPop state = state diff --git a/src/Push.hs b/src/Push.hs deleted file mode 100644 index 0273f46..0000000 --- a/src/Push.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - -module Push where - -import qualified Data.Map as Map --- import Instructions.IntInstructions --- import Instructions.ExecInstructions -import State - --- import Debug.Trace (trace, traceStack) - --- Each core func should be: (State -> State -> State) --- but each core function can use abstract helper functions. --- That is more efficient than checking length. --- Everntually, this can be part of the apply func to state helpers, --- which should take the number and type of parameter they have. - --- This is one of the push genome functions itself, not infrastructure. --- Optionally, split this off into independent functions -instructionParameterLoad :: State -> State -instructionParameterLoad state@(State {parameter = (p : _), ..}) = case p of - (GeneInt val) -> state {int = val : int} - (GeneFloat val) -> state {float = val : float} - (GeneBool val) -> state {bool = val : bool} - (GeneString val) -> state {string = val : string} - (StateFunc _) -> undefined - (PlaceInput _) -> undefined - Close -> undefined - (Block xs) -> state {exec = xs <> exec} -instructionParameterLoad state = state - --- Loads a genome into the exec stack -loadProgram :: [Gene] -> State -> State -loadProgram newstack state@(State {exec = _}) = state {exec = newstack} - --- Takes a Push state, and generates the next push state via: --- If the first item on the EXEC stack is a single instruction --- then pop it and execute it. --- Else if the first item on the EXEC stack is a literal --- then pop it and push it onto the appropriate stack. --- Else (the first item must be a list) pop it and push all of the --- items that it contains back onto the EXEC stack individually, --- in reverse order (so that the item that was first in the list --- ends up on top). --- The empty-stack safety of interpretExec on empty stacks depends on the functions it calls. -interpretExec :: State -> State -interpretExec state@(State {exec = []}) = state {exec = []} -interpretExec state@(State {exec = (e : es), ..}) = - case e of - (GeneInt val) -> interpretExec state {exec = es, int = val : int} - (GeneFloat val) -> interpretExec (state {exec = es, float = val : float}) - (GeneBool val) -> interpretExec (state {exec = es, bool = val : bool}) - (GeneString val) -> interpretExec (state {exec = es, string = val : string}) - (StateFunc func) -> interpretExec $ func state {exec = es} - (Block block) -> interpretExec (state {exec = block ++ es}) - (PlaceInput val) -> interpretExec (state {exec = (input Map.! val) : es}) - Close -> undefined -- remove Close constructor later? - --- Need to make interpretExec strict, right? diff --git a/src/State.hs b/src/State.hs deleted file mode 100644 index 43aca0d..0000000 --- a/src/State.hs +++ /dev/null @@ -1,82 +0,0 @@ -module State where - -import qualified Data.Map as Map - --- The exec stack must store heterogenous types, --- and we must be able to detect that type at runtime. --- One solution is for the exec stack to be a list of [Gene]. --- The parameter stack could be singular [Gene] or multiple [atomic] types. -data Gene - = GeneInt Int - | GeneFloat Float - | GeneBool Bool - | GeneString String - | GeneIntVector [Int] - | GeneFloatVector [Float] - | GeneBoolVector [Bool] - | GeneStringVector [String] - | StateFunc (State -> State) - | PlaceInput String - | Close - | Block [Gene] - -instance Eq Gene where - GeneInt x == GeneInt y = x == y - GeneFloat x == GeneFloat y = x == y - GeneBool x == GeneBool y = x == y - GeneString x == GeneString y = x == y - PlaceInput x == PlaceInput y = x == y - GeneIntVector xs == GeneIntVector ys = xs == ys - GeneFloatVector xs == GeneFloatVector ys = xs == ys - GeneBoolVector xs == GeneBoolVector ys = xs == ys - GeneStringVector xs == GeneStringVector ys = xs == ys - Close == Close = True - StateFunc _ == StateFunc _ = True -- This line is probably not the best thing to do - Block [x] == Block [y] = [x] == [y] - _ == _ = False - -instance Show Gene where - show (GeneInt x) = "Int: " <> show x - show (GeneFloat x) = "Float: " <> show x - show (GeneBool x) = "Bool: " <> show x - show (GeneString x) = "String: " <> x - show (StateFunc _) = "Func: unnamed" - show (PlaceInput x) = "In: " <> x - show (GeneIntVector xs) = "Int Vec: " <> show xs - show (GeneFloatVector xs) = "Float Vec: " <> show xs - show (GeneBoolVector xs) = "Bool Vec: " <> show xs - show (GeneStringVector xs) = "String Vec: " <> show xs - show Close = "Close" - show (Block xs) = "Block: " <> show xs - -data State = State - { exec :: [Gene], - int :: [Int], - float :: [Float], - bool :: [Bool], - string :: [String], - vectorInt :: [[Int]], - vectorFloat :: [[Float]], - vectorBool :: [[Bool]], - vectorString :: [[String]], - parameter :: [Gene], - input :: Map.Map String Gene - } - deriving (Show, Eq) - -emptyState :: State -emptyState = - State - { exec = [], - int = [], - float = [], - bool = [], - string = [], - parameter = [], - vectorInt = [], - vectorFloat = [], - vectorBool = [], - vectorString = [], - input = Map.empty - } - diff --git a/test/Main.hs b/test/Main.hs index f60c02f..2c54d96 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,45 +1,41 @@ -import Control.Exception (assert) -import Push -import State -import Instructions.IntInstructions -import Instructions.ExecInstructions -import Instructions.FloatInstructions +-- import HushGP.Instructions +-- import HushGP.Push +import HushGP.PushTests +-- import HushGP.State +import Test.QuickCheck --- @TODO: Finish int and float tests +-- import Data.List +-- import Control.Lens -intTestFunc :: String -> [Int] -> [Gene] -> State -> IO () -intTestFunc name goal genome startState = - let state = loadProgram genome startState - in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.") +-- import Debug.Trace -floatTestFunc :: String -> [Float] -> [Gene] -> State -> IO () -floatTestFunc name goal genome startState = - let state = loadProgram genome startState - in assert (goal == float (interpretExec state)) putStrLn (name ++ " passed test.") +pushTestArgs :: Args +pushTestArgs = stdArgs {maxSize = 10} + +-- These two used for ghci testing +-- For example (in ghci): qcw prop_myTest +qcw :: (Testable a) => a -> IO () +qcw = quickCheckWith pushTestArgs + +vcw :: (Testable a) => a -> IO () +vcw = verboseCheckWith pushTestArgs main :: IO () main = do - intTestFunc "instructionIntAdd" [8] [GeneInt 6, GeneInt 2, StateFunc instructionIntAdd] emptyState - intTestFunc "instructionIntSub" [4] [GeneInt 6, GeneInt 2, StateFunc instructionIntSub] emptyState - intTestFunc "instructionIntMul" [12] [GeneInt 6, GeneInt 2, StateFunc instructionIntMul] emptyState - intTestFunc "instructionIntDiv" [3] [GeneInt 6, GeneInt 2, StateFunc instructionIntDiv] emptyState - intTestFunc "instructionIntDiv0" [0, 2] [GeneInt 2, GeneInt 0, StateFunc instructionIntDiv] emptyState - intTestFunc "instructionIntMod" [3] [GeneInt 13, GeneInt 5, StateFunc instructionIntMod] 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, GeneInt 4, StateFunc instructionIntAdd] emptyState - intTestFunc "instructionExecDoRange" [12] [GeneInt 2, Block [GeneInt 4, GeneInt 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState - intTestFunc "instructionExecDoCount" [8] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState - intTestFunc "instructionExecDoTimes" [69, 69, 69, 69, 2] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoTimes], GeneInt 69] emptyState - intTestFunc "instructionExecWhile" [70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecWhile, GeneInt 70] emptyState - intTestFunc "instructionExecDoWhile" [70, 70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecDoWhile, GeneInt 70] emptyState - intTestFunc "instructionExecWhenTrue" [71] [GeneBool True, StateFunc instructionExecWhen, GeneInt 71] emptyState - - let loadedState = loadProgram [GeneBool False, StateFunc instructionExecWhen, GeneInt 71] emptyState - assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhenFalse passed test." - - floatTestFunc "instructionFloatAdd" [4.32] [GeneFloat 4.01, GeneFloat 0.31, StateFunc instructionFloatAdd] emptyState - floatTestFunc "instructionFloatSub" [3.6900003] [GeneFloat 4.01, GeneFloat 0.32, StateFunc instructionFloatSub] emptyState - floatTestFunc "instructionFloatMul" [1.38] [GeneFloat 0.12, GeneFloat 11.5, StateFunc instructionFloatMul] emptyState - floatTestFunc "instructionFloatDiv" [57.5] [GeneFloat 11.5, GeneFloat 0.2, StateFunc instructionFloatDiv] emptyState - floatTestFunc "instructionFloatDiv0" [0, 69.69] [GeneFloat 69.69, GeneFloat 0.0, StateFunc instructionFloatDiv] emptyState + qcw prop_IntAdd + qcw prop_IntSub + qcw prop_IntMul + qcw prop_IntDiv + qcw prop_IntMod + qcw prop_IntFromFloat + qcw prop_IntFromBool + qcw prop_IntMin + qcw prop_IntMax + qcw prop_IntInc + qcw prop_IntDec + qcw prop_IntLT + qcw prop_IntGT + qcw prop_IntLTE + qcw prop_IntGTE + qcw prop_IntDup + qcw prop_IntPop diff --git a/test/MainOld.hs b/test/MainOld.hs new file mode 100644 index 0000000..c3728e8 --- /dev/null +++ b/test/MainOld.hs @@ -0,0 +1,324 @@ +import Control.Exception (assert) +import Instructions +import Push +import State + +-- import Debug.Trace + +-- TODO: Need a function that can compare states. +-- May look at quickCheck later + +intTestFunc :: String -> [Int] -> [Gene] -> State -> IO () +intTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _int (interpretExec state)) putStrLn (name ++ " passed test.") + +floatTestFunc :: String -> [Float] -> [Gene] -> State -> IO () +floatTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _float (interpretExec state)) putStrLn (name ++ " passed test.") + +boolTestFunc :: String -> [Bool] -> [Gene] -> State -> IO () +boolTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _bool (interpretExec state)) putStrLn (name ++ " passed test.") + +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.") + +stringTestFunc :: String -> [String] -> [Gene] -> State -> IO () +stringTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _string (interpretExec state)) putStrLn (name <> " passed test.") + +charTestFunc :: String -> [Char] -> [Gene] -> State -> IO () +charTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _char (interpretExec state)) putStrLn (name <> " passed test.") + +vectorIntTestFunc :: String -> [[Int]] -> [Gene] -> State -> IO () +vectorIntTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _vectorInt (interpretExec state)) putStrLn (name <> " passed test.") + +vectorFloatTestFunc :: String -> [[Float]] -> [Gene] -> State -> IO () +vectorFloatTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == _vectorFloat (interpretExec state)) putStrLn (name <> " passed test.") + +main :: IO () +main = do + -- Int tests + intTestFunc "instructionIntAdd" [8] [GeneInt 6, GeneInt 2, StateFunc (instructionIntAdd, "placeholder")] emptyState + intTestFunc "instructionIntSub" [4] [GeneInt 6, GeneInt 2, StateFunc (instructionIntSub, "placeholder")] emptyState + intTestFunc "instructionIntMul" [12] [GeneInt 6, GeneInt 2, StateFunc (instructionIntMul, "placeholder")] emptyState + intTestFunc "instructionIntDiv" [3] [GeneInt 6, GeneInt 2, StateFunc (instructionIntDiv, "placeholder")] emptyState + intTestFunc "instructionIntDiv0" [0, 2] [GeneInt 2, GeneInt 0, StateFunc (instructionIntDiv, "placeholder")] emptyState + intTestFunc "instructionIntMod" [3] [GeneInt 13, GeneInt 5, StateFunc (instructionIntMod, "placeholder")] emptyState + intTestFunc "instructionIntPop" [2] [GeneInt 2, GeneInt 0, StateFunc (instructionIntPop, "placeholder")] emptyState + intTestFunc "instructionIntDup" [3, 3, 2] [GeneInt 2, GeneInt 3, StateFunc (instructionIntDup, "placeholder")] emptyState + intTestFunc "instructionIntDupN3" [2, 2, 2] [GeneInt 2, GeneInt 3, StateFunc (instructionIntDupN, "placeholder")] emptyState + intTestFunc "instructionIntDupN-1" [0] [GeneInt 0, GeneInt 2, GeneInt (-1), StateFunc (instructionIntDupN, "placeholder")] emptyState + intTestFunc "instructionIntSwap" [2, 0, 3] [GeneInt 3, GeneInt 2, GeneInt 0, StateFunc (instructionIntSwap, "placeholder")] emptyState + intTestFunc "instructionIntSwapFail" [1] [GeneInt 1, StateFunc (instructionIntSwap, "placeholder")] emptyState + intTestFunc "instructionIntRot" [1, 3, 2] [GeneInt 1, GeneInt 2, GeneInt 3, StateFunc (instructionIntRot, "placeholder")] emptyState + intTestFunc "instructionIntRotFail" [7, 8] [GeneInt 8, GeneInt 7, StateFunc (instructionIntRot, "placeholder")] emptyState + intTestFunc "instructionIntFlush" [] [GeneInt 9696, GeneInt 92, GeneInt 420, StateFunc (instructionIntFlush, "placeholder")] emptyState -- I think I'm funny + intTestFunc "instructionIntStackDepth" [2, 51, 52] [GeneInt 52, GeneInt 51, StateFunc (instructionIntStackDepth, "placeholder")] emptyState + intTestFunc "instructionIntYank" [3, 3, 2, 1] [GeneInt 3, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, StateFunc (instructionIntYank, "placeholder")] emptyState + intTestFunc "instructionIntYankDup" [3, 3, 2, 1, 3] [GeneInt 3, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, StateFunc (instructionIntYankDup, "placeholder")] emptyState + intTestFunc "instructionIntShove" [2, 3, 1, 1] [GeneInt 1, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 2, StateFunc (instructionIntShove, "placeholder")] emptyState + intTestFunc "instructionIntShoveDup" [3, 2, 3, 1, 1] [GeneInt 1, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 2, StateFunc (instructionIntShoveDup, "placeholder")] emptyState + + -- Exec tests + intTestFunc "instructionExecIf" [6, 5] [GeneBool True, StateFunc (instructionExecIf, "placeholder"), Block [GeneInt 5, GeneInt 6], Block [GeneInt 7, GeneInt 8]] emptyState + intTestFunc "instructionExecDup" [8] [StateFunc (instructionExecDup, "placeholder"), GeneInt 4, StateFunc (instructionIntAdd, "placeholder")] emptyState + intTestFunc "instructionExecDoRange" [12] [GeneInt 2, Block [GeneInt 4, GeneInt 1, StateFunc (instructionExecDoRange, "placeholder")], StateFunc (instructionIntAdd, "placeholder")] emptyState + intTestFunc "instructionExecDoCount" [8] [GeneInt 2, Block [GeneInt 4, StateFunc (instructionExecDoCount, "placeholder")], StateFunc (instructionIntAdd, "placeholder")] emptyState + intTestFunc "instructionExecDoTimes" [69, 69, 69, 69, 2] [GeneInt 2, Block [GeneInt 4, StateFunc (instructionExecDoTimes, "placeholder")], GeneInt 69] emptyState + intTestFunc "instructionExecWhile" [70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc (instructionExecWhile, "placeholder"), GeneInt 70] emptyState + intTestFunc "instructionExecDoWhile" [70, 70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc (instructionExecDoWhile, "placeholder"), GeneInt 70] emptyState + intTestFunc "instructionExecWhenTrue" [71] [GeneBool True, StateFunc (instructionExecWhen, "placeholder"), GeneInt 71] emptyState + + let loadedState = loadProgram [GeneBool False, StateFunc (instructionExecWhen, "placeholder"), GeneInt 71] emptyState + assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhenFalse passed test." + + -- Float tests + floatTestFunc "instructionFloatAdd" [4.32] [GeneFloat 4.01, GeneFloat 0.31, StateFunc (instructionFloatAdd, "placeholder")] emptyState + floatTestFunc "instructionFloatSub" [3.6900003] [GeneFloat 4.01, GeneFloat 0.32, StateFunc (instructionFloatSub, "placeholder")] emptyState + floatTestFunc "instructionFloatMul" [1.38] [GeneFloat 0.12, GeneFloat 11.5, StateFunc (instructionFloatMul, "placeholder")] emptyState + floatTestFunc "instructionFloatDiv" [57.5] [GeneFloat 11.5, GeneFloat 0.2, StateFunc (instructionFloatDiv, "placeholder")] emptyState + floatTestFunc "instructionFloatDiv0" [0, 69.69] [GeneFloat 69.69, GeneFloat 0.0, StateFunc (instructionFloatDiv, "placeholder")] emptyState + floatTestFunc "instructionFloatYank" [1.1, 4.4, 3.3, 2.2] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc (instructionFloatYank, "placeholder")] emptyState + floatTestFunc "instructionFloatYankDup" [1.1, 4.4, 3.3, 2.2, 1.1] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc (instructionFloatYankDup, "placeholder")] emptyState + floatTestFunc "instructionFloatShove" [3.3, 2.2, 4.4, 1.1] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc (instructionFloatShove, "placeholder")] emptyState + floatTestFunc "instructionFloatShoveDup" [4.4, 3.3, 2.2, 4.4, 1.1] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc (instructionFloatShoveDup, "placeholder")] emptyState + floatTestFunc "instructionFloatDupNonEmpty" [4.4, 4.4, 3.3] [GeneFloat 3.3, GeneFloat 4.4, StateFunc (instructionFloatDup, "placeholder")] emptyState + floatTestFunc "instructionFloatDupEmpty" [] [StateFunc (instructionFloatDup, "placeholder")] emptyState + floatTestFunc "instructionFloatDupN3" [4.4, 4.4, 4.4, 3.3] [GeneFloat 3.3, GeneFloat 4.4, GeneInt 3, StateFunc (instructionFloatDupN, "placeholder")] emptyState + floatTestFunc "instructionFloatDupN-1" [3.3] [GeneFloat 3.3, GeneFloat 4.4, GeneInt (-1), StateFunc (instructionFloatDupN, "placeholder")] emptyState + boolTestFunc "instructionIntEqTrue" [True] [GeneInt 3, GeneInt 3, StateFunc (instructionIntEq, "placeholder")] emptyState + boolTestFunc "instructionIntEqFalse" [False] [GeneInt 3, GeneInt 5, StateFunc (instructionIntEq, "placeholder")] emptyState + boolTestFunc "instructionIntEqFail" [] [GeneInt 3, StateFunc (instructionIntEq, "placeholder")] emptyState + + -- Code tests + codeTestFunc "instructionCodeFromExec" [] [StateFunc (instructionCodeFromExec, "placeholder"), StateFunc (instructionFloatFromInt, "placeholder"), StateFunc (instructionCodePop, "placeholder")] emptyState + intTestFunc "instructionCodeDoRange" [18] [GeneInt 3, GeneInt 6, StateFunc (instructionCodeFromExec, "placeholder"), StateFunc (instructionIntAdd, "placeholder"), StateFunc (instructionCodeDoRange, "placeholder")] emptyState + -- How to test instructionCodeDoThenPop????? + codeTestFunc "instructionCodeFirst" [GeneInt 5] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 5, StateFunc (instructionIntSub, "placeholder")], StateFunc (instructionCodeFirst, "placeholder")] emptyState + codeTestFunc "instructionCodeLast" [GeneBool True] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 5, StateFunc (instructionIntSub, "placeholder"), GeneBool True], StateFunc (instructionCodeLast, "placeholder")] emptyState + codeTestFunc "instructionCodeTail" [Block [GeneFloat 3.2, GeneBool True, GeneInt 3]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [StateFunc (instructionFloatAdd, "placeholder"), GeneFloat 3.2, GeneBool True, GeneInt 3], StateFunc (instructionCodeTail, "placeholder")] emptyState + codeTestFunc "instructionCodeInit" [Block [GeneVectorInt [1], GeneFloat 3.2, GeneBool True]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneVectorInt [1], GeneFloat 3.2, GeneBool True, GeneInt 3], StateFunc (instructionCodeInit, "placeholder")] emptyState + codeTestFunc "instructionCodeWrap" [Block [GeneInt 3]] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 3, StateFunc (instructionCodeWrap, "placeholder")] emptyState + codeTestFunc "instructionCodeList" [Block [GeneFloat 5.43, GeneInt 3]] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 3, StateFunc (instructionCodeFromExec, "placeholder"), GeneFloat 5.43, StateFunc (instructionCodeList, "placeholder")] emptyState + codeTestFunc "instructionCodeCombine2Blocks" [Block [GeneInt 3, GeneInt 4, GeneInt 1, GeneInt 2]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, GeneInt 2], StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 3, GeneInt 4], StateFunc (instructionCodeCombine, "placeholder")] emptyState + codeTestFunc "instructionCodeCombine1Block1Single" [Block [GeneInt 3, GeneInt 4, GeneInt 1]] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 1, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 3, GeneInt 4], StateFunc (instructionCodeCombine, "placeholder")] emptyState + codeTestFunc "instructionCodeCombine1Single1Block" [Block [GeneInt 3, GeneInt 1, GeneInt 2]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, GeneInt 2], StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 3, StateFunc (instructionCodeCombine, "placeholder")] emptyState + codeTestFunc "instrucitonCodeCombine2Single" [Block [GeneInt 2, GeneInt 1]] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 1, StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 2, StateFunc (instructionCodeCombine, "placeholder")] emptyState + intTestFunc "instructionCodeDo" [3] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 3, StateFunc (instructionCodeDo, "placeholder")] emptyState + -- How to test instructionCodeDoDup??? We would would need a multi stack testing function + boolTestFunc "instructionCodeIsCodeBlockTrue" [True] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 0], StateFunc (instructionCodeIsCodeBlock, "placeholder")] emptyState + boolTestFunc "instructionCodeIsCodeBlockFalse" [False] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 0, StateFunc (instructionCodeIsCodeBlock, "placeholder")] emptyState + boolTestFunc "instructionCodeIsSingularTrue" [True] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 0, StateFunc (instructionCodeIsSingular, "placeholder")] emptyState + boolTestFunc "instructionCodeIsSingularFalse" [False] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 0], StateFunc (instructionCodeIsSingular, "placeholder")] emptyState + intTestFunc "instructionCodeDoCount" [15] [GeneInt 6, StateFunc (instructionCodeFromExec, "placeholder"), StateFunc (instructionIntAdd, "placeholder"), StateFunc (instructionCodeDoCount, "placeholder")] emptyState + intTestFunc "instructionCodeDoTimes" [13] [GeneInt 6, GeneInt 3, GeneInt 4, GeneInt 2, StateFunc (instructionCodeFromExec, "placeholder"), StateFunc (instructionIntAdd, "placeholder"), StateFunc (instructionCodeDoTimes, "placeholder")] emptyState + intTestFunc "instructionCodeIfTrue" [6] [GeneBool True, StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 3, StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 6, StateFunc (instructionCodeIf, "placeholder")] emptyState + intTestFunc "instructionCodeIfFalse" [3] [GeneBool False, StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 3, StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 6, StateFunc (instructionCodeIf, "placeholder")] emptyState + intTestFunc "instructionCodeWhen" [6, 3, 6] [GeneInt 6, GeneInt 3, GeneInt 4, GeneInt 2, GeneBool True, StateFunc (instructionCodeFromExec, "placeholder"), StateFunc (instructionIntAdd, "placeholder"), StateFunc (instructionCodeWhen, "placeholder")] emptyState + boolTestFunc "instructionCodeMemberTrue" [True] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 2, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneFloat 3.6, GeneInt 2, GeneVectorInt [8, 9]], StateFunc (instructionCodeMember, "placeholder")] emptyState + boolTestFunc "instructionCodeMemberFalse" [False] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 7, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneFloat 3.6, GeneInt 2, GeneVectorInt [8, 9]], StateFunc (instructionCodeMember, "placeholder")] emptyState + boolTestFunc "instructionCodeMember2Blocks" [False] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 7, GeneInt 0], StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneFloat 3.6, GeneInt 2, GeneVectorInt [8, 9]], StateFunc (instructionCodeMember, "placeholder")] emptyState + codeTestFunc "instructionCodeNInBounds" [GeneInt 0] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 0, StateFunc (instructionCodeN, "placeholder")] emptyState + codeTestFunc "instructionCodeNInBoundsEnd" [GeneInt 5] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 5, StateFunc (instructionCodeN, "placeholder")] emptyState + codeTestFunc "instructionCodeNModded" [GeneInt 3] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 9, StateFunc (instructionCodeN, "placeholder")] emptyState + codeTestFunc "instructionMakeEmptyCodeBlock" [Block []] [StateFunc (instructionMakeEmptyCodeBlock, "placeholder")] emptyState + boolTestFunc "instructionIsEmptyCodeBlockTrue" [True] [StateFunc (instructionCodeFromExec, "placeholder"), Block [], StateFunc (instructionIsEmptyCodeBlock, "placeholder")] emptyState + intTestFunc "instructionCodeSize" [8] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], StateFunc (instructionCodeSize, "placeholder")] emptyState + codeTestFunc "instructionCodeExtractInBounds" [GeneInt 3] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], GeneInt 3, StateFunc (instructionCodeExtract, "placeholder")] emptyState + codeTestFunc "instructionCodeExtractOutBounds" [GeneInt 3] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], GeneInt 11, StateFunc (instructionCodeExtract, "placeholder")] emptyState + codeTestFunc "instructionCodeExtractLastEmptyBlock" [Block []] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 7, StateFunc (instructionCodeExtract, "placeholder")] emptyState + codeTestFunc "instructionCodeExtractBlock" [Block [GeneInt 2, GeneInt 3]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 1, StateFunc (instructionCodeExtract, "placeholder")] emptyState + codeTestFunc "instructionCodeExtractEdgeCase" [Block []] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 7, StateFunc (instructionCodeExtract, "placeholder")] emptyState + codeTestFunc "instructionCodeExtractNotBlock" [GeneInt 2] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 2, GeneInt 56, StateFunc (instructionCodeExtract, "placeholder")] emptyState + codeTestFunc + "instructionCodeInsertInBounds" + [Block [GeneInt 1, Block [GeneInt 2, GeneInt 9999, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6, Block [GeneInt 7, GeneInt 8], GeneInt 9]] + [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 9999, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6, Block [GeneInt 7, GeneInt 8], GeneInt 9], GeneInt 3, StateFunc (instructionCodeInsert, "placeholder")] + emptyState + codeTestFunc + "instructionCodeInsertOutBounds" + [Block [GeneInt 1, Block [GeneInt 2, GeneInt 9999, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6, Block [GeneInt 7, GeneInt 8], GeneInt 9]] + [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 9999, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6, Block [GeneInt 7, GeneInt 8], GeneInt 9], GeneInt 15, StateFunc (instructionCodeInsert, "placeholder")] + emptyState + codeTestFunc "instructionCodeInsertNotBlock" [Block [GeneInt 2, GeneInt 1]] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 2, StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 1, GeneInt 1, StateFunc (instructionCodeInsert, "placeholder")] emptyState + intTestFunc "instructionCodePosition0" [0] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 1, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, GeneInt 2, GeneInt 3], StateFunc (instructionCodeFirstPosition, "placeholder")] emptyState + intTestFunc "instructionCodePosition-1" [-1] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 7, StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, GeneInt 2, GeneInt 3], StateFunc (instructionCodeFirstPosition, "placeholder")] emptyState + intTestFunc "instructionCodePositionEmptyBlock" [0] [StateFunc (instructionCodeFromExec, "placeholder"), Block [], StateFunc (instructionCodeFromExec, "placeholder"), Block [], StateFunc (instructionCodeFirstPosition, "placeholder")] emptyState + codeTestFunc "instructionCodePositionBadStack" [GeneInt 1] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 1, StateFunc (instructionCodeFirstPosition, "placeholder")] emptyState -- tests to ensure base case of insufficient code stack works. Should do this on more of these instructions. + codeTestFunc "instructionCodeReverse2Args" [Block [GeneInt 2, GeneInt 1]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, GeneInt 2], StateFunc (instructionCodeReverse, "placeholder")] emptyState + codeTestFunc "instructionCodeReverse3Args" [Block [GeneInt 3, GeneInt 2, GeneInt 1]] [StateFunc (instructionCodeFromExec, "placeholder"), Block [GeneInt 1, GeneInt 2, GeneInt 3], StateFunc (instructionCodeReverse, "placeholder")] emptyState + codeTestFunc "instructionCodeReverseNonBlock" [GeneInt 1] [StateFunc (instructionCodeFromExec, "placeholder"), GeneInt 1, StateFunc (instructionCodeReverse, "placeholder")] emptyState + + -- String tests + stringTestFunc "instructionStringConcat" ["123abc"] [GeneString "abc", GeneString "123", StateFunc (instructionStringConcat, "placeholder")] emptyState + stringTestFunc "instructionStringSwap" ["abc", "123"] [GeneString "abc", GeneString "123", StateFunc (instructionStringSwap, "placeholder")] emptyState + stringTestFunc "instructionStringInsertString" ["123INSabc"] [GeneString "abc", GeneString "123", StateFunc (instructionStringConcat, "placeholder"), GeneString "INS", StateFunc (instructionStringSwap, "placeholder"), GeneInt 3, StateFunc (instructionStringInsertString, "placeholder")] emptyState + stringTestFunc "instructionStringFromFirstChar" ["1"] [GeneString "123", StateFunc (instructionStringFromFirstChar, "placeholder")] emptyState + stringTestFunc "instructionStringFromNthChar" ["a"] [GeneString "123abc", GeneInt 3, StateFunc (instructionStringFromNthChar, "placeholder")] emptyState + intTestFunc "instructionStringIndexOfString3" [3] [GeneString "a", GeneString "123abc", StateFunc (instructionStringIndexOfString, "placeholder")] emptyState + intTestFunc "instructionStringIndexOfString-1" [-1] [GeneString "z", GeneString "123abc", StateFunc (instructionStringIndexOfString, "placeholder")] emptyState + boolTestFunc "instructionStringContainsStringTrue" [True] [GeneString "a", GeneString "123abc", StateFunc (instructionStringContainsString, "placeholder")] emptyState + boolTestFunc "instructionStringContainsStringFalse" [False] [GeneString "z", GeneString "123abc", StateFunc (instructionStringContainsString, "placeholder")] emptyState + stringTestFunc "instructionStringSplitOnStringMult" ["nd", "r fri", "llo gam", "h"] [GeneString "e", GeneString "hello gamer friend", StateFunc (instructionStringSplitOnString, "placeholder")] emptyState + stringTestFunc "instructionStringSplitOnStringEmpty" ["", "hello gamer frien"] [GeneString "d", GeneString "hello gamer friend", StateFunc (instructionStringSplitOnString, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceFirstStringSuccess" ["thREPLACEs is a sentence"] [GeneString "REPLACE", GeneString "i", GeneString "this is a sentence", StateFunc (instructionStringReplaceFirstString, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceFirstStringFail" ["this is a sentence"] [GeneString "REPLACE", GeneString "z", GeneString "this is a sentence", StateFunc (instructionStringReplaceFirstString, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceNStringSuccess" ["thREPLACEs REPLACEs a sentence i"] [GeneString "REPLACE", GeneString "i", GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceNString, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceNStringFail" ["this is a sentence i"] [GeneString "REPLACE", GeneString "z", GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceNString, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceAllStringSuccess" ["thREPLACEs REPLACEs a sentence REPLACE"] [GeneString "REPLACE", GeneString "i", GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceAllString, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceAllStringFail" ["this is a sentence i"] [GeneString "REPLACE", GeneString "z", GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceAllString, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveFirstStringSuccess" ["ths is a sentence"] [GeneString "i", GeneString "this is a sentence", StateFunc (instructionStringRemoveFirstString, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveFirstStringFail" ["this is a sentence"] [GeneString "z", GeneString "this is a sentence", StateFunc (instructionStringRemoveFirstString, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveNStringSuccess" ["ths s a sentence i"] [GeneString "i", GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringRemoveNString, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveNStringFail" ["this is a sentence i"] [GeneString "z", GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringRemoveNString, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveAllStringSuccess" ["ths s a sentence "] [GeneString "i", GeneString "this is a sentence i", StateFunc (instructionStringRemoveAllString, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveAllStringFail" ["this is a sentence i"] [GeneString "z", GeneString "this is a sentence i", StateFunc (instructionStringRemoveAllString, "placeholder")] emptyState + intTestFunc "instructionStringOccurrencesOfString3" [3] [GeneString "i", GeneString "this is a sentence i", StateFunc (instructionStringOccurrencesOfString, "placeholder")] emptyState + intTestFunc "instructionStringOccurrencesOfString3" [2] [GeneString "is", GeneString "this is a sentence i", StateFunc (instructionStringOccurrencesOfString, "placeholder")] emptyState + intTestFunc "instructionStringOccurrencesOfString0" [0] [GeneString "z", GeneString "this is a sentence i", StateFunc (instructionStringOccurrencesOfString, "placeholder")] emptyState + stringTestFunc "instructionStringInsertChar" ["123Zabc"] [GeneString "abc", GeneString "123", StateFunc (instructionStringConcat, "placeholder"), GeneChar 'Z', GeneInt 3, StateFunc (instructionStringInsertChar, "placeholder")] emptyState + boolTestFunc "instructionStringContainsCharTrue" [True] [GeneString "abc", GeneChar 'a', StateFunc (instructionStringContainsChar, "placeholder")] emptyState + boolTestFunc "instructionStringContainsCharFalse" [False] [GeneString "abc", GeneChar 'z', StateFunc (instructionStringContainsChar, "placeholder")] emptyState + intTestFunc "instructionStringIndexOfChar3" [3] [GeneChar 'a', GeneString "123abc", StateFunc (instructionStringIndexOfChar, "placeholder")] emptyState + intTestFunc "instructionStringIndexOfChar-1" [-1] [GeneChar 'z', GeneString "123abc", StateFunc (instructionStringIndexOfChar, "placeholder")] emptyState + stringTestFunc "instructionStringSplitOnCharMult" ["nd", "r fri", "llo gam", "h"] [GeneChar 'e', GeneString "hello gamer friend", StateFunc (instructionStringSplitOnChar, "placeholder")] emptyState + stringTestFunc "instructionStringSplitOnCharEmpty" ["", "hello gamer frien"] [GeneChar 'd', GeneString "hello gamer friend", StateFunc (instructionStringSplitOnChar, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceFirstCharSuccess" ["thRs is a sentence"] [GeneChar 'R', GeneChar 'i', GeneString "this is a sentence", StateFunc (instructionStringReplaceFirstChar, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceFirstCharFail" ["this is a sentence"] [GeneChar 'R', GeneChar 'z', GeneString "this is a sentence", StateFunc (instructionStringReplaceFirstChar, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceNCharSuccess" ["thRs Rs a sentence i"] [GeneChar 'R', GeneChar 'i', GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceNChar, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceNCharFail" ["this is a sentence i"] [GeneChar 'R', GeneChar 'z', GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceNChar, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceAllCharSuccess" ["thRs Rs a sentence R"] [GeneChar 'R', GeneChar 'i', GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceAllChar, "placeholder")] emptyState + stringTestFunc "instructionStringReplaceAllCharFail" ["this is a sentence i"] [GeneChar 'R', GeneChar 'z', GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringReplaceAllChar, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveFirstCharSuccess" ["ths is a sentence"] [GeneChar 'i', GeneString "this is a sentence", StateFunc (instructionStringRemoveFirstChar, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveFirstCharFail" ["this is a sentence"] [GeneChar 'z', GeneString "this is a sentence", StateFunc (instructionStringRemoveFirstChar, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveNCharSuccess" ["ths s a sentence i"] [GeneChar 'i', GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringRemoveNChar, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveNCharFail" ["this is a sentence i"] [GeneChar 'z', GeneString "this is a sentence i", GeneInt 2, StateFunc (instructionStringRemoveNChar, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveAllCharSuccess" ["ths s a sentence "] [GeneChar 'i', GeneString "this is a sentence i", StateFunc (instructionStringRemoveAllChar, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveAllCharFail" ["this is a sentence i"] [GeneChar 'z', GeneString "this is a sentence i", StateFunc (instructionStringRemoveAllChar, "placeholder")] emptyState + intTestFunc "instructionStringOccurrencesOfChar3" [3] [GeneChar 'i', GeneString "this is a sentence i", StateFunc (instructionStringOccurrencesOfChar, "placeholder")] emptyState + intTestFunc "instructionStringOccurrencesOfChar0" [0] [GeneChar 'z', GeneString "this is a sentence i", StateFunc (instructionStringOccurrencesOfChar, "placeholder")] emptyState + stringTestFunc "instructionStringReverse" ["321cba"] [GeneString "abc123", StateFunc (instructionStringReverse, "placeholder")] emptyState + stringTestFunc "instructionStringHead3" ["abc"] [GeneString "abc123", GeneInt 3, StateFunc (instructionStringHead, "placeholder")] emptyState + stringTestFunc "instructionStringHead0" [""] [GeneString "abc123", GeneInt 0, StateFunc (instructionStringHead, "placeholder")] emptyState + stringTestFunc "instructionStringTail3" ["123"] [GeneString "abc123", GeneInt 3, StateFunc (instructionStringTail, "placeholder")] emptyState + stringTestFunc "instructionStringTail0" [""] [GeneString "abc123", GeneInt 0, StateFunc (instructionStringTail, "placeholder")] emptyState + stringTestFunc "instructionStringAppendChar" ["Rabc123"] [GeneString "abc123", GeneChar 'R', StateFunc (instructionStringAppendChar, "placeholder")] emptyState + stringTestFunc "instructionStringRestFull" ["bc123"] [GeneString "abc123", StateFunc (instructionStringRest, "placeholder")] emptyState + stringTestFunc "instructionStringRestEmpty" [""] [GeneString "", StateFunc (instructionStringRest, "placeholder")] emptyState + stringTestFunc "instructionStringButLastFull" ["abc12"] [GeneString "abc123", StateFunc (instructionStringButLast, "placeholder")] emptyState + stringTestFunc "instructionStringButLastEmpty" [""] [GeneString "", StateFunc (instructionStringButLast, "placeholder")] emptyState + stringTestFunc "instructionStringDrop3" ["123"] [GeneString "abc123", GeneInt 3, StateFunc (instructionStringDrop, "placeholder")] emptyState + stringTestFunc "instructionStringDrop0" ["abc123"] [GeneString "abc123", GeneInt 0, StateFunc (instructionStringDrop, "placeholder")] emptyState + stringTestFunc "instructionStringButLastN3" ["abc"] [GeneString "abc123", GeneInt 3, StateFunc (instructionStringButLastN, "placeholder")] emptyState + stringTestFunc "instructionStringButLastN0" ["abc123"] [GeneString "abc123", GeneInt 0, StateFunc (instructionStringButLastN, "placeholder")] emptyState + intTestFunc "instructionStringLength6" [6] [GeneString "abc123", StateFunc (instructionStringLength, "placeholder")] emptyState + stringTestFunc "instructionStringMakeEmpty" ["", "abc123"] [GeneString "abc123", StateFunc (instructionStringMakeEmpty, "placeholder")] emptyState + stringTestFunc "instructionStringRemoveNth" ["abc23"] [GeneString "abc123", GeneInt 3, StateFunc (instructionStringRemoveNth, "placeholder")] emptyState + stringTestFunc "instructionStringSetNth" ["abR123"] [GeneString "abc123", GeneInt 2, GeneChar 'R', StateFunc (instructionStringSetNth, "placeholder")] emptyState + stringTestFunc "instructionStringStripWhitespace" ["abc123"] [GeneString " \r \n abc123 \t", StateFunc (instructionStringStripWhitespace, "placeholder")] emptyState + stringTestFunc "instructionStringFromBoolTrue" ["True"] [GeneBool True, StateFunc (instructionStringFromBool, "placeholder")] emptyState + stringTestFunc "instructionStringFromBoolTrue" ["False"] [GeneBool False, StateFunc (instructionStringFromBool, "placeholder")] emptyState + stringTestFunc "instructionStringFromInt1000" ["1000"] [GeneInt 1000, StateFunc (instructionStringFromInt, "placeholder")] emptyState + stringTestFunc "instructionStringFromInt-1" ["-1"] [GeneInt (-1), StateFunc (instructionStringFromInt, "placeholder")] emptyState + stringTestFunc "instructionStringFromFloat3.2" ["3.2"] [GeneFloat 3.2, StateFunc (instructionStringFromFloat, "placeholder")] emptyState + stringTestFunc "instructionStringFromFloat-99.0" ["-99.0"] [GeneFloat (-99.0), StateFunc (instructionStringFromFloat, "placeholder")] emptyState + stringTestFunc "instructionStringFromChar" ["Z"] [GeneChar 'Z', StateFunc (instructionStringFromChar, "placeholder")] emptyState + stringTestFunc "instructionStringFromChar" [" "] [GeneChar ' ', StateFunc (instructionStringFromChar, "placeholder")] emptyState + + -- char instructions + stringTestFunc "instructionCharConcat" ["ab"] [GeneChar 'b', GeneChar 'a', StateFunc (instructionCharConcat, "placeholder")] emptyState + charTestFunc "instructionCharFromFirstCharSuccess" ['a'] [GeneString "abc123", StateFunc (instructionCharFromFirstChar, "placeholder")] emptyState + charTestFunc "instructionCharFromFirstCharFail" [] [GeneString "", StateFunc (instructionCharFromFirstChar, "placeholder")] emptyState + charTestFunc "instructionCharFromLastCharSuccess" ['3'] [GeneString "abc123", StateFunc (instructionCharFromLastChar, "placeholder")] emptyState + charTestFunc "instructionCharFromLastCharFail" [] [GeneString "", StateFunc (instructionCharFromLastChar, "placeholder")] emptyState + charTestFunc "instructionCharFromNthCharSuccess" ['c'] [GeneString "abc123", GeneInt 2, StateFunc (instructionCharFromNthChar, "placeholder")] emptyState + boolTestFunc "instructionCharIsWhitespaceSpace" [True] [GeneChar ' ', StateFunc (instructionCharIsWhitespace, "placeholder")] emptyState + boolTestFunc "instructionCharIsWhitespacet" [True] [GeneChar '\t', StateFunc (instructionCharIsWhitespace, "placeholder")] emptyState + boolTestFunc "instructionCharIsWhitespacer" [True] [GeneChar '\r', StateFunc (instructionCharIsWhitespace, "placeholder")] emptyState + boolTestFunc "instructionCharIsWhitespacen" [True] [GeneChar '\n', StateFunc (instructionCharIsWhitespace, "placeholder")] emptyState + boolTestFunc "instructionCharIsWhitespaceFalse" [False] [GeneChar 'a', StateFunc (instructionCharIsWhitespace, "placeholder")] emptyState + boolTestFunc "instructionCharIsLetterTrue" [True] [GeneChar 'a', StateFunc (instructionCharIsLetter, "placeholder")] emptyState + boolTestFunc "instructionCharIsLetterFalse" [False] [GeneChar '1', StateFunc (instructionCharIsLetter, "placeholder")] emptyState + boolTestFunc "instructionCharIsDigitTrue" [True] [GeneChar '1', StateFunc (instructionCharIsDigit, "placeholder")] emptyState + boolTestFunc "instructionCharIsDigitFalse" [False] [GeneChar 'a', StateFunc (instructionCharIsDigit, "placeholder")] emptyState + + -- vector int instructions + vectorIntTestFunc "instructionVectorIntConcat" [[4, 5, 6, 1, 2, 3]] [GeneVectorInt [1, 2, 3], GeneVectorInt [4, 5, 6], StateFunc (instructionVectorIntConcat, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntConj" [[99, 1, 2, 3]] [GeneVectorInt [1, 2, 3], GeneInt 99, StateFunc (instructionVectorIntConj, "placeholder")] emptyState + vectorIntTestFunc "instructionIntTakeN" [[1, 2], [6, 7, 8]] [GeneVectorInt [6, 7, 8], GeneVectorInt [1, 2, 3], GeneInt 2, StateFunc (instructionVectorIntTakeN, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntSubVector" [[1, 2, 3]] [GeneVectorInt [0, 1, 2, 3, 4, 5], GeneInt 3, GeneInt 1, StateFunc (instructionVectorIntSubVector, "placeholder")] emptyState + intTestFunc "instructionVectorIntFirst" [1] [GeneVectorInt [1, 2, 3, 4, 5], StateFunc (instructionVectorIntFirst, "placeholder")] emptyState + intTestFunc "instructionVectorIntLast" [5] [GeneVectorInt [1, 2, 3, 4, 5], StateFunc (instructionVectorIntLast, "placeholder")] emptyState + intTestFunc "instructionVectorIntNthInBounds" [2] [GeneVectorInt [1, 2, 3, 4, 5], GeneInt 1, StateFunc (instructionVectorIntNth, "placeholder")] emptyState + intTestFunc "instructionVectorIntNthOverflow" [2] [GeneVectorInt [1, 2, 3, 4, 5], GeneInt 6, StateFunc (instructionVectorIntNth, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntRestFull" [[2, 3, 4, 5]] [GeneVectorInt [1, 2, 3, 4, 5], StateFunc (instructionVectorIntRest, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntRestEmpty" [[]] [GeneVectorInt [], StateFunc (instructionVectorIntRest, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntButLastFull" [[1, 2, 3, 4]] [GeneVectorInt [1, 2, 3, 4, 5], StateFunc (instructionVectorIntButLast, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntButLastEmpty" [[]] [GeneVectorInt [], StateFunc (instructionVectorIntButLast, "placeholder")] emptyState + intTestFunc "instructionVectorIntLength3" [3] [GeneVectorInt [1, 2, 3], StateFunc (instructionVectorIntLength, "placeholder")] emptyState + intTestFunc "instructionVectorIntLength0" [0] [GeneVectorInt [], StateFunc (instructionVectorIntLength, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntReverse" [[4, 3, 2, 1]] [GeneVectorInt [1, 2, 3, 4], StateFunc (instructionVectorIntReverse, "placeholder")] emptyState + intTestFunc "instructionVectorIntPushAllFull" [1, 2, 3, 4, 99] [GeneVectorInt [1, 2, 3, 4], GeneInt 99, StateFunc (instructionVectorIntPushAll, "placeholder")] emptyState + intTestFunc "instructionVectorIntPushAllEmpty" [99] [GeneVectorInt [], GeneInt 99, StateFunc (instructionVectorIntPushAll, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntMakeEmpty" [[]] [StateFunc (instructionVectorIntMakeEmpty, "placeholder")] emptyState + boolTestFunc "instructionVectorIntIsEmptyTrue" [True] [GeneVectorInt [], StateFunc (instructionVectorIntIsEmpty, "placeholder")] emptyState + boolTestFunc "instructionVectorIntIsEmptyFalse" [False] [GeneVectorInt [1, 2, 3, 4], StateFunc (instructionVectorIntIsEmpty, "placeholder")] emptyState + intTestFunc "instructionVectorIntIndexOf1" [1] [GeneVectorInt [1, 2, 3, 4, 5], GeneInt 2, StateFunc (instructionVectorIntIndexOf, "placeholder")] emptyState + intTestFunc "instructionVectorIntIndexOfFail" [-1] [GeneVectorInt [], GeneInt 2, StateFunc (instructionVectorIntIndexOf, "placeholder")] emptyState + intTestFunc "instructionVectorIntOccurrencesOf2" [2] [GeneVectorInt [1, 2, 3, 4, 2, 6, 7], GeneInt 2, StateFunc (instructionVectorIntOccurrencesOf, "placeholder")] emptyState + intTestFunc "instructionVectorIntOccurrencesOf0" [0] [GeneVectorInt [1, 2, 3, 4, 2, 6, 7], GeneInt 0, StateFunc (instructionVectorIntOccurrencesOf, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntSetNth3" [[0, 1, 2, 99, 4, 5]] [GeneVectorInt [0, 1, 2, 3, 4, 5], GeneInt 99, GeneInt 3, StateFunc (instructionVectorIntSetNth, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntSetNth9" [[0, 1, 2, 99, 4, 5]] [GeneVectorInt [0, 1, 2, 3, 4, 5], GeneInt 99, GeneInt 9, StateFunc (instructionVectorIntSetNth, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntReplace3" [[0, 1, 2, 99, 4, 5, 99, 5, 99]] [GeneInt 99, GeneInt 3, GeneVectorInt [0, 1, 2, 3, 4, 5, 3, 5, 3], StateFunc (instructionVectorIntReplace, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntReplace-1" [[0, 1, 2, 3, 4, 5, 3, 5, 3]] [GeneInt 99, GeneInt (-1), GeneVectorInt [0, 1, 2, 3, 4, 5, 3, 5, 3], StateFunc (instructionVectorIntReplace, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntReplaceFirst3" [[0, 1, 2, 99, 4, 5, 3, 5, 3]] [GeneInt 99, GeneInt 3, GeneVectorInt [0, 1, 2, 3, 4, 5, 3, 5, 3], StateFunc (instructionVectorIntReplaceFirst, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntReplaceFirst-2" [[0, 1, 2, 3, 4, 5, 3, 5, 3]] [GeneInt 99, GeneInt (-2), GeneVectorInt [0, 1, 2, 3, 4, 5, 3, 5, 3], StateFunc (instructionVectorIntReplaceFirst, "placeholder")] emptyState + vectorIntTestFunc "instructionVectorIntRemove" [[0, 1, 2, 4, 5, 5]] [GeneInt 3, GeneVectorInt [0, 1, 2, 3, 4, 5, 3, 5, 3], StateFunc (instructionVectorIntRemove, "placeholder")] emptyState + intTestFunc "instructionVectorIntIterate" [66] [GeneInt 40, GeneVectorInt [0, 1, 2, 3, 4, 5, 3, 5, 3], StateFunc (instructionVectorIntIterate, "placeholder"), StateFunc (instructionIntAdd, "placeholder")] emptyState + + -- vector float functions + vectorFloatTestFunc "instructionVectorFloatConcat" [[4.0, 5.0, 6.0, 1.0, 2.0, 3.0]] [GeneVectorFloat [1.0, 2.0, 3.0], GeneVectorFloat [4.0, 5.0, 6.0], StateFunc (instructionVectorFloatConcat, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatConj" [[99.0, 1.0, 2.0, 3.0]] [GeneVectorFloat [1.0, 2.0, 3.0], GeneFloat 99.0, StateFunc (instructionVectorFloatConj, "placeholder")] emptyState + vectorFloatTestFunc "instructionFloatTakeN" [[1.0, 2.0], [6.0, 7.0, 8.0]] [GeneVectorFloat [6.0, 7.0, 8.0], GeneVectorFloat [1.0, 2.0, 3.0], GeneInt 2, StateFunc (instructionVectorFloatTakeN, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatSubVector" [[1.0, 2.0, 3.0]] [GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0], GeneInt 3, GeneInt 1, StateFunc (instructionVectorFloatSubVector, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatFirst" [1.0] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], StateFunc (instructionVectorFloatFirst, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatLast" [5.0] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], StateFunc (instructionVectorFloatLast, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatNthInBounds" [2.0] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], GeneInt 1, StateFunc (instructionVectorFloatNth, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatNthOverflow" [2.0] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], GeneInt 6, StateFunc (instructionVectorFloatNth, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatRestFull" [[2.0, 3.0, 4.0, 5.0]] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], StateFunc (instructionVectorFloatRest, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatRestEmpty" [[]] [GeneVectorFloat [], StateFunc (instructionVectorFloatRest, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatButLastFull" [[1.0, 2.0, 3.0, 4.0]] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], StateFunc (instructionVectorFloatButLast, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatButLastEmpty" [[]] [GeneVectorFloat [], StateFunc (instructionVectorFloatButLast, "placeholder")] emptyState + intTestFunc "instructionVectorFloatLength3" [3] [GeneVectorFloat [1.0, 2.0, 3.0], StateFunc (instructionVectorFloatLength, "placeholder")] emptyState + intTestFunc "instructionVectorFloatLength0" [0] [GeneVectorFloat [], StateFunc (instructionVectorFloatLength, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatReverse" [[4.0, 3.0, 2.0, 1.0]] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0], StateFunc (instructionVectorFloatReverse, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatPushAllFull" [1.0, 2.0, 3.0, 4.0, 99.0] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0], GeneFloat 99.0, StateFunc (instructionVectorFloatPushAll, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatPushAllEmpty" [99.0] [GeneVectorFloat [], GeneFloat 99.0, StateFunc (instructionVectorFloatPushAll, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatMakeEmpty" [[]] [StateFunc (instructionVectorFloatMakeEmpty, "placeholder")] emptyState + boolTestFunc "instructionVectorFloatIsEmptyTrue" [True] [GeneVectorFloat [], StateFunc (instructionVectorFloatIsEmpty, "placeholder")] emptyState + boolTestFunc "instructionVectorFloatIsEmptyFalse" [False] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0], StateFunc (instructionVectorFloatIsEmpty, "placeholder")] emptyState + intTestFunc "instructionVectorFloatIndexOf1" [1] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 5.0], GeneFloat 2.0, StateFunc (instructionVectorFloatIndexOf, "placeholder")] emptyState + intTestFunc "instructionVectorFloatIndexOfFail" [-1] [GeneVectorFloat [], GeneFloat 2.0, StateFunc (instructionVectorFloatIndexOf, "placeholder")] emptyState + intTestFunc "instructionVectorFloatOccurrencesOf2" [2] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 2.0, 6.0, 7.0], GeneFloat 2.0, StateFunc (instructionVectorFloatOccurrencesOf, "placeholder")] emptyState + intTestFunc "instructionVectorFloatOccurrencesOf0" [0] [GeneVectorFloat [1.0, 2.0, 3.0, 4.0, 2.0, 6.0, 7.0], GeneFloat 0.0, StateFunc (instructionVectorFloatOccurrencesOf, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatSetNth3" [[0.0, 1.0, 2.0, 99.0, 4.0, 5.0]] [GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0], GeneFloat 99.0, GeneInt 3, StateFunc (instructionVectorFloatSetNth, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatSetNth9" [[0.0, 1.0, 2.0, 99.0, 4.0, 5.0]] [GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0], GeneFloat 99.0, GeneInt 9, StateFunc (instructionVectorFloatSetNth, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatReplace3" [[0.0, 1.0, 2.0, 99.0, 4.0, 5.0, 99.0, 5.0, 99.0]] [GeneFloat 99.0, GeneFloat 3.0, GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0], StateFunc (instructionVectorFloatReplace, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatReplace-1" [[0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0]] [GeneFloat 99.0, GeneFloat (-1.0), GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0], StateFunc (instructionVectorFloatReplace, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatReplaceFirst3" [[0.0, 1.0, 2.0, 99.0, 4.0, 5.0, 3.0, 5.0, 3.0]] [GeneFloat 99.0, GeneFloat 3.0, GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0], StateFunc (instructionVectorFloatReplaceFirst, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatReplaceFirst-2" [[0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0]] [GeneFloat 99.0, GeneFloat (-2.0), GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0], StateFunc (instructionVectorFloatReplaceFirst, "placeholder")] emptyState + vectorFloatTestFunc "instructionVectorFloatRemove" [[0.0, 1.0, 2.0, 4.0, 5.0, 5.0]] [GeneFloat 3, GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0], StateFunc (instructionVectorFloatRemove, "placeholder")] emptyState + floatTestFunc "instructionVectorFloatIterate" [66.0] [GeneFloat 40.0, GeneVectorFloat [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 3.0, 5.0, 3.0], StateFunc (instructionVectorFloatIterate, "placeholder"), StateFunc (instructionFloatAdd, "placeholder")] emptyState