documentation, time to fix my sleep schedule
This commit is contained in:
parent
9a3453ad5f
commit
de18d828a9
@ -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]
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user