Port numeric instructions

src/propeller/genome.clj

@@ -1,7 +1,7 @@
 (ns propeller.genome
   (:use propeller.push.instructions))
 
-(defn push-from-plushy
+(defn plushy->push
   "Returns the Push program expressed by the given plushy representation."
   [plushy]
   (let [opener? #(and (vector? %) (= (first %) 'open))]     ;; [open <n>] marks opens

src/propeller/gp.clj

@@ -9,7 +9,7 @@
     (println "               Report for Generation" generation)
     (println "-------------------------------------------------------")
     (print "Best plushy: ") (prn (:plushy best))
-    (print "Best program: ") (prn (push-from-plushy (:plushy best)))
+    (print "Best program: ") (prn (plushy->push (:plushy best)))
     (println "Best total error:" (:total-error best))
     (println "Best errors:" (:errors best))
     (println "Best behaviors:" (:behaviors best))

src/propeller/problems/simple_regression.clj

@@ -1,29 +1,31 @@
 (ns propeller.problems.simple-regression
-  (:use propeller.genome
-        [propeller.push state interpreter])
-  (:require [tools.math :as math]))
+  (:require [propeller.genome :refer [plushy->push]]
+            [propeller.push.interpreter :refer [interpret-program]]
+            [propeller.push.state :refer [empty-state
+                                          peek-stack]]
+            [tools.math :as math]))
 
 ;; =============================================================================
 ;; Problem: f(x) = 7x^2 - 20x + 13
 ;; =============================================================================
 
-(defn target-function-hard
+(defn- target-function-hard
   "Target function: f(x) = 7x^2 - 20x + 13"
   [x]
   (+ (* 7 x x) (* -20 x) 13))
 
-(defn target-function
+(defn- target-function
   "Target function: f(x) = x^3 + x + 3"
   [x]
   (+ (* x x x) x 3))
 
 (defn regression-error-function
-  "Finds the behaviors and errors of an individual: Error is the absolute
+  "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,
   or 1000000 if no behavior is produced. The behavior is here defined as the
   final top item on the INTEGER stack."
   [argmap individual]
-  (let [program (push-from-plushy (:plushy individual))
+  (let [program (plushy->push (:plushy individual))
         inputs (range -10 11)
         correct-outputs (map target-function inputs)
         outputs (map (fn [input]

src/propeller/problems/string_classification.clj

@@ -12,7 +12,7 @@
   behavior is produced. The behavior is here defined as the final top item on
   the BOOLEAN stack."
   [argmap individual]
-  (let [program (push-from-plushy (:plushy individual))
+  (let [program (plushy->push (:plushy individual))
         inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"]
         correct-outputs [false false false false true true true]
         outputs (map (fn [input]

src/propeller/push/instructions.clj

@@ -55,16 +55,3 @@
 ;; Number of blocks opened by instructions (default = 0)
 (def opens {:exec_dup 1
             :exec_if  2})
-
-(defn make-instruction
-  "A utility function for making Push instructions. Takes a state, a function
-  to apply to the args, the stacks to take the args from, and the stack to
-  return the result to. Applies the function to the args (popped from the
-  given stacks), and pushes the result onto the return-stack."
-  [state function arg-stacks return-stack]
-  (let [popped-args (get-args-from-stacks state arg-stacks)]
-    (if (= popped-args :not-enough-args)
-      state
-      (let [result (apply function (:args popped-args))
-            new-state (:state popped-args)]
-        (push-to-stack new-state return-stack result)))))

src/propeller/push/instructions/boolean.clj

@@ -1,6 +1,6 @@
 (ns propeller.push.instructions.boolean
-  (:require [propeller.push.instructions :refer [make-instruction
-                                                 def-instruction]]))
+  (:require [propeller.push.instructions :refer [def-instruction]]
+            [propeller.push.utils :refer [make-instruction]]))
 
 ;; Pushes TRUE if the top two BOOLEANs are equal, and FALSE otherwise
 (def-instruction

src/propeller/push/instructions/char.clj

@@ -1,6 +1,6 @@
 (ns propeller.push.instructions.char
-  (:require [propeller.push.instructions :refer [make-instruction
-                                                 def-instruction]]
+  (:require [propeller.push.instructions :refer [def-instruction]]
+            [propeller.push.utils :refer [make-instruction]]
             [tools.character :as char]))
 
 ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter

src/propeller/push/instructions/code.clj

@@ -1,7 +1,7 @@
 (ns propeller.push.instructions.code
-  (:require [propeller.push.state :as state]
-            [propeller.push.instructions :refer [make-instruction
-                                                 def-instruction]]))
+  (:require [propeller.push.instructions :refer [def-instruction]]
+            [propeller.push.state :as state]
+            [propeller.push.utils :refer [make-instruction]]))
 
 (def-instruction
   :exec_dup

src/propeller/push/instructions/numeric.clj

@@ -1,32 +1,138 @@
 (ns propeller.push.instructions.numeric
-  (:require [propeller.push.instructions :refer [make-instruction
-                                                 def-instruction]]))
+  (:require [propeller.push.instructions :refer [def-instruction]]
+            [propeller.push.utils :refer [generate-functions
+                                          make-instruction]]
+            [tools.math :as math]))
 
-(def-instruction
-  :integer_=
-  (fn [state]
-    (make-instruction state = [:integer :integer] :boolean)))
+;; =============================================================================
+;; FLOAT and INTEGER (polymorphic)
+;; =============================================================================
 
-(def-instruction
-  :integer_+
-  (fn [state]
-    (make-instruction state +' [:integer :integer] :integer)))
+;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal, and
+;; FALSE otherwise
+(defn- _=
+  [stack state]
+  (make-instruction state = [stack stack] :boolean))
 
-(def-instruction
-  :integer_-
-  (fn [state]
-    (make-instruction state -' [:integer :integer] :integer)))
+;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than the top
+;; item, and FALSE otherwise
+(defn- _>
+  [stack state]
+  (make-instruction state > [stack stack] :boolean))
 
-(def-instruction
-  :integer_*
-  (fn [state]
-    (make-instruction state *' [:integer :integer] :integer)))
+;; Pushes TRUE onto the BOOLEAN stack if the second item is less than the top
+;; item, and FALSE otherwise
+(defn- _<
+  [stack state]
+  (make-instruction state < [stack stack] :boolean))
 
+;; Pushes the sum of the top two items onto the same stack
+(defn- _+
+  [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- _-
+  [stack state]
+  (make-instruction state -' [stack stack] stack))
+
+;; Pushes the product of the top two items onto the same stack
+(defn- _*
+  [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, acts as a NOOP
+(defn- _quot
+  [stack state]
+  (make-instruction state
+                    #(if (zero? %2)
+                       (list %1 %2) ; push both items back
+                       (quot %1 %2))
+                    [stack stack]
+                    stack))
+
+;; Pushes the second item modulo the top item onto the same stack. If the top
+;; item is zero, acts as a NOOP. The modulus is computed as the remainder of the
+;; quotient, where the quotient has first been truncated towards negative
+;; infinity.
+(defn- _%
+  [stack state]
+  (make-instruction state
+                    #(if (zero? %2)
+                       (list %1 %2) ; push both items back
+                       (mod %1 %2))
+                    [stack stack]
+                    stack))
+
+;; Pushes the maximum of the top two items
+(defn- _max
+  [stack state]
+  (make-instruction state max [stack stack] stack))
+
+;; Pushes the minimum of the top two items
+(defn- _min
+  [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
+  [stack state]
+  (make-instruction state
+                    #((if (= stack :float) float int) (if % 1 0))
+                    [:boolean]
+                    stack))
+
+;; Automate type-specific function generation. All resulting functions take a
+;; Push state as their only argument. For FLOAT and INTEGER, create one of each
+;; of the 11 following type-specific functions: =, >, <, +, -, *, QUOT, %, MAX,
+;; MIN, and FROMBOOLEAN. (22 functions total, with syntax e.g. integer_=,
+;; float_min etc.)
+(generate-functions
+  [:float :integer]
+  [_=, _>, _<, _+, _-, _*, _quot, _%, _max, _min, _fromboolean])
+
+;; =============================================================================
+;; FLOAT only
+;; =============================================================================
+
+;; Pushes the cosine of the top FLOAT
 (def-instruction
-  :integer_%
+  :float_cos
   (fn [state]
-    (make-instruction state
-                      (fn [int1 int2]
-                        (if (zero? int2) int1 (quot int1 int2)))
-                      [:integer :integer]
-                      :integer)))
+    (make-instruction state math/cos [:float] :float)))
+
+;; Pushes the sine of the top FLOAT
+(def-instruction
+  :float_sin
+  (fn [state]
+    (make-instruction state math/sin [:float] :float)))
+
+;; Pushes the tangent of the top FLOAT
+(def-instruction
+  :float_tan
+  (fn [state]
+    (make-instruction state math/tan [:float] :float)))
+
+;; Pushes the tangent of the top FLOAT
+(def-instruction
+  :float_tan
+  (fn [state]
+    (make-instruction state math/tan [:float] :float)))
+
+;; Pushes a floating point version of the top INTEGER
+(def-instruction
+  :float_frominteger
+  (fn [state]
+    (make-instruction state math/tan [:float] :float)))
+
+;; =============================================================================
+;; INTEGER only
+;; =============================================================================
+
+;; Pushes the result of truncating the top FLOAT towards negative infinity
+(def-instruction
+  :integer_fromfloat
+  (fn [state]
+    (make-instruction state int [:float] :integer)))

src/propeller/push/instructions/random.clj

@@ -1,9 +1,17 @@
 (ns propeller.push.instructions.random
-  (:require [propeller.push.instructions :refer [def-instruction
-                                                 make-instruction]]))
+  (:require [propeller.push.instructions :refer [def-instruction]]))
 
-;; Pushes a random BOOLEAN
-(def-instruction
-  :boolean_rand
-  (fn [state]
-    (make-instruction state #(rand-nth [true false]) [] :boolean)))
+;;; Pushes a random BOOLEAN
+;(def-instruction
+;  :boolean_rand
+;  (fn [state]
+;    (make-instruction state #(rand-nth [true false]) [] :boolean)))
+;
+;(defn- _rand
+;  "For an INTEGER stack type, pushes a newly generated random INTEGER that is
+;  greater than or equal to MIN-RANDOM-INTEGER and less than or equal to
+;  MAX-RANDOM-INTEGER. Analogous for a FLOAT stack type, with its corresponding
+;  MAX-RANDOM-FLOAT and MIN-RANDOM-FLOAT."
+;  [state stack-type]
+;  (let [data-type (keyword stack-type)]
+;    ()))

src/propeller/push/instructions/string.clj

@@ -1,6 +1,6 @@
 (ns propeller.push.instructions.string
-  (:require [propeller.push.instructions :refer [def-instruction
-                                                 make-instruction]]))
+  (:require [propeller.push.instructions :refer [def-instruction]]
+            [propeller.push.utils :refer [make-instruction]]))
 
 (def-instruction
   :string_=

src/propeller/push/state.clj

@@ -1,30 +1,30 @@
 (ns propeller.push.state)
 
 ;; Set of all stacks used by the Push interpreter
-(defonce ^:private stack-types #{:auxiliary
-                                 :boolean
-                                 :char
-                                 :code
-                                 :environment
-                                 :exec
-                                 :float
-                                 :genome
-                                 :gtm
-                                 :input
-                                 :integer
-                                 :output
-                                 :return
-                                 :string
-                                 :tag
-                                 :vector_boolean
-                                 :vector_float
-                                 :vector_integer
-                                 :vector_string
-                                 :zip})
+(defonce stacks #{:auxiliary
+                  :boolean
+                  :char
+                  :code
+                  :environment
+                  :exec
+                  :float
+                  :genome
+                  :gtm
+                  :input
+                  :integer
+                  :output
+                  :return
+                  :string
+                  :tag
+                  :vector_boolean
+                  :vector_float
+                  :vector_integer
+                  :vector_string
+                  :zip})
 
 ;; Record-based states for performance
 (defmacro define-push-state []
-  `(defrecord ~'State [~@(map #(symbol (name %)) stack-types)]))
+  `(defrecord ~'State [~@(map #(symbol (name %)) stacks)]))
 
 (define-push-state)
 
@@ -32,18 +32,10 @@
 (defonce empty-state (map->State {}))
 
 (def example-push-state
-  {:exec '()
+  {:exec    '()
    :integer '(1 2 3 4 5 6 7)
-   :string '("abc")
-   :input {:in1 4}})
-
-(defn print-state
-  "Pretty-prints a Push state, for logging or debugging purposes."
-  [state]
-  (doseq [stack stack-types]
-    (printf "%-15s = " stack)
-    (prn (if (get state stack) (get state stack) '()))
-    (flush)))
+   :string  '("abc")
+   :input   {:in1 4}})
 
 (defn empty-stack?
   "Returns true if the stack is empty."

src/propeller/push/utils.clj

@@ -1 +1,34 @@
-(ns propeller.push.utils)
+(ns propeller.push.utils
+  (:require [propeller.push.instructions :refer [def-instruction]]
+            [propeller.push.state :as push-state]))
+
+;; A utility function for making Push instructions. Takes a state, a function
+;; to apply to the args, the stacks to take the args from, and the stack to
+;; return the result to. Applies the function to the args (popped from the
+;; given stacks), and pushes the result onto the return-stack
+(defn make-instruction
+  [state function arg-stacks return-stack]
+  (let [popped-args (push-state/get-args-from-stacks state arg-stacks)]
+    (if (= popped-args :not-enough-args)
+      state
+      (let [result (apply function (:args popped-args))
+            new-state (:state popped-args)]
+        (push-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
+;; combination instructions, which here would be :float_+, :float_*, :float_=,
+;; :integer_+, :integer_*, and :integer_=
+(defmacro generate-functions [stacks functions]
+  `(do ~@(for [stack stacks
+               function functions
+               :let [instruction-name (keyword (str (name stack) function))]]
+           `(def-instruction ~instruction-name (partial ~function ~stack)))))
+
+;; Pretty-prints a Push state, for logging or debugging purposes
+(defn print-state
+  [state]
+  (doseq [stack push-state/stacks]
+    (printf "%-15s = " stack)
+    (prn (if (get state stack) (get state stack) '()))
+    (flush)))

src/propeller/session.clj

@@ -21,9 +21,9 @@
                      (assoc empty-push-state :input {:in1 "I can hear you."})
                      1000)
 
-#_(push-from-plushy (make-random-plushy default-instructions 20))
+#_(plushy->push (make-random-plushy default-instructions 20))
 
-#_(interpret-program (push-from-plushy (make-random-plushy default-instructions 20))
+#_(interpret-program (plushy->push (make-random-plushy default-instructions 20))
                      (assoc empty-push-state :input {:in1 "I can hear you."})
                      1000)
 

src/propeller/variation.clj

@@ -1,5 +1,5 @@
 (ns propeller.variation
-  (:use [propeller selection]))
+  (:require [propeller.selection :refer :all]))
 
 (defn crossover
   "Crosses over two individuals using uniform crossover. Pads shorter one."