diff --git a/HushGP.cabal b/HushGP.cabal index 5679300..49c8ce5 100644 --- a/HushGP.cabal +++ b/HushGP.cabal @@ -52,6 +52,7 @@ library , HushGP.Instructions.VectorStringInstructions , HushGP.Instructions.VectorBoolInstructions , HushGP.Instructions.VectorCharInstructions + , HushGP.Instructions.Utility , HushGP.PushTests , HushGP.PushTests.IntTests , HushGP.PushTests.GenericTests diff --git a/src/HushGP/Instructions.hs b/src/HushGP/Instructions.hs index 2e4d6a1..acfa87c 100644 --- a/src/HushGP/Instructions.hs +++ b/src/HushGP/Instructions.hs @@ -12,19 +12,19 @@ module HushGP.Instructions module HushGP.Instructions.VectorStringInstructions, module HushGP.Instructions.VectorBoolInstructions, module HushGP.Instructions.VectorCharInstructions, - allIntInstructions, - allFloatInstructions, - allBoolInstructions, - allCharInstructions, - allCodeInstructions, - allExecInstructions, - allStringInstructions, - allVectorIntInstructions, - allVectorFloatInstructions, - allVectorCharInstructions, - allVectorStringInstructions, - allVectorBoolInstructions, - allInstructions + -- allIntInstructions, + -- allFloatInstructions, + -- allBoolInstructions, + -- allCharInstructions, + -- allCodeInstructions, + -- allExecInstructions, + -- allStringInstructions, + -- allVectorIntInstructions, + -- allVectorFloatInstructions, + -- allVectorCharInstructions, + -- allVectorStringInstructions, + -- allVectorBoolInstructions, + -- allInstructions ) where @@ -41,501 +41,501 @@ import HushGP.Instructions.VectorFloatInstructions import HushGP.Instructions.VectorIntInstructions import HushGP.Instructions.VectorBoolInstructions import HushGP.Instructions.VectorStringInstructions -import HushGP.State +-- import HushGP.State -allIntInstructions :: [Gene] -allIntInstructions = map StateFunc [ - (instructionIntFromFloat, "instructionIntFromFloat"), - (instructionIntFromBool, "instructionIntFromBool"), - (instructionIntAdd, "instructionIntAdd"), - (instructionIntSub, "instructionIntSub"), - (instructionIntMul, "instructionIntMul"), - (instructionIntDiv, "instructionIntDiv"), - (instructionIntMod, "instructionIntMod"), - (instructionIntMin, "instructionIntMin"), - (instructionIntMax, "instructionIntMax"), - (instructionIntInc, "instructionIntInc"), - (instructionIntDec, "instructionIntDec"), - (instructionIntLT, "instructionIntLT"), - (instructionIntGT, "instructionIntGT"), - (instructionIntLTE, "instructionIntLTE"), - (instructionIntGTE, "instructionIntGTE"), - (instructionIntDup, "instructionIntDup"), - (instructionIntPop, "instructionIntPop"), - (instructionIntDupN, "instructionIntDupN"), - (instructionIntSwap, "instructionIntSwap"), - (instructionIntRot, "instructionIntRot"), - (instructionIntFlush, "instructionIntFlush"), - (instructionIntEq, "instructionIntEq"), - (instructionIntYank, "instructionIntYank"), - (instructionIntYankDup, "instructionIntYankDup"), - (instructionIntShove, "instructionIntShove"), - (instructionIntIsStackEmpty, "instructionIntIsStackEmpty"), - (instructionIntFromChar, "instructionIntFromChar"), - (instructionIntFromString, "instructionIntFromString"), - (instructionIntDupItems, "instructionIntDupItems") - ] +-- allIntInstructions :: [Gene] +-- allIntInstructions = map StateFunc [ +-- (instructionIntFromFloat, "instructionIntFromFloat"), +-- (instructionIntFromBool, "instructionIntFromBool"), +-- (instructionIntAdd, "instructionIntAdd"), +-- (instructionIntSub, "instructionIntSub"), +-- (instructionIntMul, "instructionIntMul"), +-- (instructionIntDiv, "instructionIntDiv"), +-- (instructionIntMod, "instructionIntMod"), +-- (instructionIntMin, "instructionIntMin"), +-- (instructionIntMax, "instructionIntMax"), +-- (instructionIntInc, "instructionIntInc"), +-- (instructionIntDec, "instructionIntDec"), +-- (instructionIntLT, "instructionIntLT"), +-- (instructionIntGT, "instructionIntGT"), +-- (instructionIntLTE, "instructionIntLTE"), +-- (instructionIntGTE, "instructionIntGTE"), +-- (instructionIntDup, "instructionIntDup"), +-- (instructionIntPop, "instructionIntPop"), +-- (instructionIntDupN, "instructionIntDupN"), +-- (instructionIntSwap, "instructionIntSwap"), +-- (instructionIntRot, "instructionIntRot"), +-- (instructionIntFlush, "instructionIntFlush"), +-- (instructionIntEq, "instructionIntEq"), +-- (instructionIntYank, "instructionIntYank"), +-- (instructionIntYankDup, "instructionIntYankDup"), +-- (instructionIntShove, "instructionIntShove"), +-- (instructionIntIsStackEmpty, "instructionIntIsStackEmpty"), +-- (instructionIntFromChar, "instructionIntFromChar"), +-- (instructionIntFromString, "instructionIntFromString"), +-- (instructionIntDupItems, "instructionIntDupItems") +-- ] -allFloatInstructions :: [Gene] -allFloatInstructions = map StateFunc [ - (instructionFloatFromInt, "instructionFloatFromInt"), - (instructionFloatFromBool, "instructionFloatFromBool"), - (instructionFloatAdd, "instructionFloatAdd"), - (instructionFloatSub, "instructionFloatSub"), - (instructionFloatMul, "instructionFloatMul"), - (instructionFloatDiv, "instructionFloatDiv"), - (instructionFloatMod, "instructionFloatMod"), - (instructionFloatMin, "instructionFloatMin"), - (instructionFloatMax, "instructionFloatMax"), - (instructionFloatInc, "instructionFloatInc"), - (instructionFloatDec, "instructionFloatDec"), - (instructionFloatLT, "instructionFloatLT"), - (instructionFloatGT, "instructionFloatGT"), - (instructionFloatLTE, "instructionFloatLTE"), - (instructionFloatGTE, "instructionFloatGTE"), - (instructionFloatDup, "instructionFloatDup"), - (instructionFloatPop, "instructionFloatPop"), - (instructionFloatDupN, "instructionFloatDupN"), - (instructionFloatSwap, "instructionFloatSwap"), - (instructionFloatRot, "instructionFloatRot"), - (instructionFloatFlush, "instructionFloatFlush"), - (instructionFloatEq, "instructionFloatEq"), - (instructionFloatYank, "instructionFloatYank"), - (instructionFloatYankDup, "instructionFloatYankDup"), - (instructionFloatShove, "instructionFloatShove"), - (instructionFloatIsStackEmpty, "instructionFloatIsStackEmpty"), - (instructionFloatFromChar, "instructionFloatFromChar"), - (instructionFloatFromString, "instructionFloatFromString"), - (instructionFloatDupItems, "instructionFloatDupItems") - ] +-- allFloatInstructions :: [Gene] +-- allFloatInstructions = map StateFunc [ +-- (instructionFloatFromInt, "instructionFloatFromInt"), +-- (instructionFloatFromBool, "instructionFloatFromBool"), +-- (instructionFloatAdd, "instructionFloatAdd"), +-- (instructionFloatSub, "instructionFloatSub"), +-- (instructionFloatMul, "instructionFloatMul"), +-- (instructionFloatDiv, "instructionFloatDiv"), +-- (instructionFloatMod, "instructionFloatMod"), +-- (instructionFloatMin, "instructionFloatMin"), +-- (instructionFloatMax, "instructionFloatMax"), +-- (instructionFloatInc, "instructionFloatInc"), +-- (instructionFloatDec, "instructionFloatDec"), +-- (instructionFloatLT, "instructionFloatLT"), +-- (instructionFloatGT, "instructionFloatGT"), +-- (instructionFloatLTE, "instructionFloatLTE"), +-- (instructionFloatGTE, "instructionFloatGTE"), +-- (instructionFloatDup, "instructionFloatDup"), +-- (instructionFloatPop, "instructionFloatPop"), +-- (instructionFloatDupN, "instructionFloatDupN"), +-- (instructionFloatSwap, "instructionFloatSwap"), +-- (instructionFloatRot, "instructionFloatRot"), +-- (instructionFloatFlush, "instructionFloatFlush"), +-- (instructionFloatEq, "instructionFloatEq"), +-- (instructionFloatYank, "instructionFloatYank"), +-- (instructionFloatYankDup, "instructionFloatYankDup"), +-- (instructionFloatShove, "instructionFloatShove"), +-- (instructionFloatIsStackEmpty, "instructionFloatIsStackEmpty"), +-- (instructionFloatFromChar, "instructionFloatFromChar"), +-- (instructionFloatFromString, "instructionFloatFromString"), +-- (instructionFloatDupItems, "instructionFloatDupItems") +-- ] -allBoolInstructions :: [Gene] -allBoolInstructions = map StateFunc [ - (instructionBoolFromInt, "instructionBoolFromInt"), - (instructionBoolFromFloat, "instructionBoolFromFloat"), - (instructionBoolAnd, "instructionBoolAnd"), - (instructionBoolInvertFirstThenAnd, "instructionBoolInvertFirstThenAnd"), - (instructionBoolInvertSecondThenAnd, "instructionBoolInvertSecondThenAnd"), - (instructionBoolOr, "instructionBoolOr"), - (instructionBoolXor, "instructionBoolXor"), - (instructionBoolPop, "instructionBoolPop"), - (instructionBoolDup, "instructionBoolDup"), - (instructionBoolDupN, "instructionBoolDupN"), - (instructionBoolSwap, "instructionBoolSwap"), - (instructionBoolRot, "instructionBoolRot"), - (instructionBoolFlush, "instructionBoolFlush"), - (instructionBoolEq, "instructionBoolEq"), - (instructionBoolStackDepth, "instructionBoolStackDepth"), - (instructionBoolYank, "instructionBoolYank"), - (instructionBoolYankDup, "instructionBoolYankDup"), - (instructionBoolShove, "instructionBoolShove"), - (instructionBoolShoveDup, "instructionBoolShoveDup"), - (instructionBoolIsStackEmpty, "instructionBoolIsStackEmpty"), - (instructionBoolDupItems, "instructionBoolDupItems") - ] +-- allBoolInstructions :: [Gene] +-- allBoolInstructions = map StateFunc [ +-- (instructionBoolFromInt, "instructionBoolFromInt"), +-- (instructionBoolFromFloat, "instructionBoolFromFloat"), +-- (instructionBoolAnd, "instructionBoolAnd"), +-- (instructionBoolInvertFirstThenAnd, "instructionBoolInvertFirstThenAnd"), +-- (instructionBoolInvertSecondThenAnd, "instructionBoolInvertSecondThenAnd"), +-- (instructionBoolOr, "instructionBoolOr"), +-- (instructionBoolXor, "instructionBoolXor"), +-- (instructionBoolPop, "instructionBoolPop"), +-- (instructionBoolDup, "instructionBoolDup"), +-- (instructionBoolDupN, "instructionBoolDupN"), +-- (instructionBoolSwap, "instructionBoolSwap"), +-- (instructionBoolRot, "instructionBoolRot"), +-- (instructionBoolFlush, "instructionBoolFlush"), +-- (instructionBoolEq, "instructionBoolEq"), +-- (instructionBoolStackDepth, "instructionBoolStackDepth"), +-- (instructionBoolYank, "instructionBoolYank"), +-- (instructionBoolYankDup, "instructionBoolYankDup"), +-- (instructionBoolShove, "instructionBoolShove"), +-- (instructionBoolShoveDup, "instructionBoolShoveDup"), +-- (instructionBoolIsStackEmpty, "instructionBoolIsStackEmpty"), +-- (instructionBoolDupItems, "instructionBoolDupItems") +-- ] -allCharInstructions :: [Gene] -allCharInstructions = map StateFunc [ - (instructionCharConcat, "instructionCharConcat"), - (instructionCharFromFirstChar, "instructionCharFromFirstChar"), - (instructionCharFromLastChar, "instructionCharFromLastChar"), - (instructionCharFromNthChar, "instructionCharFromNthChar"), - (instructionCharIsWhitespace, "instructionCharIsWhitespace"), - (instructionCharIsLetter, "instructionCharIsLetter"), - (instructionCharIsDigit, "instructionCharIsDigit"), - (instructionCharFromBool, "instructionCharFromBool"), - (instructionCharFromAsciiInt, "instructionCharFromAsciiInt"), - (instructionCharFromAsciiFloat, "instructionCharFromAsciiFloat"), - (instructionCharsFromString, "instructionCharsFromString"), - (instructionCharPop, "instructionCharPop"), - (instructionCharDup, "instructionCharDup"), - (instructionCharDupN, "instructionCharDupN"), - (instructionCharSwap, "instructionCharSwap"), - (instructionCharRot, "instructionCharRot"), - (instructionCharFlush, "instructionCharFlush"), - (instructionCharEq, "instructionCharEq"), - (instructionCharStackDepth, "instructionCharStackDepth"), - (instructionCharYank, "instructionCharYank"), - (instructionCharYankDup, "instructionCharYankDup"), - (instructionCharShove, "instructionCharShove"), - (instructionCharShoveDup, "instructionCharShoveDup"), - (instructionCharIsStackEmpty, "instructionCharIsStackEmpty"), - (instructionCharDupItems, "instructionCharDupItems") - ] +-- allCharInstructions :: [Gene] +-- allCharInstructions = map StateFunc [ +-- (instructionCharConcat, "instructionCharConcat"), +-- (instructionCharFromFirstChar, "instructionCharFromFirstChar"), +-- (instructionCharFromLastChar, "instructionCharFromLastChar"), +-- (instructionCharFromNthChar, "instructionCharFromNthChar"), +-- (instructionCharIsWhitespace, "instructionCharIsWhitespace"), +-- (instructionCharIsLetter, "instructionCharIsLetter"), +-- (instructionCharIsDigit, "instructionCharIsDigit"), +-- (instructionCharFromBool, "instructionCharFromBool"), +-- (instructionCharFromAsciiInt, "instructionCharFromAsciiInt"), +-- (instructionCharFromAsciiFloat, "instructionCharFromAsciiFloat"), +-- (instructionCharsFromString, "instructionCharsFromString"), +-- (instructionCharPop, "instructionCharPop"), +-- (instructionCharDup, "instructionCharDup"), +-- (instructionCharDupN, "instructionCharDupN"), +-- (instructionCharSwap, "instructionCharSwap"), +-- (instructionCharRot, "instructionCharRot"), +-- (instructionCharFlush, "instructionCharFlush"), +-- (instructionCharEq, "instructionCharEq"), +-- (instructionCharStackDepth, "instructionCharStackDepth"), +-- (instructionCharYank, "instructionCharYank"), +-- (instructionCharYankDup, "instructionCharYankDup"), +-- (instructionCharShove, "instructionCharShove"), +-- (instructionCharShoveDup, "instructionCharShoveDup"), +-- (instructionCharIsStackEmpty, "instructionCharIsStackEmpty"), +-- (instructionCharDupItems, "instructionCharDupItems") +-- ] -allCodeInstructions :: [Gene] -allCodeInstructions = map StateFunc [ - (instructionCodePop, "instructionCodePop"), - (instructionCodeIsCodeBlock, "instructionCodeIsCodeBlock"), - (instructionCodeIsSingular, "instructionCodeIsSingular"), - (instructionCodeLength, "instructionCodeLength"), - (instructionCodeFirst, "instructionCodeFirst"), - (instructionCodeLast, "instructionCodeLast"), - (instructionCodeTail, "instructionCodeTail"), - (instructionCodeInit, "instructionCodeInit"), - (instructionCodeWrap, "instructionCodeWrap"), - (instructionCodeList, "instructionCodeList"), - (instructionCodeCombine, "instructionCodeCombine"), - (instructionCodeDo, "instructionCodeDo"), - (instructionCodeDoDup, "instructionCodeDoDup"), - (instructionCodeDoThenPop, "instructionCodeDoThenPop"), - (instructionCodeDoRange, "instructionCodeDoRange"), - (instructionCodeDoCount, "instructionCodeDoCount"), - (instructionCodeDoTimes, "instructionCodeDoTimes"), - (instructionCodeIf, "instructionCodeIf"), - (instructionCodeWhen, "instructionCodeWhen"), - (instructionCodeMember, "instructionCodeMember"), - (instructionCodeN, "instructionCodeN"), - (instructionMakeEmptyCodeBlock, "instructionMakeEmptyCodeBlock"), - (instructionIsEmptyCodeBlock, "instructionIsEmptyCodeBlock"), - (instructionCodeSize, "instructionCodeSize"), - (instructionCodeExtract, "instructionCodeExtract"), - (instructionCodeInsert, "instructionCodeInsert"), - (instructionCodeFirstPosition, "instructionCodeFirstPosition"), - (instructionCodeReverse, "instructionCodeReverse"), - (instructionCodeDup, "instructionCodeDup"), - (instructionCodeDupN, "instructionCodeDupN"), - (instructionCodeDup, "instructionCodeDup"), - (instructionCodeDupN, "instructionCodeDupN"), - (instructionCodeSwap, "instructionCodeSwap"), - (instructionCodeRot, "instructionCodeRot"), - (instructionCodeFlush, "instructionCodeFlush"), - (instructionCodeEq, "instructionCodeEq"), - (instructionCodeStackDepth, "instructionCodeStackDepth"), - (instructionCodeYank, "instructionCodeYank"), - (instructionCodeYankDup, "instructionCodeYankDup"), - (instructionCodeShove, "instructionCodeShove"), - (instructionCodeShoveDup, "instructionCodeShoveDup"), - (instructionCodeIsStackEmpty, "instructionCodeIsStackEmpty"), - (instructionCodeFromBool, "instructionCodeFromBool"), - (instructionCodeFromInt, "instructionCodeFromInt"), - (instructionCodeFromChar, "instructionCodeFromChar"), - (instructionCodeFromFloat, "instructionCodeFromFloat"), - (instructionCodeFromString, "instructionCodeFromString"), - (instructionCodeFromVectorInt, "instructionCodeFromVectorInt"), - (instructionCodeFromVectorFloat, "instructionCodeFromVectorFloat"), - (instructionCodeFromVectorString, "instructionCodeFromVectorString"), - (instructionCodeFromVectorBool, "instructionCodeFromVectorBool"), - (instructionCodeFromVectorChar, "instructionCodeFromVectorChar"), - (instructionCodeFromExec, "instructionCodeFromExec"), - (instructionCodeContainer, "instructionCodeContainer"), - (instructionCodeDiscrepancy, "instructionCodeDiscrepancy"), - (instructionCodeNoOp, "instructionCodeNoOp"), - (instructionCodeTailN, "instructionCodeTailN"), - (instructionCodeDupItems, "instructionCodeDupItems") - ] +-- allCodeInstructions :: [Gene] +-- allCodeInstructions = map StateFunc [ +-- (instructionCodePop, "instructionCodePop"), +-- (instructionCodeIsCodeBlock, "instructionCodeIsCodeBlock"), +-- (instructionCodeIsSingular, "instructionCodeIsSingular"), +-- (instructionCodeLength, "instructionCodeLength"), +-- (instructionCodeFirst, "instructionCodeFirst"), +-- (instructionCodeLast, "instructionCodeLast"), +-- (instructionCodeTail, "instructionCodeTail"), +-- (instructionCodeInit, "instructionCodeInit"), +-- (instructionCodeWrap, "instructionCodeWrap"), +-- (instructionCodeList, "instructionCodeList"), +-- (instructionCodeCombine, "instructionCodeCombine"), +-- (instructionCodeDo, "instructionCodeDo"), +-- (instructionCodeDoDup, "instructionCodeDoDup"), +-- (instructionCodeDoThenPop, "instructionCodeDoThenPop"), +-- (instructionCodeDoRange, "instructionCodeDoRange"), +-- (instructionCodeDoCount, "instructionCodeDoCount"), +-- (instructionCodeDoTimes, "instructionCodeDoTimes"), +-- (instructionCodeIf, "instructionCodeIf"), +-- (instructionCodeWhen, "instructionCodeWhen"), +-- (instructionCodeMember, "instructionCodeMember"), +-- (instructionCodeN, "instructionCodeN"), +-- (instructionMakeEmptyCodeBlock, "instructionMakeEmptyCodeBlock"), +-- (instructionIsEmptyCodeBlock, "instructionIsEmptyCodeBlock"), +-- (instructionCodeSize, "instructionCodeSize"), +-- (instructionCodeExtract, "instructionCodeExtract"), +-- (instructionCodeInsert, "instructionCodeInsert"), +-- (instructionCodeFirstPosition, "instructionCodeFirstPosition"), +-- (instructionCodeReverse, "instructionCodeReverse"), +-- (instructionCodeDup, "instructionCodeDup"), +-- (instructionCodeDupN, "instructionCodeDupN"), +-- (instructionCodeDup, "instructionCodeDup"), +-- (instructionCodeDupN, "instructionCodeDupN"), +-- (instructionCodeSwap, "instructionCodeSwap"), +-- (instructionCodeRot, "instructionCodeRot"), +-- (instructionCodeFlush, "instructionCodeFlush"), +-- (instructionCodeEq, "instructionCodeEq"), +-- (instructionCodeStackDepth, "instructionCodeStackDepth"), +-- (instructionCodeYank, "instructionCodeYank"), +-- (instructionCodeYankDup, "instructionCodeYankDup"), +-- (instructionCodeShove, "instructionCodeShove"), +-- (instructionCodeShoveDup, "instructionCodeShoveDup"), +-- (instructionCodeIsStackEmpty, "instructionCodeIsStackEmpty"), +-- (instructionCodeFromBool, "instructionCodeFromBool"), +-- (instructionCodeFromInt, "instructionCodeFromInt"), +-- (instructionCodeFromChar, "instructionCodeFromChar"), +-- (instructionCodeFromFloat, "instructionCodeFromFloat"), +-- (instructionCodeFromString, "instructionCodeFromString"), +-- (instructionCodeFromVectorInt, "instructionCodeFromVectorInt"), +-- (instructionCodeFromVectorFloat, "instructionCodeFromVectorFloat"), +-- (instructionCodeFromVectorString, "instructionCodeFromVectorString"), +-- (instructionCodeFromVectorBool, "instructionCodeFromVectorBool"), +-- (instructionCodeFromVectorChar, "instructionCodeFromVectorChar"), +-- (instructionCodeFromExec, "instructionCodeFromExec"), +-- (instructionCodeContainer, "instructionCodeContainer"), +-- (instructionCodeDiscrepancy, "instructionCodeDiscrepancy"), +-- (instructionCodeNoOp, "instructionCodeNoOp"), +-- (instructionCodeTailN, "instructionCodeTailN"), +-- (instructionCodeDupItems, "instructionCodeDupItems") +-- ] -allExecInstructions :: [Gene] -allExecInstructions = map StateFunc [ - (instructionExecIf, "instructionExecIf"), - (instructionExecDup, "instructionExecDup"), - (instructionExecDupN, "instructionExecDupN"), - (instructionExecPop, "instructionExecPop"), - (instructionExecSwap, "instructionExecSwap"), - (instructionExecRot, "instructionExecRot"), - (instructionExecFlush, "instructionExecFlush"), - (instructionExecEq, "instructionExecEq"), - (instructionExecStackDepth, "instructionExecStackDepth"), - (instructionExecYank, "instructionExecYank"), - (instructionExecYankDup, "instructionExecYankDup"), - (instructionExecShove, "instructionExecShove"), - (instructionExecShoveDup, "instructionExecShoveDup"), - (instructionExecIsStackEmpty, "instructionExecIsStackEmpty"), - (instructionExecDoRange, "instructionExecDoRange"), - (instructionExecDoCount, "instructionExecDoCount"), - (instructionExecDoTimes, "instructionExecDoTimes"), - (instructionExecWhile, "instructionExecWhile"), - (instructionExecDoWhile, "instructionExecDoWhile"), - (instructionExecWhen, "instructionExecWhen"), - (instructionExecK, "instructionExecK"), - (instructionExecS, "instructionExecS"), - (instructionExecY, "instrucitonExecY"), - (instructionExecDupItems, "instructionExecDupItems") - ] +-- allExecInstructions :: [Gene] +-- allExecInstructions = map StateFunc [ +-- (instructionExecIf, "instructionExecIf"), +-- (instructionExecDup, "instructionExecDup"), +-- (instructionExecDupN, "instructionExecDupN"), +-- (instructionExecPop, "instructionExecPop"), +-- (instructionExecSwap, "instructionExecSwap"), +-- (instructionExecRot, "instructionExecRot"), +-- (instructionExecFlush, "instructionExecFlush"), +-- (instructionExecEq, "instructionExecEq"), +-- (instructionExecStackDepth, "instructionExecStackDepth"), +-- (instructionExecYank, "instructionExecYank"), +-- (instructionExecYankDup, "instructionExecYankDup"), +-- (instructionExecShove, "instructionExecShove"), +-- (instructionExecShoveDup, "instructionExecShoveDup"), +-- (instructionExecIsStackEmpty, "instructionExecIsStackEmpty"), +-- (instructionExecDoRange, "instructionExecDoRange"), +-- (instructionExecDoCount, "instructionExecDoCount"), +-- (instructionExecDoTimes, "instructionExecDoTimes"), +-- (instructionExecWhile, "instructionExecWhile"), +-- (instructionExecDoWhile, "instructionExecDoWhile"), +-- (instructionExecWhen, "instructionExecWhen"), +-- (instructionExecK, "instructionExecK"), +-- (instructionExecS, "instructionExecS"), +-- (instructionExecY, "instrucitonExecY"), +-- (instructionExecDupItems, "instructionExecDupItems") +-- ] -allStringInstructions :: [Gene] -allStringInstructions = map StateFunc [ - (instructionStringConcat, "instructionStringConcat"), - (instructionStringSwap, "instructionStringSwap"), - (instructionStringInsertString, "instructionStringInsertString"), - (instructionStringFromFirstChar, "instructionStringFromFirstChar"), - (instructionStringFromLastChar, "instructionStringFromLastChar"), - (instructionStringFromNthChar, "instructionStringFromNthChar"), - (instructionStringIndexOfString, "instructionStringIndexOfString"), - (instructionStringContainsString, "instructionStringContainsString"), - (instructionStringSplitOnString, "instructionStringSplitOnString"), - (instructionStringReplaceFirstString, "instructionStringReplaceFirstString"), - (instructionStringReplaceNString, "instructionStringReplaceNString"), - (instructionStringReplaceAllString, "instructionStringReplaceAllString"), - (instructionStringRemoveFirstString, "instructionStringRemoveFirstString"), - (instructionStringRemoveNString, "instructionStringRemoveNString"), - (instructionStringRemoveAllString, "instructionStringRemoveAllString"), - (instructionStringOccurrencesOfString, "instructionStringOccurrencesOfString"), - (instructionStringInsertChar, "instructionStringInsertChar"), - (instructionStringContainsChar, "instructionStringContainsChar"), - (instructionStringIndexOfChar, "instructionStringIndexOfChar"), - (instructionStringSplitOnChar, "instructionStringSplitOnChar"), - (instructionStringReplaceFirstChar, "instructionStringReplaceFirstChar"), - (instructionStringReplaceNChar, "instructionStringReplaceNChar"), - (instructionStringReplaceAllChar, "instructionStringReplaceAllChar"), - (instructionStringRemoveFirstChar, "instructionStringRemoveFirstChar"), - (instructionStringRemoveNChar, "instructionStringRemoveNChar"), - (instructionStringRemoveAllChar, "instructionStringRemoveAllChar"), - (instructionStringOccurrencesOfChar, "instructionStringOccurrencesOfChar"), - (instructionStringReverse, "instructionStringReverse"), - (instructionStringHead, "instructionStringHead"), - (instructionStringTail, "instructionStringTail"), - (instructionStringAppendChar, "instructionStringAppendChar"), - (instructionStringRest, "instructionStringRest"), - (instructionStringButLast, "instructionStringButLast"), - (instructionStringDrop, "instructionStringDrop"), - (instructionStringButLastN, "instructionStringButLastN"), - (instructionStringLength, "instructionStringLength"), - (instructionStringMakeEmpty, "instructionStringMakeEmpty"), - (instructionStringIsEmptyString, "instructionStringIsEmptyString"), - (instructionStringRemoveNth, "instructionStringRemoveNth"), - (instructionStringSetNth, "instructionStringSetNth"), - (instructionStringStripWhitespace, "instructionStringStripWhitespace"), - (instructionStringFromBool, "instructionStringFromBool"), - (instructionStringFromInt, "instructionStringFromInt"), - (instructionStringFromFloat, "instructionStringFromFloat"), - (instructionStringFromChar, "instructionStringFromChar"), - (instructionStringPop, "instructionStringPop"), - (instructionStringDup, "instructionStringDup"), - (instructionStringDupN, "instructionStringDupN"), - (instructionStringSwap, "instructionStringSwap"), - (instructionStringRot, "instructionStringRot"), - (instructionStringFlush, "instructionStringFlush"), - (instructionStringEq, "instructionStringEq"), - (instructionStringStackDepth, "instructionStringStackDepth"), - (instructionStringYank, "instructionStringYank"), - (instructionStringYankDup, "instructionStringYankDup"), - (instructionStringShove, "instructionStringShove"), - (instructionStringShoveDup, "instructionStringShoveDup"), - (instructionStringIsStackEmpty, "instructionStringIsStackEmpty"), - (instructionStringSort, "instructionStringSort"), - (instructionStringSortReverse, "instructionStringSortReverse"), - (instructionStringDupItems, "instructionStringDupItems"), - (instructionStringParseToChar, "instructionStringParseToChar"), - (instructionStringSubString, "instructionStringSubString") - ] +-- allStringInstructions :: [Gene] +-- allStringInstructions = map StateFunc [ +-- (instructionStringConcat, "instructionStringConcat"), +-- (instructionStringSwap, "instructionStringSwap"), +-- (instructionStringInsertString, "instructionStringInsertString"), +-- (instructionStringFromFirstChar, "instructionStringFromFirstChar"), +-- (instructionStringFromLastChar, "instructionStringFromLastChar"), +-- (instructionStringFromNthChar, "instructionStringFromNthChar"), +-- (instructionStringIndexOfString, "instructionStringIndexOfString"), +-- (instructionStringContainsString, "instructionStringContainsString"), +-- (instructionStringSplitOnString, "instructionStringSplitOnString"), +-- (instructionStringReplaceFirstString, "instructionStringReplaceFirstString"), +-- (instructionStringReplaceNString, "instructionStringReplaceNString"), +-- (instructionStringReplaceAllString, "instructionStringReplaceAllString"), +-- (instructionStringRemoveFirstString, "instructionStringRemoveFirstString"), +-- (instructionStringRemoveNString, "instructionStringRemoveNString"), +-- (instructionStringRemoveAllString, "instructionStringRemoveAllString"), +-- (instructionStringOccurrencesOfString, "instructionStringOccurrencesOfString"), +-- (instructionStringInsertChar, "instructionStringInsertChar"), +-- (instructionStringContainsChar, "instructionStringContainsChar"), +-- (instructionStringIndexOfChar, "instructionStringIndexOfChar"), +-- (instructionStringSplitOnChar, "instructionStringSplitOnChar"), +-- (instructionStringReplaceFirstChar, "instructionStringReplaceFirstChar"), +-- (instructionStringReplaceNChar, "instructionStringReplaceNChar"), +-- (instructionStringReplaceAllChar, "instructionStringReplaceAllChar"), +-- (instructionStringRemoveFirstChar, "instructionStringRemoveFirstChar"), +-- (instructionStringRemoveNChar, "instructionStringRemoveNChar"), +-- (instructionStringRemoveAllChar, "instructionStringRemoveAllChar"), +-- (instructionStringOccurrencesOfChar, "instructionStringOccurrencesOfChar"), +-- (instructionStringReverse, "instructionStringReverse"), +-- (instructionStringHead, "instructionStringHead"), +-- (instructionStringTail, "instructionStringTail"), +-- (instructionStringAppendChar, "instructionStringAppendChar"), +-- (instructionStringRest, "instructionStringRest"), +-- (instructionStringButLast, "instructionStringButLast"), +-- (instructionStringDrop, "instructionStringDrop"), +-- (instructionStringButLastN, "instructionStringButLastN"), +-- (instructionStringLength, "instructionStringLength"), +-- (instructionStringMakeEmpty, "instructionStringMakeEmpty"), +-- (instructionStringIsEmptyString, "instructionStringIsEmptyString"), +-- (instructionStringRemoveNth, "instructionStringRemoveNth"), +-- (instructionStringSetNth, "instructionStringSetNth"), +-- (instructionStringStripWhitespace, "instructionStringStripWhitespace"), +-- (instructionStringFromBool, "instructionStringFromBool"), +-- (instructionStringFromInt, "instructionStringFromInt"), +-- (instructionStringFromFloat, "instructionStringFromFloat"), +-- (instructionStringFromChar, "instructionStringFromChar"), +-- (instructionStringPop, "instructionStringPop"), +-- (instructionStringDup, "instructionStringDup"), +-- (instructionStringDupN, "instructionStringDupN"), +-- (instructionStringSwap, "instructionStringSwap"), +-- (instructionStringRot, "instructionStringRot"), +-- (instructionStringFlush, "instructionStringFlush"), +-- (instructionStringEq, "instructionStringEq"), +-- (instructionStringStackDepth, "instructionStringStackDepth"), +-- (instructionStringYank, "instructionStringYank"), +-- (instructionStringYankDup, "instructionStringYankDup"), +-- (instructionStringShove, "instructionStringShove"), +-- (instructionStringShoveDup, "instructionStringShoveDup"), +-- (instructionStringIsStackEmpty, "instructionStringIsStackEmpty"), +-- (instructionStringSort, "instructionStringSort"), +-- (instructionStringSortReverse, "instructionStringSortReverse"), +-- (instructionStringDupItems, "instructionStringDupItems"), +-- (instructionStringParseToChar, "instructionStringParseToChar"), +-- (instructionStringSubString, "instructionStringSubString") +-- ] -allVectorIntInstructions :: [Gene] -allVectorIntInstructions = map StateFunc [ - (instructionVectorIntConcat, "instructionVectorIntConcat"), - (instructionVectorIntConj, "instructionVectorIntConj"), - (instructionVectorIntTakeN, "instructionVectorIntTakeN"), - (instructionVectorIntSubVector, "instructionVectorIntSubVector"), - (instructionVectorIntFirst, "instructionVectorIntFirst"), - (instructionVectorIntLast, "instructionVectorIntLast"), - (instructionVectorIntNth, "instructionVectorIntNth"), - (instructionVectorIntRest, "instructionVectorIntRest"), - (instructionVectorIntButLast, "instructionVectorIntButLast"), - (instructionVectorIntLength, "instructionVectorIntLength"), - (instructionVectorIntReverse, "instructionVectorIntReverse"), - (instructionVectorIntPushAll, "instructionVectorIntPushAll"), - (instructionVectorIntMakeEmpty, "instructionVectorIntMakeEmpty"), - (instructionVectorIntIsEmpty, "instructionVectorIntIsEmpty"), - (instructionVectorIntIndexOf, "instructionVectorIntIndexOf"), - (instructionVectorIntOccurrencesOf, "instructionVectorIntOccurrencesOf"), - (instructionVectorIntSetNth, "instructionVectorIntSetNth"), - (instructionVectorIntReplace, "instructionVectorIntReplace"), - (instructionVectorIntReplaceFirst, "instructionVectorIntReplaceFirst"), - (instructionVectorIntRemove, "instructionVectorIntRemove"), - (instructionVectorIntIterate, "instructionVectorIntIterate"), - (instructionVectorIntPop, "instructionVectorIntPop"), - (instructionVectorIntDup, "instructionVectorIntDup"), - (instructionVectorIntDupN, "instructionVectorIntDupN"), - (instructionVectorIntSwap, "instructionVectorIntSwap"), - (instructionVectorIntRot, "instructionVectorIntRot"), - (instructionVectorIntFlush, "instructionVectorIntFlush"), - (instructionVectorIntEq, "instructionVectorIntEq"), - (instructionVectorIntStackDepth, "instructionVectorIntStackDepth"), - (instructionVectorIntYank, "instructionVectorIntYank"), - (instructionVectorIntYankDup, "instructionVectorIntYankDup"), - (instructionVectorIntShove, "instructionVectorIntShove"), - (instructionVectorIntShoveDup, "instructionVectorIntShoveDup"), - (instructionVectorIntIsStackEmpty, "instructionVectorIntIsStackEmpty"), - (instructionVectorIntSort, "instructionVectorIntSort"), - (instructionVectorIntSortReverse, "instructionVectorIntSortReverse"), - (instructionVectorIntDupItems, "instructionVectorIntDupItems") - ] +-- allVectorIntInstructions :: [Gene] +-- allVectorIntInstructions = map StateFunc [ +-- (instructionVectorIntConcat, "instructionVectorIntConcat"), +-- (instructionVectorIntConj, "instructionVectorIntConj"), +-- (instructionVectorIntTakeN, "instructionVectorIntTakeN"), +-- (instructionVectorIntSubVector, "instructionVectorIntSubVector"), +-- (instructionVectorIntFirst, "instructionVectorIntFirst"), +-- (instructionVectorIntLast, "instructionVectorIntLast"), +-- (instructionVectorIntNth, "instructionVectorIntNth"), +-- (instructionVectorIntRest, "instructionVectorIntRest"), +-- (instructionVectorIntButLast, "instructionVectorIntButLast"), +-- (instructionVectorIntLength, "instructionVectorIntLength"), +-- (instructionVectorIntReverse, "instructionVectorIntReverse"), +-- (instructionVectorIntPushAll, "instructionVectorIntPushAll"), +-- (instructionVectorIntMakeEmpty, "instructionVectorIntMakeEmpty"), +-- (instructionVectorIntIsEmpty, "instructionVectorIntIsEmpty"), +-- (instructionVectorIntIndexOf, "instructionVectorIntIndexOf"), +-- (instructionVectorIntOccurrencesOf, "instructionVectorIntOccurrencesOf"), +-- (instructionVectorIntSetNth, "instructionVectorIntSetNth"), +-- (instructionVectorIntReplace, "instructionVectorIntReplace"), +-- (instructionVectorIntReplaceFirst, "instructionVectorIntReplaceFirst"), +-- (instructionVectorIntRemove, "instructionVectorIntRemove"), +-- (instructionVectorIntIterate, "instructionVectorIntIterate"), +-- (instructionVectorIntPop, "instructionVectorIntPop"), +-- (instructionVectorIntDup, "instructionVectorIntDup"), +-- (instructionVectorIntDupN, "instructionVectorIntDupN"), +-- (instructionVectorIntSwap, "instructionVectorIntSwap"), +-- (instructionVectorIntRot, "instructionVectorIntRot"), +-- (instructionVectorIntFlush, "instructionVectorIntFlush"), +-- (instructionVectorIntEq, "instructionVectorIntEq"), +-- (instructionVectorIntStackDepth, "instructionVectorIntStackDepth"), +-- (instructionVectorIntYank, "instructionVectorIntYank"), +-- (instructionVectorIntYankDup, "instructionVectorIntYankDup"), +-- (instructionVectorIntShove, "instructionVectorIntShove"), +-- (instructionVectorIntShoveDup, "instructionVectorIntShoveDup"), +-- (instructionVectorIntIsStackEmpty, "instructionVectorIntIsStackEmpty"), +-- (instructionVectorIntSort, "instructionVectorIntSort"), +-- (instructionVectorIntSortReverse, "instructionVectorIntSortReverse"), +-- (instructionVectorIntDupItems, "instructionVectorIntDupItems") +-- ] -allVectorFloatInstructions :: [Gene] -allVectorFloatInstructions = map StateFunc [ - (instructionVectorFloatConcat, "instructionVectorFloatConcat"), - (instructionVectorFloatConj, "instructionVectorFloatConj"), - (instructionVectorFloatTakeN, "instructionVectorFloatTakeN"), - (instructionVectorFloatSubVector, "instructionVectorFloatSubVector"), - (instructionVectorFloatFirst, "instructionVectorFloatFirst"), - (instructionVectorFloatLast, "instructionVectorFloatLast"), - (instructionVectorFloatNth, "instructionVectorFloatNth"), - (instructionVectorFloatRest, "instructionVectorFloatRest"), - (instructionVectorFloatButLast, "instructionVectorFloatButLast"), - (instructionVectorFloatLength, "instructionVectorFloatLength"), - (instructionVectorFloatReverse, "instructionVectorFloatReverse"), - (instructionVectorFloatPushAll, "instructionVectorFloatPushAll"), - (instructionVectorFloatMakeEmpty, "instructionVectorFloatMakeEmpty"), - (instructionVectorFloatIsEmpty, "instructionVectorFloatIsEmpty"), - (instructionVectorFloatIndexOf, "instructionVectorFloatIndexOf"), - (instructionVectorFloatOccurrencesOf, "instructionVectorFloatOccurrencesOf"), - (instructionVectorFloatSetNth, "instructionVectorFloatSetNth"), - (instructionVectorFloatReplace, "instructionVectorFloatReplace"), - (instructionVectorFloatReplaceFirst, "instructionVectorFloatReplaceFirst"), - (instructionVectorFloatRemove, "instructionVectorFloatRemove"), - (instructionVectorFloatIterate, "instructionVectorFloatIterate"), - (instructionVectorFloatPop, "instructionVectorFloatPop"), - (instructionVectorFloatDup, "instructionVectorFloatDup"), - (instructionVectorFloatDupN, "instructionVectorFloatDupN"), - (instructionVectorFloatSwap, "instructionVectorFloatSwap"), - (instructionVectorFloatRot, "instructionVectorFloatRot"), - (instructionVectorFloatFlush, "instructionVectorFloatFlush"), - (instructionVectorFloatEq, "instructionVectorFloatEq"), - (instructionVectorFloatStackDepth, "instructionVectorFloatStackDepth"), - (instructionVectorFloatYank, "instructionVectorFloatYank"), - (instructionVectorFloatYankDup, "instructionVectorFloatYankDup"), - (instructionVectorFloatShove, "instructionVectorFloatShove"), - (instructionVectorFloatShoveDup, "instructionVectorFloatShoveDup"), - (instructionVectorFloatIsStackEmpty, "instructionVectorFloatIsStackEmpty"), - (instructionVectorFloatSort, "instructionVectorFloatSort"), - (instructionVectorFloatSortReverse, "instructionVectorFloatSortReverse"), - (instructionVectorFloatDupItems, "instructionVectorFloatDupItems") - ] +-- allVectorFloatInstructions :: [Gene] +-- allVectorFloatInstructions = map StateFunc [ +-- (instructionVectorFloatConcat, "instructionVectorFloatConcat"), +-- (instructionVectorFloatConj, "instructionVectorFloatConj"), +-- (instructionVectorFloatTakeN, "instructionVectorFloatTakeN"), +-- (instructionVectorFloatSubVector, "instructionVectorFloatSubVector"), +-- (instructionVectorFloatFirst, "instructionVectorFloatFirst"), +-- (instructionVectorFloatLast, "instructionVectorFloatLast"), +-- (instructionVectorFloatNth, "instructionVectorFloatNth"), +-- (instructionVectorFloatRest, "instructionVectorFloatRest"), +-- (instructionVectorFloatButLast, "instructionVectorFloatButLast"), +-- (instructionVectorFloatLength, "instructionVectorFloatLength"), +-- (instructionVectorFloatReverse, "instructionVectorFloatReverse"), +-- (instructionVectorFloatPushAll, "instructionVectorFloatPushAll"), +-- (instructionVectorFloatMakeEmpty, "instructionVectorFloatMakeEmpty"), +-- (instructionVectorFloatIsEmpty, "instructionVectorFloatIsEmpty"), +-- (instructionVectorFloatIndexOf, "instructionVectorFloatIndexOf"), +-- (instructionVectorFloatOccurrencesOf, "instructionVectorFloatOccurrencesOf"), +-- (instructionVectorFloatSetNth, "instructionVectorFloatSetNth"), +-- (instructionVectorFloatReplace, "instructionVectorFloatReplace"), +-- (instructionVectorFloatReplaceFirst, "instructionVectorFloatReplaceFirst"), +-- (instructionVectorFloatRemove, "instructionVectorFloatRemove"), +-- (instructionVectorFloatIterate, "instructionVectorFloatIterate"), +-- (instructionVectorFloatPop, "instructionVectorFloatPop"), +-- (instructionVectorFloatDup, "instructionVectorFloatDup"), +-- (instructionVectorFloatDupN, "instructionVectorFloatDupN"), +-- (instructionVectorFloatSwap, "instructionVectorFloatSwap"), +-- (instructionVectorFloatRot, "instructionVectorFloatRot"), +-- (instructionVectorFloatFlush, "instructionVectorFloatFlush"), +-- (instructionVectorFloatEq, "instructionVectorFloatEq"), +-- (instructionVectorFloatStackDepth, "instructionVectorFloatStackDepth"), +-- (instructionVectorFloatYank, "instructionVectorFloatYank"), +-- (instructionVectorFloatYankDup, "instructionVectorFloatYankDup"), +-- (instructionVectorFloatShove, "instructionVectorFloatShove"), +-- (instructionVectorFloatShoveDup, "instructionVectorFloatShoveDup"), +-- (instructionVectorFloatIsStackEmpty, "instructionVectorFloatIsStackEmpty"), +-- (instructionVectorFloatSort, "instructionVectorFloatSort"), +-- (instructionVectorFloatSortReverse, "instructionVectorFloatSortReverse"), +-- (instructionVectorFloatDupItems, "instructionVectorFloatDupItems") +-- ] -allVectorCharInstructions :: [Gene] -allVectorCharInstructions = map StateFunc [ - (instructionVectorCharConcat, "instructionVectorCharConcat"), - (instructionVectorCharConj, "instructionVectorCharConj"), - (instructionVectorCharTakeN, "instructionVectorCharTakeN"), - (instructionVectorCharSubVector, "instructionVectorCharSubVector"), - (instructionVectorCharFirst, "instructionVectorCharFirst"), - (instructionVectorCharLast, "instructionVectorCharLast"), - (instructionVectorCharNth, "instructionVectorCharNth"), - (instructionVectorCharRest, "instructionVectorCharRest"), - (instructionVectorCharButLast, "instructionVectorCharButLast"), - (instructionVectorCharLength, "instructionVectorCharLength"), - (instructionVectorCharReverse, "instructionVectorCharReverse"), - (instructionVectorCharPushAll, "instructionVectorCharPushAll"), - (instructionVectorCharMakeEmpty, "instructionVectorCharMakeEmpty"), - (instructionVectorCharIsEmpty, "instructionVectorCharIsEmpty"), - (instructionVectorCharIndexOf, "instructionVectorCharIndexOf"), - (instructionVectorCharOccurrencesOf, "instructionVectorCharOccurrencesOf"), - (instructionVectorCharSetNth, "instructionVectorCharSetNth"), - (instructionVectorCharReplace, "instructionVectorCharReplace"), - (instructionVectorCharReplaceFirst, "instructionVectorCharReplaceFirst"), - (instructionVectorCharRemove, "instructionVectorCharRemove"), - (instructionVectorCharIterate, "instructionVectorCharIterate"), - (instructionVectorCharPop, "instructionVectorCharPop"), - (instructionVectorCharDup, "instructionVectorCharDup"), - (instructionVectorCharDupN, "instructionVectorCharDupN"), - (instructionVectorCharSwap, "instructionVectorCharSwap"), - (instructionVectorCharRot, "instructionVectorCharRot"), - (instructionVectorCharFlush, "instructionVectorCharFlush"), - (instructionVectorCharEq, "instructionVectorCharEq"), - (instructionVectorCharStackDepth, "instructionVectorCharStackDepth"), - (instructionVectorCharYank, "instructionVectorCharYank"), - (instructionVectorCharYankDup, "instructionVectorCharYankDup"), - (instructionVectorCharShove, "instructionVectorCharShove"), - (instructionVectorCharShoveDup, "instructionVectorCharShoveDup"), - (instructionVectorCharIsStackEmpty, "instructionVectorCharIsStackEmpty"), - (instructionVectorCharSort, "instructionVectorCharSort"), - (instructionVectorCharSortReverse, "instructionVectorCharSortReverse"), - (instructionVectorCharDupItems, "instructionVectorCharDupItems") - ] +-- allVectorCharInstructions :: [Gene] +-- allVectorCharInstructions = map StateFunc [ +-- (instructionVectorCharConcat, "instructionVectorCharConcat"), +-- (instructionVectorCharConj, "instructionVectorCharConj"), +-- (instructionVectorCharTakeN, "instructionVectorCharTakeN"), +-- (instructionVectorCharSubVector, "instructionVectorCharSubVector"), +-- (instructionVectorCharFirst, "instructionVectorCharFirst"), +-- (instructionVectorCharLast, "instructionVectorCharLast"), +-- (instructionVectorCharNth, "instructionVectorCharNth"), +-- (instructionVectorCharRest, "instructionVectorCharRest"), +-- (instructionVectorCharButLast, "instructionVectorCharButLast"), +-- (instructionVectorCharLength, "instructionVectorCharLength"), +-- (instructionVectorCharReverse, "instructionVectorCharReverse"), +-- (instructionVectorCharPushAll, "instructionVectorCharPushAll"), +-- (instructionVectorCharMakeEmpty, "instructionVectorCharMakeEmpty"), +-- (instructionVectorCharIsEmpty, "instructionVectorCharIsEmpty"), +-- (instructionVectorCharIndexOf, "instructionVectorCharIndexOf"), +-- (instructionVectorCharOccurrencesOf, "instructionVectorCharOccurrencesOf"), +-- (instructionVectorCharSetNth, "instructionVectorCharSetNth"), +-- (instructionVectorCharReplace, "instructionVectorCharReplace"), +-- (instructionVectorCharReplaceFirst, "instructionVectorCharReplaceFirst"), +-- (instructionVectorCharRemove, "instructionVectorCharRemove"), +-- (instructionVectorCharIterate, "instructionVectorCharIterate"), +-- (instructionVectorCharPop, "instructionVectorCharPop"), +-- (instructionVectorCharDup, "instructionVectorCharDup"), +-- (instructionVectorCharDupN, "instructionVectorCharDupN"), +-- (instructionVectorCharSwap, "instructionVectorCharSwap"), +-- (instructionVectorCharRot, "instructionVectorCharRot"), +-- (instructionVectorCharFlush, "instructionVectorCharFlush"), +-- (instructionVectorCharEq, "instructionVectorCharEq"), +-- (instructionVectorCharStackDepth, "instructionVectorCharStackDepth"), +-- (instructionVectorCharYank, "instructionVectorCharYank"), +-- (instructionVectorCharYankDup, "instructionVectorCharYankDup"), +-- (instructionVectorCharShove, "instructionVectorCharShove"), +-- (instructionVectorCharShoveDup, "instructionVectorCharShoveDup"), +-- (instructionVectorCharIsStackEmpty, "instructionVectorCharIsStackEmpty"), +-- (instructionVectorCharSort, "instructionVectorCharSort"), +-- (instructionVectorCharSortReverse, "instructionVectorCharSortReverse"), +-- (instructionVectorCharDupItems, "instructionVectorCharDupItems") +-- ] -allVectorStringInstructions :: [Gene] -allVectorStringInstructions = map StateFunc [ - (instructionVectorStringConcat, "instructionVectorStringConcat"), - (instructionVectorStringConj, "instructionVectorStringConj"), - (instructionVectorStringTakeN, "instructionVectorStringTakeN"), - (instructionVectorStringSubVector, "instructionVectorStringSubVector"), - (instructionVectorStringFirst, "instructionVectorStringFirst"), - (instructionVectorStringLast, "instructionVectorStringLast"), - (instructionVectorStringNth, "instructionVectorStringNth"), - (instructionVectorStringRest, "instructionVectorStringRest"), - (instructionVectorStringButLast, "instructionVectorStringButLast"), - (instructionVectorStringLength, "instructionVectorStringLength"), - (instructionVectorStringReverse, "instructionVectorStringReverse"), - (instructionVectorStringPushAll, "instructionVectorStringPushAll"), - (instructionVectorStringMakeEmpty, "instructionVectorStringMakeEmpty"), - (instructionVectorStringIsEmpty, "instructionVectorStringIsEmpty"), - (instructionVectorStringIndexOf, "instructionVectorStringIndexOf"), - (instructionVectorStringOccurrencesOf, "instructionVectorStringOccurrencesOf"), - (instructionVectorStringSetNth, "instructionVectorStringSetNth"), - (instructionVectorStringReplace, "instructionVectorStringReplace"), - (instructionVectorStringReplaceFirst, "instructionVectorStringReplaceFirst"), - (instructionVectorStringRemove, "instructionVectorStringRemove"), - (instructionVectorStringIterate, "instructionVectorStringIterate"), - (instructionVectorStringPop, "instructionVectorStringPop"), - (instructionVectorStringDup, "instructionVectorStringDup"), - (instructionVectorStringDupN, "instructionVectorStringDupN"), - (instructionVectorStringSwap, "instructionVectorStringSwap"), - (instructionVectorStringRot, "instructionVectorStringRot"), - (instructionVectorStringFlush, "instructionVectorStringFlush"), - (instructionVectorStringEq, "instructionVectorStringEq"), - (instructionVectorStringStackDepth, "instructionVectorStringStackDepth"), - (instructionVectorStringYank, "instructionVectorStringYank"), - (instructionVectorStringYankDup, "instructionVectorStringYankDup"), - (instructionVectorStringShove, "instructionVectorStringShove"), - (instructionVectorStringShoveDup, "instructionVectorStringShoveDup"), - (instructionVectorStringIsStackEmpty, "instructionVectorStringIsStackEmpty"), - (instructionVectorStringSort, "instructionVectorStringSort"), - (instructionVectorStringSortReverse, "instructionVectorStringSortReverse"), - (instructionVectorStringDupItems, "instructionVectorStringDupItems") - ] +-- allVectorStringInstructions :: [Gene] +-- allVectorStringInstructions = map StateFunc [ +-- (instructionVectorStringConcat, "instructionVectorStringConcat"), +-- (instructionVectorStringConj, "instructionVectorStringConj"), +-- (instructionVectorStringTakeN, "instructionVectorStringTakeN"), +-- (instructionVectorStringSubVector, "instructionVectorStringSubVector"), +-- (instructionVectorStringFirst, "instructionVectorStringFirst"), +-- (instructionVectorStringLast, "instructionVectorStringLast"), +-- (instructionVectorStringNth, "instructionVectorStringNth"), +-- (instructionVectorStringRest, "instructionVectorStringRest"), +-- (instructionVectorStringButLast, "instructionVectorStringButLast"), +-- (instructionVectorStringLength, "instructionVectorStringLength"), +-- (instructionVectorStringReverse, "instructionVectorStringReverse"), +-- (instructionVectorStringPushAll, "instructionVectorStringPushAll"), +-- (instructionVectorStringMakeEmpty, "instructionVectorStringMakeEmpty"), +-- (instructionVectorStringIsEmpty, "instructionVectorStringIsEmpty"), +-- (instructionVectorStringIndexOf, "instructionVectorStringIndexOf"), +-- (instructionVectorStringOccurrencesOf, "instructionVectorStringOccurrencesOf"), +-- (instructionVectorStringSetNth, "instructionVectorStringSetNth"), +-- (instructionVectorStringReplace, "instructionVectorStringReplace"), +-- (instructionVectorStringReplaceFirst, "instructionVectorStringReplaceFirst"), +-- (instructionVectorStringRemove, "instructionVectorStringRemove"), +-- (instructionVectorStringIterate, "instructionVectorStringIterate"), +-- (instructionVectorStringPop, "instructionVectorStringPop"), +-- (instructionVectorStringDup, "instructionVectorStringDup"), +-- (instructionVectorStringDupN, "instructionVectorStringDupN"), +-- (instructionVectorStringSwap, "instructionVectorStringSwap"), +-- (instructionVectorStringRot, "instructionVectorStringRot"), +-- (instructionVectorStringFlush, "instructionVectorStringFlush"), +-- (instructionVectorStringEq, "instructionVectorStringEq"), +-- (instructionVectorStringStackDepth, "instructionVectorStringStackDepth"), +-- (instructionVectorStringYank, "instructionVectorStringYank"), +-- (instructionVectorStringYankDup, "instructionVectorStringYankDup"), +-- (instructionVectorStringShove, "instructionVectorStringShove"), +-- (instructionVectorStringShoveDup, "instructionVectorStringShoveDup"), +-- (instructionVectorStringIsStackEmpty, "instructionVectorStringIsStackEmpty"), +-- (instructionVectorStringSort, "instructionVectorStringSort"), +-- (instructionVectorStringSortReverse, "instructionVectorStringSortReverse"), +-- (instructionVectorStringDupItems, "instructionVectorStringDupItems") +-- ] -allVectorBoolInstructions :: [Gene] -allVectorBoolInstructions = map StateFunc [ - (instructionVectorBoolConcat, "instructionVectorBoolConcat"), - (instructionVectorBoolConj, "instructionVectorBoolConj"), - (instructionVectorBoolTakeN, "instructionVectorBoolTakeN"), - (instructionVectorBoolSubVector, "instructionVectorBoolSubVector"), - (instructionVectorBoolFirst, "instructionVectorBoolFirst"), - (instructionVectorBoolLast, "instructionVectorBoolLast"), - (instructionVectorBoolNth, "instructionVectorBoolNth"), - (instructionVectorBoolRest, "instructionVectorBoolRest"), - (instructionVectorBoolButLast, "instructionVectorBoolButLast"), - (instructionVectorBoolLength, "instructionVectorBoolLength"), - (instructionVectorBoolReverse, "instructionVectorBoolReverse"), - (instructionVectorBoolPushAll, "instructionVectorBoolPushAll"), - (instructionVectorBoolMakeEmpty, "instructionVectorBoolMakeEmpty"), - (instructionVectorBoolIsEmpty, "instructionVectorBoolIsEmpty"), - (instructionVectorBoolIndexOf, "instructionVectorBoolIndexOf"), - (instructionVectorBoolOccurrencesOf, "instructionVectorBoolOccurrencesOf"), - (instructionVectorBoolSetNth, "instructionVectorBoolSetNth"), - (instructionVectorBoolReplace, "instructionVectorBoolReplace"), - (instructionVectorBoolReplaceFirst, "instructionVectorBoolReplaceFirst"), - (instructionVectorBoolRemove, "instructionVectorBoolRemove"), - (instructionVectorBoolIterate, "instructionVectorBoolIterate"), - (instructionVectorBoolPop, "instructionVectorBoolPop"), - (instructionVectorBoolDup, "instructionVectorBoolDup"), - (instructionVectorBoolDupN, "instructionVectorBoolDupN"), - (instructionVectorBoolSwap, "instructionVectorBoolSwap"), - (instructionVectorBoolRot, "instructionVectorBoolRot"), - (instructionVectorBoolFlush, "instructionVectorBoolFlush"), - (instructionVectorBoolEq, "instructionVectorBoolEq"), - (instructionVectorBoolStackDepth, "instructionVectorBoolStackDepth"), - (instructionVectorBoolYank, "instructionVectorBoolYank"), - (instructionVectorBoolYankDup, "instructionVectorBoolYankDup"), - (instructionVectorBoolShove, "instructionVectorBoolShove"), - (instructionVectorBoolShoveDup, "instructionVectorBoolShoveDup"), - (instructionVectorBoolIsStackEmpty, "instructionVectorBoolIsStackEmpty"), - (instructionVectorBoolSort, "instructionVectorBoolSort"), - (instructionVectorBoolSortReverse, "instructionVectorBoolSortReverse"), - (instructionVectorBoolDupItems, "instructionVectorBoolDupItems") - ] +-- allVectorBoolInstructions :: [Gene] +-- allVectorBoolInstructions = map StateFunc [ +-- (instructionVectorBoolConcat, "instructionVectorBoolConcat"), +-- (instructionVectorBoolConj, "instructionVectorBoolConj"), +-- (instructionVectorBoolTakeN, "instructionVectorBoolTakeN"), +-- (instructionVectorBoolSubVector, "instructionVectorBoolSubVector"), +-- (instructionVectorBoolFirst, "instructionVectorBoolFirst"), +-- (instructionVectorBoolLast, "instructionVectorBoolLast"), +-- (instructionVectorBoolNth, "instructionVectorBoolNth"), +-- (instructionVectorBoolRest, "instructionVectorBoolRest"), +-- (instructionVectorBoolButLast, "instructionVectorBoolButLast"), +-- (instructionVectorBoolLength, "instructionVectorBoolLength"), +-- (instructionVectorBoolReverse, "instructionVectorBoolReverse"), +-- (instructionVectorBoolPushAll, "instructionVectorBoolPushAll"), +-- (instructionVectorBoolMakeEmpty, "instructionVectorBoolMakeEmpty"), +-- (instructionVectorBoolIsEmpty, "instructionVectorBoolIsEmpty"), +-- (instructionVectorBoolIndexOf, "instructionVectorBoolIndexOf"), +-- (instructionVectorBoolOccurrencesOf, "instructionVectorBoolOccurrencesOf"), +-- (instructionVectorBoolSetNth, "instructionVectorBoolSetNth"), +-- (instructionVectorBoolReplace, "instructionVectorBoolReplace"), +-- (instructionVectorBoolReplaceFirst, "instructionVectorBoolReplaceFirst"), +-- (instructionVectorBoolRemove, "instructionVectorBoolRemove"), +-- (instructionVectorBoolIterate, "instructionVectorBoolIterate"), +-- (instructionVectorBoolPop, "instructionVectorBoolPop"), +-- (instructionVectorBoolDup, "instructionVectorBoolDup"), +-- (instructionVectorBoolDupN, "instructionVectorBoolDupN"), +-- (instructionVectorBoolSwap, "instructionVectorBoolSwap"), +-- (instructionVectorBoolRot, "instructionVectorBoolRot"), +-- (instructionVectorBoolFlush, "instructionVectorBoolFlush"), +-- (instructionVectorBoolEq, "instructionVectorBoolEq"), +-- (instructionVectorBoolStackDepth, "instructionVectorBoolStackDepth"), +-- (instructionVectorBoolYank, "instructionVectorBoolYank"), +-- (instructionVectorBoolYankDup, "instructionVectorBoolYankDup"), +-- (instructionVectorBoolShove, "instructionVectorBoolShove"), +-- (instructionVectorBoolShoveDup, "instructionVectorBoolShoveDup"), +-- (instructionVectorBoolIsStackEmpty, "instructionVectorBoolIsStackEmpty"), +-- (instructionVectorBoolSort, "instructionVectorBoolSort"), +-- (instructionVectorBoolSortReverse, "instructionVectorBoolSortReverse"), +-- (instructionVectorBoolDupItems, "instructionVectorBoolDupItems") +-- ] -allInstructions :: [Gene] -allInstructions = - allIntInstructions <> - allFloatInstructions <> - allBoolInstructions <> - allCharInstructions <> - allCodeInstructions <> - allExecInstructions <> - allStringInstructions <> - allVectorIntInstructions <> - allVectorFloatInstructions <> - allVectorCharInstructions <> - allVectorStringInstructions <> - allVectorBoolInstructions +-- allInstructions :: [Gene] +-- allInstructions = +-- 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 index d6a96ae..c55f929 100644 --- a/src/HushGP/Instructions/BoolInstructions.hs +++ b/src/HushGP/Instructions/BoolInstructions.hs @@ -2,6 +2,7 @@ module HushGP.Instructions.BoolInstructions where import HushGP.State import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility -- |If top of int stack /= 0 pushes True to bool stack, else false. instructionBoolFromInt :: State -> State @@ -12,12 +13,6 @@ instructionBoolFromInt state = state instructionBoolFromFloat :: State -> State instructionBoolFromFloat state@(State {_float = f1 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 /= 0) : bs} instructionBoolFromFloat state = state - --- |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 - -- |Takes the top two bools and Ands them. instructionBoolAnd :: State -> State instructionBoolAnd = boolTemplate (&&) @@ -36,13 +31,6 @@ instructionBoolInvertSecondThenAnd state = state instructionBoolOr :: State -> State instructionBoolOr = boolTemplate (||) --- |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 - -- |Takes the xor of the top two bools. instructionBoolXor :: State -> State instructionBoolXor = boolTemplate xor diff --git a/src/HushGP/Instructions/CharInstructions.hs b/src/HushGP/Instructions/CharInstructions.hs index 902dc46..9c0d540 100644 --- a/src/HushGP/Instructions/CharInstructions.hs +++ b/src/HushGP/Instructions/CharInstructions.hs @@ -2,12 +2,8 @@ module HushGP.Instructions.CharInstructions where import Data.Char import HushGP.State -import HushGP.Instructions.StringInstructions (wschars) import HushGP.Instructions.GenericInstructions - --- |Converts a whole number `mod` 128 to a char. -intToAscii :: Integral a => a -> Char -intToAscii val = chr (abs (fromIntegral val) `mod` 128) +import HushGP.Instructions.Utility -- |Combines the top two chars into a string and pushes the result to the string stack. instructionCharConcat :: State -> State diff --git a/src/HushGP/Instructions/CodeInstructions.hs b/src/HushGP/Instructions/CodeInstructions.hs index 599619a..afe2d91 100644 --- a/src/HushGP/Instructions/CodeInstructions.hs +++ b/src/HushGP/Instructions/CodeInstructions.hs @@ -4,105 +4,9 @@ import Data.List (elemIndex) import HushGP.State import HushGP.Instructions.GenericInstructions import HushGP.Instructions.IntInstructions +import HushGP.Instructions.Utility -- import Debug.Trace --- |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 -> Int -blockLength (Block bxs) = 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 - | 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 -> Int -countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (length xs - 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 -> Int -codeRecursiveSize (Block bxs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- bxs] -codeRecursiveSize _ = 1 - -- |Pops the top of the code stack instructionCodePop :: State -> State instructionCodePop = instructionPop code diff --git a/src/HushGP/Instructions/FloatInstructions.hs b/src/HushGP/Instructions/FloatInstructions.hs index c7566a4..4f542fe 100644 --- a/src/HushGP/Instructions/FloatInstructions.hs +++ b/src/HushGP/Instructions/FloatInstructions.hs @@ -2,6 +2,7 @@ module HushGP.Instructions.FloatInstructions where import Data.Fixed (mod') import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility import HushGP.State import Data.Char diff --git a/src/HushGP/Instructions/GenericInstructions.hs b/src/HushGP/Instructions/GenericInstructions.hs index 31b8b7e..c754252 100644 --- a/src/HushGP/Instructions/GenericInstructions.hs +++ b/src/HushGP/Instructions/GenericInstructions.hs @@ -2,111 +2,13 @@ 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 --- |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 - -- |Duplicates the top of a stack based on a lens. instructionDup :: Lens' State [a] -> State -> State instructionDup accessor state = diff --git a/src/HushGP/Instructions/StringInstructions.hs b/src/HushGP/Instructions/StringInstructions.hs index 5f22327..cab2a5a 100644 --- a/src/HushGP/Instructions/StringInstructions.hs +++ b/src/HushGP/Instructions/StringInstructions.hs @@ -2,30 +2,9 @@ module HushGP.Instructions.StringInstructions where import HushGP.State import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility import Control.Lens --- |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 - -- |Concats the top two strings on the string stack and pushes the result. instructionStringConcat :: State -> State instructionStringConcat = instructionVectorConcat string diff --git a/src/HushGP/Instructions/Utility.hs b/src/HushGP/Instructions/Utility.hs new file mode 100644 index 0000000..31b0cb5 --- /dev/null +++ b/src/HushGP/Instructions/Utility.hs @@ -0,0 +1,249 @@ +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 + +-- 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 -> Int +blockLength (Block bxs) = 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 + | 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 -> Int +countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (length xs - 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 -> Int +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 diff --git a/src/HushGP/PushTests/UtilTests.hs b/src/HushGP/PushTests/UtilTests.hs index ea2ce60..4422001 100644 --- a/src/HushGP/PushTests/UtilTests.hs +++ b/src/HushGP/PushTests/UtilTests.hs @@ -1,6 +1,6 @@ module HushGP.PushTests.UtilTests where -import HushGP.Instructions.GenericInstructions +import HushGP.Instructions.Utility import Test.QuickCheck prop_DeleteAtTest :: Int -> [Int] -> Property