diff --git a/src/HushGP/Instructions.hs b/src/HushGP/Instructions.hs index b2b4a99..2e4d6a1 100644 --- a/src/HushGP/Instructions.hs +++ b/src/HushGP/Instructions.hs @@ -316,7 +316,8 @@ allStringInstructions = map StateFunc [ (instructionStringSort, "instructionStringSort"), (instructionStringSortReverse, "instructionStringSortReverse"), (instructionStringDupItems, "instructionStringDupItems"), - (instructionStringParseToChar, "instructionStringParseToChar") + (instructionStringParseToChar, "instructionStringParseToChar"), + (instructionStringSubString, "instructionStringSubString") ] allVectorIntInstructions :: [Gene] diff --git a/src/HushGP/Instructions/BoolInstructions.hs b/src/HushGP/Instructions/BoolInstructions.hs index 2d55641..e77eb07 100644 --- a/src/HushGP/Instructions/BoolInstructions.hs +++ b/src/HushGP/Instructions/BoolInstructions.hs @@ -3,80 +3,106 @@ module HushGP.Instructions.BoolInstructions where import HushGP.State import HushGP.Instructions.GenericInstructions +-- |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 +-- |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 (&&) +-- |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 (||) --- no builtin haskell xor moment +-- |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 +-- |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 diff --git a/src/HushGP/Instructions/CharInstructions.hs b/src/HushGP/Instructions/CharInstructions.hs index 79c0e00..42d9153 100644 --- a/src/HushGP/Instructions/CharInstructions.hs +++ b/src/HushGP/Instructions/CharInstructions.hs @@ -5,88 +5,129 @@ 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) +-- |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'] 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 the size of the char stack to the int stack 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 diff --git a/src/HushGP/Instructions/CodeInstructions.hs b/src/HushGP/Instructions/CodeInstructions.hs index 016cafe..c5cc085 100644 --- a/src/HushGP/Instructions/CodeInstructions.hs +++ b/src/HushGP/Instructions/CodeInstructions.hs @@ -6,18 +6,25 @@ import HushGP.Instructions.GenericInstructions import HushGP.Instructions.IntInstructions -- 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 @@ -33,6 +40,7 @@ findContainer (Block fullA) gene 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 @@ -333,10 +341,22 @@ instructionCodeFromVectorChar = instructionCodeFrom vectorChar GeneVectorChar 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 diff --git a/src/HushGP/Instructions/GenericInstructions.hs b/src/HushGP/Instructions/GenericInstructions.hs index d529ead..09026f4 100644 --- a/src/HushGP/Instructions/GenericInstructions.hs +++ b/src/HushGP/Instructions/GenericInstructions.hs @@ -315,8 +315,8 @@ instructionVectorOccurrencesOf primAccessor vectorAccessor state = (Just (v1, vs), Just (p1, ps)) -> (state & vectorAccessor .~ vs & primAccessor .~ ps) & int .~ (amtOccurences v1 [p1] : view int (state & vectorAccessor .~ vs & primAccessor .~ ps)) _ -> state --- | This function parses the primitives of a vector type and pushes split up onto their --- respective stack +-- | This function parses the primitives of a vector type and pushes that vector split into +-- lists of size one onto the respective vector stack. instructionVectorParseToPrim :: Lens' State [[a]] -> State -> State instructionVectorParseToPrim accessor state = case uncons (view accessor state) of diff --git a/src/HushGP/Instructions/StringInstructions.hs b/src/HushGP/Instructions/StringInstructions.hs index e32df23..cd241f1 100644 --- a/src/HushGP/Instructions/StringInstructions.hs +++ b/src/HushGP/Instructions/StringInstructions.hs @@ -244,3 +244,6 @@ instructionStringDupItems = instructionDupItems string instructionStringParseToChar :: State -> State instructionStringParseToChar = instructionVectorParseToPrim string + +instructionStringSubString :: State -> State +instructionStringSubString = instructionSubVector string