documentation, time to fix my sleep schedule

This commit is contained in:
Rowan Torbitzky-Lane 2025-02-07 17:55:12 -06:00
parent 9a3453ad5f
commit de18d828a9
6 changed files with 95 additions and 4 deletions

View File

@ -316,7 +316,8 @@ allStringInstructions = map StateFunc [
(instructionStringSort, "instructionStringSort"), (instructionStringSort, "instructionStringSort"),
(instructionStringSortReverse, "instructionStringSortReverse"), (instructionStringSortReverse, "instructionStringSortReverse"),
(instructionStringDupItems, "instructionStringDupItems"), (instructionStringDupItems, "instructionStringDupItems"),
(instructionStringParseToChar, "instructionStringParseToChar") (instructionStringParseToChar, "instructionStringParseToChar"),
(instructionStringSubString, "instructionStringSubString")
] ]
allVectorIntInstructions :: [Gene] allVectorIntInstructions :: [Gene]

View File

@ -3,80 +3,106 @@ module HushGP.Instructions.BoolInstructions where
import HushGP.State import HushGP.State
import HushGP.Instructions.GenericInstructions import HushGP.Instructions.GenericInstructions
-- |If top of int stack /= 0 pushes true to bool stack, else false
instructionBoolFromInt :: State -> State instructionBoolFromInt :: State -> State
instructionBoolFromInt state@(State {_int = i1 : is, _bool = bs}) = state {_int = is, _bool = (i1 /= 0) : bs} instructionBoolFromInt state@(State {_int = i1 : is, _bool = bs}) = state {_int = is, _bool = (i1 /= 0) : bs}
instructionBoolFromInt state = state instructionBoolFromInt state = state
-- |If top of float stack /= 0 pushes true to bool stack, else false
instructionBoolFromFloat :: State -> State instructionBoolFromFloat :: State -> State
instructionBoolFromFloat state@(State {_float = f1 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 /= 0) : bs} instructionBoolFromFloat state@(State {_float = f1 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 /= 0) : bs}
instructionBoolFromFloat state = state instructionBoolFromFloat state = state
-- |A template function to make bool comparisons concise
boolTemplate :: (Bool -> Bool -> Bool) -> State -> State boolTemplate :: (Bool -> Bool -> Bool) -> State -> State
boolTemplate func state@(State {_bool = b1 : b2 : bs}) = state {_bool = func b1 b2 : bs} boolTemplate func state@(State {_bool = b1 : b2 : bs}) = state {_bool = func b1 b2 : bs}
boolTemplate _ state = state boolTemplate _ state = state
-- |Takes the top two bools and ands them
instructionBoolAnd :: State -> State instructionBoolAnd :: State -> State
instructionBoolAnd = boolTemplate (&&) instructionBoolAnd = boolTemplate (&&)
-- |Takes the top two bools, inverts the first bool and then ands the modified state
instructionBoolInvertFirstThenAnd :: State -> State instructionBoolInvertFirstThenAnd :: State -> State
instructionBoolInvertFirstThenAnd state@(State {_bool = b1 : bs}) = boolTemplate (&&) state {_bool = not b1 : bs} instructionBoolInvertFirstThenAnd state@(State {_bool = b1 : bs}) = boolTemplate (&&) state {_bool = not b1 : bs}
instructionBoolInvertFirstThenAnd state = state instructionBoolInvertFirstThenAnd state = state
-- |Takes the top two bools, inverts the second bool and then ands the modified state
instructionBoolInvertSecondThenAnd :: State -> State instructionBoolInvertSecondThenAnd :: State -> State
instructionBoolInvertSecondThenAnd state@(State {_bool = b1 : b2 : bs}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs} instructionBoolInvertSecondThenAnd state@(State {_bool = b1 : b2 : bs}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs}
instructionBoolInvertSecondThenAnd state = state instructionBoolInvertSecondThenAnd state = state
-- |Takes the top two bools and ors them
instructionBoolOr :: State -> State instructionBoolOr :: State -> State
instructionBoolOr = boolTemplate (||) instructionBoolOr = boolTemplate (||)
-- no builtin haskell xor moment -- |Utility function. Haskell doesn't have its own xor operation.
xor :: Bool -> Bool -> Bool xor :: Bool -> Bool -> Bool
xor b1 b2 xor b1 b2
| b1 && not b2 = True | b1 && not b2 = True
| not b1 && b2 = True | not b1 && b2 = True
| otherwise = False | otherwise = False
-- |Takes the xor of the top two bools
instructionBoolXor :: State -> State instructionBoolXor :: State -> State
instructionBoolXor = boolTemplate xor instructionBoolXor = boolTemplate xor
-- |Pops the top of the bool stack
instructionBoolPop :: State -> State instructionBoolPop :: State -> State
instructionBoolPop = instructionPop bool instructionBoolPop = instructionPop bool
-- |Duplicates the top of the bool stack
instructionBoolDup :: State -> State instructionBoolDup :: State -> State
instructionBoolDup = instructionDup bool instructionBoolDup = instructionDup bool
-- |Duplicates the top of the bool stack based on the top int from the int stack
instructionBoolDupN :: State -> State instructionBoolDupN :: State -> State
instructionBoolDupN = instructionDupN bool instructionBoolDupN = instructionDupN bool
-- |Swaps the top two bools
instructionBoolSwap :: State -> State instructionBoolSwap :: State -> State
instructionBoolSwap = instructionSwap bool instructionBoolSwap = instructionSwap bool
-- |Rotates the top three bools
instructionBoolRot :: State -> State instructionBoolRot :: State -> State
instructionBoolRot = instructionRot bool instructionBoolRot = instructionRot bool
-- |Sets the bool stack to []
instructionBoolFlush :: State -> State instructionBoolFlush :: State -> State
instructionBoolFlush = instructionFlush bool instructionBoolFlush = instructionFlush bool
-- |Tests if the top two bools are equal and pushes the result to the bool stack
instructionBoolEq :: State -> State instructionBoolEq :: State -> State
instructionBoolEq = instructionEq bool instructionBoolEq = instructionEq bool
-- |Calculates the size of a stack and pushes the result to the int stack
instructionBoolStackDepth :: State -> State instructionBoolStackDepth :: State -> State
instructionBoolStackDepth = instructionStackDepth bool 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 :: State -> State
instructionBoolYank = instructionYank bool 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 :: State -> State
instructionBoolYankDup = instructionYankDup bool 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 :: State -> State
instructionBoolShove = instructionShove bool 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 :: State -> State
instructionBoolShoveDup = instructionShoveDup bool instructionBoolShoveDup = instructionShoveDup bool
-- |If the bool stack is empty, pushes true to bool stack, else false
instructionBoolIsStackEmpty :: State -> State instructionBoolIsStackEmpty :: State -> State
instructionBoolIsStackEmpty = instructionIsStackEmpty bool 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 :: State -> State
instructionBoolDupItems = instructionDupItems bool instructionBoolDupItems = instructionDupItems bool

View File

@ -5,88 +5,129 @@ import HushGP.State
import HushGP.Instructions.StringInstructions (wschars) import HushGP.Instructions.StringInstructions (wschars)
import HushGP.Instructions.GenericInstructions import HushGP.Instructions.GenericInstructions
-- |Converts a whole number `mod` 128 to a char
intToAscii :: Integral a => a -> Char intToAscii :: Integral a => a -> Char
intToAscii val = chr (abs (fromIntegral val) `mod` 128) 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
instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state{_char = cs, _string = [c1, c2] : ss} instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state{_char = cs, _string = [c1, c2] : ss}
instructionCharConcat state = state 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 :: State -> State
instructionCharFromFirstChar = instructionVectorFirst char string 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 :: State -> State
instructionCharFromLastChar = instructionVectorLast char string 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 :: State -> State
instructionCharFromNthChar = instructionVectorNth char string 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
instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs} instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs}
instructionCharIsWhitespace state = state 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
instructionCharIsLetter state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isAlpha c1 : bs} instructionCharIsLetter state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isAlpha c1 : bs}
instructionCharIsLetter state = state 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
instructionCharIsDigit state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isDigit c1 : bs} instructionCharIsDigit state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isDigit c1 : bs}
instructionCharIsDigit state = state 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
instructionCharFromBool state@(State {_char = cs, _bool = b1 : bs}) = state{_char = (if b1 then 'T' else 'F') : cs, _bool = bs} instructionCharFromBool state@(State {_char = cs, _bool = b1 : bs}) = state{_char = (if b1 then 'T' else 'F') : cs, _bool = bs}
instructionCharFromBool state = state 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
instructionCharFromAsciiInt state@(State {_char = cs, _int = i1 : is}) = state{_char = intToAscii i1 : cs, _int = is} instructionCharFromAsciiInt state@(State {_char = cs, _int = i1 : is}) = state{_char = intToAscii i1 : cs, _int = is}
instructionCharFromAsciiInt state = state 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
instructionCharFromAsciiFloat state@(State {_char = cs, _float = f1 : fs}) = state{_char = intToAscii @Integer (floor f1) : cs, _float = fs} instructionCharFromAsciiFloat state@(State {_char = cs, _float = f1 : fs}) = state{_char = intToAscii @Integer (floor f1) : cs, _float = fs}
instructionCharFromAsciiFloat state = state 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
instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss} instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss}
instructionCharsFromString state = state instructionCharsFromString state = state
-- |Pops the top of the char stack
instructionCharPop :: State -> State instructionCharPop :: State -> State
instructionCharPop = instructionPop char instructionCharPop = instructionPop char
-- |Duplicates the top of the char stack
instructionCharDup :: State -> State instructionCharDup :: State -> State
instructionCharDup = instructionDup char instructionCharDup = instructionDup char
-- |Duplicates the top of the char stack N times based on the top of
-- int stack
instructionCharDupN :: State -> State instructionCharDupN :: State -> State
instructionCharDupN = instructionDupN char instructionCharDupN = instructionDupN char
-- |Swaps the top two chars of the char stack.
instructionCharSwap :: State -> State instructionCharSwap :: State -> State
instructionCharSwap = instructionSwap char instructionCharSwap = instructionSwap char
-- |Rotates the top three chars of the char stack
instructionCharRot :: State -> State instructionCharRot :: State -> State
instructionCharRot = instructionRot char instructionCharRot = instructionRot char
-- |Sets the char stack to []
instructionCharFlush :: State -> State instructionCharFlush :: State -> State
instructionCharFlush = instructionFlush char 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 :: State -> State
instructionCharEq = instructionEq char instructionCharEq = instructionEq char
-- |Calculates the stack depth of the char stack. Pushes the result
-- to the int stack.
instructionCharStackDepth :: State -> State instructionCharStackDepth :: State -> State
instructionCharStackDepth = instructionStackDepth char 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 :: State -> State
instructionCharYank = instructionYank char 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 :: State -> State
instructionCharYankDup = instructionYankDup char instructionCharYankDup = instructionYankDup char
-- |Pushes the size of the char stack to the int stack
instructionCharIsStackEmpty :: State -> State instructionCharIsStackEmpty :: State -> State
instructionCharIsStackEmpty = instructionIsStackEmpty char 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 :: State -> State
instructionCharShove = instructionShove char 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 :: State -> State
instructionCharShoveDup = instructionShoveDup char 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 :: State -> State
instructionCharDupItems = instructionDupItems char instructionCharDupItems = instructionDupItems char

View File

@ -6,18 +6,25 @@ import HushGP.Instructions.GenericInstructions
import HushGP.Instructions.IntInstructions import HushGP.Instructions.IntInstructions
-- import Debug.Trace -- 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 :: Gene -> Bool
isBlock (Block _) = True isBlock (Block _) = True
isBlock _ = False isBlock _ = False
-- |Utility function: Returns the length of the passed block.
-- If the gene isn't a block, returns 1
blockLength :: Gene -> Int blockLength :: Gene -> Int
blockLength (Block bxs) = length bxs blockLength (Block bxs) = length bxs
blockLength _ = 1 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 :: Gene -> Bool
blockIsNull (Block bxs) = null bxs blockIsNull (Block bxs) = null bxs
blockIsNull _ = False blockIsNull _ = False
-- |Utility Function: A helper function for instructionCodeContainer. The full description is there.
-- https://faculty.hampshire.edu/lspector/push3-description.html#Type -- https://faculty.hampshire.edu/lspector/push3-description.html#Type
-- CODE.CONTAINER -- CODE.CONTAINER
findContainer :: Gene -> Gene -> Gene findContainer :: Gene -> Gene -> Gene
@ -33,6 +40,7 @@ findContainer (Block fullA) gene
findContainer' _ _ = Block [] -- This should never happen findContainer' _ _ = Block [] -- This should never happen
findContainer _ _ = Block [] findContainer _ _ = Block []
-- |Utility Function: A helper function for instructionCodeDiscrepancy. The full description is there.
countDiscrepancy :: Gene -> Gene -> Int 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 (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 countDiscrepancy xgene ygene = if xgene == ygene then 1 else 0
@ -333,10 +341,22 @@ instructionCodeFromVectorChar = instructionCodeFrom vectorChar GeneVectorChar
instructionCodeFromExec :: State -> State instructionCodeFromExec :: State -> State
instructionCodeFromExec = instructionCodeFrom exec id 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
instructionCodeContainer state@(State {_code = c1 : c2 : cs}) = state {_code = findContainer c1 c2 : cs} instructionCodeContainer state@(State {_code = c1 : c2 : cs}) = state {_code = findContainer c1 c2 : cs}
instructionCodeContainer state = state 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
instructionCodeDiscrepancy state@(State {_code = c1 : c2 : cs, _int = is}) = state {_code = cs, _int = countDiscrepancy c1 c2 : is} instructionCodeDiscrepancy state@(State {_code = c1 : c2 : cs, _int = is}) = state {_code = cs, _int = countDiscrepancy c1 c2 : is}
instructionCodeDiscrepancy state = state instructionCodeDiscrepancy state = state

View File

@ -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)) (Just (v1, vs), Just (p1, ps)) -> (state & vectorAccessor .~ vs & primAccessor .~ ps) & int .~ (amtOccurences v1 [p1] : view int (state & vectorAccessor .~ vs & primAccessor .~ ps))
_ -> state _ -> state
-- | This function parses the primitives of a vector type and pushes split up onto their -- | This function parses the primitives of a vector type and pushes that vector split into
-- respective stack -- lists of size one onto the respective vector stack.
instructionVectorParseToPrim :: Lens' State [[a]] -> State -> State instructionVectorParseToPrim :: Lens' State [[a]] -> State -> State
instructionVectorParseToPrim accessor state = instructionVectorParseToPrim accessor state =
case uncons (view accessor state) of case uncons (view accessor state) of

View File

@ -244,3 +244,6 @@ instructionStringDupItems = instructionDupItems string
instructionStringParseToChar :: State -> State instructionStringParseToChar :: State -> State
instructionStringParseToChar = instructionVectorParseToPrim string instructionStringParseToChar = instructionVectorParseToPrim string
instructionStringSubString :: State -> State
instructionStringSubString = instructionSubVector string