Finish polymorphic and vector instructions

.idea/codeStyles/Project.xml

@@ -0,0 +1,7 @@
+<component name="ProjectCodeStyleConfiguration">
+  <code_scheme name="Project" version="173">
+    <ScalaCodeStyleSettings>
+      <option name="MULTILINE_STRING_CLOSING_QUOTES_ON_NEW_LINE" value="true" />
+    </ScalaCodeStyleSettings>
+  </code_scheme>
+</component>

.idea/codeStyles/codeStyleConfig.xml

@@ -0,0 +1,5 @@
+<component name="ProjectCodeStyleConfiguration">
+  <state>
+    <option name="PREFERRED_PROJECT_CODE_STYLE" value="Default" />
+  </state>
+</component>

project.clj

@@ -3,6 +3,7 @@
   :url "http://example.com/FIXME"
   :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
             :url  "https://www.eclipse.org/legal/epl-2.0/"}
-  :dependencies [[org.clojure/clojure "1.10.0"]]
+  :dependencies [[org.clojure/clojure "1.10.0"]
+                 [org.clojure/clojurescript "1.9.946"]]
   :main ^:skip-aot propeller.core
   :repl-options {:init-ns propeller.core})

propeller-cli

@@ -0,0 +1,5 @@
+#!/usr/bin/env bash
+
+# Bash script utility for running propeller for people unfamiliar with Clojure
+
+

src/propeller/core.clj

@@ -2,8 +2,7 @@
   (:gen-class)
   (:require [propeller.gp :as gp]
             [propeller.problems.simple-regression :as regression]
-            [propeller.problems.string-classification :as string-classif]
+            [propeller.problems.string-classification :as string-classif]))
-            [propeller.push.core :as push]))
 
 (defn -main
   "Runs propel-gp, giving it a map of arguments."
@@ -11,7 +10,7 @@
   (gp/gp
     (update-in
       (merge
-        {:instructions            push/default-instructions
+        {:instructions            regression/instructions
          :error-function          regression/error-function
          :max-generations         500
          :population-size         500
@@ -25,4 +24,4 @@
         (apply hash-map
                (map read-string args)))
       [:error-function]
-      #(if (fn? %) % (eval %)))))
+      identity)))

src/propeller/genome.clj

@@ -1,5 +1,13 @@
 (ns propeller.genome
-  (:require [propeller.push.core :as push]))
+  (:require [propeller.push.core :as push]
+            [propeller.utils :as utils]))
+
+(defn make-random-plushy
+  "Creates and returns a new plushy."
+  [instructions max-initial-plushy-size]
+  (repeatedly
+    (rand-int max-initial-plushy-size)
+    #(utils/random-instruction instructions)))
 
 (defn plushy->push
   "Returns the Push program expressed by the given plushy representation."
@@ -25,9 +33,3 @@
                      (rest plushy))
               (recur push (rest plushy)))                   ;; unmatched close, ignore
             (recur (concat push [i]) (rest plushy))))))))   ;; anything else
-
-(defn make-random-plushy
-  "Creates and returns a new plushy."
-  [instructions max-initial-plushy-size]
-  (repeatedly (rand-int max-initial-plushy-size)
-              #(rand-nth instructions)))

src/propeller/gp.clj

@@ -7,8 +7,10 @@
             [propeller.push.instructions.code]
             [propeller.push.instructions.input-output]
             [propeller.push.instructions.numeric]
+            [propeller.push.instructions.random]
             [propeller.push.instructions.polymorphic]
-            [propeller.push.instructions.string]))
+            [propeller.push.instructions.string]
+            [propeller.push.instructions.vector]))
 
 (defn report
   "Reports information each generation."
@@ -36,14 +38,11 @@
   ;;
   (println "Starting GP with args: " argmap)
   ;;
-  (do (println "Registered instructions:")
-      (println (sort (keys @push/instruction-table))))
-  ;;
   (loop [generation 0
          population (repeatedly
                       population-size
-                      #(hash-map :plushy
+                      #(hash-map :plushy (genome/make-random-plushy
-                                 (genome/make-random-plushy instructions
+                                           instructions
                                            max-initial-plushy-size)))]
     (let [evaluated-pop (sort-by :total-error
                                  (map (partial error-function argmap)

src/propeller/problems/simple_regression.clj

@@ -18,6 +18,39 @@
   [x]
   (+ (* x x x) x 3))
 
+;; Set of original propel instructions
+(def instructions
+  (list :in1
+        :integer_add
+        :integer_subtract
+        :integer_mult
+        :integer_quot
+        :integer_eq
+        :exec_dup
+        :exec_if
+        :boolean_and
+        :boolean_or
+        :boolean_not
+        :boolean_eq
+        :string_eq
+        :string_take
+        :string_drop
+        :string_reverse
+        :string_concat
+        :string_length
+        :string_includes?
+        'close
+        0
+        1
+        true
+        false
+        ""
+        "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+        "A"
+        "C"
+        "G"
+        "T"))
+
 (defn error-function
   "Finds the behaviors and errors of an individual. The error is the absolute
   deviation between the target output value and the program's selected behavior,

src/propeller/problems/string_classification.clj

@@ -7,6 +7,39 @@
 ;; String classification
 ;; =============================================================================
 
+;; Set of original propel instructions
+(def instructions
+  (list :in1
+        :integer_add
+        :integer_subtract
+        :integer_mult
+        :integer_quot
+        :integer_eq
+        :exec_dup
+        :exec_if
+        :boolean_and
+        :boolean_or
+        :boolean_not
+        :boolean_eq
+        :string_eq
+        :string_take
+        :string_drop
+        :string_reverse
+        :string_concat
+        :string_length
+        :string_includes?
+        'close
+        0
+        1
+        true
+        false
+        ""
+        "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+        "A"
+        "C"
+        "G"
+        "T"))
+
 (defn error-function
   "Finds the behaviors and errors of an individual: Error is 0 if the value and
   the program's selected behavior match, or 1 if they differ, or 1000000 if no

src/propeller/push/core.clj

@@ -13,39 +13,6 @@
 
 (def instruction-table (atom (hash-map)))
 
-;; Set of original propel instructions
-(def default-instructions
-  (list :in1
-        :integer_add
-        :integer_subtract
-        :integer_mult
-        :integer_quot
-        :integer_eq
-        :exec_dup
-        :exec_if
-        :boolean_and
-        :boolean_or
-        :boolean_not
-        :boolean_eq
-        :string_eq
-        :string_take
-        :string_drop
-        :string_reverse
-        :string_concat
-        :string_length
-        :string_includes?
-        'close
-        0
-        1
-        true
-        false
-        ""
-        "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-        "A"
-        "C"
-        "G"
-        "T"))
-
 ;; Number of blocks opened by instructions (default = 0)
 (def opens {:exec_dup 1
             :exec_if  2})

src/propeller/push/instructions/boolean.clj

@@ -9,24 +9,28 @@
 ;; Pushes the logical AND of the top two BOOLEANs
 (def-instruction
   :boolean_and
+  ^{:stacks #{:boolean}}
   (fn [state]
     (make-instruction state #(and %1 %2) [:boolean :boolean] :boolean)))
 
 ;; Pushes the logical OR of the top two BOOLEANs
 (def-instruction
   :boolean_or
+  ^{:stacks #{:boolean}}
   (fn [state]
     (make-instruction state #(or %1 %2) [:boolean :boolean] :boolean)))
 
 ;; Pushes the logical NOT of the top BOOLEAN
 (def-instruction
   :boolean_not
+  ^{:stacks #{:boolean}}
   (fn [state]
     (make-instruction state not [:boolean] :boolean)))
 
 ;; Pushes the logical XOR of the top two BOOLEAN
 (def-instruction
   :boolean_xor
+  ^{:stacks #{:boolean}}
   (fn [state]
     (make-instruction state #(or (and %1 (not %2))
                                  (and (not %1) %2))
@@ -37,6 +41,7 @@
 ;; first one
 (def-instruction
   :boolean_invert_first_then_and
+  ^{:stacks #{:boolean}}
   (fn [state]
     (make-instruction state #(and %1 (not %2)) [:boolean :boolean] :boolean)))
 
@@ -44,17 +49,20 @@
 ;; second one
 (def-instruction
   :boolean_invert_second_then_and
+  ^{:stacks #{:boolean}}
   (fn [state]
     (make-instruction state #(and (not %1) %2) [:boolean :boolean] :boolean)))
 
 ;; Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise
 (def-instruction
   :boolean_fromfloat
+  ^{:stacks #{:boolean :float}}
   (fn [state]
     (make-instruction state #(not (zero? %)) [:float] :boolean)))
 
 ;; Pushes FALSE if the top INTEGER is 0, and TRUE otherwise
 (def-instruction
   :boolean_frominteger
+  ^{:stacks #{:boolean :integer}}
   (fn [state]
     (make-instruction state #(not (zero? %)) [:integer] :boolean)))

src/propeller/push/instructions/char.clj

@@ -1,5 +1,6 @@
 (ns propeller.push.instructions.char
-  (:require [propeller.push.utils :refer [def-instruction
+  (:require [propeller.push.state :as state]
+            [propeller.push.utils :refer [def-instruction
                                           make-instruction]]
             [propeller.tools.character :as char]))
 
@@ -10,12 +11,14 @@
 ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter
 (def-instruction
   :char_isletter
+  ^{:stacks #{:boolean :char}}
   (fn [state]
     (make-instruction state char/is-letter [:char] :boolean)))
 
 ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a digit
 (def-instruction
   :char_isdigit
+  ^{:stacks #{:boolean :char}}
   (fn [state]
     (make-instruction state char/is-digit [:char] :boolean)))
 
@@ -23,6 +26,7 @@
 ;; (newline, space, or tab)
 (def-instruction
   :char_iswhitespace
+  ^{:stacks #{:boolean :char}}
   (fn [state]
     (make-instruction state char/is-whitespace [:char] :boolean)))
 
@@ -32,6 +36,7 @@
 ;; pushed.
 (def-instruction
   :char_fromfloat
+  ^{:stacks #{:char :float}}
   (fn [state]
     (make-instruction state #(char (mod (long %) 128)) [:float] :char)))
 
@@ -40,13 +45,19 @@
 ;; 128. For instance, 248 will result in x being pushed
 (def-instruction
   :char_frominteger
+  ^{:stacks #{:char :integer}}
   (fn [state]
     (make-instruction state #(char (mod % 128)) [:integer] :char)))
 
 ;; Pops the STRING stack and pushes the top element's constituent characters
 ;; onto the CHAR stack, in order. For instance, "hello" will result in the
-;; top of the CHAR stack being o l l e h
+;; top of the CHAR stack being \h \e \l \l \o
 (def-instruction
   :char_allfromstring
+  ^{:stacks #{:char :string}}
   (fn [state]
-    (make-instruction state #(map char %) [:string] :char)))
+    (if (state/empty-stack? state :string)
+      state
+      (let [top-string (state/peek-stack state :string)
+            popped-state (state/pop-stack state :string)]
+        (state/push-to-stack-multiple popped-state :char (map char top-string))))))

src/propeller/push/instructions/code.clj

@@ -1,14 +1,101 @@
 (ns propeller.push.instructions.code
-  (:require [propeller.push.state :as state]
+  (:require [propeller.utils :as utils]
+            [propeller.push.state :as state]
             [propeller.push.utils :refer [def-instruction
+                                          generate-instructions
                                           make-instruction]]))
 
 ;; =============================================================================
-;; CODE and EXEC Instructions
+;; Polymorphic Instructions
+;; =============================================================================
+
+(def _noop
+  ^{:stacks #{}}
+  (fn [stack state] state))
+
+(def _do*range
+  ^{:stacks #{:exec :integer}}
+  (fn [stack state] state))
+
+(def _noop
+  ^{:stacks #{}}
+  (fn [stack state] state))
+
+(def _noop
+  ^{:stacks #{}}
+  (fn [stack state] state))
+
+(generate-instructions
+  [:exec :code]
+  [_noop])
+
+
+;; =============================================================================
+;; CODE Instructions
+;; =============================================================================
+
+;; Concatenates the top two instructions on the :code stack and pushes the
+;; result back onto the stack
+(def-instruction
+  :code_append
+  ^{:stacks #{:code}}
+  (fn [state]
+    (make-instruction state
+                      #(utils/not-lazy
+                         (concat (utils/ensure-list %2)
+                                 (utils/ensure-list %1)))
+                      [:code :code]
+                      :code)))
+
+(def-instruction
+  :code_atom
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+(def-instruction
+  :code_car
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+(def-instruction
+  :code_cdr
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+(def-instruction
+  :code_cons
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+(def-instruction
+  :code_do
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+(def-instruction
+  :code_do*
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+(def-instruction
+  :code_append
+  ^{:stacks #{:code}}
+  (fn [state]
+    ()))
+
+;; =============================================================================
+;; EXEC Instructions
 ;; =============================================================================
 
 (def-instruction
   :exec_dup
+  ^{:stacks #{:exec}}
   (fn [state]
     (if (state/empty-stack? state :exec)
       state
@@ -16,5 +103,6 @@
 
 (def-instruction
   :exec_if
+  ^{:stacks #{:boolean :exec}}
   (fn [state]
     (make-instruction state #(if %1 %3 %2) [:boolean :exec :exec] :exec)))

src/propeller/push/instructions/numeric.clj

@@ -1,6 +1,6 @@
 (ns propeller.push.instructions.numeric
   (:require [propeller.push.utils :refer [def-instruction
-                                          generate-functions
+                                          generate-instructions
                                           make-instruction]]
             [propeller.tools.math :as math]))
 
@@ -10,103 +10,119 @@
 
 ;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than the top
 ;; item, and FALSE otherwise
-(defn- _gt
+(def _gt
-  [stack state]
+  ^{:stacks #{:boolean}}
-  (make-instruction state > [stack stack] :boolean))
+  (fn [stack state]
+    (make-instruction state > [stack stack] :boolean)))
 
 ;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than or
 ;; equal to the top item, and FALSE otherwise
-(defn- _gte
+(def _gte
-  [stack state]
+  ^{:stacks #{:boolean}}
-  (make-instruction state >= [stack stack] :boolean))
+  (fn [stack state]
+    (make-instruction state >= [stack stack] :boolean)))
 
 ;; Pushes TRUE onto the BOOLEAN stack if the second item is less than the top
 ;; item, and FALSE otherwise
-(defn- _lt
+(def _lt
-  [stack state]
+  ^{:stacks #{:boolean}}
-  (make-instruction state < [stack stack] :boolean))
+  (fn [stack state]
+    (make-instruction state < [stack stack] :boolean)))
 
 ;; Pushes TRUE onto the BOOLEAN stack if the second item is less than or equal
 ;; to the top item, and FALSE otherwise
-(defn- _lte
+(def _lte
-  [stack state]
+  ^{:stacks #{:boolean}}
-  (make-instruction state <= [stack stack] :boolean))
+  (fn [stack state]
+    (make-instruction state <= [stack stack] :boolean)))
 
 ;; Pushes the sum of the top two items onto the same stack
-(defn- _add
+(def _add
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state +' [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state +' [stack stack] stack)))
 
 ;; Pushes the difference of the top two items (i.e. the second item minus the
 ;; top item) onto the same stack
-(defn- _subtract
+(def _subtract
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state -' [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state -' [stack stack] stack)))
 
 ;; Pushes the product of the top two items onto the same stack
-(defn- _mult
+(def _mult
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state *' [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state *' [stack stack] stack)))
 
 ;; Pushes the quotient of the top two items (i.e. the second item divided by the
 ;; top item) onto the same stack. If the top item is zero, pushes 1
-(defn- _quot
+(def _quot
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state #(if (zero? %2) 1 (quot %1 %2)) [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state #(if (zero? %2) 1 (quot %1 %2)) [stack stack] stack)))
 
 ;; Pushes the second item modulo the top item onto the same stack. If the top
 ;; item is zero, pushes 1. The modulus is computed as the remainder of the
 ;; quotient, where the quotient has first been truncated towards negative
 ;; infinity.
-(defn- _mod
+(def _mod
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state #(if (zero? %2) 1 (mod %1 %2)) [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state #(if (zero? %2) 1 (mod %1 %2)) [stack stack] stack)))
 
 ;; Pushes the maximum of the top two items
-(defn- _max
+(def _max
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state max [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state max [stack stack] stack)))
 
 ;; Pushes the minimum of the top two items
-(defn- _min
+(def _min
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state min [stack stack] stack))
+  (fn [stack state]
+    (make-instruction state min [stack stack] stack)))
 
 ;; Pushes 1 / 1.0 if the top BOOLEAN is TRUE, or 0 / 0.0 if FALSE
-(defn- _fromboolean
+(def _fromboolean
-  [stack state]
+  ^{:stacks #{:boolean}}
+  (fn [stack state]
     (make-instruction state
                       #((if (= stack :integer) int float) (if % 1 0))
                       [:boolean]
-                    stack))
+                      stack)))
 
 ;; Pushes the ASCII value of the top CHAR
-(defn- _fromchar
+(def _fromchar
-  [stack state]
+  ^{:stacks #{:char}}
-  (make-instruction state (if (= stack :integer) int float) [:char] stack))
+  (fn [stack state]
+    (make-instruction state (if (= stack :integer) int float) [:char] stack)))
 
 ;; Pushes the value of the top STRING, if it can be parsed as a number.
 ;; Otherwise, acts as a NOOP
-(defn- _fromstring
+(def _fromstring
-  [stack state]
+  ^{:stacks #{:string}}
+  (fn [stack state]
     (make-instruction state
                       #(try ((if (= stack :integer) int float) (read-string %))
                             (catch Exception e))
                       [:string]
-                    stack))
+                      stack)))
 
 ;; Pushes the increment (i.e. +1) of the top item of the stack
-(defn- _inc
+(def _inc
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state inc [stack] stack))
+  (fn [stack state]
+    (make-instruction state inc [stack] stack)))
 
 ;; Pushes the decrement (i.e. -1) of the top item of the stack
-(defn- _dec
+(def _dec
-  [stack state]
+  ^{:stacks #{}}
-  (make-instruction state dec [stack] stack))
+  (fn [stack state]
+    (make-instruction state dec [stack] stack)))
 
 ;; 2 types x 16 functions = 32 instructions
-(generate-functions
+(generate-instructions
   [:float :integer]
   [_gt _gte _lt _lte _add _subtract _mult _quot _mod _max _min _inc _dec
    _fromboolean _fromchar _fromstring])
@@ -118,24 +134,28 @@
 ;; Pushes the cosine of the top FLOAT
 (def-instruction
   :float_cos
+  ^{:stacks #{:float}}
   (fn [state]
     (make-instruction state math/cos [:float] :float)))
 
 ;; Pushes the sine of the top FLOAT
 (def-instruction
   :float_sin
+  ^{:stacks #{:float}}
   (fn [state]
     (make-instruction state math/sin [:float] :float)))
 
 ;; Pushes the tangent of the top FLOAT
 (def-instruction
   :float_tan
+  ^{:stacks #{:float}}
   (fn [state]
     (make-instruction state math/tan [:float] :float)))
 
 ;; Pushes the floating point version of the top INTEGER
 (def-instruction
   :float_frominteger
+  ^{:stacks #{:float :integer}}
   (fn [state]
     (make-instruction state float [:integer] :float)))
 
@@ -146,5 +166,6 @@
 ;; Pushes the result of truncating the top FLOAT towards negative infinity
 (def-instruction
   :integer_fromfloat
+  ^{:stacks #{:float :integer}}
   (fn [state]
     (make-instruction state int [:float] :integer)))

src/propeller/push/instructions/polymorphic.clj

@@ -1,107 +1,181 @@
 (ns propeller.push.instructions.polymorphic
-  (:require  [propeller.push.state :as state]
+  (:require [propeller.utils :as utils]
-             [propeller.push.utils :refer [def-instruction
+            [propeller.push.state :as state]
-                                           generate-functions
+            [propeller.push.utils :refer [generate-instructions
                                           make-instruction]]))
 
 ;; =============================================================================
 ;; Polymorphic Instructions
 ;;
-;; (for all types, with the exception of non-data  stacks like auxiliary, tag,
+;; (for all stacks, with the exception of non-data ones like auxiliary, input,
-;; input, and output)
+;; and output)
 ;; =============================================================================
 
-;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal.
-;; Otherwise FALSE
-(defn- _eq
-  [stack state]
-  (make-instruction state = [stack stack] :boolean))
-
 ;; Duplicates the top item of the stack. Does not pop its argument (since that
 ;; would negate the effect of the duplication)
-(defn- _dup
+(def _dup
-  [stack state]
+  ^{:stacks #{}}
+  (fn [stack state]
     (let [top-item (state/peek-stack state stack)]
       (if (state/empty-stack? state stack)
         state
-      (state/push-to-stack state stack top-item))))
+        (state/push-to-stack state stack top-item)))))
 
 ;; Duplicates n copies of the top item (i.e leaves n copies there). Does not pop
 ;; its argument (since that would negate the effect of the duplication). The
 ;; number n is determined by the top INTEGER. For n = 0, equivalent to POP.
 ;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values
-;; of n are treated as 0.
+;; of n are treated as 0
-(defn- _duptimes
+(def _duptimes
-  [stack state]
+  ^{:stacks #{:integer}}
+  (fn [stack state]
     (if (or (and (= stack :integer)
-               (>= (count (:integer state)) 2))
+                 (<= 2 (count (:integer state))))
             (and (not= stack :integer)
                  (not (state/empty-stack? state :integer))
                  (not (state/empty-stack? state stack))))
       (let [n (state/peek-stack state :integer)
-          item-to-duplicate (state/peek-stack state stack)]
+            popped-state (state/pop-stack state :integer)
-      nil)
+            top-item (state/peek-stack popped-state stack)
-    state))
+            top-item-dup (take (- n 1) (repeat top-item))]
+        (cond
+          (< 0 n) (state/push-to-stack-multiple popped-state stack top-item-dup)
+          :else (state/pop-stack popped-state stack)))
+      state)))
 
-
+;; Duplicates the top n items on the stack, one time each. The number n is
-(defn- _dupitems
+;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If
-  [stack state]
+;; fewer than n items are on the stack, the entire stack will be duplicated.
-  ())
+(def _dupitems
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (if (state/empty-stack? state :integer)
+      state
+      (let [n (state/peek-stack state :integer)
+            popped-state (state/pop-stack state :integer)
+            top-items (take n (get popped-state stack))]
+        (state/push-to-stack-multiple popped-state stack top-items)))))
 
 ;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE
-(defn- _empty
+(def _empty
-  [stack state]
+  ^{:stacks #{:boolean}}
-  (state/push-to-stack state :boolean (state/empty-stack? state stack)))
+  (fn [stack state]
+    (state/push-to-stack state :boolean (state/empty-stack? state stack))))
+
+;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal.
+;; Otherwise FALSE
+(def _eq
+  ^{:stacks #{:boolean}}
+  (fn [stack state]
+    (make-instruction state = [stack stack] :boolean)))
 
 ;; Empties the given stack
-(defn- _flush
+(def _flush
-  [stack state]
+  ^{:stacks #{}}
-  ())
+  (fn [stack state]
+    (assoc state stack '())))
 
 ;; Pops the given stack
-(defn- _pop
+(def _pop
-  [stack state]
+  ^{:stacks #{}}
-  (state/pop-stack state stack))
+  (fn [stack state]
+    (state/pop-stack state stack)))
 
 ;; Rotates the top three items on the stack (i.e. pulls the third item out and
 ;; pushes it on top). Equivalent to (yank state stack-type 2)
-(defn- _rot
+(def _rot
-  [stack state]
+  ^{:stacks #{}}
-  ())
+  (fn [stack state]
+    (if (<= 3 (count (get state stack)))
+      (let [top-three (state/peek-stack-multiple state stack 3)
+            popped-state (state/pop-stack-multiple state stack 3)
+            top-three-rot (take 3 (conj top-three (last top-three)))]
+        (state/push-to-stack-multiple popped-state stack top-three-rot))
+      state)))
 
 ;; Inserts the top item deeper into the stack, using the top INTEGER to
 ;; determine how deep
-(defn- _shove
+(def _shove
-  [stack state]
+  ^{:stacks #{:integer}}
-  ())
+  (fn [stack state]
+    (if (or (and (= stack :integer)
+                 (<= 2 (count (:integer state))))
+            (and (not= stack :integer)
+                 (not (state/empty-stack? state :integer))
+                 (not (state/empty-stack? state stack))))
+      (let [index-raw (state/peek-stack state :integer)
+            popped-state (state/pop-stack state :integer)
+            top-item (state/peek-stack popped-state stack)
+            popped-state (state/pop-stack popped-state stack)
+            index (max 0 (min index-raw (count (get popped-state stack))))]
+        (update popped-state stack #(utils/not-lazy (concat (take index %)
+                                                            (list top-item)
+                                                            (drop index %)))))
+      state)))
 
 ;; Pushes the given stack's depth onto the INTEGER stack
-(defn- _stackdepth
+(def _stackdepth
-  [stack state]
+  ^{:stacks #{:integer}}
-  ())
+  (fn [stack state]
+    (let [stack-depth (count (get state stack))]
+      (state/push-to-stack state :integer stack-depth))))
 
 ;; Swaps the top two items on the stack
-(defn- _swap
+(def _swap
-  [stack state]
+  ^{:stacks #{}}
-  ())
+  (fn [stack state]
+    (if (<= 2 (count (get state stack)))
+      (let [top-two (state/peek-stack-multiple state stack 2)
+            popped-state (state/pop-stack-multiple state stack 2)]
+        (state/push-to-stack-multiple popped-state stack (reverse top-two)))
+      state)))
 
-;; Removes an indexed item from deep in the stack. The top INTEGER is used to
+;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER
-;; determine how deep to yank from
+;; is used to determine how deep to yank from
-(defn- _yank
+(def _yank
-  [stack state]
+  ^{:stacks #{:integer}}
-  ())
+  (fn [stack state]
+    (if (or (and (= stack :integer)
+                 (<= 2 (count (:integer state))))
+            (and (not= stack :integer)
+                 (not (state/empty-stack? state :integer))
+                 (not (state/empty-stack? state stack))))
+      (let [index-raw (state/peek-stack state :integer)
+            popped-state (state/pop-stack state :integer)
+            index (max 0 (min index-raw (count (get popped-state stack))))
+            indexed-item (nth (get popped-state stack) index)]
+        (update popped-state stack #(utils/not-lazy
+                                      (concat (list indexed-item)
+                                              (take index %)
+                                              (rest (drop index %))))))
+      state)))
 
-;; Pushes a copy of an indexed item deep in the stack, without removing it.
+;; Pushes a copy of an indexed item from deep in the stack, without removing it.
 ;; The top INTEGER is used to determine how deep to yankdup from
-(defn- _yankdup
+(def _yankdup
-  [stack state]
+  ^{:stacks #{:integer}}
-  ())
+  (fn [stack state]
+    (if (or (and (= stack :integer)
+                 (<= 2 (count (:integer state))))
+            (and (not= stack :integer)
+                 (not (state/empty-stack? state :integer))
+                 (not (state/empty-stack? state stack))))
+      (let [index-raw (state/peek-stack state :integer)
+            popped-state (state/pop-stack state :integer)
+            index (max 0 (min index-raw (count (get popped-state stack))))
+            indexed-item (nth (get popped-state stack) index)]
+        (state/push-to-stack popped-state stack indexed-item))
+      state)))
 
-;; 5 types x 1 function = 5 instructions
+;; 9 types x 1 functions = 9 instructions
-(generate-functions [:boolean :char :float :integer :string] [_eq])
+(generate-instructions
+  [:boolean :char :float :integer :string
+   :vector_boolean :vector_float :vector_integer :vector_string]
+  [_eq])
 
-;; 7 types x 12 function = 84 instructions
+;; 11 types x 12 functions = 132 instructions
-(generate-functions
+(generate-instructions
-  [:boolean :char :code :exec :float :integer :string]
+  [:boolean :char :code :exec :float :integer :string
+   :vector_boolean :vector_float :vector_integer :vector_string]
   [_dup _duptimes _dupitems _empty _flush _pop _rot _shove _stackdepth
    _swap _yank _yankdup])

src/propeller/push/instructions/random.clj

@@ -0,0 +1,4 @@
+(ns propeller.push.instructions.random
+  (:require [propeller.push.utils :refer [def-instruction]]))
+
+

src/propeller/push/instructions/string.clj

@@ -8,35 +8,42 @@
 
 (def-instruction
   :string_=
+  ^{:stacks #{:boolean :string}}
   (fn [state]
     (make-instruction state = [:string :string] :boolean)))
 
 (def-instruction
   :string_concat
+  ^{:stacks #{:string}}
   (fn [state]
     (make-instruction state #(apply str (concat %1 %2)) [:string :string] :string)))
 
 (def-instruction
   :string_drop
+  ^{:stacks #{:integer :string}}
   (fn [state]
     (make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string)))
 
 (def-instruction
   :string_includes?
+  ^{:stacks #{:boolean :string}}
   (fn [state]
     (make-instruction state clojure.string/includes? [:string :string] :boolean)))
 
 (def-instruction
   :string_length
+  ^{:stacks #{:integer :string}}
   (fn [state]
     (make-instruction state count [:string] :integer)))
 
 (def-instruction
   :string_reverse
+  ^{:stacks #{:string}}
   (fn [state]
     (make-instruction state #(apply str (reverse %)) [:string] :string)))
 
 (def-instruction
   :string_take
+  ^{:stacks #{:integer :string}}
   (fn [state]
     (make-instruction state #(apply str (take %1 %2)) [:integer :string] :string)))

src/propeller/push/instructions/vector.clj

@@ -0,0 +1,204 @@
+(ns propeller.push.instructions.vector
+  (:require [clojure.string]
+            [propeller.utils :as utils]
+            [propeller.push.state :as state]
+            [propeller.push.utils :refer [def-instruction
+                                          generate-instructions
+                                          make-instruction]]))
+
+;; =============================================================================
+;; VECTOR Instructions
+;; =============================================================================
+
+;; Pushes the butlast of the top item
+(def _butlast
+  ^{:stacks #{}}
+  (fn [stack state]
+    (make-instruction state #(vec (butlast %)) [stack] stack)))
+
+;; Concats and pushes the top two vectors of the stack
+(def _concat
+  ^{:stacks #{}}
+  (fn [stack state]
+    (make-instruction state #(vec (concat %2 %1)) [stack stack] stack)))
+
+;; Conj's the top item of the appropriately-typed literal stack onto the vector
+;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER)
+(def _conj
+  ^{:stacks #{}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state #(conj %2 %1) [lit-stack stack] stack))))
+
+;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack
+;; contains the top element of the appropriately-typed literal stack. Otherwise,
+;; pushes FALSE
+(def _contains
+  ^{:stacks #{:boolean}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean))))
+
+;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector.
+;; Otherwise, pushes FALSE
+(def _emptyvector
+  ^{:stacks #{:boolean}}
+  (fn [stack state]
+    (make-instruction state empty? [stack] :boolean)))
+
+;; Pushes the first item of the top element of the vector stack onto the
+;; approrpiately-typed literal stack
+(def _first
+  ^{:stacks #{}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state first [stack] lit-stack))))
+
+;; Pushes onto the INTEGER stack the index of the top element of the
+;; appropriately-typed literal stack within the top element of the vector stack
+(def _indexof
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer))))
+
+;; Pushes the last item of the top element of the vector stack onto the
+;; approrpiately-typed literal stack
+(def _last
+  ^{:stacks #{}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state last [stack] lit-stack))))
+
+;; Pushes the length of the top item onto the INTEGER stack
+(def _length
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (make-instruction state count [stack] :integer)))
+
+;; Pushes the Nth item of the top element of the vector stack onto the
+;; approrpiately-typed literal stack, where N is taken from the INTEGER stack.
+;; To insure the index is within bounds, N is taken mod the vector length
+(def _nth
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state
+                        #(get %2 (mod %1 (count %2)))
+                        [:integer stack]
+                        lit-stack))))
+
+;; Pushes onto the INTEGER stack the number of occurrences of the top element of
+;; the appropriately-typed literal stack within the top element of the vector
+;; stack
+(def _occurrencesof
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state
+                        (fn [lit vect] (count (filter #(= lit %) vect)))
+                        [lit-stack stack]
+                        :integer))))
+
+;; Pushes every item of the top element onto the appropriately-typed stack
+(def _pushall
+  ^{:stacks #{}}
+  (fn [stack state]
+    (if (state/empty-stack? state stack)
+      state
+      (let [lit-stack (utils/get-vector-literal-type stack)
+            top-vector (state/peek-stack state stack)
+            popped-state (state/pop-stack state stack)]
+        (state/push-to-stack-multiple popped-state lit-stack top-vector)))))
+
+;; Removes all occurrences of the top element of the appropriately-typed literal
+;; stack from the first element of the vector stack
+(def _remove
+  ^{:stacks #{}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state
+                        (fn [lit vect] (vec (filter #(not= lit %) vect)))
+                        [lit-stack stack]
+                        stack))))
+
+;; Replaces all occurrences of the second element of the appropriately-typed
+;; literal stack with the top element of the appropriately-typed literal stack
+;; within the top item of the vector stack
+(def _replace
+  ^{:stacks #{}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state
+                        (fn [lit1 lit2 vect]
+                          (replace {lit1 lit2} vect))
+                        [lit-stack lit-stack stack]
+                        stack))))
+
+;; Replaces the first occurrence of the second element of the appropriately-typed
+;; literal stack with the top element of the appropriately-typed literal stack
+;; within the top item of the vector stack
+(def _replacefirst
+  ^{:stacks #{}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state
+                        (fn [lit1 lit2 vect]
+                          (assoc vect (utils/indexof lit1 vect) lit2))
+                        [lit-stack lit-stack stack]
+                        stack))))
+
+;; Pushes the rest of the top item
+(def _rest
+  ^{:stacks #{}}
+  (fn [stack state]
+    (make-instruction state #(vec (rest %)) [stack] stack)))
+
+;; Pushes the reverse of the top item
+(def _reverse
+  ^{:stacks #{}}
+  (fn [stack state]
+    (make-instruction state #(vec (reverse %)) [stack] stack)))
+
+;; Replaces in the top vector the item at index N (taken from the INTEGER stack)
+;; with the top item from the appropriately-typed literal stack. To insure the
+;; index is within bounds, N is taken mod the vector length
+(def _set
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (let [lit-stack (utils/get-vector-literal-type stack)]
+      (make-instruction state
+                        (fn [lit n vect]
+                          (assoc vect (mod n (count vect)) lit))
+                        [:integer lit-stack stack]
+                        stack))))
+
+;; Pushes a subvector of the top item, with start and end indices determined by
+;; the second and top items of the INTEGER stack respectively
+(def _subvec
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (make-instruction state
+                      (fn [stop-raw start-raw vect]
+                        (let [start (min (count vect) (max 0 start-raw))
+                              stop (min (count vect) (max start-raw stop-raw))]
+                          (subvec vect start stop)))
+                      [:integer :integer stack]
+                      stack)))
+
+;; Pushes the first N items of the top element, where N is taken from the top of
+;; the INTEGER stack
+(def _take
+  ^{:stacks #{:integer}}
+  (fn [stack state]
+    (make-instruction state #(vec (take %1 %2)) [:integer stack] stack)))
+
+;; 4 types x 20 functions = 80 instructions
+(generate-instructions
+  [:vector_boolean :vector_float :vector_integer :vector_string]
+  [_butlast _concat _conj _contains _emptyvector _first _indexof _last
+   _length _nth _occurrencesof _pushall _remove _replace _replacefirst
+   _rest _reverse _set _subvec _take])
+
+;; Manually add extra metadata for _conj
+

src/propeller/push/state.clj

@@ -5,15 +5,12 @@
                       :boolean        '()
                       :char           '()
                       :code           '()
-                      :environment    '()
                       :exec           '()
                       :float          '()
-                      :genome         '()
                       :input          {}
                       :integer        '()
-                      :return         '()
+                      :output         '()
                       :string         '()
-                      :tag            '()
                       :vector_boolean '()
                       :vector_float   '()
                       :vector_integer '()
@@ -31,24 +28,41 @@
   (empty? (get state stack)))
 
 (defn peek-stack
-  "Returns top item on a stack."
+  "Returns the top item on a stack."
   [state stack]
   (let [working-stack (get state stack)]
     (if (empty? working-stack)
       :no-stack-item
       (first working-stack))))
 
+(defn peek-stack-multiple
+  "Returns the top n items on a stack. If there are less than n items on the
+  stack, returns the entire stack."
+  [state stack n]
+  (take n (get state stack)))
+
 (defn pop-stack
-  "Removes top item of stack."
+  "Removes the top item of stack."
   [state stack]
   (update state stack rest))
 
+(defn pop-stack-multiple
+  "Removes the top n items of a stack. If there are less than n items on the
+  stack, pops the entire stack."
+  [state stack n]
+  (update state stack #(drop n %)))
+
 (defn push-to-stack
-  "Pushes item(s) onto stack."
+  "Pushes an item onto a stack."
+  [state stack item]
+  (update state stack conj item))
+
+(defn push-to-stack-multiple
+  "Pushes a list of items onto a stack, leaving them in the order they are in."
   [state stack items]
   (let [items-list (if (coll? items) items (list items))
         items-list-no-nil (filter #(not (nil? %)) items-list)]
-    (update state stack into items-list-no-nil)))
+    (update state stack into (reverse items-list-no-nil))))
 
 (defn get-args-from-stacks
   "Takes a state and a collection of stacks to take args from. If there are

src/propeller/push/utils.clj

@@ -1,5 +1,6 @@
 (ns propeller.push.utils
-  (:require [propeller.push.core :as push]
+  (:require [clojure.set]
+            [propeller.push.core :as push]
             [propeller.push.state :as state]))
 
 (defmacro def-instruction
@@ -20,14 +21,44 @@
         (state/push-to-stack new-state return-stack result)))))
 
 ;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix
-;; function strings, e.g. [_+, _*, _=], automates the generation of all possible
+;; function strings, e.g. [_add, _mult, _eq], automates the generation of all
-;; combination instructions, which here would be :float_+, :float_*, :float_=,
+;; possible combination instructions, which here would be :float_add, :float_mult,
-;; :integer_+, :integer_*, and :integer_=
+;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring
-(defmacro generate-functions [stacks functions]
+;; and updating the generic function's stack-type metadata
+(defmacro generate-instructions [stacks functions]
   `(do ~@(for [stack stacks
-               function functions
+               func functions
-               :let [instruction-name (keyword (str (name stack) function))]]
+               :let [instruction-name (keyword (str (name stack) func))
-           `(def-instruction ~instruction-name (partial ~function ~stack)))))
+                     metadata `(update-in (meta ~func) [:stacks] #(conj % ~stack))
+                     new-func `(with-meta (partial ~func ~stack) ~metadata)]]
+           `(def-instruction ~instruction-name ~new-func))))
+
+;; Given a set of stacks, returns all instructions that operate on those stacks
+;; only. This won't include random or parenthesis-altering instructions unless
+;; :random or :parentheses respectively are in the stacks set
+(defn get-stack-instructions
+  [stacks]
+  (doseq [[instruction-name function] @push/instruction-table]
+    (assert
+      (:stacks (meta function))
+      (format "ERROR: Instruction %s does not have :stacks defined in metadata."
+              (name instruction-name))))
+  (for [[instruction-name function] @push/instruction-table
+        :when (clojure.set/subset? (:stacks (meta function)) stacks)]
+    instruction-name))
+
+;; If a piece of data is a literal, return its corresponding stack name, e.g.
+;; :integer. Otherwise, return nil"
+(defn get-literal-type
+  [data]
+  (let [literals {:boolean (fn [thing] (or (true? thing) (false? thing)))
+                  :char    char?
+                  :float   float?
+                  :integer integer?
+                  :string  string?}]
+    (first (for [[stack function] literals
+                 :when (function data)]
+             stack))))
 
 ;; Pretty-prints a Push state, for logging or debugging purposes
 (defn print-state

src/propeller/tools/distributions.cljc

@@ -28,7 +28,7 @@
   Accepts an argument map with optional keys :n, :mu, and :sigma."
   [{:keys [n mu sigma]
     :or   {n 1, mu 0, sigma 1}}]
-  (repeatedly n #(box-muller (rand 1) (rand 1))))
+  (repeatedly n #(box-muller (rand) (rand))))
 
 (defn pdf-norm
   "Returns the value of the Normal Probability Distribution Function at a

src/propeller/util.clj

@@ -1,8 +0,0 @@
-(ns propeller.util)
-
-(defn not-lazy
-  "Returns lst if it is not a list, or a non-lazy version of lst if it is."
-  [lst]
-  (if (seq? lst)
-    (apply list lst)
-    lst))

src/propeller/utils.clj

@@ -0,0 +1,34 @@
+(ns propeller.utils)
+
+(defn indexof
+  "Returns the first index of an element in a collection. If the element is not
+  present in the collection, returns -1."
+  [element coll]
+  (or (first (keep-indexed #(if (= element %2) %1) coll)) -1))
+
+(defn not-lazy
+  "Returns lst if it is not a seq, or a non-lazy version of lst if it is."
+  [lst]
+  (if (seq? lst)
+    (apply list lst)
+    lst))
+
+(defn ensure-list
+  "Returns a non-lazy list if passed a seq argument. Othwrwise, returns a list
+  containing the argument."
+  [thing]
+  (if (seq? thing)
+    (not-lazy thing)
+    (list thing)))
+
+(defn random-instruction
+  "Returns a random instruction from a supplied pool of instructions, evaluating
+  ERC-producing functions to a constant literal."
+  [instructions]
+  (let [instruction (rand-nth instructions)]
+    (if (fn? instruction) (instruction) instruction)))
+
+(defn get-vector-literal-type
+  "Returns the literal stack corresponding to some vector stack."
+  [vector-stack]
+  (keyword (clojure.string/replace (str vector-stack) ":vector_" "")))

src/propeller/variation.clj

@@ -1,5 +1,6 @@
 (ns propeller.variation
-  (:require [propeller.selection :as selection]))
+  (:require [propeller.selection :as selection]
+            [propeller.utils :as utils]))
 
 (defn crossover
   "Crosses over two individuals using uniform crossover. Pads shorter one."
@@ -21,7 +22,7 @@
   [plushy instructions umad-rate]
   (apply concat
          (map #(if (< (rand) umad-rate)
-                 (shuffle [% (rand-nth instructions)])
+                 (shuffle [% (utils/random-instruction instructions)])
                  [%])
               plushy)))