more instructions/knocking off the TODO

TODO.md

@@ -3,7 +3,7 @@
 ## Push Language TODO
 
 - [ ] Make all vector functions applicable to string functions and vice versa
-- [ ] Implement all functions as seen in propeller
+- [X] Implement all functions as seen in propeller
 - [X] Implement all functions as seen in the specification
 - [ ] Implement Linear Algebra functions as specified in the previous papers
 - [X] Add a function to sort a vector forward and backwards
@@ -12,7 +12,7 @@
 - [X] Make int yank, shove, yankdup, and shovedup generic
 - [ ] Write hackage documentation for each function
 - [ ] Refactor all functions to take state as the final parameter
-- [ ] Standardize the pattern matching parameters
+- [ ] Standardize the pattern matching parameter names, such as c1 : cs
 - [ ] Write unit/quickcheck tests for all of the instructions
 
 ## PushGP TODO

src/HushGP/Instructions.hs

@@ -70,7 +70,10 @@ allIntInstructions = map StateFunc [
     (instructionIntYank, "instructionIntYank"),
     (instructionIntYankDup, "instructionIntYankDup"),
     (instructionIntShove, "instructionIntShove"),
-    (instructionIntIsEmpty, "instructionIntIsEmpty")
+    (instructionIntIsEmpty, "instructionIntIsEmpty"),
+    (instructionIntFromChar, "instructionIntFromChar"),
+    (instructionIntFromString, "instructionIntFromString"),
+    (instructionIntDupItems, "instructionIntDupItems")
   ]
 
 allFloatInstructions :: [Gene]
@@ -100,7 +103,10 @@ allFloatInstructions = map StateFunc [
     (instructionFloatYank, "instructionFloatYank"),
     (instructionFloatYankDup, "instructionFloatYankDup"),
     (instructionFloatShove, "instructionFloatShove"),
-    (instructionFloatIsEmpty, "instructionFloatIsEmpty")
+    (instructionFloatIsEmpty, "instructionFloatIsEmpty"),
+    (instructionFloatFromChar, "instructionFloatFromChar"),
+    (instructionFloatFromString, "instructionFloatFromString"),
+    (instructionFloatDupItems, "instructionFloatDupItems")
   ]
 
 allBoolInstructions :: [Gene]
@@ -124,7 +130,8 @@ allBoolInstructions = map StateFunc [
     (instructionBoolYankDup, "instructionBoolYankDup"),
     (instructionBoolShove, "instructionBoolShove"),
     (instructionBoolShoveDup, "instructionBoolShoveDup"),
-    (instructionBoolIsEmpty, "instructionBoolIsEmpty")
+    (instructionBoolIsEmpty, "instructionBoolIsEmpty"),
+    (instructionBoolDupItems, "instructionBoolDupItems")
   ]
 
 allCharInstructions :: [Gene]
@@ -152,7 +159,8 @@ allCharInstructions = map StateFunc [
     (instructionCharYankDup, "instructionCharYankDup"),
     (instructionCharShove, "instructionCharShove"),
     (instructionCharShoveDup, "instructionCharShoveDup"),
-    (instructionCharIsEmpty, "instructionCharIsEmpty")  
+    (instructionCharIsEmpty, "instructionCharIsEmpty"),
+    (instructionCharDupItems, "instructionCharDupItems")
   ]
 
 allCodeInstructions :: [Gene]
@@ -213,7 +221,8 @@ allCodeInstructions = map StateFunc [
     (instructionCodeContainer, "instructionCodeContainer"),
     (instructionCodeDiscrepancy, "instructionCodeDiscrepancy"),
     (instructionCodeNoOp, "instructionCodeNoOp"),
-    (instructionCodeTailN, "instructionCodeTailN")
+    (instructionCodeTailN, "instructionCodeTailN"),
+    (instructionCodeDupItems, "instructionCodeDupItems")
   ]
 
 allExecInstructions :: [Gene]
@@ -240,7 +249,8 @@ allExecInstructions = map StateFunc [
     (instructionExecWhen, "instructionExecWhen"),
     (instructionExecK, "instructionExecK"),
     (instructionExecS, "instructionExecS"),
-    (instructionExecY, "instrucitonExecY")
+    (instructionExecY, "instrucitonExecY"),
+    (instructionExecDupItems, "instructionExecDupItems")
   ]
 
 allStringInstructions :: [Gene]
@@ -302,7 +312,11 @@ allStringInstructions = map StateFunc [
     (instructionStringYankDup, "instructionStringYankDup"),
     (instructionStringShove, "instructionStringShove"),
     (instructionStringShoveDup, "instructionStringShoveDup"),
-    (instructionStringIsEmpty, "instructionStringIsEmpty")
+    (instructionStringIsEmpty, "instructionStringIsEmpty"),
+    (instructionStringSort, "instructionStringSort"),
+    (instructionStringSortReverse, "instructionStringSortReverse"),
+    (instructionStringDupItems, "instructionStringDupItems"),
+    (instructionStringParseToChar, "instructionStringParseToChar")
   ]
 
 allVectorIntInstructions :: [Gene]
@@ -340,7 +354,10 @@ allVectorIntInstructions = map StateFunc [
     (instructionVectorIntYankDup, "instructionVectorIntYankDup"),
     (instructionVectorIntShove, "instructionVectorIntShove"),
     (instructionVectorIntShoveDup, "instructionVectorIntShoveDup"),
-    (instructionVectorIntStackIsEmpty, "instructionVectorIntStackIsEmpty")
+    (instructionVectorIntStackIsEmpty, "instructionVectorIntStackIsEmpty"),
+    (instructionVectorIntSort, "instructionVectorIntSort"),
+    (instructionVectorIntSortReverse, "instructionVectorIntSortReverse"),
+    (instructionVectorIntDupItems, "instructionVectorIntDupItems")
   ]
 
 allVectorFloatInstructions :: [Gene]
@@ -378,7 +395,10 @@ allVectorFloatInstructions = map StateFunc [
     (instructionVectorFloatYankDup, "instructionVectorFloatYankDup"),
     (instructionVectorFloatShove, "instructionVectorFloatShove"),
     (instructionVectorFloatShoveDup, "instructionVectorFloatShoveDup"),
-    (instructionVectorFloatStackIsEmpty, "instructionVectorFloatStackIsEmpty")
+    (instructionVectorFloatStackIsEmpty, "instructionVectorFloatStackIsEmpty"),
+    (instructionVectorFloatSort, "instructionVectorFloatSort"),
+    (instructionVectorFloatSortReverse, "instructionVectorFloatSortReverse"),
+    (instructionVectorFloatDupItems, "instructionVectorFloatDupItems")
   ]
 
 allVectorCharInstructions :: [Gene]
@@ -416,7 +436,10 @@ allVectorCharInstructions = map StateFunc [
     (instructionVectorCharYankDup, "instructionVectorCharYankDup"),
     (instructionVectorCharShove, "instructionVectorCharShove"),
     (instructionVectorCharShoveDup, "instructionVectorCharShoveDup"),
-    (instructionVectorCharStackIsEmpty, "instructionVectorCharStackIsEmpty")
+    (instructionVectorCharStackIsEmpty, "instructionVectorCharStackIsEmpty"),
+    (instructionVectorCharSort, "instructionVectorCharSort"),
+    (instructionVectorCharSortReverse, "instructionVectorCharSortReverse"),
+    (instructionVectorCharDupItems, "instructionVectorCharDupItems")
   ]
 
 allVectorStringInstructions :: [Gene]
@@ -454,7 +477,10 @@ allVectorStringInstructions = map StateFunc [
     (instructionVectorStringYankDup, "instructionVectorStringYankDup"),
     (instructionVectorStringShove, "instructionVectorStringShove"),
     (instructionVectorStringShoveDup, "instructionVectorStringShoveDup"),
-    (instructionVectorStringStackIsEmpty, "instructionVectorStringStackIsEmpty")
+    (instructionVectorStringStackIsEmpty, "instructionVectorStringStackIsEmpty"),
+    (instructionVectorStringSort, "instructionVectorStringSort"),
+    (instructionVectorStringSortReverse, "instructionVectorStringSortReverse"),
+    (instructionVectorStringDupItems, "instructionVectorStringDupItems")
   ]
 
 allVectorBoolInstructions :: [Gene]
@@ -492,7 +518,10 @@ allVectorBoolInstructions = map StateFunc [
     (instructionVectorBoolYankDup, "instructionVectorBoolYankDup"),
     (instructionVectorBoolShove, "instructionVectorBoolShove"),
     (instructionVectorBoolShoveDup, "instructionVectorBoolShoveDup"),
-    (instructionVectorBoolStackIsEmpty, "instructionVectorBoolStackIsEmpty")
+    (instructionVectorBoolStackIsEmpty, "instructionVectorBoolStackIsEmpty"),
+    (instructionVectorBoolSort, "instructionVectorBoolSort"),
+    (instructionVectorBoolSortReverse, "instructionVectorBoolSortReverse"),
+    (instructionVectorBoolDupItems, "instructionVectorBoolDupItems")
   ]
 
 allInstructions :: [Gene]

src/HushGP/Instructions/BoolInstructions.hs

@@ -77,3 +77,6 @@ instructionBoolShoveDup state = instructionShoveDup state bool
 
 instructionBoolIsEmpty :: State -> State
 instructionBoolIsEmpty state = instructionIsEmpty state bool
+
+instructionBoolDupItems :: State -> State
+instructionBoolDupItems = instructionDupItems bool

src/HushGP/Instructions/CharInstructions.hs

@@ -87,3 +87,6 @@ instructionCharShove state = instructionShove state char
 
 instructionCharShoveDup :: State -> State
 instructionCharShoveDup state = instructionShoveDup state char
+
+instructionCharDupItems :: State -> State
+instructionCharDupItems = instructionDupItems char

src/HushGP/Instructions/CodeInstructions.hs

@@ -346,3 +346,6 @@ instructionCodeDiscrepancy state = state
 
 instructionCodeNoOp :: State -> State
 instructionCodeNoOp state = state
+
+instructionCodeDupItems :: State -> State
+instructionCodeDupItems = instructionDupItems code

src/HushGP/Instructions/ExecInstructions.hs

@@ -119,3 +119,6 @@ instructionExecS state = state
 instructionExecY :: State -> State
 instructionExecY state@(State {_exec = e1 : es}) = state{_exec = e1 : Block [StateFunc (instructionExecY, "instructionExecY"), e1] : es}
 instructionExecY state = state
+
+instructionExecDupItems :: State -> State
+instructionExecDupItems = instructionDupItems exec

src/HushGP/Instructions/FloatInstructions.hs

@@ -3,6 +3,7 @@ module HushGP.Instructions.FloatInstructions where
 import Data.Fixed (mod')
 import HushGP.Instructions.GenericInstructions
 import HushGP.State
+import Data.Char
 
 instructionFloatFromInt :: State -> State
 instructionFloatFromInt state@(State {_float = fs, _int = (i : is)}) = state {_float = (fromIntegral i :: Float) : fs, _int = is}
@@ -12,6 +13,17 @@ instructionFloatFromBool :: State -> State
 instructionFloatFromBool state@(State {_bool = (b : bs), _float = fs}) = state {_bool = bs, _float = (if b then 1.0 else 0.0) : fs}
 instructionFloatFromBool state = state
 
+instructionFloatFromChar :: State -> State
+instructionFloatFromChar state@(State {_char = c : cs, _float = fs}) = state {_char = cs, _float = (fromIntegral (ord c) :: Float) : fs}
+instructionFloatFromChar state = state
+
+instructionFloatFromString :: State -> State
+instructionFloatFromString state@(State {_string = s1 : ss, _float = fs}) =
+  if all isDigit s1
+  then state{_string = ss, _float = read @Float s1 : fs}
+  else state
+instructionFloatFromString state = state
+
 instructionFloatAdd :: State -> State
 instructionFloatAdd state@(State {_float = (f1 : f2 : fs)}) = state {_float = f2 + f1 : fs}
 instructionFloatAdd state = state
@@ -114,3 +126,6 @@ instructionFloatCos state = state
 instructionFloatTan :: State -> State
 instructionFloatTan state@(State {_float = f1 : fs}) = state {_float = tan f1 : fs}
 instructionFloatTan state = state
+
+instructionFloatDupItems :: State -> State
+instructionFloatDupItems = instructionDupItems float

src/HushGP/Instructions/GenericInstructions.hs

@@ -4,6 +4,7 @@ import Control.Lens
 import HushGP.State
 import Data.List (sort, sortBy)
 import Data.Ord
+import Data.List.Split
 
 -- import Debug.Trace 
 
@@ -103,7 +104,7 @@ instructionIsEmpty state@(State {_bool = bs}) accessor = state{_bool = null (vie
 
 -- I might be able to move some of the int stack error checking
 -- to the integer call. For now this may be a tad inefficient.
-instructionDupN :: forall a. Show a => State -> Lens' State [a] -> State
+instructionDupN :: forall a. State -> Lens' State [a] -> State
 instructionDupN state accessor = 
   case uncons (view int state) of
     Just (i1,is) ->
@@ -119,6 +120,15 @@ instructionDupN state accessor =
       then instructionDupNHelper (count - 1) instruction internalAccessor (internalState & accessor .~ (instruction : view accessor internalState))
       else internalState
 
+-- |Duplicates the top N items on a stack. If n <= 0 nothing happens
+-- TODO: Will need to implement a max stack items at some point
+instructionDupItems :: Lens' State [a] -> State -> State
+instructionDupItems accessor state@(State {_int = i1 : is}) =
+  if i1 <= 0
+  then state{_int = is}
+  else state{_int = is} & accessor .~ (take i1 (view accessor state{_int = is}) <> view accessor state{_int = is})
+instructionDupItems _ state = state
+
 instructionSwap :: State -> Lens' State [a] -> State
 instructionSwap state accessor =
   state & accessor .~ swapper (view accessor state)
@@ -207,6 +217,12 @@ instructionConj state primAccessor vectorAccessor =
     (Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((p1 : v1) : vs)
     _ -> state
 
+instructionConjEnd :: Lens' State [a] -> Lens' State [[a]] -> State -> State
+instructionConjEnd primAccessor vectorAccessor state = 
+  case (uncons (view primAccessor state), uncons (view vectorAccessor state)) of
+    (Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((v1 <> [p1]) : vs)
+    _ -> state
+
 -- v for vector, vs for vectorstack (also applicable to strings)
 -- Could abstract this unconsing even further in all functions below
 instructionTakeN :: State -> Lens' State [[a]] -> State
@@ -306,6 +322,14 @@ instructionVectorOccurrencesOf state primAccessor vectorAccessor =
     (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
+instructionVectorParseToPrim :: Lens' State [[a]] -> State -> State
+instructionVectorParseToPrim accessor state =
+  case uncons (view accessor state) of
+    Just (x1, xs) -> state & accessor .~ (chunksOf 1 x1 <> xs)
+    _ -> state
+
 instructionVectorSetNth :: State -> Lens' State [a] -> Lens' State [[a]] -> State
 instructionVectorSetNth state@(State {_int = i1 : is}) primAccessor vectorAccessor =
   case (uncons (view vectorAccessor state{_int = is}), uncons (view primAccessor state{_int = is})) of

src/HushGP/Instructions/IntInstructions.hs

@@ -2,6 +2,7 @@ module HushGP.Instructions.IntInstructions where
 
 import HushGP.State
 import HushGP.Instructions.GenericInstructions
+import Data.Char
 -- import Debug.Trace
 
 instructionIntFromFloat :: State -> State
@@ -12,6 +13,17 @@ instructionIntFromBool :: State -> State
 instructionIntFromBool state@(State {_bool = (b : bs), _int = is}) = state {_bool = bs, _int = (if b then 1 else 0) : is}
 instructionIntFromBool state = state
 
+instructionIntFromChar :: State -> State
+instructionIntFromChar state@(State {_char = c : cs, _int = is}) = state {_char = cs, _int = ord c : is}
+instructionIntFromChar state = state
+
+instructionIntFromString :: State -> State
+instructionIntFromString state@(State {_string = s1 : ss, _int = is}) =
+  if all isDigit s1
+  then state{_string = ss, _int = read @Int s1 : is}
+  else state
+instructionIntFromString state = state
+
 instructionIntAdd :: State -> State
 instructionIntAdd state@(State {_int = (i1 : i2 : is)}) = state {_int = i2 + i1 : is}
 instructionIntAdd state = state
@@ -102,3 +114,6 @@ instructionIntShoveDup state = instructionShoveDup state int
 
 instructionIntIsEmpty :: State -> State
 instructionIntIsEmpty state = instructionIsEmpty state int
+
+instructionIntDupItems :: State -> State
+instructionIntDupItems = instructionDupItems int

src/HushGP/Instructions/StringInstructions.hs

@@ -140,6 +140,9 @@ instructionStringTail state = state
 instructionStringAppendChar :: State -> State
 instructionStringAppendChar state = instructionConj state char string
 
+instructionStringConjEndChar :: State -> State
+instructionStringConjEndChar = instructionConjEnd char string
+
 instructionStringRest :: State -> State
 instructionStringRest state = instructionRest state string
 
@@ -229,3 +232,15 @@ instructionStringShove state = instructionShove state string
 
 instructionStringShoveDup :: State -> State
 instructionStringShoveDup state = instructionShoveDup state string
+
+instructionStringSort :: State -> State
+instructionStringSort = instructionVectorSort string
+
+instructionStringSortReverse :: State -> State
+instructionStringSortReverse = instructionVectorSortReverse string
+
+instructionStringDupItems :: State -> State
+instructionStringDupItems = instructionDupItems string
+
+instructionStringParseToChar :: State -> State
+instructionStringParseToChar = instructionVectorParseToPrim string

src/HushGP/Instructions/VectorBoolInstructions.hs

@@ -104,3 +104,12 @@ instructionVectorBoolShove state = instructionShove state vectorBool
 
 instructionVectorBoolShoveDup :: State -> State
 instructionVectorBoolShoveDup state = instructionShoveDup state vectorBool
+
+instructionVectorBoolSort :: State -> State
+instructionVectorBoolSort = instructionVectorSort vectorBool
+
+instructionVectorBoolSortReverse :: State -> State
+instructionVectorBoolSortReverse = instructionVectorSortReverse vectorBool
+
+instructionVectorBoolDupItems :: State -> State
+instructionVectorBoolDupItems = instructionDupItems vectorBool

src/HushGP/Instructions/VectorCharInstructions.hs

@@ -104,3 +104,12 @@ instructionVectorCharShove state = instructionShove state vectorChar
 
 instructionVectorCharShoveDup :: State -> State
 instructionVectorCharShoveDup state = instructionShoveDup state vectorChar
+
+instructionVectorCharSort :: State -> State
+instructionVectorCharSort = instructionVectorSort vectorChar
+
+instructionVectorCharSortReverse :: State -> State
+instructionVectorCharSortReverse = instructionVectorSortReverse vectorChar
+
+instructionVectorCharDupItems :: State -> State
+instructionVectorCharDupItems = instructionDupItems vectorChar

src/HushGP/Instructions/VectorFloatInstructions.hs

@@ -104,3 +104,12 @@ instructionVectorFloatShove state = instructionShove state vectorFloat
 
 instructionVectorFloatShoveDup :: State -> State
 instructionVectorFloatShoveDup state = instructionShoveDup state vectorFloat
+
+instructionVectorFloatSort :: State -> State
+instructionVectorFloatSort = instructionVectorSort vectorFloat
+
+instructionVectorFloatSortReverse :: State -> State
+instructionVectorFloatSortReverse = instructionVectorSortReverse vectorFloat
+
+instructionVectorFloatDupItems :: State -> State
+instructionVectorFloatDupItems = instructionDupItems vectorFloat

src/HushGP/Instructions/VectorIntInstructions.hs

@@ -104,3 +104,12 @@ instructionVectorIntShove state = instructionShove state vectorChar
 
 instructionVectorIntShoveDup :: State -> State
 instructionVectorIntShoveDup state = instructionShoveDup state vectorChar
+
+instructionVectorIntSort :: State -> State
+instructionVectorIntSort = instructionVectorSort vectorInt
+
+instructionVectorIntSortReverse :: State -> State
+instructionVectorIntSortReverse = instructionVectorSortReverse vectorInt
+
+instructionVectorIntDupItems :: State -> State
+instructionVectorIntDupItems = instructionDupItems vectorInt

src/HushGP/Instructions/VectorStringInstructions.hs

@@ -104,3 +104,12 @@ instructionVectorStringShove state = instructionShove state vectorString
 
 instructionVectorStringShoveDup :: State -> State
 instructionVectorStringShoveDup state = instructionShoveDup state vectorString
+
+instructionVectorStringSort :: State -> State
+instructionVectorStringSort = instructionVectorSort vectorString
+
+instructionVectorStringSortReverse :: State -> State
+instructionVectorStringSortReverse = instructionVectorSortReverse vectorString
+
+instructionVectorStringDupItems :: State -> State
+instructionVectorStringDupItems = instructionDupItems vectorString