paired digits, shopping list, snow day

src/propeller/problems/PSB2/paired_digits.cljc

@@ -0,0 +1,66 @@
+(ns propeller.problems.PSB2.paired-digits
+  (:require [psb2.core :as psb2]
+            [propeller.genome :as genome]
+            [propeller.push.interpreter :as interpreter]
+            [propeller.utils :as utils]
+            [propeller.push.utils.helpers :refer [get-stack-instructions]]
+            [propeller.push.state :as state]
+            [propeller.tools.math :as math]))
+
+; ===========  PROBLEM DESCRIPTION  =============================
+; PAIRED DIGITS from PSB2
+; Given a string of digits, return the sum
+; of the digits whose following digit is the same.
+;
+; Source: https://arxiv.org/pdf/2106.06086.pdf
+; ===============================================================
+
+(def train-and-test-data (psb2/fetch-examples "data" "paired-digits" 200 2000))
+
+(defn random-int [] (- (rand-int 201) 100))
+
+(defn random-char [] (rand-nth '(\0 \1 \2 \3 \4 \5 \6 \7 \8 \9)))
+
+(def instructions
+  (utils/not-lazy
+    (concat
+      ;;; stack-specific instructions
+      (get-stack-instructions #{:exec :integer :boolean :char :string :print})
+      ;;; input instructions
+      (list :in1)
+      ;;; close
+      (list 'close)
+      ;;; ERCs (constants)
+      (list 0 random-int random-char))))
+
+(defn error-function
+  [argmap data individual]
+  (let [program (genome/plushy->push (:plushy individual) argmap)
+        inputs (map (fn [i] (get i :input1)) data)
+        correct-outputs (map (fn [i] (get i :output1)) data)
+        outputs (map (fn [input]
+                       (state/peek-stack
+                         (interpreter/interpret-program
+                           program
+                           (assoc state/empty-state :input {:in1 input})
+                           (:step-limit argmap))
+                         :integer))
+                     inputs)
+        errors (map (fn [correct-output output]
+                      (if (= output :no-stack-item)
+                        1000000
+                        (min 1000.0 (math/abs (- correct-output output)))))
+                    correct-outputs
+                    outputs)]
+    (assoc individual
+      :behaviors outputs
+      :errors errors
+      :total-error #?(:clj  (apply +' errors)
+                      :cljs (apply + errors)))))
+
+(def arglist
+  {:instructions   instructions
+   :error-function error-function
+   :training-data  (:train train-and-test-data)
+   :testing-data   (:test train-and-test-data)})
+

src/propeller/problems/PSB2/shopping_list.cljc

@@ -0,0 +1,75 @@
+(ns propeller.problems.PSB2.shopping-list
+  (:require [psb2.core :as psb2]
+            [propeller.genome :as genome]
+            [propeller.push.interpreter :as interpreter]
+            [propeller.utils :as utils]
+            [propeller.push.utils.helpers :refer [get-stack-instructions]]
+            [propeller.push.state :as state]
+            [propeller.tools.math :as math]))
+
+; ===========  PROBLEM DESCRIPTION  ===============================
+; DICE GAME from PSB2
+; Peter has an n sided die and Colin has an m
+; sided die. If they both roll their dice at the same time, return
+; the probability that Peter rolls strictly higher than Colin.
+;
+; Source: https://arxiv.org/pdf/2106.06086.pdf
+; ==================================================================
+
+(def train-and-test-data (psb2/fetch-examples "data" "shopping-list" 200 2000))
+
+(defn random-float [] (- (rand 201) 100))
+
+(defn map-vals-input
+  "Returns all the input values of a map (specific helper method for bouncing-balls)"
+  [i]
+  (vals (select-keys i [:input1 :input2])))
+
+(defn map-vals-output
+  "Returns the output values of a map (specific helper method for bouncing-balls)"
+  [i]
+  (get i :output1))
+
+(def instructions
+  (utils/not-lazy
+    (concat
+      ;;; stack-specific instructions
+      (get-stack-instructions #{:exec :integer :float :boolean :print})
+      ;;; input instructions
+      (list :in1 :in2)
+      ;;; close
+      (list 'close)
+      ;;; ERCs (constants)
+      (list 0.0 100.0 random-float))))
+
+(defn error-function
+  [argmap data individual]
+  (let [program (genome/plushy->push (:plushy individual) argmap)
+        inputs (map (fn [i] (map-vals-input i)) data)
+        correct-outputs (map (fn [i] (map-vals-output i)) data)
+        outputs (map (fn [input]
+                       (state/peek-stack
+                         (interpreter/interpret-program
+                           program
+                           (assoc state/empty-state :input {:in1 (nth input 0)
+                                                            :in2 (nth input 1)})
+                           (:step-limit argmap))
+                         :float))
+                     inputs)
+        errors (map (fn [correct-output output]
+                      (if (= output :no-stack-item)
+                        1000000.0
+                        (min 1000.0 (math/abs (- correct-output output)))))
+                    correct-outputs
+                    outputs)]
+    (assoc individual
+      :behaviors outputs
+      :errors errors
+      :total-error #?(:clj  (apply +' errors)
+                      :cljs (apply + errors)))))
+
+(def arglist
+  {:instructions   instructions
+   :error-function error-function
+   :training-data  (:train train-and-test-data)
+   :testing-data   (:test train-and-test-data)})

src/propeller/problems/PSB2/snow_day.cljc

@@ -0,0 +1,79 @@
+(ns propeller.problems.PSB2.snow-day
+  (:require [psb2.core :as psb2]
+            [propeller.genome :as genome]
+            [propeller.push.interpreter :as interpreter]
+            [propeller.utils :as utils]
+            [propeller.push.utils.helpers :refer [get-stack-instructions]]
+            [propeller.push.state :as state]
+            [propeller.tools.math :as math]))
+
+; ===========  PROBLEM DESCRIPTION  ===============================
+; SNOW DAY from PSB2
+; Given an integer representing a number
+; of hours and 3 floats representing how much snow is on the
+; ground, the rate of snow fall, and the proportion of snow
+; melting per hour, return the amount of snow on the ground
+; after the amount of hours given. Each hour is considered a
+; discrete event of adding snow and then melting, not a continuous
+; process.
+;
+; Source: https://arxiv.org/pdf/2106.06086.pdf
+; ==================================================================
+
+(def train-and-test-data (psb2/fetch-examples "data" "snow-day" 200 2000))
+
+(defn map-vals-input
+  "Returns all the input values of a map (specific helper method for bouncing-balls)"
+  [i]
+  (vals (select-keys i [:input1 :input2 :input3 :input4])))
+
+(defn map-vals-output
+  "Returns the output values of a map (specific helper method for bouncing-balls)"
+  [i]
+  (get i :output1))
+
+(def instructions
+  (utils/not-lazy
+    (concat
+      ;;; stack-specific instructions
+      (get-stack-instructions #{:exec :integer :float :boolean :print})
+      ;;; input instructions
+      (list :in1 :in2 :in3 :in4)
+      ;;; close
+      (list 'close)
+      ;;; ERCs (constants)
+      (list 0 1 -1 0.0 1.0 -1.0))))
+
+(defn error-function
+  [argmap data individual]
+  (let [program (genome/plushy->push (:plushy individual) argmap)
+        inputs (map (fn [i] (map-vals-input i)) data)
+        correct-outputs (map (fn [i] (map-vals-output i)) data)
+        outputs (map (fn [input]
+                       (state/peek-stack
+                         (interpreter/interpret-program
+                           program
+                           (assoc state/empty-state :input {:in1 (nth input 0)
+                                                            :in2 (nth input 1)
+                                                            :in3 (nth input 2)
+                                                            :in4 (nth input 3)})
+                           (:step-limit argmap))
+                         :float))
+                     inputs)
+        errors (map (fn [correct-output output]
+                      (if (= output :no-stack-item)
+                        1000000.0
+                        (min 1000.0 (math/abs (- correct-output output)))))
+                    correct-outputs
+                    outputs)]
+    (assoc individual
+      :behaviors outputs
+      :errors errors
+      :total-error #?(:clj  (apply +' errors)
+                      :cljs (apply + errors)))))
+
+(def arglist
+  {:instructions   instructions
+   :error-function error-function
+   :training-data  (:train train-and-test-data)
+   :testing-data   (:test train-and-test-data)})