From 14f63f880bbcbe1e0e9b9ad775049c3d4dacf11f Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Mon, 7 Dec 2020 13:58:34 -0500 Subject: [PATCH 01/44] Fix comment and error message in handle-input-instruction; begin developing valiant problem --- src/propeller/problems/valiant.cljc | 165 ++++++++++++++++++ .../push/instructions/input_output.cljc | 9 +- 2 files changed, 169 insertions(+), 5 deletions(-) create mode 100644 src/propeller/problems/valiant.cljc diff --git a/src/propeller/problems/valiant.cljc b/src/propeller/problems/valiant.cljc new file mode 100644 index 0000000..640bc64 --- /dev/null +++ b/src/propeller/problems/valiant.cljc @@ -0,0 +1,165 @@ +(ns propeller.problems.valiant) + +(defn train-and-test-data + [num-vars num-inputs num-train num-test] + (let [input-indices (take num-inputs (shuffle (range num-vars))) + rand-vars (fn [] (vec (repeatedly num-vars #(< (rand) 0.5)))) + even-parity? (fn [vars] + (even? (count (filter #(= % true) + (map #(nth vars %) + input-indices))))) + train-inputs (repeatedly num-train rand-vars) + test-inputs (repeatedly num-test rand-vars)] + {:train {:inputs train-inputs + :outputs (map even-parity? train-inputs)} + :test {:inputs test-inputs + :outputs (map even-parity? test-inputs)}})) + +(def instructions + (list :in1 + :integer_add + :integer_subtract + :integer_mult + :integer_quot + :integer_eq + :exec_dup + :exec_if + 'close + 0 + 1)) + +boolean_and boolean_or boolean_not exec_if + +;============== NOTE NOTE NOTE ================= +; This file has note been updated for Clojush 2.0, and will likely not work +;============== NOTE NOTE NOTE ================= +; +;(ns clojush.problems.boolean.valiant +; (:use [clojush.pushgp.pushgp] +; [clojush.pushstate] +; [clojush.random] +; [clojush.interpreter] +; [clojure.math.numeric-tower])) +; +;(def numvars 100) ;1000) +;(def numinputs 50) ;500) +;(def numcases 500) ;5000) +; +;(def input-indices +; (vec (take numinputs (shuffle (range numvars))))) +; +;(def cases +; (vec (repeatedly numcases +; (fn [] (let [vars (vec (repeatedly numvars #(< (lrand) 0.5)))] +; [vars (even? (count (filter #(= % true) +; (map #(nth vars %) +; input-indices))))]))))) +; +;(println "input-indices:" input-indices) +; +;;; ugly way to define all of the input instructions, since I haven't fully +;;; grokked Clojure macros +; +;(def n-hack (atom 0)) +; +;(defn define-input [n] +; (reset! n-hack n) +; (eval `(define-registered ~(symbol (str "input" @n-hack)) +; (fn [state#] +; (push-item (nth (first (:auxiliary state#)) ~(+ @n-hack)) +; :boolean +; state#))))) +; +;(dotimes [n numvars] (define-input n)) +; +;;; this gives the instructions: (registered-for-type "input") +; +;(defn rp [prog state] (run-push prog state true)) +; +;(defn valiant-fitness +; [individual] +; (assoc individual +; :errors +; (doall (for [c (range numcases)] +; (let [[inputs answer] (nth cases c) +; output (->> (make-push-state) +; (push-item inputs :auxiliary) +; (run-push (:program individual)) +; ;(rp (:program individual)) +; (top-item :boolean))] +; ;(println "output" output "answer" answer) +; (if (= output answer) 0 1)))))) +; +;;input-indices +; +;;(reduce + (valiant-fitness '(input1 input4 input0 input7 input9 boolean_and boolean_and boolean_and boolean_and))) +; +;;; oversized-offspring-fail-to-random? -- take fail to random code from here and use right +;;; parameters +;;(in-ns 'clojush.pushgp.genetic-operators) +;;(defn crossover +;; "Returns a copy of parent1 with a random subprogram replaced with a random +;; subprogram of parent2." +;; [parent1 parent2 max-points] +;; (let [new-program (case (lrand-int 2) +;; 0 (insert-code-at-point +;; (:program parent1) +;; (select-node-index (:program parent1)) +;; (code-at-point (:program parent2) +;; (select-node-index (:program parent2)))) +;; 1 (list (random-code 10 @global-atom-generators) 'exec_if (:program parent1) (:program parent2)))] +;; (if (> (count-points new-program) max-points) +;; ;parent1 +;; (make-individual :program (random-code 10 @global-atom-generators) :history (:history parent1) +;; :ancestors (if global-maintain-ancestors +;; (cons (:program parent1) (:ancestors parent1)) +;; (:ancestors parent1))) +;; (make-individual :program new-program :history (:history parent1) +;; :ancestors (if global-maintain-ancestors +;; (cons (:program parent1) (:ancestors parent1)) +;; (:ancestors parent1)))))) +;;(in-ns 'experimental.valiant) +;;; +;;; Probabilistic Pseudo Hillclimbing (persistence) +;;; +; +;;(def argmap +;; {:error-function valiant-fitness +;; :atom-generators (concat (vec (registered-for-type "input")) +;; ;) +;; (apply concat +;; (repeat 25 +;; '(boolean_and boolean_or boolean_not exec_if)))) +;; :use-lexicase-selection true +;; :max-points 40000 +;; :max-genome-size-in-initial-program 10 +;; :population-size 100 +;; :evalpush-limit 10000 +;; :mutation-probability 0.4 +;; :mutation-max-points 50 +;; ;:crossover-probability 0.4 +;; :simplification-probability 0.2 +;; :reproduction-simplifications 1 +;; ;:deletion-mutation-probability 0.2 +;; :boolean-gsxover-probability 0.4 +;; :boolean-gsxover-new-code-max-points 10 +;; :parent-reversion-probability 0.95 +;; ;:decimation-ratio 0.01 +;; ;:use-single-thread true +;; }) +; +;(def argmap +; {:error-function valiant-fitness +; :atom-generators (concat (vec (registered-for-type "input")) +; ;) +; (apply concat +; (repeat 25 +; '(boolean_and boolean_or boolean_not exec_if)))) +; :max-points 4000 +; :max-genome-size-in-initial-program 100 +; :population-size 100 +; :evalpush-limit 2000 +; :genetic-operator-probabilities {[:alternation :uniform-mutation] 1.0} ;Somewhat equivalent to normal Push's ULTRA operator +; :alignment-deviation 20 +; ;:use-single-thread true +; }) \ No newline at end of file diff --git a/src/propeller/push/instructions/input_output.cljc b/src/propeller/push/instructions/input_output.cljc index 55db2ee..18d24c7 100755 --- a/src/propeller/push/instructions/input_output.cljc +++ b/src/propeller/push/instructions/input_output.cljc @@ -12,16 +12,15 @@ ;; ============================================================================= ;; Allows Push to handle input instructions of the form :inN, e.g. :in2, taking -;; elements thus labeled from the :input stack and pushing them onto the :exec -;; stack. We can tell whether a particular inN instruction is valid if N-1 -;; values are on the input stack. +;; elements thus labeled from the :input map and pushing them onto the :exec +;; stack. (defn handle-input-instruction [state instruction] (if-let [input (instruction (:input state))] (state/push-to-stack state :exec input) - (throw #?(:clj (Exception. (str "Undefined input instruction " instruction)) + (throw #?(:clj (Exception. (str "Undefined instruction " instruction)) :cljs (js/Error - (str "Undefined input instruction " instruction)))))) + (str "Undefined instruction " instruction)))))) ;; ============================================================================= ;; OUTPUT Instructions From bb916c2ad36fdf36a42f12f8a98407d086734267 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Mon, 7 Dec 2020 20:19:59 -0500 Subject: [PATCH 02/44] Fix handling of false boolean input values; continue development of valiant problem --- src/propeller/problems/valiant.cljc | 193 +++--------- .../push/instructions/input_output.cljc | 7 +- src/propeller/session.cljc | 298 ++++++++++-------- 3 files changed, 207 insertions(+), 291 deletions(-) diff --git a/src/propeller/problems/valiant.cljc b/src/propeller/problems/valiant.cljc index 640bc64..d47fd86 100644 --- a/src/propeller/problems/valiant.cljc +++ b/src/propeller/problems/valiant.cljc @@ -1,7 +1,14 @@ -(ns propeller.problems.valiant) +(ns propeller.problems.valiant + (:require [propeller.genome :as genome] + [propeller.push.interpreter :as interpreter] + [propeller.push.state :as state])) -(defn train-and-test-data - [num-vars num-inputs num-train num-test] +(def num-vars 100) ;1000) +(def num-inputs 50) ;500) +(def num-train 500) ;5000) +(def num-test 200) + +(def train-and-test-data (let [input-indices (take num-inputs (shuffle (range num-vars))) rand-vars (fn [] (vec (repeatedly num-vars #(< (rand) 0.5)))) even-parity? (fn [vars] @@ -16,150 +23,38 @@ :outputs (map even-parity? test-inputs)}})) (def instructions - (list :in1 - :integer_add - :integer_subtract - :integer_mult - :integer_quot - :integer_eq - :exec_dup - :exec_if - 'close - 0 - 1)) + (vec (concat (for [i (range num-inputs)] (keyword (str "in" i))) + (take num-inputs + (cycle [:boolean_and + :boolean_or + :boolean_not + :exec_if + 'close]))))) -boolean_and boolean_or boolean_not exec_if - -;============== NOTE NOTE NOTE ================= -; This file has note been updated for Clojush 2.0, and will likely not work -;============== NOTE NOTE NOTE ================= -; -;(ns clojush.problems.boolean.valiant -; (:use [clojush.pushgp.pushgp] -; [clojush.pushstate] -; [clojush.random] -; [clojush.interpreter] -; [clojure.math.numeric-tower])) -; -;(def numvars 100) ;1000) -;(def numinputs 50) ;500) -;(def numcases 500) ;5000) -; -;(def input-indices -; (vec (take numinputs (shuffle (range numvars))))) -; -;(def cases -; (vec (repeatedly numcases -; (fn [] (let [vars (vec (repeatedly numvars #(< (lrand) 0.5)))] -; [vars (even? (count (filter #(= % true) -; (map #(nth vars %) -; input-indices))))]))))) -; -;(println "input-indices:" input-indices) -; -;;; ugly way to define all of the input instructions, since I haven't fully -;;; grokked Clojure macros -; -;(def n-hack (atom 0)) -; -;(defn define-input [n] -; (reset! n-hack n) -; (eval `(define-registered ~(symbol (str "input" @n-hack)) -; (fn [state#] -; (push-item (nth (first (:auxiliary state#)) ~(+ @n-hack)) -; :boolean -; state#))))) -; -;(dotimes [n numvars] (define-input n)) -; -;;; this gives the instructions: (registered-for-type "input") -; -;(defn rp [prog state] (run-push prog state true)) -; -;(defn valiant-fitness -; [individual] -; (assoc individual -; :errors -; (doall (for [c (range numcases)] -; (let [[inputs answer] (nth cases c) -; output (->> (make-push-state) -; (push-item inputs :auxiliary) -; (run-push (:program individual)) -; ;(rp (:program individual)) -; (top-item :boolean))] -; ;(println "output" output "answer" answer) -; (if (= output answer) 0 1)))))) -; -;;input-indices -; -;;(reduce + (valiant-fitness '(input1 input4 input0 input7 input9 boolean_and boolean_and boolean_and boolean_and))) -; -;;; oversized-offspring-fail-to-random? -- take fail to random code from here and use right -;;; parameters -;;(in-ns 'clojush.pushgp.genetic-operators) -;;(defn crossover -;; "Returns a copy of parent1 with a random subprogram replaced with a random -;; subprogram of parent2." -;; [parent1 parent2 max-points] -;; (let [new-program (case (lrand-int 2) -;; 0 (insert-code-at-point -;; (:program parent1) -;; (select-node-index (:program parent1)) -;; (code-at-point (:program parent2) -;; (select-node-index (:program parent2)))) -;; 1 (list (random-code 10 @global-atom-generators) 'exec_if (:program parent1) (:program parent2)))] -;; (if (> (count-points new-program) max-points) -;; ;parent1 -;; (make-individual :program (random-code 10 @global-atom-generators) :history (:history parent1) -;; :ancestors (if global-maintain-ancestors -;; (cons (:program parent1) (:ancestors parent1)) -;; (:ancestors parent1))) -;; (make-individual :program new-program :history (:history parent1) -;; :ancestors (if global-maintain-ancestors -;; (cons (:program parent1) (:ancestors parent1)) -;; (:ancestors parent1)))))) -;;(in-ns 'experimental.valiant) -;;; -;;; Probabilistic Pseudo Hillclimbing (persistence) -;;; -; -;;(def argmap -;; {:error-function valiant-fitness -;; :atom-generators (concat (vec (registered-for-type "input")) -;; ;) -;; (apply concat -;; (repeat 25 -;; '(boolean_and boolean_or boolean_not exec_if)))) -;; :use-lexicase-selection true -;; :max-points 40000 -;; :max-genome-size-in-initial-program 10 -;; :population-size 100 -;; :evalpush-limit 10000 -;; :mutation-probability 0.4 -;; :mutation-max-points 50 -;; ;:crossover-probability 0.4 -;; :simplification-probability 0.2 -;; :reproduction-simplifications 1 -;; ;:deletion-mutation-probability 0.2 -;; :boolean-gsxover-probability 0.4 -;; :boolean-gsxover-new-code-max-points 10 -;; :parent-reversion-probability 0.95 -;; ;:decimation-ratio 0.01 -;; ;:use-single-thread true -;; }) -; -;(def argmap -; {:error-function valiant-fitness -; :atom-generators (concat (vec (registered-for-type "input")) -; ;) -; (apply concat -; (repeat 25 -; '(boolean_and boolean_or boolean_not exec_if)))) -; :max-points 4000 -; :max-genome-size-in-initial-program 100 -; :population-size 100 -; :evalpush-limit 2000 -; :genetic-operator-probabilities {[:alternation :uniform-mutation] 1.0} ;Somewhat equivalent to normal Push's ULTRA operator -; :alignment-deviation 20 -; ;:use-single-thread true -; }) \ No newline at end of file +(defn error-function + ([argmap individual] + (error-function argmap individual :train)) + ([argmap individual subset] + (let [program (genome/plushy->push (:plushy individual) argmap) + data (get train-and-test-data subset) + inputs (:inputs data) + correct-outputs (:outputs data) + outputs (map (fn [input] + (state/peek-stack + (interpreter/interpret-program + program + (assoc state/empty-state + :input (zipmap (for [i (range (count input))] + (keyword (str "in" i))) + input)) + (:step-limit argmap)) + :boolean)) + inputs) + errors (map #(if (= %1 %2) 0 1) + correct-outputs + outputs)] + (assoc individual + :behaviors outputs + :errors errors + :total-error #?(:clj (apply +' errors) + :cljs (apply + errors)))))) diff --git a/src/propeller/push/instructions/input_output.cljc b/src/propeller/push/instructions/input_output.cljc index 18d24c7..2a622e1 100755 --- a/src/propeller/push/instructions/input_output.cljc +++ b/src/propeller/push/instructions/input_output.cljc @@ -16,9 +16,10 @@ ;; stack. (defn handle-input-instruction [state instruction] - (if-let [input (instruction (:input state))] - (state/push-to-stack state :exec input) - (throw #?(:clj (Exception. (str "Undefined instruction " instruction)) + (if (contains? (:input state) instruction) + (let [input (instruction (:input state))] + (state/push-to-stack state :exec input)) + (throw #?(:clj (Exception. (str "Undefined instruction " instruction)) :cljs (js/Error (str "Undefined instruction " instruction)))))) diff --git a/src/propeller/session.cljc b/src/propeller/session.cljc index 7154b7e..73bdf24 100755 --- a/src/propeller/session.cljc +++ b/src/propeller/session.cljc @@ -5,150 +5,170 @@ [propeller.variation :as variation] [propeller.problems.simple-regression :as regression] [propeller.problems.string-classification :as string-classif] + propeller.problems.valiant [propeller.push.core :as push] [propeller.push.interpreter :as interpreter] [propeller.push.state :as state] [propeller.push.utils.helpers :refer [get-stack-instructions]])) -#_(interpreter/interpret-program - '(1 2 :integer_add) state/empty-state 1000) - -#_(interpreter/interpret-program - '(3 3 :integer_eq :exec_if (1 "yes") (2 "no")) - state/empty-state - 1000) - -#_(interpreter/interpret-program - '(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if - (:in1 " I am asking." :string_concat) - (:in1 " I am saying." :string_concat)) - (assoc state/empty-state :input {:in1 "Can you hear me?"}) - 1000) - -#_(interpreter/interpret-program - '(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if - (:in1 " I am asking." :string_concat) - (:in1 " I am saying." :string_concat)) - (assoc state/empty-state :input {:in1 "I can hear you."}) - 1000) - -#_(genome/plushy->push - (genome/make-random-plushy (get-stack-instructions #{:float :integer :exec :boolean}) 20)) - -#_(gp/gp {:instructions propeller.problems.software.number-io/instructions - :error-function propeller.problems.software.number-io/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :variation {:umad 0.5 :crossover 0.5} - :elitism false}) - -#_(gp/gp {:instructions propeller.problems.simple-regression/instructions - :error-function propeller.problems.simple-regression/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :tournament - :tournament-size 5 - :umad-rate 0.01 - :variation {:umad 1.0 - :crossover 0.0} - :elitism false}) - -#_(gp/gp {:instructions propeller.problems.simple-regression/instructions - :error-function propeller.problems.simple-regression/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :tournament - :tournament-size 5 - :umad-rate 0.1 - :variation {:umad 1.0 - :crossover 0.0} - :elitism false}) +;#_(interpreter/interpret-program +; '(1 2 :integer_add) state/empty-state 1000) +; +;#_(interpreter/interpret-program +; '(3 3 :integer_eq :exec_if (1 "yes") (2 "no")) +; state/empty-state +; 1000) +; +;#_(interpreter/interpret-program +; '(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if +; (:in1 " I am asking." :string_concat) +; (:in1 " I am saying." :string_concat)) +; (assoc state/empty-state :input {:in1 "Can you hear me?"}) +; 1000) +; +;#_(interpreter/interpret-program +; '(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if +; (:in1 " I am asking." :string_concat) +; (:in1 " I am saying." :string_concat)) +; (assoc state/empty-state :input {:in1 "I can hear you."}) +; 1000) +; +;#_(genome/plushy->push +; (genome/make-random-plushy (get-stack-instructions #{:float :integer :exec :boolean}) 20)) +; +;#_(gp/gp {:instructions propeller.problems.software.number-io/instructions +; :error-function propeller.problems.software.number-io/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :lexicase +; :tournament-size 5 +; :umad-rate 0.1 +; :variation {:umad 0.5 :crossover 0.5} +; :elitism false}) +; +;#_(gp/gp {:instructions propeller.problems.simple-regression/instructions +; :error-function propeller.problems.simple-regression/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :tournament +; :tournament-size 5 +; :umad-rate 0.01 +; :variation {:umad 1.0 +; :crossover 0.0} +; :elitism false}) +; +;#_(gp/gp {:instructions propeller.problems.simple-regression/instructions +; :error-function propeller.problems.simple-regression/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :tournament +; :tournament-size 5 +; :umad-rate 0.1 +; :variation {:umad 1.0 +; :crossover 0.0} +; :elitism false}) +; +; +;#_(gp/gp {:instructions propeller.problems.simple-regression/instructions +; :error-function propeller.problems.simple-regression/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :lexicase +; :tournament-size 5 +; :umad-rate 0.1 +; :variation {:umad 1.0 +; :crossover 0.0} +; :elitism false}) +; +;#_(gp/gp {:instructions propeller.problems.simple-regression/instructions +; :error-function propeller.problems.simple-regression/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :lexicase +; :tournament-size 5 +; :umad-rate 0.1 +; :diploid-flip-rate 0.1 +; :variation {:umad 0.8 +; :diploid-flip 0.2} +; :elitism false +; :diploid true}) +; +; +;#_(gp/gp {:instructions propeller.problems.software.smallest/instructions +; :error-function propeller.problems.software.smallest/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :lexicase +; :tournament-size 5 +; :umad-rate 0.1 +; :diploid-flip-rate 0.1 +; :variation {;:umad 0.8 +; ;:diploid-flip 0.2 +; :umad 1 +; } +; :elitism false +; :diploid false}) +; +;#_(gp/gp {:instructions propeller.problems.software.smallest/instructions +; :error-function propeller.problems.software.smallest/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 200 ;100 +; :step-limit 200 +; :parent-selection :lexicase +; :tournament-size 5 +; :umad-rate 0.1 +; :diploid-flip-rate 0.1 +; :variation {:umad 0.8 +; :diploid-flip 0.2 +; ;:umad 1 +; } +; :elitism false +; :diploid true}) +; +; +;(gp/gp {:instructions propeller.problems.string-classification/instructions +; :error-function propeller.problems.string-classification/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 100 +; :step-limit 200 +; :parent-selection :lexicase +; :tournament-size 5 +; :umad-rate 0.1 +; :diploid-flip-rate 0.1 +; :variation {:umad 0.8 +; :diploid-flip 0.2 +; } +; :elitism false +; :diploid true}) -#_(gp/gp {:instructions propeller.problems.simple-regression/instructions - :error-function propeller.problems.simple-regression/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :variation {:umad 1.0 - :crossover 0.0} - :elitism false}) +(gp/gp {:instructions propeller.problems.valiant/instructions + :error-function propeller.problems.valiant/error-function + :max-generations 500 + :population-size 500 + :max-initial-plushy-size 1000 + :step-limit 2000 + :parent-selection :lexicase + :tournament-size 5 + :umad-rate 0.001 + :diploid-flip-rate 0.001 + :variation {:umad 0.5 + :diploid-flip 0.5 + } + :elitism false + :diploid true}) -#_(gp/gp {:instructions propeller.problems.simple-regression/instructions - :error-function propeller.problems.simple-regression/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :diploid-flip-rate 0.1 - :variation {:umad 0.8 - :diploid-flip 0.2} - :elitism false - :diploid true}) - - -#_(gp/gp {:instructions propeller.problems.software.smallest/instructions - :error-function propeller.problems.software.smallest/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :diploid-flip-rate 0.1 - :variation {;:umad 0.8 - ;:diploid-flip 0.2 - :umad 1 - } - :elitism false - :diploid false}) - -#_(gp/gp {:instructions propeller.problems.software.smallest/instructions - :error-function propeller.problems.software.smallest/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 200 ;100 - :step-limit 200 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :diploid-flip-rate 0.1 - :variation {:umad 0.8 - :diploid-flip 0.2 - ;:umad 1 - } - :elitism false - :diploid true}) - -#_(gp/gp {:instructions propeller.problems.string-classification/instructions - :error-function propeller.problems.string-classification/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 100 - :step-limit 200 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :diploid-flip-rate 0.1 - :variation {:umad 0.8 - :diploid-flip 0.2 - } - :elitism false - :diploid true}) From d49f9e4bf081a3db3c0c073a09017694633a57ed Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Tue, 8 Dec 2020 12:12:23 -0500 Subject: [PATCH 03/44] Remove extraneous argmap argument; experiment with valiant --- .DS_Store | Bin 6148 -> 8196 bytes src/.DS_Store | Bin 6148 -> 6148 bytes src/propeller/.DS_Store | Bin 6148 -> 6148 bytes src/propeller/problems/valiant.cljc | 11 ++++--- src/propeller/session.cljc | 46 +++++++++++++++++++++++++--- src/propeller/variation.cljc | 2 +- 6 files changed, 48 insertions(+), 11 deletions(-) diff --git a/.DS_Store b/.DS_Store index feca8613504bcd7430524202412f605a970dd548..4c8696c854640d8b1087a87465a54826e6211a0c 100644 GIT binary patch literal 8196 zcmeHMJ%|%Q6n>LGcTq8gaB0Lvusby=jCX|+V-zfegNPRAakrar1TzsQ6vEi?`WABsQs7pPS^=%VtOE4xo`ADZ2Nwe6{GK!) z$ym!Pm7J#M;F_`Y`|HWw4<9e9c=bTM(~#Z`oUkwylE~{q6>4BB%<%cUipt#Qo_x9V zi*rlyEpNge?V<3;)+m1pZ1C|@g8+Or19(4;%Q>9+vAw_ZmesFZL(XEJkCF$!*~L)< z4=Pg`Y-0ujk-5L^y?pol8siSpN$s;}1fL0Atl3A-9?mLsKE+MdiSUy1czpiVIFCrr zNlpiQs`*i3tlFn}Ieot)cHAeY({%kHo82d|cp{lPWSE9w95pt|4X^fx*n1*SZ zo9WD8kjv&TEL-`N;j%SY$>MZ1zd9V6#?tBB#p_$Gdpm>s!v{}U0YJo43Xbvb;rMJ) zo+3H<`C@{|GVlEfx0;Ye-ej|=B4^y9#3Jr)x!Z1f?K-Z|>{7VtZIroAx4)7L9NC@5 z<%}NQSl@Uv-u%)v%$j zEUW@?UU`O||F6z}|G%*M=)$!Ei=Y5Wl**+dRyzLGGF@~G7cA^s*lDAFBW_s;4%CIN iv*S40@DD?rTLLQxJK`1*Z2#azfPVfn<@K=03j77KVL@*I delta 143 zcmZp1XfcprU|?W$DortDU=RQ@Ie-{MGpJ5X6gFlAGME{P8HyN^Q;L&wlJfI&KyqNf z1f@Z0fLMS5BEKy(5WE;o< L44dP5<}d>Qx3LtN diff --git a/src/.DS_Store b/src/.DS_Store index bf7db11ae7cdca67181c347f9cc33b772a663d38..059041468db135bd0d2cc7fe59bb35aa6d395f07 100644 GIT binary patch delta 268 zcmZoMXfc@J&&akhU^gQp+hiUlMbVQ<1v#0;B?bo98JU<_SlQS)I5{{bJ29o{b8vEU z#tTSPR~s6bnd>N+S=8z%R9hGTnU-djwY8ia;;M$Wo(Z{?Rn;}Mbu%YlWsb^;)0}{{3HejhT};EIhn;J1_sv|nV4Bv+1NQa zIJhS}F{SBpa&mCS3y4)$8=L7Um|529C{&x98|WyQ7@O7Ba&m~P8rpg$B)qu~2NHo}wrV0|Nsi1A_nqLk>eKLoP#cQh9N~#)Hcl>p?Oc3DYVuLgC%Y#c2OG=BK5{sfi zynw`#j3g*KBtJg~&Q44U%S>T_Yz`)#i e@H_Klei2;}kdYv38Xz>-#?2uj8<;0HumAwE{$D5n delta 94 zcmZoMXfc=|#>CJzu~2NHo}wrd0|Nsi1A_nqLk>eKLoP#cN^x?|#6tDS1|lqze=x~z vHf6rVvN?gdlW8+M2R{c; Date: Tue, 8 Dec 2020 22:53:37 -0500 Subject: [PATCH 04/44] Provide more modular and and extensible approach to genetic operator dispatch --- src/propeller/problems/valiant.cljc | 8 +-- src/propeller/session.cljc | 27 ++++++++-- src/propeller/variation.cljc | 76 +++++++++++++++++++++-------- 3 files changed, 82 insertions(+), 29 deletions(-) diff --git a/src/propeller/problems/valiant.cljc b/src/propeller/problems/valiant.cljc index e43d899..c51e9a4 100644 --- a/src/propeller/problems/valiant.cljc +++ b/src/propeller/problems/valiant.cljc @@ -26,10 +26,10 @@ (vec (concat (for [i (range num-inputs)] (keyword (str "in" i))) (take num-inputs (cycle [:boolean_xor - ;:boolean_or - ;:boolean_not - ;:exec_if - ;'close + :boolean_or + :boolean_not + :exec_if + 'close ]))))) (defn error-function diff --git a/src/propeller/session.cljc b/src/propeller/session.cljc index 9f83bd4..1db83ca 100755 --- a/src/propeller/session.cljc +++ b/src/propeller/session.cljc @@ -190,21 +190,38 @@ ;;; below is when I switched to just xor +;(gp/gp {:instructions propeller.problems.valiant/instructions +; :error-function propeller.problems.valiant/error-function +; :max-generations 500 +; :population-size 500 +; :max-initial-plushy-size 50 +; :step-limit 2000 +; :parent-selection :lexicase +; :tournament-size 2 +; :umad-rate 0.01 +; :diploid-flip-rate 0.01 +; :variation {:umad 0.5 +; :crossover 0.25 +; :diploid-flip 0.25 +; } +; :elitism false +; :diploid true}) + +;; separated diploid from other operators + (gp/gp {:instructions propeller.problems.valiant/instructions :error-function propeller.problems.valiant/error-function :max-generations 500 - :population-size 500 + :population-size 50 :max-initial-plushy-size 50 :step-limit 2000 :parent-selection :lexicase :tournament-size 2 :umad-rate 0.01 :diploid-flip-rate 0.01 - :variation {:umad 0.5 - :crossover 0.25 + :variation {:diploid-umad 0.5 + :diploid-crossover 0.25 :diploid-flip 0.25 } :elitism false :diploid true}) - - diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc index 1c01464..b8c148b 100755 --- a/src/propeller/variation.cljc +++ b/src/propeller/variation.cljc @@ -80,26 +80,62 @@ individuals in the population." [pop argmap] {:plushy - (let [prob (rand) - [xover add del] (if (:diploid argmap) - [diploid-crossover diploid-uniform-addition diploid-uniform-deletion] - [crossover uniform-addition uniform-deletion]) - xover-prob (or (:crossover (:variation argmap)) 0) - umad-prob (or (:umad (:variation argmap)) 0) - flip-prob (or (:diploid-flip (:variation argmap)) 0)] - (cond - (< prob xover-prob) - (xover (:plushy (selection/select-parent pop argmap)) - (:plushy (selection/select-parent pop argmap))) + (let [r (rand) + op (loop [accum 0.0 + ops-probs (vec (:variation argmap))] + (if (empty? ops-probs) + :reproduction + (let [[op1 prob1] (first ops-probs)] + (if (>= (+ accum prob1) r) + op1 + (recur (+ accum prob1) + (rest ops-probs))))))] + (case op + :crossover + (crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) ; - (< prob (+ xover-prob umad-prob)) - (del (add (:plushy (selection/select-parent pop argmap)) - (:instructions argmap) - (:umad-rate argmap)) - (:umad-rate argmap)) + :umad + (-> (:plushy (selection/select-parent pop argmap)) + (uniform-addition (:instructions argmap) (:umad-rate argmap)) + (uniform-deletion (:umad-rate argmap))) ; - (< prob (+ xover-prob umad-prob flip-prob)) - (diploid-flip (:plushy (selection/select-parent pop argmap)) - (:diploid-flip-rate argmap)) + :uniform-addition + (-> (:plushy (selection/select-parent pop argmap)) + (uniform-addition (:instructions argmap) (:umad-rate argmap))) ; - :else (:plushy (selection/select-parent pop argmap))))}) + :uniform-deletion + (-> (:plushy (selection/select-parent pop argmap)) + (uniform-deletion (:umad-rate argmap))) + ; + :diploid-crossover + (diploid-crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) + ; + :diploid-umad + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-uniform-addition (:instructions argmap) (:umad-rate argmap)) + (diploid-uniform-deletion (:umad-rate argmap))) + ; + :diploid-uniform-addition + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-uniform-addition (:instructions argmap) (:umad-rate argmap))) + ; + :diploid-uniform-deletion + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-uniform-deletion (:umad-rate argmap))) + ; + :diploid-flip + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-flip (:diploid-flip-rate argmap))) + ; + :reproduction + (:plushy (selection/select-parent pop argmap)) + ; + :else + (throw #?(:clj (Exception. (str "No match in new-individual for " op)) + :cljs (js/Error + (str "No match in new-individual for " op))))))}) + From 0af6aa095e178115f26bf1d916b815a07ee4d932 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Wed, 9 Dec 2020 10:42:05 -0500 Subject: [PATCH 05/44] Add uniform-replacement; pass argmap to plushy->push in report --- src/propeller/gp.cljc | 2 +- src/propeller/session.cljc | 14 ++++++++------ src/propeller/variation.cljc | 14 +++++++++++++- 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index 1f7e927..ed68be9 100755 --- a/src/propeller/gp.cljc +++ b/src/propeller/gp.cljc @@ -19,7 +19,7 @@ (println " Report for Generation" generation) (println "-------------------------------------------------------") (print "Best plushy: ") (prn (:plushy best)) - (print "Best program: ") (prn (genome/plushy->push (:plushy best))) + (print "Best program: ") (prn (genome/plushy->push (:plushy best) argmap)) (println "Best total error:" (:total-error best)) (println "Best errors:" (:errors best)) (println "Best behaviors:" (:behaviors best)) diff --git a/src/propeller/session.cljc b/src/propeller/session.cljc index 1db83ca..fbca6ec 100755 --- a/src/propeller/session.cljc +++ b/src/propeller/session.cljc @@ -212,16 +212,18 @@ (gp/gp {:instructions propeller.problems.valiant/instructions :error-function propeller.problems.valiant/error-function :max-generations 500 - :population-size 50 - :max-initial-plushy-size 50 - :step-limit 2000 + :population-size 1000 + :max-initial-plushy-size 10 + :step-limit 1000 :parent-selection :lexicase :tournament-size 2 :umad-rate 0.01 + :replacement-rate 0.01 :diploid-flip-rate 0.01 - :variation {:diploid-umad 0.5 - :diploid-crossover 0.25 - :diploid-flip 0.25 + :variation {:diploid-umad 0.25 + :diploid-crossover 0.25 + :diploid-flip 0.25 + :uniform-replacement 0.25 } :elitism false :diploid true}) diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc index b8c148b..d35c452 100755 --- a/src/propeller/variation.cljc +++ b/src/propeller/variation.cljc @@ -42,6 +42,15 @@ [%]) plushy))) +(defn uniform-replacement + "Returns plushy with new instructions possibly replacing existing + instructions." + [plushy instructions replacement-rate] + (map #(if (< (rand) replacement-rate) + (utils/random-instruction instructions) + %) + plushy)) + (defn diploid-uniform-addition "Returns plushy with new instructions possibly added before or after each existing instruction." @@ -105,6 +114,10 @@ (-> (:plushy (selection/select-parent pop argmap)) (uniform-addition (:instructions argmap) (:umad-rate argmap))) ; + :uniform-replacement + (-> (:plushy (selection/select-parent pop argmap)) + (uniform-replacement (:instructions argmap) (:replacement-rate argmap))) + ; :uniform-deletion (-> (:plushy (selection/select-parent pop argmap)) (uniform-deletion (:umad-rate argmap))) @@ -138,4 +151,3 @@ (throw #?(:clj (Exception. (str "No match in new-individual for " op)) :cljs (js/Error (str "No match in new-individual for " op))))))}) - From 2f4adfde7acb212ba158d09a77e85d5e766b1878 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Wed, 9 Dec 2020 10:49:53 -0500 Subject: [PATCH 06/44] Pass argmap to report --- src/propeller/gp.cljc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index ed68be9..2a46aeb 100755 --- a/src/propeller/gp.cljc +++ b/src/propeller/gp.cljc @@ -13,7 +13,7 @@ (defn report "Reports information each generation." - [pop generation] + [pop generation argmap] (let [best (first pop)] (println "-------------------------------------------------------") (println " Report for Generation" generation) @@ -48,7 +48,7 @@ :cljs map) (partial error-function argmap) population)) best-individual (first evaluated-pop)] - (report evaluated-pop generation) + (report evaluated-pop generation argmap) (cond ;; Success on training cases is verified on testing cases (zero? (:total-error best-individual)) From a6e195eb0ec03a4650cc32b1b46fafc51ffe2540 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Thu, 17 Dec 2020 08:15:40 -0600 Subject: [PATCH 07/44] Add `data` and `.calva` to .`gitignore` We don't want to be committing the data files or the Calva files generated by running Clojure in VS Code. This fixes that. --- .gitignore | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 5211373..d061ca6 100644 --- a/.gitignore +++ b/.gitignore @@ -12,4 +12,10 @@ pom.xml.asc .hg/ out notes -.idea/ \ No newline at end of file +.idea/ +.calva/ + +# Don't commit the data directory that we'll +# use to hold the data from +# https://github.com/thelmuth/program-synthesis-benchmark-datasets +/data \ No newline at end of file From d1e863a23a5b960b61d46b714d228eb4b0bc9168 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Thu, 17 Dec 2020 15:56:27 -0600 Subject: [PATCH 08/44] Start `test.check` tests on vector instructions This is a start on using `test.check` to write tests for the vector instructions. We currently have tests for: * `vector/_emptyvector` * `vector/_indexof` * `vector/_subvec` There are _lots_ of other functions still to be tested. This did reveal errors in `vector/_subvec`, which will be addressed in the next commit. We used macros to make it easy to generate tests for each of the four vector types; this should be extensible to additional vector types in the future if needed. --- project.clj | 3 +- .../push/instructions/vector_spec.clj | 112 ++++++++++++++++++ 2 files changed, 114 insertions(+), 1 deletion(-) create mode 100644 test/propeller/push/instructions/vector_spec.clj diff --git a/project.clj b/project.clj index ae2d7d2..e941433 100644 --- a/project.clj +++ b/project.clj @@ -4,6 +4,7 @@ :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"] - [org.clojure/clojurescript "1.9.946"]] + [org.clojure/clojurescript "1.9.946"] + [org.clojure/test.check "1.1.0"]] :main ^:skip-aot propeller.core :repl-options {:init-ns propeller.core}) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj new file mode 100644 index 0000000..bec11b0 --- /dev/null +++ b/test/propeller/push/instructions/vector_spec.clj @@ -0,0 +1,112 @@ +(ns propeller.push.instructions.vector-spec + (:require + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [clojure.test.check.clojure-test :as ct :refer [defspec]] + [propeller.push.state :as state] + [propeller.push.instructions.vector :as vector])) + +(defn check-empty-vector + [generator value-type] + (let [stack-type (keyword (str "vector_" value-type))] + (prop/for-all [vect (gen/vector generator)] + (let [start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_emptyvector stack-type start-state)] + (= (empty? vect) + (state/peek-stack end-state :boolean)))))) + +(defmacro empty-vector-spec + [generator value-type] + `(defspec ~(symbol (str "empty-vector-spec-" value-type)) + 100 + (check-empty-vector ~generator ~value-type))) + +(empty-vector-spec gen/small-integer "integer") +(empty-vector-spec gen/double "float") +(empty-vector-spec gen/boolean "boolean") +(empty-vector-spec gen/string "string") + +(defn check-expected-index + "Creates an otherwise empty Push state with the given vector on the + appropriate vector stack (assumed to be :vector_), and + the given value on the appropriate stack (determined by value-type). + It then runs the vector/_indexof instruction, and confirms that the + result (on the :integer stack) is the expected value." + [vect value value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + (keyword value-type) value) + end-state (vector/_indexof stack-type start-state) + expected-index (.indexOf vect value)] + (= expected-index + (state/peek-stack end-state :integer)))) + +(defmacro indexof-spec + [generator value-type] + `(do + (defspec ~(symbol (str "indexof-spec-" value-type)) + ; Should this be smaller for booleans? (Ditto for below.) + 100 + (prop/for-all [vect# (gen/vector ~generator) + value# ~generator] + (check-expected-index vect# value# ~value-type))) + ; For float and string vectors, it's rather rare to actually have a random value that + ; appears in the vector, so we don't consistently test the case where it should + ; return -1. So maybe we do need a separate test for those? + (defspec ~(symbol (str "indexof-spec-has-value-" value-type)) + 100 + (prop/for-all [vect# (gen/not-empty (gen/vector ~generator))] + (check-expected-index vect# (rand-nth vect#) ~value-type))))) + +(indexof-spec gen/small-integer "integer") +(indexof-spec gen/double "float") +(indexof-spec gen/boolean "boolean") +(indexof-spec gen/string "string") + +(defn clean-subvec-bounds + [start stop vect-size] + (let [start (max 0 start) + stop (max 0 stop) + start (min start vect-size) + stop (min stop vect-size) + stop (max start stop)] + [start stop])) + +(defn check-subvec + "Creates an otherwise empty Push state with the given vector on the + appropriate vector stack (assumed to be :vector_), and + the given values on the integer stack. + It then runs the vector/_subvec instruction, and confirms that the + result (on the :vector_ stack) is the expected value." + [vect start stop value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + :integer start) + :integer stop) + end-state (vector/_subvec stack-type start-state) + [cleaned-start cleaned-stop] (clean-subvec-bounds start stop (count vect)) + expected-subvec (subvec vect cleaned-start cleaned-stop)] + (= expected-subvec + (state/peek-stack end-state stack-type)))) + +(defmacro subvec-spec + [generator value-type] + `(defspec ~(symbol (str "subvec-spec-" value-type)) + (prop/for-all [vect# (gen/vector ~generator) + start# gen/small-integer + stop# gen/small-integer] + (check-subvec vect# start# stop# ~value-type)))) + +(subvec-spec gen/small-integer "integer") +(subvec-spec gen/double "float") +(subvec-spec gen/boolean "boolean") +(subvec-spec gen/string "string") \ No newline at end of file From fc26886815c27541f2b856145afdc619ef08d519 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Thu, 17 Dec 2020 15:58:11 -0600 Subject: [PATCH 09/44] Fix bugs in `vector/_subvec` There were two independent bugs in `vector/_subvec` that were turned up by our `test.check` testing. The first was that the order of the arguments was wrong and `stop-raw` and `start-raw` were flipped. The second was that `stop` wasn't max'ed with 0, which meant it could sometimes be negative, leading to an `IndexOutOfBoundsException`. --- src/propeller/push/instructions/vector.cljc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index cf88860..eb299b2 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -208,9 +208,9 @@ ^{:stacks #{:integer}} (fn [stack state] (make-instruction state - (fn [stop-raw start-raw vect] + (fn [start-raw stop-raw vect] (let [start (min (count vect) (max 0 start-raw)) - stop (min (count vect) (max start-raw stop-raw))] + stop (min (count vect) (max 0 start-raw stop-raw))] (subvec vect start stop))) [:integer :integer stack] stack))) From b3d9d89f4c1359baa6748905c51b2a013f2cd130 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Fri, 11 Dec 2020 14:00:06 -0600 Subject: [PATCH 10/44] Allow instructions to indicate they should be ignored `make-instruction` will ignore any instructions that return `:ignore-instruction`. This allows instructions to be skipped without consuming their arguments. --- src/propeller/push/utils/helpers.cljc | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/propeller/push/utils/helpers.cljc b/src/propeller/push/utils/helpers.cljc index 46eb572..4eccfb6 100755 --- a/src/propeller/push/utils/helpers.cljc +++ b/src/propeller/push/utils/helpers.cljc @@ -28,7 +28,11 @@ ;; 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 +;; given stacks), and pushes the result onto the return-stack. +;; +;; If the function returns :ignore-instruction, then we will return the +;; initial state unchanged. This allows instructions to fail gracefully +;; without consuming stack values. (defn make-instruction [state function arg-stacks return-stack] (let [popped-args (get-args-from-stacks state arg-stacks)] @@ -36,7 +40,9 @@ state (let [result (apply function (:args popped-args)) new-state (:state popped-args)] - (state/push-to-stack new-state return-stack result))))) + (if (= result :ignore-instruction) + state + (state/push-to-stack new-state return-stack result)))))) ;; Given a set of stacks, returns all instructions that operate on those stacks ;; only. Won't include random instructions unless :random is in the set as well From f2eecc774fc7dd9c3a5ac787ada81c0e21917822 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Thu, 17 Dec 2020 18:42:57 -0600 Subject: [PATCH 11/44] Add tests for `vector/_first` These turned up an oversight in the implementation in `vector/_first` that is addressed in the next commit. --- .../push/instructions/vector_spec.clj | 36 +++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index bec11b0..33a8009 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -6,6 +6,8 @@ [propeller.push.state :as state] [propeller.push.instructions.vector :as vector])) +;;; vector/_emptyvector + (defn check-empty-vector [generator value-type] (let [stack-type (keyword (str "vector_" value-type))] @@ -28,6 +30,38 @@ (empty-vector-spec gen/boolean "boolean") (empty-vector-spec gen/string "string") +;;; vector/_first + +(defn check-first + [generator value-type] + (let [stack-type (keyword (str "vector_" value-type))] + (prop/for-all [vect (gen/vector generator)] + (let [start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_first stack-type start-state)] + (or + (and (empty? vect) + (= (state/peek-stack end-state stack-type) + vect)) + (and + (= (first vect) + (state/peek-stack end-state (keyword value-type))) + (state/empty-stack? end-state stack-type))))))) + +(defmacro first-spec + [generator value-type] + `(defspec ~(symbol (str "first-spec-" value-type)) + 100 + (check-first ~generator ~value-type))) + +(first-spec gen/small-integer "integer") +(first-spec gen/double "float") +(first-spec gen/boolean "boolean") +(first-spec gen/string "string") + +;;; vector/_indexof + (defn check-expected-index "Creates an otherwise empty Push state with the given vector on the appropriate vector stack (assumed to be :vector_), and @@ -68,6 +102,8 @@ (indexof-spec gen/boolean "boolean") (indexof-spec gen/string "string") +;;; vector/_subvec + (defn clean-subvec-bounds [start stop vect-size] (let [start (max 0 start) From 66ec0a1ebd3a443a55eb01bc8dc5b0f8e4f4235a Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Thu, 17 Dec 2020 18:45:06 -0600 Subject: [PATCH 12/44] Address the possibility of vectors being empty in `vector/_first` The original version just used the built-in `first`, which returns `nil` if you give it an empty collection, which is almost certainly not a useful behavior. This changes it to return `:ignore-instruction` if the vector is empty, thereby leaving all the stacks unchanged. --- src/propeller/push/instructions/vector.cljc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index eb299b2..ae2ea99 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -52,12 +52,16 @@ (make-instruction state empty? [stack] :boolean))) ;; Pushes the first item of the top element of the vector stack onto the -;; approrpiately-typed literal stack +;; approrpiately-typed literal stack. If the vector is empty, return +;; :ignore-instruction so that nothing is changed on the stacks. (def _first ^{:stacks #{:elem}} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] - (make-instruction state first [stack] lit-stack)))) + (make-instruction state + #(if (empty? %) :ignore-instruction (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 From ab1f6d4396f9392c118dc2c2265f7beb8f825452 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Fri, 18 Dec 2020 17:02:18 -0600 Subject: [PATCH 13/44] Add tests for `vector/_last` This adds test.check tests for `vector/_last`. This is _really_ similar to `vector/_first` (and the other vector tests), so I think there are definitely ways to extract common logic from these. --- .../push/instructions/vector_spec.clj | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 33a8009..bbe9b29 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -60,6 +60,36 @@ (first-spec gen/boolean "boolean") (first-spec gen/string "string") +;;; vector/_last + +(defn check-last + [generator value-type] + (let [stack-type (keyword (str "vector_" value-type))] + (prop/for-all [vect (gen/vector generator)] + (let [start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_last stack-type start-state)] + (or + (and (empty? vect) + (= (state/peek-stack end-state stack-type) + vect)) + (and + (= (last vect) + (state/peek-stack end-state (keyword value-type))) + (state/empty-stack? end-state stack-type))))))) + +(defmacro last-spec + [generator value-type] + `(defspec ~(symbol (str "last-spec-" value-type)) + 100 + (check-last ~generator ~value-type))) + +(last-spec gen/small-integer "integer") +(last-spec gen/double "float") +(last-spec gen/boolean "boolean") +(last-spec gen/string "string") + ;;; vector/_indexof (defn check-expected-index From 91df21dba586734b1d1b4b5acfc325c6e409bcb7 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Fri, 18 Dec 2020 17:03:56 -0600 Subject: [PATCH 14/44] Fix error in `vector/_last` Similar to `vector/_first`, this didn't check for the empty vector case, so I've changed it to return `:ignore-instruction` in that case. There's a lot of duplication between `_first` and `_last`, which makes me think there's some refactoring opportunities. --- src/propeller/push/instructions/vector.cljc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index ae2ea99..d8f695d 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -52,7 +52,7 @@ (make-instruction state empty? [stack] :boolean))) ;; Pushes the first item of the top element of the vector stack onto the -;; approrpiately-typed literal stack. If the vector is empty, return +;; appropriately-typed literal stack. If the vector is empty, return ;; :ignore-instruction so that nothing is changed on the stacks. (def _first ^{:stacks #{:elem}} @@ -101,7 +101,11 @@ ^{:stacks #{:elem}} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] - (make-instruction state last [stack] lit-stack)))) + (make-instruction + state + #(if (empty? %) :ignore-instruction (last %)) + [stack] + lit-stack)))) ;; Pushes the length of the top item onto the INTEGER stack (def _length From 75de8e5be5d4bf380dcf7b5d5f66ca7425b6393d Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Mon, 21 Dec 2020 16:39:48 -0600 Subject: [PATCH 15/44] Comment out the boilerplate test in `core-test` We should remove that, and maybe the whole file, but for now I'll just comment it out. --- test/propeller/core_test.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/propeller/core_test.clj b/test/propeller/core_test.clj index b11c171..1e0f1eb 100644 --- a/test/propeller/core_test.clj +++ b/test/propeller/core_test.clj @@ -2,6 +2,6 @@ (:require [clojure.test :refer :all] [propeller.core :refer :all])) -(deftest a-test - (testing "FIXME, I fail." - (is (= 0 1)))) +;; (deftest a-test +;; (testing "FIXME, I fail." +;; (is (= 0 1)))) From bd590457670b563a81d96b8c4a57b6777cefcf94 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Mon, 21 Dec 2020 16:40:22 -0600 Subject: [PATCH 16/44] Add tests for `vector/_concat` This adds tests for `vector/_concat`. --- .../push/instructions/vector_spec.clj | 34 +++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index bbe9b29..42ee485 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -132,6 +132,40 @@ (indexof-spec gen/boolean "boolean") (indexof-spec gen/string "string") +;;; vector/_concat + +(defn check-concat + "Creates an otherwise empty Push state with the two given vectors on the + appropriate vector stack (assumed to be :vector_). + It then runs the vector/_concat instruction, and confirms that the + result (on the :vector_ stack) is the expected value. + The order of concatenation is that the top of the stack will be + _second_ in the concatenation, i.e., its elements will come _after_ + the elements in the vector one below it in the stack." + [first-vect second-vect value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + first-vect) + stack-type second-vect) + end-state (vector/_concat stack-type start-state)] + (= (concat second-vect first-vect) + (state/peek-stack end-state stack-type)))) + +(defmacro concat-spec + [generator value-type] + `(defspec ~(symbol (str "concat-spec-" value-type)) + 100 + (prop/for-all [first-vect# (gen/vector ~generator) + second-vect# (gen/vector ~generator)] + (check-concat first-vect# second-vect# ~value-type)))) + +(concat-spec gen/small-integer "integer") +(concat-spec gen/double "float") +(concat-spec gen/boolean "boolean") +(concat-spec gen/string "string") + ;;; vector/_subvec (defn clean-subvec-bounds From 9028a8e17480459ffd7466979d0e8828e08c0836 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Mon, 21 Dec 2020 16:59:04 -0600 Subject: [PATCH 17/44] "Simplify" the testing for concat and subvec MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This introduces some fancy macro action that allows us to skip the four calls to `(concat-spec …)` with the different generators and types. @ErikRauer and I wrestled with this for a _long_ time today, and it turned out that it was absolutely necessary to quote the generators in `gen-type-pairs on lines 10-13. I'm not 100% sure why, but it seems that without that something (perhaps a level of macro-ness) got unwrapped too early and then it couldn't find the generator because it had lost the namespace it belonged in. Whether this actually _simplifies_ things is really up for debate. If this is as far as we get, it's probably not worth it. If we can find a reasonable way to reduce the other sources of duplication, however, it might be worth it? --- .../push/instructions/vector_spec.clj | 43 ++++++++++--------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 42ee485..130d61f 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -6,6 +6,12 @@ [propeller.push.state :as state] [propeller.push.instructions.vector :as vector])) +(def gen-type-pairs + [['gen/small-integer "integer"] + ['gen/double "float"] + ['gen/boolean "boolean"] + ['gen/string "string"]]) + ;;; vector/_emptyvector (defn check-empty-vector @@ -154,17 +160,15 @@ (state/peek-stack end-state stack-type)))) (defmacro concat-spec - [generator value-type] - `(defspec ~(symbol (str "concat-spec-" value-type)) - 100 - (prop/for-all [first-vect# (gen/vector ~generator) - second-vect# (gen/vector ~generator)] - (check-concat first-vect# second-vect# ~value-type)))) + [] + `(do ~@(for [[generator value-type] gen-type-pairs + :let [name (symbol (str "concat-spec-" value-type))]] + `(defspec ~name + (prop/for-all [first-vect# (gen/vector ~generator) + second-vect# (gen/vector ~generator)] + (check-concat first-vect# second-vect# ~value-type)))))) -(concat-spec gen/small-integer "integer") -(concat-spec gen/double "float") -(concat-spec gen/boolean "boolean") -(concat-spec gen/string "string") +(concat-spec) ;;; vector/_subvec @@ -199,14 +203,13 @@ (state/peek-stack end-state stack-type)))) (defmacro subvec-spec - [generator value-type] - `(defspec ~(symbol (str "subvec-spec-" value-type)) - (prop/for-all [vect# (gen/vector ~generator) - start# gen/small-integer - stop# gen/small-integer] - (check-subvec vect# start# stop# ~value-type)))) + [] + `(do ~@(for [[generator value-type] gen-type-pairs + :let [name (symbol (str "subvec-spec-" value-type))]] + `(defspec ~name + (prop/for-all [vect# (gen/vector ~generator) + start# gen/small-integer + stop# gen/small-integer] + (check-subvec vect# start# stop# ~value-type)))))) -(subvec-spec gen/small-integer "integer") -(subvec-spec gen/double "float") -(subvec-spec gen/boolean "boolean") -(subvec-spec gen/string "string") \ No newline at end of file +(subvec-spec) From a606a47ce1826f4285e500b233fa3eee6ed4f28f Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Sun, 27 Dec 2020 15:08:51 -0600 Subject: [PATCH 18/44] Add tests for `vector/_contains` This adds the tests for `vector/_contains` --- .../push/instructions/vector_spec.clj | 42 +++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 130d61f..3e3c091 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -12,6 +12,48 @@ ['gen/boolean "boolean"] ['gen/string "string"]]) +;;; vector/_contains + +(defn check-expected-contains + "Creates an otherwise empty Push state with the given vector on the + appropriate vector stack (assumed to be :vector_), and + the given value on the appropriate stack (determined by value-type). + It then runs the vector/_contains instruction, and confirms that the + result (on the :boolean stack) is the expected value." + [vect value value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + (keyword value-type) value) + end-state (vector/_contains stack-type start-state) + expected-result (not (= (.indexOf vect value) -1))] + (= expected-result + (state/peek-stack end-state :boolean)))) + +(defmacro contains-vector-spec + [generator value-type] + `(do + (defspec ~(symbol (str "contains-vector-spec-" value-type)) + ; Should this be smaller for booleans? (Ditto for below.) + 100 + (prop/for-all [vect# (gen/vector ~generator) + value# ~generator] + (check-expected-contains vect# value# ~value-type))) + ; For float and string vectors, it's rather rare to actually have a random value that + ; appears in the vector, so we don't consistently test the case where it should + ; return TRUE. So maybe we do need a separate test for those? + (defspec ~(symbol (str "contains-vector-spec-has-value-" value-type)) + 100 + (prop/for-all [vect# (gen/not-empty (gen/vector ~generator))] + (check-expected-contains vect# (rand-nth vect#) ~value-type))))) + +(contains-vector-spec gen/small-integer "integer") +(contains-vector-spec gen/double "float") +(contains-vector-spec gen/boolean "boolean") +(contains-vector-spec gen/string "string") + ;;; vector/_emptyvector (defn check-empty-vector From b41c35582af5d4e3df8fa1754998f1f84d6f0798 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Sun, 27 Dec 2020 15:33:56 -0600 Subject: [PATCH 19/44] Make `prop/for-all` call more consistent throughout the vector specs The specs for `vector/_emptyvector`, `vector/_first`, and `vector/_last` all called `prop/for-all` within their 'check' functions, whereas the other specs all called it within their macros. This change makes the three specs mentioned more consistent with the rest of the specs by having them also call `prop/for-all` within their macros. --- .../push/instructions/vector_spec.clj | 96 +++++++++---------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 3e3c091..5b630d3 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -57,21 +57,21 @@ ;;; vector/_emptyvector (defn check-empty-vector - [generator value-type] - (let [stack-type (keyword (str "vector_" value-type))] - (prop/for-all [vect (gen/vector generator)] - (let [start-state (state/push-to-stack state/empty-state - stack-type - vect) - end-state (vector/_emptyvector stack-type start-state)] - (= (empty? vect) - (state/peek-stack end-state :boolean)))))) + [vect value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_emptyvector stack-type start-state)] + (= (empty? vect) + (state/peek-stack end-state :boolean)))) (defmacro empty-vector-spec [generator value-type] - `(defspec ~(symbol (str "empty-vector-spec-" value-type)) - 100 - (check-empty-vector ~generator ~value-type))) + `(defspec ~(symbol (str "empty-vector-spec-" value-type)) + 100 + (prop/for-all [vect# (gen/vector ~generator)] + (check-empty-vector vect# ~value-type)))) (empty-vector-spec gen/small-integer "integer") (empty-vector-spec gen/double "float") @@ -81,27 +81,27 @@ ;;; vector/_first (defn check-first - [generator value-type] - (let [stack-type (keyword (str "vector_" value-type))] - (prop/for-all [vect (gen/vector generator)] - (let [start-state (state/push-to-stack state/empty-state - stack-type - vect) - end-state (vector/_first stack-type start-state)] - (or - (and (empty? vect) - (= (state/peek-stack end-state stack-type) - vect)) - (and - (= (first vect) - (state/peek-stack end-state (keyword value-type))) - (state/empty-stack? end-state stack-type))))))) + [vect value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_first stack-type start-state)] + (or + (and (empty? vect) + (= (state/peek-stack end-state stack-type) + vect)) + (and + (= (first vect) + (state/peek-stack end-state (keyword value-type))) + (state/empty-stack? end-state stack-type))))) (defmacro first-spec [generator value-type] `(defspec ~(symbol (str "first-spec-" value-type)) 100 - (check-first ~generator ~value-type))) + (prop/for-all [vect# (gen/vector ~generator)] + (check-first vect# ~value-type)))) (first-spec gen/small-integer "integer") (first-spec gen/double "float") @@ -111,27 +111,27 @@ ;;; vector/_last (defn check-last - [generator value-type] - (let [stack-type (keyword (str "vector_" value-type))] - (prop/for-all [vect (gen/vector generator)] - (let [start-state (state/push-to-stack state/empty-state - stack-type - vect) - end-state (vector/_last stack-type start-state)] - (or - (and (empty? vect) - (= (state/peek-stack end-state stack-type) - vect)) - (and - (= (last vect) - (state/peek-stack end-state (keyword value-type))) - (state/empty-stack? end-state stack-type))))))) + [vect value-type] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_last stack-type start-state)] + (or + (and (empty? vect) + (= (state/peek-stack end-state stack-type) + vect)) + (and + (= (last vect) + (state/peek-stack end-state (keyword value-type))) + (state/empty-stack? end-state stack-type))))) (defmacro last-spec [generator value-type] `(defspec ~(symbol (str "last-spec-" value-type)) 100 - (check-last ~generator ~value-type))) + (prop/for-all [vect# (gen/vector ~generator)] + (check-last vect# ~value-type)))) (last-spec gen/small-integer "integer") (last-spec gen/double "float") @@ -149,10 +149,10 @@ [vect value value-type] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack - (state/push-to-stack state/empty-state - stack-type - vect) - (keyword value-type) value) + (state/push-to-stack state/empty-state + stack-type + vect) + (keyword value-type) value) end-state (vector/_indexof stack-type start-state) expected-index (.indexOf vect value)] (= expected-index From d30f7c195ead437d95d540c629be502efad582b5 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Mon, 28 Dec 2020 15:27:10 -0600 Subject: [PATCH 20/44] Write generalized spec generation macro This add `gen-spec` which provides a fairly general macro for creating `test.check` specifications for vector instructions. It takes a string used to generate specification names, a function used to check the state after running the function under test, and a list of keywords indicating types for arguments generated by `test.check` and passed to the check function. Keywords like `:integer` and `:string` are associated with "simple" generators such as `gen/small-integer` and `gen/string`. The keyword `:vector` is used to generate a vector of items whose type is specified by the `generator` argument to `generator-for-arg-type`. This allows us to loop over all of the supported vector item types in the macro and generate a separate specification for each type. We moved the `value-type` argument for the `check` functions to the front to simplify passing in the value type arguments, which can vary in number. --- .../push/instructions/vector_spec.clj | 41 +++++++++++++++++-- 1 file changed, 37 insertions(+), 4 deletions(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 5b630d3..388db47 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -190,7 +190,7 @@ The order of concatenation is that the top of the stack will be _second_ in the concatenation, i.e., its elements will come _after_ the elements in the vector one below it in the stack." - [first-vect second-vect value-type] + [value-type first-vect second-vect] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack (state/push-to-stack state/empty-state @@ -210,7 +210,7 @@ second-vect# (gen/vector ~generator)] (check-concat first-vect# second-vect# ~value-type)))))) -(concat-spec) +; (concat-spec) ;;; vector/_subvec @@ -229,7 +229,7 @@ the given values on the integer stack. It then runs the vector/_subvec instruction, and confirms that the result (on the :vector_ stack) is the expected value." - [vect start stop value-type] + [value-type vect start stop] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack (state/push-to-stack @@ -254,4 +254,37 @@ stop# gen/small-integer] (check-subvec vect# start# stop# ~value-type)))))) -(subvec-spec) +; (subvec-spec) + +(defn generator-for-arg-type + [arg-type generator] + (case arg-type + :boolean 'gen/boolean + :integer 'gen/small-integer + :float 'gen/double + :string 'gen/string + ; This is for "generic" vectors where the element is provided by + ; the `generator` argument. + :vector `(gen/vector ~generator) + :vector_boolean '(gen/vector gen/boolean) + :vector_integer '(gen/vector gen/small-integer) + :vector_float '(gen/vector gen/double) + :vector_string '(gen/vector gen/string) + )) + +(defmacro gen-specs + [spec-name check-fn & arg-types] + (let [symbol-names (repeatedly (count arg-types) gensym)] + `(do ~@(for [[generator value-type] gen-type-pairs + :let [name (symbol (str spec-name "-spec-" value-type))]] + `(defspec ~name + (prop/for-all + [~@(mapcat + (fn [symbol-name arg-type] + [symbol-name (generator-for-arg-type arg-type generator)]) + symbol-names + arg-types) ] + (~check-fn ~value-type ~@symbol-names))))))) + +(gen-specs "concat" check-concat :vector :vector) +(gen-specs "subvec" check-subvec :vector :integer :integer) From 957af4fc068f2d0042ab32deea3e0879fc14a330 Mon Sep 17 00:00:00 2001 From: Nic McPhee Date: Mon, 28 Dec 2020 15:45:45 -0600 Subject: [PATCH 21/44] Use new `gen-specs` macro for other test cases This moved the new `gen-specs` macro to the top of the file, and uses it to simplify the generation for the existing specifications. This allowed us to remove quite a lot of code. We also had to change the order of arguments for all the "old" check functions so that `value-type` comes first. We renamed a few check functions so the naming is more consistent. --- .../push/instructions/vector_spec.clj | 180 +++++------------- 1 file changed, 44 insertions(+), 136 deletions(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 388db47..697d627 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -12,15 +12,45 @@ ['gen/boolean "boolean"] ['gen/string "string"]]) +(defn generator-for-arg-type + [arg-type generator] + (case arg-type + :boolean 'gen/boolean + :integer 'gen/small-integer + :float 'gen/double + :string 'gen/string + ; This is for "generic" vectors where the element is provided by + ; the `generator` argument. + :vector `(gen/vector ~generator) + :item generator + :vector_boolean '(gen/vector gen/boolean) + :vector_integer '(gen/vector gen/small-integer) + :vector_float '(gen/vector gen/double) + :vector_string '(gen/vector gen/string))) + +(defmacro gen-specs + [spec-name check-fn & arg-types] + (let [symbol-names (repeatedly (count arg-types) gensym)] + `(do ~@(for [[generator value-type] gen-type-pairs + :let [name (symbol (str spec-name "-spec-" value-type))]] + `(defspec ~name + (prop/for-all + [~@(mapcat + (fn [symbol-name arg-type] + [symbol-name (generator-for-arg-type arg-type generator)]) + symbol-names + arg-types)] + (~check-fn ~value-type ~@symbol-names))))))) + ;;; vector/_contains -(defn check-expected-contains +(defn check-contains "Creates an otherwise empty Push state with the given vector on the appropriate vector stack (assumed to be :vector_), and the given value on the appropriate stack (determined by value-type). It then runs the vector/_contains instruction, and confirms that the result (on the :boolean stack) is the expected value." - [vect value value-type] + [value-type vect value] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack (state/push-to-stack state/empty-state @@ -28,36 +58,16 @@ vect) (keyword value-type) value) end-state (vector/_contains stack-type start-state) - expected-result (not (= (.indexOf vect value) -1))] + expected-result (not= (.indexOf vect value) -1)] (= expected-result (state/peek-stack end-state :boolean)))) -(defmacro contains-vector-spec - [generator value-type] - `(do - (defspec ~(symbol (str "contains-vector-spec-" value-type)) - ; Should this be smaller for booleans? (Ditto for below.) - 100 - (prop/for-all [vect# (gen/vector ~generator) - value# ~generator] - (check-expected-contains vect# value# ~value-type))) - ; For float and string vectors, it's rather rare to actually have a random value that - ; appears in the vector, so we don't consistently test the case where it should - ; return TRUE. So maybe we do need a separate test for those? - (defspec ~(symbol (str "contains-vector-spec-has-value-" value-type)) - 100 - (prop/for-all [vect# (gen/not-empty (gen/vector ~generator))] - (check-expected-contains vect# (rand-nth vect#) ~value-type))))) - -(contains-vector-spec gen/small-integer "integer") -(contains-vector-spec gen/double "float") -(contains-vector-spec gen/boolean "boolean") -(contains-vector-spec gen/string "string") +(gen-specs "contains" check-contains :vector :item) ;;; vector/_emptyvector (defn check-empty-vector - [vect value-type] + [value-type vect] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack state/empty-state stack-type @@ -66,22 +76,12 @@ (= (empty? vect) (state/peek-stack end-state :boolean)))) -(defmacro empty-vector-spec - [generator value-type] - `(defspec ~(symbol (str "empty-vector-spec-" value-type)) - 100 - (prop/for-all [vect# (gen/vector ~generator)] - (check-empty-vector vect# ~value-type)))) - -(empty-vector-spec gen/small-integer "integer") -(empty-vector-spec gen/double "float") -(empty-vector-spec gen/boolean "boolean") -(empty-vector-spec gen/string "string") +(gen-specs "empty-vector" check-empty-vector :vector) ;;; vector/_first (defn check-first - [vect value-type] + [value-type vect] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack state/empty-state stack-type @@ -96,22 +96,12 @@ (state/peek-stack end-state (keyword value-type))) (state/empty-stack? end-state stack-type))))) -(defmacro first-spec - [generator value-type] - `(defspec ~(symbol (str "first-spec-" value-type)) - 100 - (prop/for-all [vect# (gen/vector ~generator)] - (check-first vect# ~value-type)))) - -(first-spec gen/small-integer "integer") -(first-spec gen/double "float") -(first-spec gen/boolean "boolean") -(first-spec gen/string "string") +(gen-specs "first" check-first :vector) ;;; vector/_last (defn check-last - [vect value-type] + [value-type vect] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack state/empty-state stack-type @@ -126,27 +116,17 @@ (state/peek-stack end-state (keyword value-type))) (state/empty-stack? end-state stack-type))))) -(defmacro last-spec - [generator value-type] - `(defspec ~(symbol (str "last-spec-" value-type)) - 100 - (prop/for-all [vect# (gen/vector ~generator)] - (check-last vect# ~value-type)))) - -(last-spec gen/small-integer "integer") -(last-spec gen/double "float") -(last-spec gen/boolean "boolean") -(last-spec gen/string "string") +(gen-specs "last" check-last :vector) ;;; vector/_indexof -(defn check-expected-index +(defn check-indexof "Creates an otherwise empty Push state with the given vector on the appropriate vector stack (assumed to be :vector_), and the given value on the appropriate stack (determined by value-type). It then runs the vector/_indexof instruction, and confirms that the result (on the :integer stack) is the expected value." - [vect value value-type] + [value-type vect value] (let [stack-type (keyword (str "vector_" value-type)) start-state (state/push-to-stack (state/push-to-stack state/empty-state @@ -158,27 +138,7 @@ (= expected-index (state/peek-stack end-state :integer)))) -(defmacro indexof-spec - [generator value-type] - `(do - (defspec ~(symbol (str "indexof-spec-" value-type)) - ; Should this be smaller for booleans? (Ditto for below.) - 100 - (prop/for-all [vect# (gen/vector ~generator) - value# ~generator] - (check-expected-index vect# value# ~value-type))) - ; For float and string vectors, it's rather rare to actually have a random value that - ; appears in the vector, so we don't consistently test the case where it should - ; return -1. So maybe we do need a separate test for those? - (defspec ~(symbol (str "indexof-spec-has-value-" value-type)) - 100 - (prop/for-all [vect# (gen/not-empty (gen/vector ~generator))] - (check-expected-index vect# (rand-nth vect#) ~value-type))))) - -(indexof-spec gen/small-integer "integer") -(indexof-spec gen/double "float") -(indexof-spec gen/boolean "boolean") -(indexof-spec gen/string "string") +(gen-specs "indexof" check-indexof :vector :item) ;;; vector/_concat @@ -201,16 +161,7 @@ (= (concat second-vect first-vect) (state/peek-stack end-state stack-type)))) -(defmacro concat-spec - [] - `(do ~@(for [[generator value-type] gen-type-pairs - :let [name (symbol (str "concat-spec-" value-type))]] - `(defspec ~name - (prop/for-all [first-vect# (gen/vector ~generator) - second-vect# (gen/vector ~generator)] - (check-concat first-vect# second-vect# ~value-type)))))) - -; (concat-spec) +(gen-specs "concat" check-concat :vector :vector) ;;; vector/_subvec @@ -244,47 +195,4 @@ (= expected-subvec (state/peek-stack end-state stack-type)))) -(defmacro subvec-spec - [] - `(do ~@(for [[generator value-type] gen-type-pairs - :let [name (symbol (str "subvec-spec-" value-type))]] - `(defspec ~name - (prop/for-all [vect# (gen/vector ~generator) - start# gen/small-integer - stop# gen/small-integer] - (check-subvec vect# start# stop# ~value-type)))))) - -; (subvec-spec) - -(defn generator-for-arg-type - [arg-type generator] - (case arg-type - :boolean 'gen/boolean - :integer 'gen/small-integer - :float 'gen/double - :string 'gen/string - ; This is for "generic" vectors where the element is provided by - ; the `generator` argument. - :vector `(gen/vector ~generator) - :vector_boolean '(gen/vector gen/boolean) - :vector_integer '(gen/vector gen/small-integer) - :vector_float '(gen/vector gen/double) - :vector_string '(gen/vector gen/string) - )) - -(defmacro gen-specs - [spec-name check-fn & arg-types] - (let [symbol-names (repeatedly (count arg-types) gensym)] - `(do ~@(for [[generator value-type] gen-type-pairs - :let [name (symbol (str spec-name "-spec-" value-type))]] - `(defspec ~name - (prop/for-all - [~@(mapcat - (fn [symbol-name arg-type] - [symbol-name (generator-for-arg-type arg-type generator)]) - symbol-names - arg-types) ] - (~check-fn ~value-type ~@symbol-names))))))) - -(gen-specs "concat" check-concat :vector :vector) (gen-specs "subvec" check-subvec :vector :integer :integer) From 5e87478cebf951fe7cca876261a3a2325982842c Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 29 Dec 2020 14:43:39 -0600 Subject: [PATCH 22/44] Add tests for `vector/_butlast` This adds tests for `vector/_butlast`. --- test/propeller/push/instructions/vector_spec.clj | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 697d627..c6245a9 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -42,6 +42,21 @@ arg-types)] (~check-fn ~value-type ~@symbol-names))))))) +;;; vector/_butlast + +(defn check-butlast + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_butlast stack-type start-state) + expected-result (vec (butlast vect))] + (= expected-result + (state/peek-stack end-state stack-type)))) + +(gen-specs "butlast" check-butlast :vector) + ;;; vector/_contains (defn check-contains From 89b861f1245b3067d5fb554d934e2c84ab389868 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 29 Dec 2020 14:55:58 -0600 Subject: [PATCH 23/44] Add tests for `vector/_conj` This adds tests for `vector/_conj`. Also moves the tests for `vector/_concat` towards the top of the file to be more consistent with the order in `vector.cljc`. --- .../push/instructions/vector_spec.clj | 64 ++++++++++++------- 1 file changed, 41 insertions(+), 23 deletions(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index c6245a9..a612ba1 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -57,6 +57,47 @@ (gen-specs "butlast" check-butlast :vector) +;;; vector/_concat + +(defn check-concat + "Creates an otherwise empty Push state with the two given vectors on the + appropriate vector stack (assumed to be :vector_). + It then runs the vector/_concat instruction, and confirms that the + result (on the :vector_ stack) is the expected value. + The order of concatenation is that the top of the stack will be + _second_ in the concatenation, i.e., its elements will come _after_ + the elements in the vector one below it in the stack." + [value-type first-vect second-vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + first-vect) + stack-type second-vect) + end-state (vector/_concat stack-type start-state)] + (= (concat second-vect first-vect) + (state/peek-stack end-state stack-type)))) + +(gen-specs "concat" check-concat :vector :vector) + +;;; vecotr/_conj + +(defn check-conj + [value-type vect value] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + (keyword (str value-type)) + value) + end-state (vector/_conj stack-type start-state) + expected-result (conj vect value)] + (= expected-result + (state/peek-stack end-state stack-type)))) + +(gen-specs "conj" check-conj :vector :item) + ;;; vector/_contains (defn check-contains @@ -155,29 +196,6 @@ (gen-specs "indexof" check-indexof :vector :item) -;;; vector/_concat - -(defn check-concat - "Creates an otherwise empty Push state with the two given vectors on the - appropriate vector stack (assumed to be :vector_). - It then runs the vector/_concat instruction, and confirms that the - result (on the :vector_ stack) is the expected value. - The order of concatenation is that the top of the stack will be - _second_ in the concatenation, i.e., its elements will come _after_ - the elements in the vector one below it in the stack." - [value-type first-vect second-vect] - (let [stack-type (keyword (str "vector_" value-type)) - start-state (state/push-to-stack - (state/push-to-stack state/empty-state - stack-type - first-vect) - stack-type second-vect) - end-state (vector/_concat stack-type start-state)] - (= (concat second-vect first-vect) - (state/peek-stack end-state stack-type)))) - -(gen-specs "concat" check-concat :vector :vector) - ;;; vector/_subvec (defn clean-subvec-bounds From aae0873c8137e924e2787b7a780dab90714fc78b Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 29 Dec 2020 15:08:33 -0600 Subject: [PATCH 24/44] Add tests for `vector/_length` This adds tests for `vector/_length`. Also moves the tests for `vector/_indexof` higher in the file in order to be more consistent with the ordering in `vector.cljc`. --- .../push/instructions/vector_spec.clj | 55 ++++++++++++------- 1 file changed, 35 insertions(+), 20 deletions(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index a612ba1..d970071 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -154,26 +154,6 @@ (gen-specs "first" check-first :vector) -;;; vector/_last - -(defn check-last - [value-type vect] - (let [stack-type (keyword (str "vector_" value-type)) - start-state (state/push-to-stack state/empty-state - stack-type - vect) - end-state (vector/_last stack-type start-state)] - (or - (and (empty? vect) - (= (state/peek-stack end-state stack-type) - vect)) - (and - (= (last vect) - (state/peek-stack end-state (keyword value-type))) - (state/empty-stack? end-state stack-type))))) - -(gen-specs "last" check-last :vector) - ;;; vector/_indexof (defn check-indexof @@ -196,6 +176,41 @@ (gen-specs "indexof" check-indexof :vector :item) +;;; vector/_last + +(defn check-last + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_last stack-type start-state)] + (or + (and (empty? vect) + (= (state/peek-stack end-state stack-type) + vect)) + (and + (= (last vect) + (state/peek-stack end-state (keyword value-type))) + (state/empty-stack? end-state stack-type))))) + +(gen-specs "last" check-last :vector) + +;;; vector/_length + +(defn check-length + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_length stack-type start-state) + expected-result (count vect)] + (= expected-result + (state/peek-stack end-state :integer)))) + +(gen-specs "length" check-length :vector) + ;;; vector/_subvec (defn clean-subvec-bounds From bef5a398eb206b9d0d6cb092ccc874bd93317922 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 29 Dec 2020 16:18:45 -0600 Subject: [PATCH 25/44] Add tests for `vector/_nth` This adds tests for `vector/_nth`. --- .../push/instructions/vector_spec.clj | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index d970071..26940c4 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -211,6 +211,28 @@ (gen-specs "length" check-length :vector) +;;; vector/_nth + +(defn check-nth + [value-type vect n] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + :integer + n) + end-state (vector/_nth stack-type start-state)] + (or + (and (empty? vect) + (= (state/peek-stack end-state stack-type) + vect)) + (and + (= (get vect (mod n (count vect))) + (state/peek-stack end-state (keyword value-type))))))) + +(gen-specs "nth" check-nth :vector :integer) + ;;; vector/_subvec (defn clean-subvec-bounds From 99dbabcb8225c53e302da9191388650b6b237754 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 29 Dec 2020 16:21:15 -0600 Subject: [PATCH 26/44] Fix error in `vector/_nth` Similar to `vector/_first` and `vector/_last`, `vector/_nth` would not check for the case of an empty vector and would divide by 0. This changes the instruction so that it simply throws `:ignore-instruction` in that case. --- src/propeller/push/instructions/vector.cljc | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index d8f695d..fd8f66f 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -121,7 +121,9 @@ (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state - #(get %2 (mod %1 (count %2))) + #(if (empty? %2) + :ignore-instruction + (get %2 (mod %1 (count %2)))) [:integer stack] lit-stack)))) From aa2ed597a175744d5f5600d61523e01c4cb20fe4 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Wed, 30 Dec 2020 14:23:14 -0600 Subject: [PATCH 27/44] Add tests for `vector/_occurrencesof` This adds tests for `vector/_occurrencesof`. --- .../push/instructions/vector_spec.clj | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 26940c4..59c6a57 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -233,6 +233,24 @@ (gen-specs "nth" check-nth :vector :integer) +;;; vector/_occurrencesof + +(defn check-occurrencesof + [value-type vect value] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + (keyword value-type) + value) + end-state (vector/_occurrencesof stack-type start-state) + expected-result (count (filterv #(= value %) vect))] + (= expected-result + (state/peek-stack end-state :integer)))) + +(gen-specs "occurrencesof" check-occurrencesof :vector :item) + ;;; vector/_subvec (defn clean-subvec-bounds From f71760c08f89dfe8e76631b2b0a50abb58a053b6 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Wed, 30 Dec 2020 14:47:29 -0600 Subject: [PATCH 28/44] Add tests for `vector/_pushall` This adds tests for `vector/_pushall`. --- .../push/instructions/vector_spec.clj | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 59c6a57..6e6bad5 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -251,6 +251,27 @@ (gen-specs "occurrencesof" check-occurrencesof :vector :item) +;;; vector/_pushall + +(defn check-pushall + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_pushall stack-type start-state) + value-stack (keyword value-type) + vect-length (count vect)] + (and + (= + (vec (state/peek-stack-many end-state value-stack vect-length)) + vect) + (state/empty-stack? + (state/pop-stack-many end-state value-stack vect-length) + value-stack)))) + +(gen-specs "pushall" check-pushall :vector) + ;;; vector/_subvec (defn clean-subvec-bounds From 94d421ef0ac7b9ff51c765c3a99bb3c6d1adae12 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Sun, 3 Jan 2021 16:17:09 -0600 Subject: [PATCH 29/44] Add tests for `vector/_remove` This adds tests for `vector/_remove`. --- .../propeller/push/instructions/vector_spec.clj | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 6e6bad5..46230a2 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -272,6 +272,23 @@ (gen-specs "pushall" check-pushall :vector) +;;; vector/_remove + +(defn check-remove + [value-type vect value] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + (keyword value-type) + value) + end-state (vector/_remove stack-type start-state)] + (= [] + (filterv #(= % value) (state/peek-stack end-state stack-type))))) + +(gen-specs "remove" check-remove :vector :item) + ;;; vector/_subvec (defn clean-subvec-bounds From cfe91b5ced68d4a4c75dffbeb5c0fc84c3fbd34a Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Sun, 3 Jan 2021 17:50:42 -0600 Subject: [PATCH 30/44] Add tests for `vector/_replace' This adds tests for `vector/_replace`. We might want to change `vector/_replace` to return `:ignore-instruction` when the value to be replaced is not present in the vector. Same with `vector/_remove`. --- .../push/instructions/vector_spec.clj | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 46230a2..5f85eec 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -289,6 +289,28 @@ (gen-specs "remove" check-remove :vector :item) +;;; vector/_replace + +(defn check-replace + [value-type vect toreplace replacement] + (let [stack-type (keyword (str "vector_" value-type)) + value-stack (keyword value-type) + start-state (state/push-to-stack + (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + value-stack + toreplace) + value-stack + replacement) + end-state (vector/_replace stack-type start-state) + expected-result (replace {toreplace replacement} vect)] + (= expected-result + (state/peek-stack end-state stack-type)))) + +(gen-specs "replace" check-replace :vector :item :item) + ;;; vector/_subvec (defn clean-subvec-bounds From bcddca184c716fe252382385237a6dcf87856054 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Sun, 3 Jan 2021 18:29:16 -0600 Subject: [PATCH 31/44] Add tests for `vector/_replacefirst` Add tests for `vector/_replacefirst`. --- .../push/instructions/vector_spec.clj | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 5f85eec..50c2102 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -311,6 +311,33 @@ (gen-specs "replace" check-replace :vector :item :item) +;;; vector/_replacefirst + +(defn check-replacefirst + [value-type vect toreplace replacement] + (let [stack-type (keyword (str "vector_" value-type)) + value-stack (keyword value-type) + start-state (state/push-to-stack + (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + value-stack + toreplace) + value-stack + replacement) + end-state (vector/_replacefirst stack-type start-state) + end-vector (state/peek-stack end-state stack-type) + replacement-index (.indexOf vect toreplace)] + (or + (and (= replacement-index -1) + (= [replacement toreplace] (state/peek-stack-many end-state value-stack 2)) + (= vect end-vector)) + (and (state/empty-stack? end-state value-stack) + (= end-vector (assoc vect replacement-index replacement)))))) + +(gen-specs "replacefirst" check-replacefirst :vector :item :item) + ;;; vector/_subvec (defn clean-subvec-bounds From d5f115f81c74ab0f522c5623fe7316467f077e0b Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Sun, 3 Jan 2021 18:31:12 -0600 Subject: [PATCH 32/44] Fix `vector/_replacefirst` This changes the function to throw `:ignore-instruction` if the replacement value is not present in the vector. --- src/propeller/push/instructions/vector.cljc | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index fd8f66f..b2df4da 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -183,7 +183,10 @@ (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit1 lit2 vect] - (assoc vect (utils/indexof lit1 vect) lit2)) + (let [replaceindex (utils/indexof lit1 vect)] + (if (= replaceindex -1) + :ignore-instruction + (assoc vect replaceindex lit2)))) [lit-stack lit-stack stack] stack)))) From 8afa8f83e555c8b7ceb6d6ff3781c0d85626b87e Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 5 Jan 2021 14:49:54 -0600 Subject: [PATCH 33/44] Add tests for `vector/_rest` This adds tests for `vector/_rest`. --- test/propeller/push/instructions/vector_spec.clj | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 50c2102..c0000a0 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -338,6 +338,21 @@ (gen-specs "replacefirst" check-replacefirst :vector :item :item) +;;; vector/_rest + +(defn check-rest + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_rest stack-type start-state) + expected-result (vec (rest vect))] + (= expected-result + (state/peek-stack end-state stack-type)))) + +(gen-specs "rest" check-rest :vector) + ;;; vector/_subvec (defn clean-subvec-bounds From fce10ca97c13561118b1f870cd5cb98bfcfc48b4 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 5 Jan 2021 14:55:23 -0600 Subject: [PATCH 34/44] Add tests for `vector/_reverse` This adds tests for `vector/_reverse`. --- test/propeller/push/instructions/vector_spec.clj | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index c0000a0..8209815 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -353,6 +353,21 @@ (gen-specs "rest" check-rest :vector) +;;; vector/_reverse + +(defn check-reverse + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack state/empty-state + stack-type + vect) + end-state (vector/_reverse stack-type start-state) + expected-result (vec (rest vect))] + (= expected-result + (state/peek-stack end-state stack-type)))) + +(gen-specs "reverse" check-reverse :vector) + ;;; vector/_subvec (defn clean-subvec-bounds From 1c58bcca49bfcb6390373b9b4b0b13ef4c03eae3 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 5 Jan 2021 15:26:11 -0600 Subject: [PATCH 35/44] Fix tests for `vector/_reverse` --- test/propeller/push/instructions/vector_spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 8209815..4685c2a 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -362,7 +362,7 @@ stack-type vect) end-state (vector/_reverse stack-type start-state) - expected-result (vec (rest vect))] + expected-result (vec (reverse vect))] (= expected-result (state/peek-stack end-state stack-type)))) From 2ffffa9fd476797a4d7cd942bc31251f41bc114a Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 5 Jan 2021 15:46:38 -0600 Subject: [PATCH 36/44] Add tests for `vector/_set` This adds tests for `vector/_set`. --- .../push/instructions/vector_spec.clj | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 4685c2a..3b92862 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -368,6 +368,36 @@ (gen-specs "reverse" check-reverse :vector) +;;; vector/_set + +(defn check-set + [value-type vect value n] + (let [stack-type (keyword (str "vector_" value-type)) + value-stack (keyword value-type) + start-state (state/push-to-stack + (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + value-stack + value) + :integer + n) + end-state (vector/_set stack-type start-state)] + (or + (and + (empty? vect) + (not (state/empty-stack? end-state :integer)) + (not (state/empty-stack? end-state value-stack)) + (= vect (state/peek-stack end-state stack-type))) + (and + (= (state/peek-stack end-state stack-type) + (assoc vect (mod n (count vect)) value)) + (state/empty-stack? end-state :integer) + (state/empty-stack? end-state value-stack))))) + +(gen-specs "set" check-set :vector :item :integer) + ;;; vector/_subvec (defn clean-subvec-bounds From 7613f18c7014b5681a5f1482901b3b00c8fb8bc5 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 5 Jan 2021 15:47:37 -0600 Subject: [PATCH 37/44] Fix `vector/_set` This makes it so that `vector/_set` returns `:ignore-instruction` if the given vector is empty. --- src/propeller/push/instructions/vector.cljc | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index b2df4da..8785159 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -211,8 +211,10 @@ (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit n vect] - (assoc vect (mod n (count vect)) lit)) - [:integer lit-stack stack] + (if (empty? vect) + :ignore-instruction + (assoc vect (mod n (count vect)) lit))) + [lit-stack :integer stack] stack)))) ;; Pushes a subvector of the top item, with start and end indices determined by From 5412ff6c90f4a21faf5119c3e4d8a67fb8f7709c Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Tue, 5 Jan 2021 15:52:59 -0600 Subject: [PATCH 38/44] Add tests for `vector/_take` This add tests for `vector/_take`. --- .../push/instructions/vector_spec.clj | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 3b92862..b8cb6d4 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -431,3 +431,21 @@ (state/peek-stack end-state stack-type)))) (gen-specs "subvec" check-subvec :vector :integer :integer) + +;;; vector/_take + +(defn check-take + [value-type vect n] + (let [stack-type (keyword (str "vector_" value-type)) + start-state (state/push-to-stack + (state/push-to-stack state/empty-state + stack-type + vect) + :integer + n) + end-state (vector/_take stack-type start-state) + expected-result (vec (take n vect))] + (= expected-result + (state/peek-stack end-state stack-type)))) + +(gen-specs "take" check-take :vector :integer) \ No newline at end of file From beed85b5c0a2ca255e11fe75d5599940bf46e06a Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Thu, 7 Jan 2021 14:23:41 -0600 Subject: [PATCH 39/44] Change `vector/_replacefirst` This changes `vector/_replacefirst` to just return the original vector if the value that will be replaced was not found. This change was made in order to be more consistent with Clojush. --- src/propeller/push/instructions/vector.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index 8785159..ccdc980 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -185,7 +185,7 @@ (fn [lit1 lit2 vect] (let [replaceindex (utils/indexof lit1 vect)] (if (= replaceindex -1) - :ignore-instruction + vect (assoc vect replaceindex lit2)))) [lit-stack lit-stack stack] stack)))) From 39626a1764d93cc9d5188c2a3811719ceae4a21f Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Thu, 7 Jan 2021 14:27:14 -0600 Subject: [PATCH 40/44] Fix `vector/_replacefirst` tests This fixes the `vector/_replacefirst` tests to be consistent with the changes made to `vector/_replacefirst` in the previous commit. --- test/propeller/push/instructions/vector_spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index b8cb6d4..8021dea 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -331,7 +331,7 @@ replacement-index (.indexOf vect toreplace)] (or (and (= replacement-index -1) - (= [replacement toreplace] (state/peek-stack-many end-state value-stack 2)) + (state/empty-stack? end-state value-stack) (= vect end-vector)) (and (state/empty-stack? end-state value-stack) (= end-vector (assoc vect replacement-index replacement)))))) From 080df4709ed6d850f1909bec5a175657c8be6e72 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Thu, 7 Jan 2021 15:48:28 -0600 Subject: [PATCH 41/44] Add tests for `vector/_iterate` Tests work by iterating the appropriate print instruction on the vector and checking that resulting string in `:output` stack is correct. --- .../push/instructions/vector_spec.clj | 26 ++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj index 8021dea..4a16e19 100644 --- a/test/propeller/push/instructions/vector_spec.clj +++ b/test/propeller/push/instructions/vector_spec.clj @@ -4,7 +4,8 @@ [clojure.test.check.properties :as prop] [clojure.test.check.clojure-test :as ct :refer [defspec]] [propeller.push.state :as state] - [propeller.push.instructions.vector :as vector])) + [propeller.push.instructions.vector :as vector] + [propeller.push.interpreter :as interpreter])) (def gen-type-pairs [['gen/small-integer "integer"] @@ -176,6 +177,29 @@ (gen-specs "indexof" check-indexof :vector :item) +;;; vector/_iterate + +(defn check-iterate + [value-type vect] + (let [stack-type (keyword (str "vector_" value-type)) + print-instr (keyword (str value-type "_print")) + iter-instr (keyword (str "vector_" value-type "_iterate")) + program [iter-instr print-instr] + start-state (-> state/empty-state + (state/push-to-stack stack-type vect) + (state/push-to-stack :output "")) + ; 4 times the vector length should be enough for this iteration, perhaps even + ; more than we strictly need. + end-state (interpreter/interpret-program program start-state (* 4 (count vect))) + ; pr-str adds escaped quote marks, which causes tests to fail because _print + ; treats strings and characters specially and does not call pr-str on them. + to-str-fn (if (= value-type "string") identity pr-str) + expected-result (apply str (map to-str-fn vect))] + (= expected-result + (state/peek-stack end-state :output)))) + +(gen-specs "iterate" check-iterate :vector) + ;;; vector/_last (defn check-last From 9694143c4efa74d6173c5a23f142b796b6eff758 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Thu, 21 Jan 2021 15:27:07 -0600 Subject: [PATCH 42/44] Add `.clj-kondo/` to the gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 996980f..66b50af 100644 --- a/.gitignore +++ b/.gitignore @@ -14,6 +14,7 @@ pom.xml.asc .idea/ out notes +.clj-kondo/ .idea/ .calva/ From 2af20b66b23b61d950414ab13f4017aa6cb10b40 Mon Sep 17 00:00:00 2001 From: Erik Rauer Date: Thu, 21 Jan 2021 15:46:10 -0600 Subject: [PATCH 43/44] Delete `core_test.clj` file This file was rather unnecessary so we decided to remove it for the time being. --- test/propeller/core_test.clj | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 test/propeller/core_test.clj diff --git a/test/propeller/core_test.clj b/test/propeller/core_test.clj deleted file mode 100644 index 1e0f1eb..0000000 --- a/test/propeller/core_test.clj +++ /dev/null @@ -1,7 +0,0 @@ -(ns propeller.core-test - (:require [clojure.test :refer :all] - [propeller.core :refer :all])) - -;; (deftest a-test -;; (testing "FIXME, I fail." -;; (is (= 0 1)))) From 864c8fb8ee6f486db11c177df2f82877326f5564 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Sat, 23 Jan 2021 16:14:09 -0500 Subject: [PATCH 44/44] Print behavioral diversity and avg total error; add tail-aligned crossover and diploid operators; fix valiant problem --- .DS_Store | Bin 8196 -> 8196 bytes src/.DS_Store | Bin 6148 -> 6148 bytes src/propeller/.DS_Store | Bin 6148 -> 6148 bytes src/propeller/gp.cljc | 4 ++ src/propeller/problems/valiant.cljc | 7 +-- src/propeller/session.cljc | 74 ---------------------------- src/propeller/variation.cljc | 54 ++++++++++++++++++++ 7 files changed, 62 insertions(+), 77 deletions(-) diff --git a/.DS_Store b/.DS_Store index 4c8696c854640d8b1087a87465a54826e6211a0c..b9e3ed4cde58e282d3701268d3e1003f97e862b9 100644 GIT binary patch delta 303 zcmZp1XmQw}CQ#q*!N9=4!l1{H&XCDalAG`1l9ZF51Qg?#Ehh1E%7H_UsPZXzC|8h>gZT}%hRQVLV@&y@& z!O8i#1wcIv46+I!k`-unCPNBCDnnvUI+85Ise3@#I3#Ig%k`(7wtEY)97P4fdh9At z9KaN?nOV??iNnyq%v?vo%wn>waHu@v%lSZinHh>1iWriSt-San`+C*Z$s2_w*r3ew P!jeqP3Y%XEOYr~z)5uT9 diff --git a/src/.DS_Store b/src/.DS_Store index 059041468db135bd0d2cc7fe59bb35aa6d395f07..da17f2d6d1484bfb55b14e6e12bdca890d2d7e85 100644 GIT binary patch delta 79 zcmZoMXffEZk%`07!cs@U(8zf5PNqa=W(L>Eh0J0?x%ntG%B<18MF)%Q2oD7h*eY<~h aKC{H+SY{qJI9HXKnSlYMdh=T5a1j91Qy44& diff --git a/src/propeller/.DS_Store b/src/propeller/.DS_Store index a19382269acf6b4531519f866c878f6dca85fd8f..306b0a39dc35785d3aa367defd71ec8b17637caa 100644 GIT binary patch delta 472 zcmZoMXfc=|#>B!ku~2NHo+6{b#(>?7ixZfc7zHNtFfHb=w6N4sFf=lryqzh(J}2EU zI5|JJfB_8bEPxaTLjgk(Lq0eKLoP#cZoZ34QcivnNG{2uYIES>Lyp+hr4XgA zAOmhE3(%Z|$%4$5^(;VJOBsq8GEiK^$l3-}0hdE|$;;a^mJNHsEjEVAV{+;Xm0Z3SBnH2|UlVLf&gC=Or<0672x mHdd=MZf57;=K#jr=0N7}%#-;=961;n7??ovnB)qu~2NHo+2a5#(>?7j4YFRSQc{_8km{uD41DH-p-Ogc^|9FW>F3y mmWd6kH?wo_a{#q$7UcNOJegm_k%IvU7#SE?Hb;o8VFmz*+Y|@@ diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index 2a46aeb..0eb0426 100755 --- a/src/propeller/gp.cljc +++ b/src/propeller/gp.cljc @@ -25,8 +25,12 @@ (println "Best behaviors:" (:behaviors best)) (println "Genotypic diversity:" (float (/ (count (distinct (map :plushy pop))) (count pop)))) + (println "Behavioral diversity:" + (float (/ (count (distinct (map :behaviors pop))) (count pop)))) (println "Average genome length:" (float (/ (reduce + (map count (map :plushy pop))) (count pop)))) + (println "Average total error:" + (float (/ (reduce + (map :total-error pop)) (count pop)))) (println))) (defn gp diff --git a/src/propeller/problems/valiant.cljc b/src/propeller/problems/valiant.cljc index c51e9a4..f51d8b2 100644 --- a/src/propeller/problems/valiant.cljc +++ b/src/propeller/problems/valiant.cljc @@ -3,8 +3,8 @@ [propeller.push.interpreter :as interpreter] [propeller.push.state :as state])) -(def num-vars 100) ;1000) -(def num-inputs 50) ;500) +(def num-vars 100) ;10) ;100) ;1000) +(def num-inputs 50) ;5) ; 50) ;500) (def num-train 500) ;5000) (def num-test 200) @@ -23,10 +23,11 @@ :outputs (map even-parity? test-inputs)}})) (def instructions - (vec (concat (for [i (range num-inputs)] (keyword (str "in" i))) + (vec (concat (for [i (range num-vars)] (keyword (str "in" i))) (take num-inputs (cycle [:boolean_xor :boolean_or + :boolean_and :boolean_not :exec_if 'close diff --git a/src/propeller/session.cljc b/src/propeller/session.cljc index fbca6ec..c9f9e22 100755 --- a/src/propeller/session.cljc +++ b/src/propeller/session.cljc @@ -5,7 +5,6 @@ [propeller.variation :as variation] [propeller.problems.simple-regression :as regression] [propeller.problems.string-classification :as string-classif] - propeller.problems.valiant [propeller.push.core :as push] [propeller.push.interpreter :as interpreter] [propeller.push.state :as state] @@ -154,76 +153,3 @@ ; } ; :elitism false ; :diploid true}) - - -;(gp/gp {:instructions propeller.problems.valiant/instructions -; :error-function propeller.problems.valiant/error-function -; :max-generations 500 -; :population-size 50 -; :max-initial-plushy-size 1000 -; :step-limit 2000 -; :parent-selection :tournament -; :tournament-size 10 -; :umad-rate 0.01 -; :diploid-flip-rate 0.01 -; :variation {:umad 0.9 -; :diploid-flip 0.1 -; } -; :elitism false -; :diploid true}) - -;(gp/gp {:instructions propeller.problems.valiant/instructions -; :error-function propeller.problems.valiant/error-function -; :max-generations 500 -; :population-size 100 -; :max-initial-plushy-size 1000 -; :step-limit 2000 -; :parent-selection :tournament -; :tournament-size 10 -; :umad-rate 0.01 -; :diploid-flip-rate 0.01 -; :variation {:umad 0.9 -; :diploid-flip 0.1 -; } -; :elitism false -; :diploid true}) - -;;; below is when I switched to just xor - -;(gp/gp {:instructions propeller.problems.valiant/instructions -; :error-function propeller.problems.valiant/error-function -; :max-generations 500 -; :population-size 500 -; :max-initial-plushy-size 50 -; :step-limit 2000 -; :parent-selection :lexicase -; :tournament-size 2 -; :umad-rate 0.01 -; :diploid-flip-rate 0.01 -; :variation {:umad 0.5 -; :crossover 0.25 -; :diploid-flip 0.25 -; } -; :elitism false -; :diploid true}) - -;; separated diploid from other operators - -(gp/gp {:instructions propeller.problems.valiant/instructions - :error-function propeller.problems.valiant/error-function - :max-generations 500 - :population-size 1000 - :max-initial-plushy-size 10 - :step-limit 1000 - :parent-selection :lexicase - :tournament-size 2 - :umad-rate 0.01 - :replacement-rate 0.01 - :diploid-flip-rate 0.01 - :variation {:diploid-umad 0.25 - :diploid-crossover 0.25 - :diploid-flip 0.25 - :uniform-replacement 0.25 - } - :elitism false - :diploid true}) diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc index d35c452..19578eb 100755 --- a/src/propeller/variation.cljc +++ b/src/propeller/variation.cljc @@ -16,6 +16,20 @@ shorter-padded longer)))) +(defn tail-aligned-crossover + "Crosses over two individuals using uniform crossover. Pads shorter one on the left." + [plushy-a plushy-b] + (let [shorter (min-key count plushy-a plushy-b) + longer (if (= shorter plushy-a) + plushy-b + plushy-a) + length-diff (- (count longer) (count shorter)) + shorter-padded (concat (repeat length-diff :crossover-padding) shorter)] + (remove #(= % :crossover-padding) + (map #(if (< (rand) 0.5) %1 %2) + shorter-padded + longer)))) + (defn diploid-crossover "Crosses over two individuals using uniform crossover. Pads shorter one." [plushy-a plushy-b] @@ -32,6 +46,22 @@ shorter-padded longer))))) +(defn tail-aligned-diploid-crossover + "Crosses over two individuals using uniform crossover. Pads shorter one on the left." + [plushy-a plushy-b] + (let [plushy-a (partition 2 plushy-a) + plushy-b (partition 2 plushy-b) + shorter (min-key count plushy-a plushy-b) + longer (if (= shorter plushy-a) + plushy-b + plushy-a) + length-diff (- (count longer) (count shorter)) + shorter-padded (concat (repeat length-diff :crossover-padding) shorter)] + (flatten (remove #(= % :crossover-padding) + (map #(if (< (rand) 0.5) %1 %2) + shorter-padded + longer))))) + (defn uniform-addition "Returns plushy with new instructions possibly added before or after each existing instruction." @@ -51,6 +81,16 @@ %) plushy)) +(defn diploid-uniform-silent-replacement + "Returns plushy with new instructions possibly replacing existing + instructions, but only among the silent member of each pair." + [plushy instructions replacement-rate] + (interleave (map first (partition 2 plushy)) + (map #(if (< (rand) replacement-rate) + (utils/random-instruction instructions) + %) + (map second (partition 2 plushy))))) + (defn diploid-uniform-addition "Returns plushy with new instructions possibly added before or after each existing instruction." @@ -105,6 +145,11 @@ (:plushy (selection/select-parent pop argmap)) (:plushy (selection/select-parent pop argmap))) ; + :tail-aligned-crossover + (tail-aligned-crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) + ; :umad (-> (:plushy (selection/select-parent pop argmap)) (uniform-addition (:instructions argmap) (:umad-rate argmap)) @@ -118,6 +163,10 @@ (-> (:plushy (selection/select-parent pop argmap)) (uniform-replacement (:instructions argmap) (:replacement-rate argmap))) ; + :diploid-uniform-silent-replacement + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-uniform-silent-replacement (:instructions argmap) (:replacement-rate argmap))) + ; :uniform-deletion (-> (:plushy (selection/select-parent pop argmap)) (uniform-deletion (:umad-rate argmap))) @@ -127,6 +176,11 @@ (:plushy (selection/select-parent pop argmap)) (:plushy (selection/select-parent pop argmap))) ; + :tail-aligned-diploid-crossover + (tail-aligned-diploid-crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) + ; :diploid-umad (-> (:plushy (selection/select-parent pop argmap)) (diploid-uniform-addition (:instructions argmap) (:umad-rate argmap))