From 9eae13a89d8ec9e27a5a92ba3529ce2169c57e89 Mon Sep 17 00:00:00 2001 From: skwak22 Date: Tue, 30 Jun 2020 20:36:40 +0900 Subject: [PATCH 1/2] removed clj files --- src/propeller/core.clj | 27 --- src/propeller/genome.clj | 35 --- src/propeller/gp.clj | 60 ------ src/propeller/problems/simple_regression.clj | 61 ------ src/propeller/problems/software/number_io.clj | 3 - .../problems/string_classification.clj | 71 ------ src/propeller/push/core.clj | 18 -- src/propeller/push/instructions/boolean.clj | 68 ------ src/propeller/push/instructions/char.clj | 63 ------ src/propeller/push/instructions/code.clj | 108 ---------- .../push/instructions/input_output.clj | 51 ----- src/propeller/push/instructions/numeric.clj | 171 --------------- .../push/instructions/polymorphic.clj | 181 ---------------- src/propeller/push/instructions/random.clj | 4 - src/propeller/push/instructions/string.clj | 49 ----- src/propeller/push/instructions/vector.clj | 204 ------------------ src/propeller/push/interpreter.clj | 44 ---- src/propeller/push/state.clj | 84 -------- src/propeller/push/utils.clj | 79 ------- src/propeller/selection.clj | 29 --- src/propeller/session.clj | 62 ------ src/propeller/tools/calculus.cljc | 33 --- src/propeller/tools/character.clj | 18 -- src/propeller/tools/distributions.cljc | 59 ----- src/propeller/tools/math.cljc | 104 --------- src/propeller/tools/metrics.clj | 58 ----- src/propeller/utils.clj | 36 ---- src/propeller/variation.clj | 52 ----- 28 files changed, 1832 deletions(-) delete mode 100644 src/propeller/core.clj delete mode 100644 src/propeller/genome.clj delete mode 100644 src/propeller/gp.clj delete mode 100644 src/propeller/problems/simple_regression.clj delete mode 100644 src/propeller/problems/software/number_io.clj delete mode 100644 src/propeller/problems/string_classification.clj delete mode 100644 src/propeller/push/core.clj delete mode 100644 src/propeller/push/instructions/boolean.clj delete mode 100644 src/propeller/push/instructions/char.clj delete mode 100644 src/propeller/push/instructions/code.clj delete mode 100644 src/propeller/push/instructions/input_output.clj delete mode 100644 src/propeller/push/instructions/numeric.clj delete mode 100644 src/propeller/push/instructions/polymorphic.clj delete mode 100644 src/propeller/push/instructions/random.clj delete mode 100644 src/propeller/push/instructions/string.clj delete mode 100644 src/propeller/push/instructions/vector.clj delete mode 100644 src/propeller/push/interpreter.clj delete mode 100644 src/propeller/push/state.clj delete mode 100644 src/propeller/push/utils.clj delete mode 100644 src/propeller/selection.clj delete mode 100644 src/propeller/session.clj delete mode 100644 src/propeller/tools/calculus.cljc delete mode 100644 src/propeller/tools/character.clj delete mode 100644 src/propeller/tools/distributions.cljc delete mode 100644 src/propeller/tools/math.cljc delete mode 100644 src/propeller/tools/metrics.clj delete mode 100644 src/propeller/utils.clj delete mode 100644 src/propeller/variation.clj diff --git a/src/propeller/core.clj b/src/propeller/core.clj deleted file mode 100644 index 5f4ac2a..0000000 --- a/src/propeller/core.clj +++ /dev/null @@ -1,27 +0,0 @@ -(ns propeller.core - (:gen-class) - (:require [propeller.gp :as gp] - [propeller.problems.simple-regression :as regression] - [propeller.problems.string-classification :as string-classif])) - -(defn -main - "Runs propel-gp, giving it a map of arguments." - [& args] - (gp/gp - (update-in - (merge - {:instructions regression/instructions - :error-function regression/error-function - :max-generations 500 - :population-size 500 - :max-initial-plushy-size 50 - :step-limit 100 - :parent-selection :lexicase - :tournament-size 5 - :umad-rate 0.1 - :variation {:umad 0.5 :crossover 0.5} - :elitism false} - (apply hash-map - (map read-string args))) - [:error-function] - identity))) diff --git a/src/propeller/genome.clj b/src/propeller/genome.clj deleted file mode 100644 index 6c460e2..0000000 --- a/src/propeller/genome.clj +++ /dev/null @@ -1,35 +0,0 @@ -(ns propeller.genome - (:require [propeller.push.core :as push] - [propeller.utils :as utils])) - -(defn make-random-plushy - "Creates and returns a new plushy." - [instructions max-initial-plushy-size] - (repeatedly - (rand-int max-initial-plushy-size) - #(utils/random-instruction instructions))) - -(defn plushy->push - "Returns the Push program expressed by the given plushy representation." - [plushy] - (let [opener? #(and (vector? %) (= (first %) 'open))] ;; [open ] marks opens - (loop [push () ;; iteratively build the Push program from the plushy - plushy (mapcat #(if-let [n (get push/opens %)] [% ['open n]] [%]) plushy)] - (if (empty? plushy) ;; maybe we're done? - (if (some opener? push) ;; done with plushy, but unclosed open - (recur push '(close)) ;; recur with one more close - push) ;; otherwise, really done, return push - (let [i (first plushy)] - (if (= i 'close) - (if (some opener? push) ;; process a close when there's an open - (recur (let [post-open (reverse (take-while (comp not opener?) - (reverse push))) - open-index (- (count push) (count post-open) 1) - num-open (second (nth push open-index)) - pre-open (take open-index push)] - (if (= 1 num-open) - (concat pre-open [post-open]) - (concat pre-open [post-open ['open (dec num-open)]]))) - (rest plushy)) - (recur push (rest plushy))) ;; unmatched close, ignore - (recur (concat push [i]) (rest plushy)))))))) ;; anything else diff --git a/src/propeller/gp.clj b/src/propeller/gp.clj deleted file mode 100644 index 9a36b4b..0000000 --- a/src/propeller/gp.clj +++ /dev/null @@ -1,60 +0,0 @@ -(ns propeller.gp - (:require [propeller.genome :as genome] - [propeller.variation :as variation] - [propeller.push.core :as push] - [propeller.push.instructions.boolean] - [propeller.push.instructions.char] - [propeller.push.instructions.code] - [propeller.push.instructions.input-output] - [propeller.push.instructions.numeric] - [propeller.push.instructions.random] - [propeller.push.instructions.polymorphic] - [propeller.push.instructions.string] - [propeller.push.instructions.vector])) - -(defn report - "Reports information each generation." - [pop generation] - (let [best (first pop)] - (println "-------------------------------------------------------") - (println " Report for Generation" generation) - (println "-------------------------------------------------------") - (print "Best plushy: ") (prn (:plushy best)) - (print "Best program: ") (prn (genome/plushy->push (:plushy best))) - (println "Best total error:" (:total-error best)) - (println "Best errors:" (:errors best)) - (println "Best behaviors:" (:behaviors best)) - (println "Genotypic diversity:" - (float (/ (count (distinct (map :plushy pop))) (count pop)))) - (println "Average genome length:" - (float (/ (reduce + (map count (map :plushy pop))) (count pop)))) - (println))) - -(defn gp - "Main GP loop." - [{:keys [population-size max-generations error-function instructions - max-initial-plushy-size] - :as argmap}] - ;; - (println "Starting GP with args: " argmap) - ;; - (loop [generation 0 - population (repeatedly - population-size - #(hash-map :plushy (genome/make-random-plushy - instructions - max-initial-plushy-size)))] - (let [evaluated-pop (sort-by :total-error - (map (partial error-function argmap) - population))] - (report evaluated-pop generation) - (cond - (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") - (>= generation max-generations) nil - :else (recur (inc generation) - (if (:elitism argmap) - (conj (repeatedly (dec population-size) - #(variation/new-individual evaluated-pop argmap)) - (first evaluated-pop)) - (repeatedly population-size - #(variation/new-individual evaluated-pop argmap)))))))) diff --git a/src/propeller/problems/simple_regression.clj b/src/propeller/problems/simple_regression.clj deleted file mode 100644 index bc734ff..0000000 --- a/src/propeller/problems/simple_regression.clj +++ /dev/null @@ -1,61 +0,0 @@ -(ns propeller.problems.simple-regression - (:require [propeller.genome :as genome] - [propeller.push.interpreter :as interpreter] - [propeller.push.state :as state] - [propeller.tools.math :as math])) - -;; ============================================================================= -;; Problem: f(x) = 7x^2 - 20x + 13 -;; ============================================================================= - -(defn- target-function-hard - "Target function: f(x) = 7x^2 - 20x + 13" - [x] - (+ (* 7 x x) (* -20 x) 13)) - -(defn- target-function - "Target function: f(x) = x^3 + x + 3" - [x] - (+ (* x x x) x 3)) - -;; Set of original propel instructions -(def instructions - (list :in1 - :integer_add - :integer_subtract - :integer_mult - :integer_quot - :integer_eq - :exec_dup - :exec_if - 'close - 0 - 1)) - -(defn error-function - "Finds the behaviors and errors of an individual. The error is the absolute - deviation between the target output value and the program's selected behavior, - or 1000000 if no behavior is produced. The behavior is here defined as the - final top item on the INTEGER stack." - [argmap individual] - (let [program (genome/plushy->push (:plushy individual)) - inputs (range -10 11) - correct-outputs (map target-function inputs) - outputs (map (fn [input] - (state/peek-stack - (interpreter/interpret-program - program - (assoc state/empty-state :input {:in1 input}) - (:step-limit argmap)) - :integer)) - inputs) - errors (map (fn [correct-output output] - (if (= output :no-stack-item) - 1000000 - (math/abs (- correct-output output)))) - correct-outputs - outputs)] - (assoc individual - :behaviors outputs - :errors errors - :total-error (apply +' errors)))) diff --git a/src/propeller/problems/software/number_io.clj b/src/propeller/problems/software/number_io.clj deleted file mode 100644 index d21dba7..0000000 --- a/src/propeller/problems/software/number_io.clj +++ /dev/null @@ -1,3 +0,0 @@ -(ns propeller.problems.software.number-io) - - diff --git a/src/propeller/problems/string_classification.clj b/src/propeller/problems/string_classification.clj deleted file mode 100644 index 9811d2a..0000000 --- a/src/propeller/problems/string_classification.clj +++ /dev/null @@ -1,71 +0,0 @@ -(ns propeller.problems.string-classification - (:require [propeller.genome :as genome] - [propeller.push.interpreter :as interpreter] - [propeller.push.state :as state])) - -;; ============================================================================= -;; String classification -;; ============================================================================= - -;; Set of original propel instructions -(def instructions - (list :in1 - :integer_add - :integer_subtract - :integer_mult - :integer_quot - :integer_eq - :exec_dup - :exec_if - :boolean_and - :boolean_or - :boolean_not - :boolean_eq - :string_eq - :string_take - :string_drop - :string_reverse - :string_concat - :string_length - :string_includes? - 'close - 0 - 1 - true - false - "" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "A" - "C" - "G" - "T")) - -(defn error-function - "Finds the behaviors and errors of an individual: Error is 0 if the value and - the program's selected behavior match, or 1 if they differ, or 1000000 if no - behavior is produced. The behavior is here defined as the final top item on - the BOOLEAN stack." - [argmap individual] - (let [program (genome/plushy->push (:plushy individual)) - inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"] - correct-outputs [false false false false true true true] - outputs (map (fn [input] - (state/peek-stack - (interpreter/interpret-program - program - (assoc state/empty-state :input {:in1 input}) - (:step-limit argmap)) - :boolean)) - inputs) - errors (map (fn [correct-output output] - (if (= output :no-stack-item) - 1000000 - (if (= correct-output output) - 0 - 1))) - correct-outputs - outputs)] - (assoc individual - :behaviors outputs - :errors errors - :total-error (apply +' errors)))) \ No newline at end of file diff --git a/src/propeller/push/core.clj b/src/propeller/push/core.clj deleted file mode 100644 index 624c1d9..0000000 --- a/src/propeller/push/core.clj +++ /dev/null @@ -1,18 +0,0 @@ -(ns propeller.push.core) - -;; ============================================================================= -;; PushGP Instructions -;; -;; Instructions are represented as keywords, and stored in an atom. -;; -;; Instructions must all be either functions that take one Push state and -;; return another, or constant literals. -;; -;; TMH: ERCs? -;; ============================================================================= - -(def instruction-table (atom (hash-map))) - -;; Number of blocks opened by instructions (default = 0) -(def opens {:exec_dup 1 - :exec_if 2}) diff --git a/src/propeller/push/instructions/boolean.clj b/src/propeller/push/instructions/boolean.clj deleted file mode 100644 index a4a0528..0000000 --- a/src/propeller/push/instructions/boolean.clj +++ /dev/null @@ -1,68 +0,0 @@ -(ns propeller.push.instructions.boolean - (:require [propeller.push.utils :refer [def-instruction - make-instruction]])) - -;; ============================================================================= -;; BOOLEAN Instructions -;; ============================================================================= - -;; Pushes the logical AND of the top two BOOLEANs -(def-instruction - :boolean_and - ^{:stacks #{:boolean}} - (fn [state] - (make-instruction state #(and %1 %2) [:boolean :boolean] :boolean))) - -;; Pushes the logical OR of the top two BOOLEANs -(def-instruction - :boolean_or - ^{:stacks #{:boolean}} - (fn [state] - (make-instruction state #(or %1 %2) [:boolean :boolean] :boolean))) - -;; Pushes the logical NOT of the top BOOLEAN -(def-instruction - :boolean_not - ^{:stacks #{:boolean}} - (fn [state] - (make-instruction state not [:boolean] :boolean))) - -;; Pushes the logical XOR of the top two BOOLEAN -(def-instruction - :boolean_xor - ^{:stacks #{:boolean}} - (fn [state] - (make-instruction state #(or (and %1 (not %2)) - (and (not %1) %2)) - [:boolean :boolean] - :boolean))) - -;; Pushes the logical AND of the top two BOOLEANs, after applying NOT to the -;; first one -(def-instruction - :boolean_invert_first_then_and - ^{:stacks #{:boolean}} - (fn [state] - (make-instruction state #(and %1 (not %2)) [:boolean :boolean] :boolean))) - -;; Pushes the logical AND of the top two BOOLEANs, after applying NOT to the -;; second one -(def-instruction - :boolean_invert_second_then_and - ^{:stacks #{:boolean}} - (fn [state] - (make-instruction state #(and (not %1) %2) [:boolean :boolean] :boolean))) - -;; Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise -(def-instruction - :boolean_fromfloat - ^{:stacks #{:boolean :float}} - (fn [state] - (make-instruction state #(not (zero? %)) [:float] :boolean))) - -;; Pushes FALSE if the top INTEGER is 0, and TRUE otherwise -(def-instruction - :boolean_frominteger - ^{:stacks #{:boolean :integer}} - (fn [state] - (make-instruction state #(not (zero? %)) [:integer] :boolean))) diff --git a/src/propeller/push/instructions/char.clj b/src/propeller/push/instructions/char.clj deleted file mode 100644 index c411b15..0000000 --- a/src/propeller/push/instructions/char.clj +++ /dev/null @@ -1,63 +0,0 @@ -(ns propeller.push.instructions.char - (:require [propeller.push.state :as state] - [propeller.push.utils :refer [def-instruction - make-instruction]] - [propeller.tools.character :as char])) - -;; ============================================================================= -;; CHAR Instructions -;; ============================================================================= - -;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter -(def-instruction - :char_isletter - ^{:stacks #{:boolean :char}} - (fn [state] - (make-instruction state char/is-letter [:char] :boolean))) - -;; Pushes TRUE onto the BOOLEAN stack if the popped character is a digit -(def-instruction - :char_isdigit - ^{:stacks #{:boolean :char}} - (fn [state] - (make-instruction state char/is-digit [:char] :boolean))) - -;; Pushes TRUE onto the BOOLEAN stack if the popped character is whitespace -;; (newline, space, or tab) -(def-instruction - :char_iswhitespace - ^{:stacks #{:boolean :char}} - (fn [state] - (make-instruction state char/is-whitespace [:char] :boolean))) - -;; Pops the FLOAT stack, converts the top item to a whole number, and pushes -;; its corresponding ASCII value onto the CHAR stack. Whole numbers larger than -;; 128 will be reduced modulo 128. For instance, 248.45 will result in x being -;; pushed. -(def-instruction - :char_fromfloat - ^{:stacks #{:char :float}} - (fn [state] - (make-instruction state #(char (mod (long %) 128)) [:float] :char))) - -;; Pops the INTEGER stack and pushes the top element's corresponding ASCII -;; value onto the CHAR stack. Integers larger than 128 will be reduced modulo -;; 128. For instance, 248 will result in x being pushed -(def-instruction - :char_frominteger - ^{:stacks #{:char :integer}} - (fn [state] - (make-instruction state #(char (mod % 128)) [:integer] :char))) - -;; Pops the STRING stack and pushes the top element's constituent characters -;; onto the CHAR stack, in order. For instance, "hello" will result in the -;; top of the CHAR stack being \h \e \l \l \o -(def-instruction - :char_allfromstring - ^{:stacks #{:char :string}} - (fn [state] - (if (state/empty-stack? state :string) - state - (let [top-string (state/peek-stack state :string) - popped-state (state/pop-stack state :string)] - (state/push-to-stack-multiple popped-state :char (map char top-string)))))) diff --git a/src/propeller/push/instructions/code.clj b/src/propeller/push/instructions/code.clj deleted file mode 100644 index c52051f..0000000 --- a/src/propeller/push/instructions/code.clj +++ /dev/null @@ -1,108 +0,0 @@ -(ns propeller.push.instructions.code - (:require [propeller.utils :as utils] - [propeller.push.state :as state] - [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]])) - -;; ============================================================================= -;; Polymorphic Instructions -;; ============================================================================= - -(def _noop - ^{:stacks #{}} - (fn [stack state] state)) - -(def _do*range - ^{:stacks #{:exec :integer}} - (fn [stack state] state)) - -(def _noop - ^{:stacks #{}} - (fn [stack state] state)) - -(def _noop - ^{:stacks #{}} - (fn [stack state] state)) - -(generate-instructions - [:exec :code] - [_noop]) - - -;; ============================================================================= -;; CODE Instructions -;; ============================================================================= - -;; Concatenates the top two instructions on the :code stack and pushes the -;; result back onto the stack -(def-instruction - :code_append - ^{:stacks #{:code}} - (fn [state] - (make-instruction state - #(utils/not-lazy - (concat (utils/ensure-list %2) - (utils/ensure-list %1))) - [:code :code] - :code))) - -(def-instruction - :code_atom - ^{:stacks #{:code}} - (fn [state] - ())) - -(def-instruction - :code_car - ^{:stacks #{:code}} - (fn [state] - ())) - -(def-instruction - :code_cdr - ^{:stacks #{:code}} - (fn [state] - ())) - -(def-instruction - :code_cons - ^{:stacks #{:code}} - (fn [state] - ())) - -(def-instruction - :code_do - ^{:stacks #{:code}} - (fn [state] - ())) - -(def-instruction - :code_do* - ^{:stacks #{:code}} - (fn [state] - ())) - -(def-instruction - :code_append - ^{:stacks #{:code}} - (fn [state] - ())) - -;; ============================================================================= -;; EXEC Instructions -;; ============================================================================= - -(def-instruction - :exec_dup - ^{:stacks #{:exec}} - (fn [state] - (if (state/empty-stack? state :exec) - state - (state/push-to-stack state :exec (first (:exec state)))))) - -(def-instruction - :exec_if - ^{:stacks #{:boolean :exec}} - (fn [state] - (make-instruction state #(if %1 %3 %2) [:boolean :exec :exec] :exec))) diff --git a/src/propeller/push/instructions/input_output.clj b/src/propeller/push/instructions/input_output.clj deleted file mode 100644 index 6b4b111..0000000 --- a/src/propeller/push/instructions/input_output.clj +++ /dev/null @@ -1,51 +0,0 @@ -(ns propeller.push.instructions.input-output - (:require [propeller.push.state :as state] - [propeller.push.utils :refer [def-instruction - generate-instructions]])) - -;; ============================================================================= -;; INPUT Instructions -;; ============================================================================= - -;; 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. -(defn handle-input-instruction - [state instruction] - (if-let [input (instruction (:input state))] - (state/push-to-stack state :exec input) - (throw (Exception. (str "Undefined input instruction " instruction))))) - -;; ============================================================================= -;; OUTPUT Instructions -;; ============================================================================= - -(def-instruction - :print_newline - ^{:stacks [:print]} - (fn [state] - (let [current-output (state/peek-stack state :output) - popped-state (state/pop-stack state :output)] - (state/push-to-stack popped-state :output (str current-output \newline))))) - -(def _print - ^{:stacks [:print]} - (fn [stack state] - (if (state/empty-stack? state stack) - state - (let [top-item (state/peek-stack state stack) - top-item-str (if (or (string? top-item) - (char? top-item)) - top-item - (pr-str top-item)) - current-output (state/peek-stack state :output) - popped-state (state/pop-stack (state/pop-stack state stack) :output)] - (state/push-to-stack popped-state - :output - (str current-output top-item-str)))))) - -(generate-instructions - [:boolean :char :code :exec :float :integer :string - :vector_boolean :vector_float :vector_integer :vector_string] - [_print]) diff --git a/src/propeller/push/instructions/numeric.clj b/src/propeller/push/instructions/numeric.clj deleted file mode 100644 index 20e17a7..0000000 --- a/src/propeller/push/instructions/numeric.clj +++ /dev/null @@ -1,171 +0,0 @@ -(ns propeller.push.instructions.numeric - (:require [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]] - [propeller.tools.math :as math])) - -;; ============================================================================= -;; FLOAT and INTEGER Instructions (polymorphic) -;; ============================================================================= - -;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than the top -;; item, and FALSE otherwise -(def _gt - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state > [stack stack] :boolean))) - -;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than or -;; equal to the top item, and FALSE otherwise -(def _gte - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state >= [stack stack] :boolean))) - -;; Pushes TRUE onto the BOOLEAN stack if the second item is less than the top -;; item, and FALSE otherwise -(def _lt - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state < [stack stack] :boolean))) - -;; Pushes TRUE onto the BOOLEAN stack if the second item is less than or equal -;; to the top item, and FALSE otherwise -(def _lte - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state <= [stack stack] :boolean))) - -;; Pushes the sum of the top two items onto the same stack -(def _add - ^{:stacks #{}} - (fn [stack state] - (make-instruction state +' [stack stack] stack))) - -;; Pushes the difference of the top two items (i.e. the second item minus the -;; top item) onto the same stack -(def _subtract - ^{:stacks #{}} - (fn [stack state] - (make-instruction state -' [stack stack] stack))) - -;; Pushes the product of the top two items onto the same stack -(def _mult - ^{:stacks #{}} - (fn [stack state] - (make-instruction state *' [stack stack] stack))) - -;; Pushes the quotient of the top two items (i.e. the second item divided by the -;; top item) onto the same stack. If the top item is zero, pushes 1 -(def _quot - ^{:stacks #{}} - (fn [stack state] - (make-instruction state #(if (zero? %2) 1 (quot %1 %2)) [stack stack] stack))) - -;; Pushes the second item modulo the top item onto the same stack. If the top -;; item is zero, pushes 1. The modulus is computed as the remainder of the -;; quotient, where the quotient has first been truncated towards negative -;; infinity. -(def _mod - ^{:stacks #{}} - (fn [stack state] - (make-instruction state #(if (zero? %2) 1 (mod %1 %2)) [stack stack] stack))) - -;; Pushes the maximum of the top two items -(def _max - ^{:stacks #{}} - (fn [stack state] - (make-instruction state max [stack stack] stack))) - -;; Pushes the minimum of the top two items -(def _min - ^{:stacks #{}} - (fn [stack state] - (make-instruction state min [stack stack] stack))) - -;; Pushes 1 / 1.0 if the top BOOLEAN is TRUE, or 0 / 0.0 if FALSE -(def _fromboolean - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state - #((if (= stack :integer) int float) (if % 1 0)) - [:boolean] - stack))) - -;; Pushes the ASCII value of the top CHAR -(def _fromchar - ^{:stacks #{:char}} - (fn [stack state] - (make-instruction state (if (= stack :integer) int float) [:char] stack))) - -;; Pushes the value of the top STRING, if it can be parsed as a number. -;; Otherwise, acts as a NOOP -(def _fromstring - ^{:stacks #{:string}} - (fn [stack state] - (make-instruction state - #(try ((if (= stack :integer) int float) (read-string %)) - (catch Exception e)) - [:string] - stack))) - -;; Pushes the increment (i.e. +1) of the top item of the stack -(def _inc - ^{:stacks #{}} - (fn [stack state] - (make-instruction state inc [stack] stack))) - -;; Pushes the decrement (i.e. -1) of the top item of the stack -(def _dec - ^{:stacks #{}} - (fn [stack state] - (make-instruction state dec [stack] stack))) - -;; 2 types x 16 functions = 32 instructions -(generate-instructions - [:float :integer] - [_gt _gte _lt _lte _add _subtract _mult _quot _mod _max _min _inc _dec - _fromboolean _fromchar _fromstring]) - -;; ============================================================================= -;; FLOAT Instructions only -;; ============================================================================= - -;; Pushes the cosine of the top FLOAT -(def-instruction - :float_cos - ^{:stacks #{:float}} - (fn [state] - (make-instruction state math/cos [:float] :float))) - -;; Pushes the sine of the top FLOAT -(def-instruction - :float_sin - ^{:stacks #{:float}} - (fn [state] - (make-instruction state math/sin [:float] :float))) - -;; Pushes the tangent of the top FLOAT -(def-instruction - :float_tan - ^{:stacks #{:float}} - (fn [state] - (make-instruction state math/tan [:float] :float))) - -;; Pushes the floating point version of the top INTEGER -(def-instruction - :float_frominteger - ^{:stacks #{:float :integer}} - (fn [state] - (make-instruction state float [:integer] :float))) - -;; ============================================================================= -;; INTEGER Instructions only -;; ============================================================================= - -;; Pushes the result of truncating the top FLOAT towards negative infinity -(def-instruction - :integer_fromfloat - ^{:stacks #{:float :integer}} - (fn [state] - (make-instruction state int [:float] :integer))) diff --git a/src/propeller/push/instructions/polymorphic.clj b/src/propeller/push/instructions/polymorphic.clj deleted file mode 100644 index ca0d8da..0000000 --- a/src/propeller/push/instructions/polymorphic.clj +++ /dev/null @@ -1,181 +0,0 @@ -(ns propeller.push.instructions.polymorphic - (:require [propeller.utils :as utils] - [propeller.push.state :as state] - [propeller.push.utils :refer [generate-instructions - make-instruction]])) - -;; ============================================================================= -;; Polymorphic Instructions -;; -;; (for all stacks, with the exception of non-data ones like auxiliary, input, -;; and output) -;; ============================================================================= - -;; Duplicates the top item of the stack. Does not pop its argument (since that -;; would negate the effect of the duplication) -(def _dup - ^{:stacks #{}} - (fn [stack state] - (let [top-item (state/peek-stack state stack)] - (if (state/empty-stack? state stack) - state - (state/push-to-stack state stack top-item))))) - -;; Duplicates n copies of the top item (i.e leaves n copies there). Does not pop -;; its argument (since that would negate the effect of the duplication). The -;; number n is determined by the top INTEGER. For n = 0, equivalent to POP. -;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values -;; of n are treated as 0 -(def _duptimes - ^{:stacks #{:integer}} - (fn [stack state] - (if (or (and (= stack :integer) - (<= 2 (count (:integer state)))) - (and (not= stack :integer) - (not (state/empty-stack? state :integer)) - (not (state/empty-stack? state stack)))) - (let [n (state/peek-stack state :integer) - popped-state (state/pop-stack state :integer) - top-item (state/peek-stack popped-state stack) - top-item-dup (take (- n 1) (repeat top-item))] - (cond - (< 0 n) (state/push-to-stack-multiple popped-state stack top-item-dup) - :else (state/pop-stack popped-state stack))) - state))) - -;; Duplicates the top n items on the stack, one time each. The number n is -;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If -;; fewer than n items are on the stack, the entire stack will be duplicated. -(def _dupitems - ^{:stacks #{:integer}} - (fn [stack state] - (if (state/empty-stack? state :integer) - state - (let [n (state/peek-stack state :integer) - popped-state (state/pop-stack state :integer) - top-items (take n (get popped-state stack))] - (state/push-to-stack-multiple popped-state stack top-items))))) - -;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE -(def _empty - ^{:stacks #{:boolean}} - (fn [stack state] - (state/push-to-stack state :boolean (state/empty-stack? state stack)))) - -;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal. -;; Otherwise FALSE -(def _eq - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state = [stack stack] :boolean))) - -;; Empties the given stack -(def _flush - ^{:stacks #{}} - (fn [stack state] - (assoc state stack '()))) - -;; Pops the given stack -(def _pop - ^{:stacks #{}} - (fn [stack state] - (state/pop-stack state stack))) - -;; Rotates the top three items on the stack (i.e. pulls the third item out and -;; pushes it on top). Equivalent to (yank state stack-type 2) -(def _rot - ^{:stacks #{}} - (fn [stack state] - (if (<= 3 (count (get state stack))) - (let [top-three (state/peek-stack-multiple state stack 3) - popped-state (state/pop-stack-multiple state stack 3) - top-three-rot (take 3 (conj top-three (last top-three)))] - (state/push-to-stack-multiple popped-state stack top-three-rot)) - state))) - -;; Inserts the top item deeper into the stack, using the top INTEGER to -;; determine how deep -(def _shove - ^{:stacks #{:integer}} - (fn [stack state] - (if (or (and (= stack :integer) - (<= 2 (count (:integer state)))) - (and (not= stack :integer) - (not (state/empty-stack? state :integer)) - (not (state/empty-stack? state stack)))) - (let [index-raw (state/peek-stack state :integer) - popped-state (state/pop-stack state :integer) - top-item (state/peek-stack popped-state stack) - popped-state (state/pop-stack popped-state stack) - index (max 0 (min index-raw (count (get popped-state stack))))] - (update popped-state stack #(utils/not-lazy (concat (take index %) - (list top-item) - (drop index %))))) - state))) - -;; Pushes the given stack's depth onto the INTEGER stack -(def _stackdepth - ^{:stacks #{:integer}} - (fn [stack state] - (let [stack-depth (count (get state stack))] - (state/push-to-stack state :integer stack-depth)))) - -;; Swaps the top two items on the stack -(def _swap - ^{:stacks #{}} - (fn [stack state] - (if (<= 2 (count (get state stack))) - (let [top-two (state/peek-stack-multiple state stack 2) - popped-state (state/pop-stack-multiple state stack 2)] - (state/push-to-stack-multiple popped-state stack (reverse top-two))) - state))) - -;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER -;; is used to determine how deep to yank from -(def _yank - ^{:stacks #{:integer}} - (fn [stack state] - (if (or (and (= stack :integer) - (<= 2 (count (:integer state)))) - (and (not= stack :integer) - (not (state/empty-stack? state :integer)) - (not (state/empty-stack? state stack)))) - (let [index-raw (state/peek-stack state :integer) - popped-state (state/pop-stack state :integer) - index (max 0 (min index-raw (count (get popped-state stack)))) - indexed-item (nth (get popped-state stack) index)] - (update popped-state stack #(utils/not-lazy - (concat (list indexed-item) - (take index %) - (rest (drop index %)))))) - state))) - -;; Pushes a copy of an indexed item from deep in the stack, without removing it. -;; The top INTEGER is used to determine how deep to yankdup from -(def _yankdup - ^{:stacks #{:integer}} - (fn [stack state] - (if (or (and (= stack :integer) - (<= 2 (count (:integer state)))) - (and (not= stack :integer) - (not (state/empty-stack? state :integer)) - (not (state/empty-stack? state stack)))) - (let [index-raw (state/peek-stack state :integer) - popped-state (state/pop-stack state :integer) - index (max 0 (min index-raw (count (get popped-state stack)))) - indexed-item (nth (get popped-state stack) index)] - (state/push-to-stack popped-state stack indexed-item)) - state))) - -;; 9 types x 1 functions = 9 instructions -(generate-instructions - [:boolean :char :float :integer :string - :vector_boolean :vector_float :vector_integer :vector_string] - [_eq]) - -;; 11 types x 12 functions = 132 instructions -(generate-instructions - [:boolean :char :code :exec :float :integer :string - :vector_boolean :vector_float :vector_integer :vector_string] - [_dup _duptimes _dupitems _empty _flush _pop _rot _shove _stackdepth - _swap _yank _yankdup]) diff --git a/src/propeller/push/instructions/random.clj b/src/propeller/push/instructions/random.clj deleted file mode 100644 index 87a83e8..0000000 --- a/src/propeller/push/instructions/random.clj +++ /dev/null @@ -1,4 +0,0 @@ -(ns propeller.push.instructions.random - (:require [propeller.push.utils :refer [def-instruction]])) - - diff --git a/src/propeller/push/instructions/string.clj b/src/propeller/push/instructions/string.clj deleted file mode 100644 index aa1f839..0000000 --- a/src/propeller/push/instructions/string.clj +++ /dev/null @@ -1,49 +0,0 @@ -(ns propeller.push.instructions.string - (:require [propeller.push.utils :refer [def-instruction - make-instruction]])) - -;; ============================================================================= -;; STRING Instructions -;; ============================================================================= - -(def-instruction - :string_= - ^{:stacks #{:boolean :string}} - (fn [state] - (make-instruction state = [:string :string] :boolean))) - -(def-instruction - :string_concat - ^{:stacks #{:string}} - (fn [state] - (make-instruction state #(apply str (concat %1 %2)) [:string :string] :string))) - -(def-instruction - :string_drop - ^{:stacks #{:integer :string}} - (fn [state] - (make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string))) - -(def-instruction - :string_includes? - ^{:stacks #{:boolean :string}} - (fn [state] - (make-instruction state clojure.string/includes? [:string :string] :boolean))) - -(def-instruction - :string_length - ^{:stacks #{:integer :string}} - (fn [state] - (make-instruction state count [:string] :integer))) - -(def-instruction - :string_reverse - ^{:stacks #{:string}} - (fn [state] - (make-instruction state #(apply str (reverse %)) [:string] :string))) - -(def-instruction - :string_take - ^{:stacks #{:integer :string}} - (fn [state] - (make-instruction state #(apply str (take %1 %2)) [:integer :string] :string))) diff --git a/src/propeller/push/instructions/vector.clj b/src/propeller/push/instructions/vector.clj deleted file mode 100644 index 6891504..0000000 --- a/src/propeller/push/instructions/vector.clj +++ /dev/null @@ -1,204 +0,0 @@ -(ns propeller.push.instructions.vector - (:require [clojure.string] - [propeller.utils :as utils] - [propeller.push.state :as state] - [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]])) - -;; ============================================================================= -;; VECTOR Instructions -;; ============================================================================= - -;; Pushes the butlast of the top item -(def _butlast - ^{:stacks #{}} - (fn [stack state] - (make-instruction state #(vec (butlast %)) [stack] stack))) - -;; Concats and pushes the top two vectors of the stack -(def _concat - ^{:stacks #{}} - (fn [stack state] - (make-instruction state #(vec (concat %2 %1)) [stack stack] stack))) - -;; Conj's the top item of the appropriately-typed literal stack onto the vector -;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER) -(def _conj - ^{:stacks #{}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state #(conj %2 %1) [lit-stack stack] stack)))) - -;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack -;; contains the top element of the appropriately-typed literal stack. Otherwise, -;; pushes FALSE -(def _contains - ^{:stacks #{:boolean}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean)))) - -;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector. -;; Otherwise, pushes FALSE -(def _emptyvector - ^{:stacks #{:boolean}} - (fn [stack state] - (make-instruction state empty? [stack] :boolean))) - -;; Pushes the first item of the top element of the vector stack onto the -;; approrpiately-typed literal stack -(def _first - ^{:stacks #{}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state first [stack] lit-stack)))) - -;; Pushes onto the INTEGER stack the index of the top element of the -;; appropriately-typed literal stack within the top element of the vector stack -(def _indexof - ^{:stacks #{:integer}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer)))) - -;; Pushes the last item of the top element of the vector stack onto the -;; approrpiately-typed literal stack -(def _last - ^{:stacks #{}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state last [stack] lit-stack)))) - -;; Pushes the length of the top item onto the INTEGER stack -(def _length - ^{:stacks #{:integer}} - (fn [stack state] - (make-instruction state count [stack] :integer))) - -;; Pushes the Nth item of the top element of the vector stack onto the -;; approrpiately-typed literal stack, where N is taken from the INTEGER stack. -;; To insure the index is within bounds, N is taken mod the vector length -(def _nth - ^{:stacks #{:integer}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state - #(get %2 (mod %1 (count %2))) - [:integer stack] - lit-stack)))) - -;; Pushes onto the INTEGER stack the number of occurrences of the top element of -;; the appropriately-typed literal stack within the top element of the vector -;; stack -(def _occurrencesof - ^{:stacks #{:integer}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state - (fn [lit vect] (count (filter #(= lit %) vect))) - [lit-stack stack] - :integer)))) - -;; Pushes every item of the top element onto the appropriately-typed stack -(def _pushall - ^{:stacks #{}} - (fn [stack state] - (if (state/empty-stack? state stack) - state - (let [lit-stack (utils/get-vector-literal-type stack) - top-vector (state/peek-stack state stack) - popped-state (state/pop-stack state stack)] - (state/push-to-stack-multiple popped-state lit-stack top-vector))))) - -;; Removes all occurrences of the top element of the appropriately-typed literal -;; stack from the first element of the vector stack -(def _remove - ^{:stacks #{}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state - (fn [lit vect] (vec (filter #(not= lit %) vect))) - [lit-stack stack] - stack)))) - -;; Replaces all occurrences of the second element of the appropriately-typed -;; literal stack with the top element of the appropriately-typed literal stack -;; within the top item of the vector stack -(def _replace - ^{:stacks #{}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state - (fn [lit1 lit2 vect] - (replace {lit1 lit2} vect)) - [lit-stack lit-stack stack] - stack)))) - -;; Replaces the first occurrence of the second element of the appropriately-typed -;; literal stack with the top element of the appropriately-typed literal stack -;; within the top item of the vector stack -(def _replacefirst - ^{:stacks #{}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state - (fn [lit1 lit2 vect] - (assoc vect (utils/indexof lit1 vect) lit2)) - [lit-stack lit-stack stack] - stack)))) - -;; Pushes the rest of the top item -(def _rest - ^{:stacks #{}} - (fn [stack state] - (make-instruction state #(vec (rest %)) [stack] stack))) - -;; Pushes the reverse of the top item -(def _reverse - ^{:stacks #{}} - (fn [stack state] - (make-instruction state #(vec (reverse %)) [stack] stack))) - -;; Replaces in the top vector the item at index N (taken from the INTEGER stack) -;; with the top item from the appropriately-typed literal stack. To insure the -;; index is within bounds, N is taken mod the vector length -(def _set - ^{:stacks #{:integer}} - (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] - (make-instruction state - (fn [lit n vect] - (assoc vect (mod n (count vect)) lit)) - [:integer lit-stack stack] - stack)))) - -;; Pushes a subvector of the top item, with start and end indices determined by -;; the second and top items of the INTEGER stack respectively -(def _subvec - ^{:stacks #{:integer}} - (fn [stack state] - (make-instruction state - (fn [stop-raw start-raw vect] - (let [start (min (count vect) (max 0 start-raw)) - stop (min (count vect) (max start-raw stop-raw))] - (subvec vect start stop))) - [:integer :integer stack] - stack))) - -;; Pushes the first N items of the top element, where N is taken from the top of -;; the INTEGER stack -(def _take - ^{:stacks #{:integer}} - (fn [stack state] - (make-instruction state #(vec (take %1 %2)) [:integer stack] stack))) - -;; 4 types x 20 functions = 80 instructions -(generate-instructions - [:vector_boolean :vector_float :vector_integer :vector_string] - [_butlast _concat _conj _contains _emptyvector _first _indexof _last - _length _nth _occurrencesof _pushall _remove _replace _replacefirst - _rest _reverse _set _subvec _take]) - -;; Manually add extra metadata for _conj - diff --git a/src/propeller/push/interpreter.clj b/src/propeller/push/interpreter.clj deleted file mode 100644 index d8504ca..0000000 --- a/src/propeller/push/interpreter.clj +++ /dev/null @@ -1,44 +0,0 @@ -(ns propeller.push.interpreter - (:require [propeller.push.core :as push] - [propeller.push.state :as state] - [propeller.push.utils :refer [get-literal-type]] - [propeller.push.instructions.input-output :as io])) - -(defn interpret-one-step - "Takes a Push state and executes the next instruction on the exec stack." - [state] - (let [popped-state (state/pop-stack state :exec) - instruction (first (:exec state)) - literal-type (get-literal-type instruction)] ; nil for non-literals - (cond - ;; - ;; Recognize functional instruction or input instruction - (keyword? instruction) - (if-let [function (instruction @push/instruction-table)] - (function popped-state) - (io/handle-input-instruction popped-state instruction)) - ;; - ;; Recognize constant literal instruction - literal-type - (if (= :generic-vector literal-type) - ;; Empty vector gets pushed on all vector stacks - (reduce #(update-in % [%2] conj []) popped-state - [:vector_boolean :vector_float :vector_integer :vector_string]) - (state/push-to-stack popped-state literal-type instruction)) - ;; - ;; Recognize parenthesized group of instructions - (seq? instruction) - (update popped-state :exec #(concat %2 %1) instruction) - ;; - :else - (throw (Exception. (str "Unrecognized Push instruction in program: " - (name instruction))))))) - -(defn interpret-program - "Runs the given problem starting with the stacks in start-state." - [program start-state step-limit] - (loop [state (assoc start-state :exec program :step 1)] - (if (or (empty? (:exec state)) - (> (:step state) step-limit)) - state - (recur (update (interpret-one-step state) :step inc))))) diff --git a/src/propeller/push/state.clj b/src/propeller/push/state.clj deleted file mode 100644 index 53f6da9..0000000 --- a/src/propeller/push/state.clj +++ /dev/null @@ -1,84 +0,0 @@ -(ns propeller.push.state) - -;; Empty push state - all available stacks are empty -(defonce empty-state {:auxiliary '() - :boolean '() - :char '() - :code '() - :exec '() - :float '() - :input {} - :integer '() - :output '() - :string '() - :vector_boolean '() - :vector_float '() - :vector_integer '() - :vector_string '()}) - -(def example-push-state - {:exec '() - :integer '(1 2 3 4 5 6 7) - :string '("abc") - :input {:in1 4}}) - -(defn empty-stack? - "Returns true if the stack is empty." - [state stack] - (empty? (get state stack))) - -(defn peek-stack - "Returns the top item on a stack." - [state stack] - (let [working-stack (get state stack)] - (if (empty? working-stack) - :no-stack-item - (first working-stack)))) - -(defn peek-stack-multiple - "Returns the top n items on a stack. If there are less than n items on the - stack, returns the entire stack." - [state stack n] - (take n (get state stack))) - -(defn pop-stack - "Removes the top item of stack." - [state stack] - (update state stack rest)) - -(defn pop-stack-multiple - "Removes the top n items of a stack. If there are less than n items on the - stack, pops the entire stack." - [state stack n] - (update state stack #(drop n %))) - -(defn push-to-stack - "Pushes an item onto a stack." - [state stack item] - (update state stack conj item)) - -(defn push-to-stack-multiple - "Pushes a list of items onto a stack, leaving them in the order they are in." - [state stack items] - (let [items-list (if (coll? items) items (list items)) - items-list-no-nil (filter #(not (nil? %)) items-list)] - (update state stack into (reverse items-list-no-nil)))) - -(defn get-args-from-stacks - "Takes a state and a collection of stacks to take args from. If there are - enough args on each of the desired stacks, returns a map with keys - {:state :args}, where :state is the new state and :args is a list of args - popped from the stacks. If there aren't enough args on the stacks, returns - :not-enough-args without popping anything." - [state stacks] - (loop [state state - stacks (reverse stacks) - args '()] - (if (empty? stacks) - {:state state :args args} - (let [current-stack (first stacks)] - (if (empty-stack? state current-stack) - :not-enough-args - (recur (pop-stack state current-stack) - (rest stacks) - (conj args (peek-stack state current-stack)))))))) diff --git a/src/propeller/push/utils.clj b/src/propeller/push/utils.clj deleted file mode 100644 index f1582e1..0000000 --- a/src/propeller/push/utils.clj +++ /dev/null @@ -1,79 +0,0 @@ -(ns propeller.push.utils - (:require [clojure.set] - [propeller.push.core :as push] - [propeller.push.state :as state])) - -(defmacro def-instruction - [instruction definition] - `(swap! push/instruction-table assoc '~instruction ~definition)) - -;; A utility function for making Push instructions. Takes a state, a function -;; to apply to the args, the stacks to take the args from, and the stack to -;; return the result to. Applies the function to the args (popped from the -;; given stacks), and pushes the result onto the return-stack -(defn make-instruction - [state function arg-stacks return-stack] - (let [popped-args (state/get-args-from-stacks state arg-stacks)] - (if (= popped-args :not-enough-args) - state - (let [result (apply function (:args popped-args)) - new-state (:state popped-args)] - (state/push-to-stack new-state return-stack result))))) - -;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix -;; function strings, e.g. [_add, _mult, _eq], automates the generation of all -;; possible combination instructions, which here would be :float_add, :float_mult, -;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring -;; and updating the generic function's stack-type metadata -(defmacro generate-instructions [stacks functions] - `(do ~@(for [stack stacks - func functions - :let [instruction-name (keyword (str (name stack) func)) - metadata `(update-in (meta ~func) [:stacks] #(conj % ~stack)) - new-func `(with-meta (partial ~func ~stack) ~metadata)]] - `(def-instruction ~instruction-name ~new-func)))) - -;; Given a set of stacks, returns all instructions that operate on those stacks -;; only. This won't include random or parenthesis-altering instructions unless -;; :random or :parentheses respectively are in the stacks set -(defn get-stack-instructions - [stacks] - (doseq [[instruction-name function] @push/instruction-table] - (assert - (:stacks (meta function)) - (format "ERROR: Instruction %s does not have :stacks defined in metadata." - (name instruction-name)))) - (for [[instruction-name function] @push/instruction-table - :when (clojure.set/subset? (:stacks (meta function)) stacks)] - instruction-name)) - -;; If a piece of data is a literal, return its corresponding stack name, e.g. -;; :integer. Otherwise, return nil" -(defn get-literal-type - [data] - (let [literals {:boolean (fn [thing] (or (true? thing) (false? thing))) - :char char? - :float float? - :integer integer? - :string string? - :vector_boolean (fn [thing] (and (vector? thing) - (or (true? (first thing)) - (false? (first thing))))) - :vector_float (fn [thing] (and (vector? thing) - (float? (first thing)))) - :vector_integer (fn [thing] (and (vector? thing) - (integer? (first thing)))) - :vector_string (fn [thing] (and (vector? thing) - (string? (first thing)))) - :generic-vector (fn [thing] (= [] thing))}] - (first (for [[stack function] literals - :when (function data)] - stack)))) - -;; Pretty-prints a Push state, for logging or debugging purposes -(defn print-state - [state] - (doseq [stack (keys state/empty-state)] - (printf "%-15s = " stack) - (prn (if (get state stack) (get state stack) '())) - (flush))) diff --git a/src/propeller/selection.clj b/src/propeller/selection.clj deleted file mode 100644 index d6739c2..0000000 --- a/src/propeller/selection.clj +++ /dev/null @@ -1,29 +0,0 @@ -(ns propeller.selection) - -(defn tournament-selection - "Selects an individual from the population using a tournament." - [pop argmap] - (let [tournament-size (:tournament-size argmap) - tournament-set (take tournament-size (shuffle pop))] - (apply min-key :total-error tournament-set))) - -(defn lexicase-selection - "Selects an individual from the population using lexicase selection." - [pop argmap] - (loop [survivors pop - cases (shuffle (range (count (:errors (first pop)))))] - (if (or (empty? cases) - (empty? (rest survivors))) - (rand-nth survivors) - (let [min-err-for-case (apply min (map #(nth % (first cases)) - (map :errors survivors)))] - (recur (filter #(= (nth (:errors %) (first cases)) min-err-for-case) - survivors) - (rest cases)))))) - -(defn select-parent - "Selects a parent from the population using the specified method." - [pop argmap] - (case (:parent-selection argmap) - :tournament (tournament-selection pop argmap) - :lexicase (lexicase-selection pop argmap))) diff --git a/src/propeller/session.clj b/src/propeller/session.clj deleted file mode 100644 index 3e626db..0000000 --- a/src/propeller/session.clj +++ /dev/null @@ -1,62 +0,0 @@ -(ns propeller.session - (:require [propeller.genome :as genome] - [propeller.gp :as gp] - [propeller.selection :as selection] - [propeller.variation :as variation] - [propeller.problems.simple-regression :as regression] - [propeller.problems.string-classification :as string-classif] - [propeller.push.core :as push] - [propeller.push.interpreter :as interpreter] - [propeller.push.state :as state])) - -#_(interpreter/interpret-program - '(1 2 integer_add) state/empty-state 1000) - -#_(interpreter/interpret-program - '(3 5 :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 push/default-instructions 20)) - -#_(interpreter/interpret-program - (genome/plushy->push - (genome/make-random-plushy push/default-instructions 20)) - (assoc state/empty-state :input {:in1 "I can hear you."}) - 1000) - -;; ============================================================================= -;; Target function: f(x) = x^3 + x + 3 -;; ============================================================================= - -#_(gp/gp {:instructions push/default-instructions - :error-function regression/error-function - :max-generations 50 - :population-size 200 - :max-initial-plushy-size 50 - :step-limit 100 - :parent-selection :tournament - :tournament-size 5}) - -#_(gp/gp {:instructions push/default-instructions - :error-function string-classif/error-function - :max-generations 50 - :population-size 200 - :max-initial-plushy-size 50 - :step-limit 100 - :parent-selection :lexicase}) diff --git a/src/propeller/tools/calculus.cljc b/src/propeller/tools/calculus.cljc deleted file mode 100644 index 19dfc4e..0000000 --- a/src/propeller/tools/calculus.cljc +++ /dev/null @@ -1,33 +0,0 @@ -(ns propeller.tools.calculus) - -(defonce ^:const dx 0.0001) - -(defn deriv - "Returns the derivative of f evaluated at c. If called with only one argument, - it returns the derivative function." - ([f c] - ((deriv f) c)) - ([f] - (fn [x] - (/ (- (f (+ x dx)) (f x)) dx)))) - -(defn integrate - "Returns the definite integral of f over [a, b] using Simpson's method. - If called with only one argument (the function), returns the indefinite - integral, which takes as input a value x and (optionally) a constant c." - ([f] - (fn this - ([x] (this x 0)) - ([x c] (+ (integrate f 0 x) c)))) - ([f a b] - (let [n (/ 1 dx) - h (/ (- b a) n)] - (loop [i 1 - sum1 (f (+ a (/ h 2))) - sum2 0] - (if (< i n) - (recur (inc i) - (+ sum1 (f (+ a (* h i) (/ h 2)))) - (+ sum2 (f (+ a (* h i))))) - (* (/ h 6) (+ (f a) (f b) (* 4 sum1) (* 2 sum2)))))))) - diff --git a/src/propeller/tools/character.clj b/src/propeller/tools/character.clj deleted file mode 100644 index 32d64d3..0000000 --- a/src/propeller/tools/character.clj +++ /dev/null @@ -1,18 +0,0 @@ -(ns propeller.tools.character) - -(defn is-letter - "Returns true if the given character is a letter, A-Z or a-z." - [c] - (<= (int \A) (int c) (int \z))) - - -(defn is-digit - "Returns true if the given character is a digit, 0-9." - [c] - (<= (int \0) (int c) (int \9))) - - -(defn is-whitespace - "Returns true if the given character is whitespace (newline, space, tab)." - [c] - (contains? #{(int \newline) (int \tab) (int \space)} (int c))) diff --git a/src/propeller/tools/distributions.cljc b/src/propeller/tools/distributions.cljc deleted file mode 100644 index e6358a3..0000000 --- a/src/propeller/tools/distributions.cljc +++ /dev/null @@ -1,59 +0,0 @@ -(ns propeller.tools.distributions - (:require [propeller.tools.calculus :as calculus] - [propeller.tools.math :as math])) - -;; ============================================================================= -;; NORMAL -;; ============================================================================= - -(defn- box-muller - "Given two uniformly distributed random variables (from 0 to 1), returns a - Standard Normal variable computed using the Box-Muller Transform." - [u1 u2] - (* (math/sqrt (* -2 (math/log u1))) - (math/cos (* 2 math/PI u2)))) - -(defn- normal-pdf - "Given a mean and standard deviation, returns the corresponding Normal - Probability Distribution Function." - [mu sigma] - (fn [x] - (* (/ 1 (* sigma (math/sqrt (* 2 math/PI)))) - (math/exp (- (/ (math/pow (/ (- x mu) sigma) 2) 2)))))) - -(defn rand-norm - "Generates n Normally-distributed random variables with given mean and - standard deviation. If no parameters are provided, defaults to a - single random observation from a Standard Normal distribution. - Accepts an argument map with optional keys :n, :mu, and :sigma." - [{:keys [n mu sigma] - :or {n 1, mu 0, sigma 1}}] - (repeatedly n #(box-muller (rand) (rand)))) - -(defn pdf-norm - "Returns the value of the Normal Probability Distribution Function at a - particular value x. If no distributional parameters are provided, defaults to - the Standard Normal PDF. - Accepts an argument map with keys :x, and optionally :mu and :sigma." - [{:keys [x mu sigma] - :or {mu 0, sigma 1}}] - ((normal-pdf mu sigma) x)) - -(defn cdf-norm - "Parameters: {:keys [x mu sigma]} - Returns the value of the Normal Cumulative Distribution Function at a - particular value x. If no distributional parameters are provided, defaults to - the Standard Normal CDF. - Accepts an argument map with keys :x, and optionally :mu and :sigma." - [{:keys [x mu sigma] - :or {mu 0, sigma 1}}] - (calculus/integrate (normal-pdf mu sigma) (- mu (* 6 sigma)) x)) - -(defn quant-norm - "For a given probability p, returns the corresponding value of the quantile - function (i.e. the inverse Cumulative Distribution Function). If no - distributional parameters are provided, defaults to Standard Normal quantiles. - Accepts an argument map with keys :p, and optionally :mu and :sigma." - [{:keys [p mu sigma] - :or {mu 0, sigma 1}}] - ()) ; unfinished... diff --git a/src/propeller/tools/math.cljc b/src/propeller/tools/math.cljc deleted file mode 100644 index 03ed549..0000000 --- a/src/propeller/tools/math.cljc +++ /dev/null @@ -1,104 +0,0 @@ -(ns propeller.tools.math) - -(defonce PI #?(:clj Math/PI - :cljs js/Math.PI)) - -(defonce E #?(:clj Math/E - :cljs js/Math.PI)) - -(defn abs - "Returns the absolute value of a number." - [x] - (if (neg? x) (- x) x)) - -(defn approx= [x y epsilon] - "Returns true if the absolute difference between x and y is less than or - equal to some specified error level, epsilon." - (<= (abs (- y x)) epsilon)) - -(defn ceil - "Returns the smallest integer greater than or equal to x." - [x] - #?(:clj (Math/ceil x) - :cljs (js/Math.ceil x))) - -(defn cos - "Returns the cosine of an angle (specified in radians)." - [x] - #?(:clj (Math/cos x) - :cljs (js/Math.cos x))) - -(defn div - "Returns the result of floating point division between x and y." - [x y] - (double (/ x y))) - -(defn exp - "Returns Euler's number (approx. 2.71) raised to the given power." - [x] - #?(:clj (Math/exp x) - :cljs (js/Math.exp x))) - -(defn floor - "Returns the largest integer less than or equal to x." - [x] - #?(:clj (Math/floor x) - :cljs (js/Math.floor x))) - -(defn log - "Returns the logarithm of x with the given base. If called with only one - argument, returns the natural logarithm (base e) of the given value." - ([x base] - (/ (log x) (log base))) - ([x] - #?(:clj (Math/log x) - :cljs (js/Math.log x)))) - -(defn pow - "Returns the value obtained by raising the first argument to the power of - the second argument." - [x n] - #?(:clj (Math/pow x n) - :cljs (js/Math.pow x n))) - -(defn root - "Returns the root of x with base n." - [x n] - (pow x (/ 1 n))) - -(defn round - "Returns the value of x rounded to the nearest integer." - [x] - #?(:clj (Math/round x) - :cljs (js/Math.round x))) - -(defn sign - "Returns the 1 if the argument is positive, -1 if the argument is negative, - and 0 if the argument is zero." - [x] - (cond (< x 0) -1 - (> x 0) 1 - :else 0)) - -(defn sin - "Returns the sine of an angle (specified in radians)." - [x] - #?(:clj (Math/sin x) - :cljs (js/Math.sin x))) - -(defn sqrt - "Returns the square root of the given value." - [x] - #?(:clj (Math/sqrt x) - :cljs (js/Math.sqrt x))) - -(defn square - "Returns the square of the given value." - [x] - (* x x)) - -(defn tan - "Returns the tangent of an angle (specified in radians)." - [x] - #?(:clj (Math/tan x) - :cljs (js/Math.tan x))) diff --git a/src/propeller/tools/metrics.clj b/src/propeller/tools/metrics.clj deleted file mode 100644 index 7964add..0000000 --- a/src/propeller/tools/metrics.clj +++ /dev/null @@ -1,58 +0,0 @@ -(ns propeller.tools.metrics - (:require [propeller.tools.math :as math])) - -(defn mean - "Returns the mean of a collection." - [coll] - (if (empty? coll) 0 (math/div (apply + coll) (count coll)))) - -(defn median - "Returns the median of a collection." - [coll] - (let [sorted-coll (sort coll) - count (count sorted-coll) - midpoint (quot count 2)] - (if (odd? count) - (nth sorted-coll midpoint) - (let [below (nth sorted-coll (dec midpoint)) - above (nth sorted-coll midpoint)] - (mean [below above]))))) - -(defn hamming-distance - "Calculates the Hamming distance between two sequences, including strings." - [seq1 seq2] - (apply + (map #(if (= %1 %2) 0 1) seq1 seq2))) - -(defn levenshtein-distance - "Levenshtein Distance - http://en.wikipedia.org/wiki/Levenshtein_distance - In Information Theory and Computer Science, the Levenshtein distance is a - metric for measuring the amount of difference between two sequences. This - is a functional implementation of the Levenshtein edit distance with as - little mutability as possible. Still maintains the O(nm) guarantee." - [a b & {p :predicate :or {p =}}] - (cond - (empty? a) (count b) - (empty? b) (count a) - :else (peek - (reduce - ;; we use a simple reduction to convert the previous row into the - ;; next-row using the compute-next-row which takes a current - ;; element, the previous-row computed so far, and the predicate - ;; to compare for equality - (fn [prev-row current-element] - (compute-next-row prev-row current-element b p)) - ;; we need to initialize the prev-row with the edit distance - ;; between the various prefixes of b and the empty string - (range (inc (count b))) - a)))) - -(defn sequence-similarity - "Returns a number between 0 and 1, indicating how similar the sequences are - as a normalized, inverted Levenshtein distance, with 1 indicating identity - and 0 indicating no similarity." - [seq1 seq2] - (if (and (empty? seq1) (empty? seq2)) - 1 - (let [distance (levenshtein-distance seq1 seq2) - max-distance (max (count seq1) (count seq2))] - (math/div (- max-distance distance) max-distance)))) diff --git a/src/propeller/utils.clj b/src/propeller/utils.clj deleted file mode 100644 index 492ec20..0000000 --- a/src/propeller/utils.clj +++ /dev/null @@ -1,36 +0,0 @@ -(ns propeller.utils) - -(defn get-vector-literal-type - "Returns the literal stack corresponding to some vector stack." - [vector-stack] - (keyword (clojure.string/replace (str vector-stack) ":vector_" ""))) - -(defn indexof - "Returns the first index of an element in a collection. If the element is not - present in the collection, returns -1." - [element coll] - (or (first (keep-indexed #(if (= element %2) %1) coll)) -1)) - -(defn not-lazy - "Returns lst if it is not a seq, or a non-lazy version of lst if it is." - [lst] - (if (seq? lst) - (apply list lst) - lst)) - -(defn ensure-list - "Returns a non-lazy list if passed a seq argument. Othwrwise, returns a list - containing the argument." - [thing] - (if (seq? thing) - (not-lazy thing) - (list thing))) - -(defn random-instruction - "Returns a random instruction from a supplied pool of instructions, evaluating - ERC-producing functions to a constant literal." - [instructions] - (let [instruction (rand-nth instructions)] - (if (fn? instruction) - (instruction) - instruction))) diff --git a/src/propeller/variation.clj b/src/propeller/variation.clj deleted file mode 100644 index d04d1f3..0000000 --- a/src/propeller/variation.clj +++ /dev/null @@ -1,52 +0,0 @@ -(ns propeller.variation - (:require [propeller.selection :as selection] - [propeller.utils :as utils])) - -(defn crossover - "Crosses over two individuals using uniform crossover. Pads shorter one." - [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 shorter (repeat length-diff :crossover-padding))] - (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." - [plushy instructions umad-rate] - (apply concat - (map #(if (< (rand) umad-rate) - (shuffle [% (utils/random-instruction instructions)]) - [%]) - plushy))) - -(defn uniform-deletion - "Randomly deletes instructions from plushy at some rate." - [plushy umad-rate] - (remove (fn [_] (< (rand) - (/ 1 (+ 1 (/ 1 umad-rate))))) - plushy)) - -(defn new-individual - "Returns a new individual produced by selection and variation of - individuals in the population." - [pop argmap] - {:plushy - (let [prob (rand)] - (cond - (< prob (:crossover (:variation argmap))) - (crossover (:plushy (selection/select-parent pop argmap)) - (:plushy (selection/select-parent pop argmap))) - (< prob (+ (:crossover (:variation argmap)) - (:umad (:variation argmap)) 2)) - (uniform-deletion (uniform-addition (:plushy (selection/select-parent pop argmap)) - (:instructions argmap) - (:umad-rate argmap)) - (:umad-rate argmap)) - :else (:plushy (selection/select-parent pop argmap))))}) From b555e1300e9314491ebbaeb69be40f6dd51b51e2 Mon Sep 17 00:00:00 2001 From: Sunghoon Kwak <49034253+skwak22@users.noreply.github.com> Date: Tue, 30 Jun 2020 20:39:36 +0900 Subject: [PATCH 2/2] Converted files to cljc & ns changes for cljs --- src/propeller/core.cljc | 28 +++ src/propeller/genome.cljc | 35 +++ src/propeller/gp.cljc | 60 +++++ src/propeller/problems/simple_regression.cljc | 61 ++++++ .../problems/software/number_io.cljc | 3 + .../problems/string_classification.cljc | 71 ++++++ src/propeller/push/core.cljc | 18 ++ src/propeller/push/instructions/bool.cljc | 69 ++++++ src/propeller/push/instructions/chara.cljc | 65 ++++++ src/propeller/push/instructions/code.cljc | 111 ++++++++++ .../push/instructions/input_output.cljc | 53 +++++ src/propeller/push/instructions/numeric.cljc | 174 +++++++++++++++ .../push/instructions/polymorphic.cljc | 183 ++++++++++++++++ src/propeller/push/instructions/random.cljc | 5 + src/propeller/push/instructions/string.cljc | 52 +++++ src/propeller/push/instructions/vector.cljc | 207 ++++++++++++++++++ src/propeller/push/interpreter.cljc | 44 ++++ src/propeller/push/state.cljc | 84 +++++++ src/propeller/push/utils.cljc | 79 +++++++ src/propeller/selection.cljc | 29 +++ src/propeller/session.cljc | 62 ++++++ src/propeller/tools/calculus.cljc | 33 +++ src/propeller/tools/character.cljc | 18 ++ src/propeller/tools/distributions.cljc | 59 +++++ src/propeller/tools/math.cljc | 104 +++++++++ src/propeller/tools/metrics.cljc | 58 +++++ src/propeller/utils.cljc | 36 +++ src/propeller/variation.cljc | 52 +++++ 28 files changed, 1853 insertions(+) create mode 100644 src/propeller/core.cljc create mode 100644 src/propeller/genome.cljc create mode 100644 src/propeller/gp.cljc create mode 100644 src/propeller/problems/simple_regression.cljc create mode 100644 src/propeller/problems/software/number_io.cljc create mode 100644 src/propeller/problems/string_classification.cljc create mode 100644 src/propeller/push/core.cljc create mode 100644 src/propeller/push/instructions/bool.cljc create mode 100644 src/propeller/push/instructions/chara.cljc create mode 100644 src/propeller/push/instructions/code.cljc create mode 100644 src/propeller/push/instructions/input_output.cljc create mode 100644 src/propeller/push/instructions/numeric.cljc create mode 100644 src/propeller/push/instructions/polymorphic.cljc create mode 100644 src/propeller/push/instructions/random.cljc create mode 100644 src/propeller/push/instructions/string.cljc create mode 100644 src/propeller/push/instructions/vector.cljc create mode 100644 src/propeller/push/interpreter.cljc create mode 100644 src/propeller/push/state.cljc create mode 100644 src/propeller/push/utils.cljc create mode 100644 src/propeller/selection.cljc create mode 100644 src/propeller/session.cljc create mode 100644 src/propeller/tools/calculus.cljc create mode 100644 src/propeller/tools/character.cljc create mode 100644 src/propeller/tools/distributions.cljc create mode 100644 src/propeller/tools/math.cljc create mode 100644 src/propeller/tools/metrics.cljc create mode 100644 src/propeller/utils.cljc create mode 100644 src/propeller/variation.cljc diff --git a/src/propeller/core.cljc b/src/propeller/core.cljc new file mode 100644 index 0000000..6279fb3 --- /dev/null +++ b/src/propeller/core.cljc @@ -0,0 +1,28 @@ +(ns propeller.core + #?(:clj (:gen-class)) + (:require [propeller.gp :as gp] + [propeller.problems.simple-regression :as regression] + [propeller.problems.string-classification :as string-classif] + #?(:cljs [cljs.reader :refer [read-string]]))) + +(defn -main + "Runs propel-gp, giving it a map of arguments." + [& args] + (gp/gp + (update-in + (merge + {:instructions regression/instructions + :error-function regression/error-function + :max-generations 500 + :population-size 500 + :max-initial-plushy-size 50 + :step-limit 100 + :parent-selection :lexicase + :tournament-size 5 + :umad-rate 0.1 + :variation {:umad 0.5 :crossover 0.5} + :elitism false} + (apply hash-map + (map read-string args))) + [:error-function] + identity))) diff --git a/src/propeller/genome.cljc b/src/propeller/genome.cljc new file mode 100644 index 0000000..6c460e2 --- /dev/null +++ b/src/propeller/genome.cljc @@ -0,0 +1,35 @@ +(ns propeller.genome + (:require [propeller.push.core :as push] + [propeller.utils :as utils])) + +(defn make-random-plushy + "Creates and returns a new plushy." + [instructions max-initial-plushy-size] + (repeatedly + (rand-int max-initial-plushy-size) + #(utils/random-instruction instructions))) + +(defn plushy->push + "Returns the Push program expressed by the given plushy representation." + [plushy] + (let [opener? #(and (vector? %) (= (first %) 'open))] ;; [open ] marks opens + (loop [push () ;; iteratively build the Push program from the plushy + plushy (mapcat #(if-let [n (get push/opens %)] [% ['open n]] [%]) plushy)] + (if (empty? plushy) ;; maybe we're done? + (if (some opener? push) ;; done with plushy, but unclosed open + (recur push '(close)) ;; recur with one more close + push) ;; otherwise, really done, return push + (let [i (first plushy)] + (if (= i 'close) + (if (some opener? push) ;; process a close when there's an open + (recur (let [post-open (reverse (take-while (comp not opener?) + (reverse push))) + open-index (- (count push) (count post-open) 1) + num-open (second (nth push open-index)) + pre-open (take open-index push)] + (if (= 1 num-open) + (concat pre-open [post-open]) + (concat pre-open [post-open ['open (dec num-open)]]))) + (rest plushy)) + (recur push (rest plushy))) ;; unmatched close, ignore + (recur (concat push [i]) (rest plushy)))))))) ;; anything else diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc new file mode 100644 index 0000000..f5f9088 --- /dev/null +++ b/src/propeller/gp.cljc @@ -0,0 +1,60 @@ +(ns propeller.gp + (:require [propeller.genome :as genome] + [propeller.variation :as variation] + [propeller.push.core :as push] + [propeller.push.instructions.bool] + [propeller.push.instructions.chara] + [propeller.push.instructions.code] + [propeller.push.instructions.input-output] + [propeller.push.instructions.numeric] + [propeller.push.instructions.random] + [propeller.push.instructions.polymorphic] + [propeller.push.instructions.string] + [propeller.push.instructions.vector])) + +(defn report + "Reports information each generation." + [pop generation] + (let [best (first pop)] + (println "-------------------------------------------------------") + (println " Report for Generation" generation) + (println "-------------------------------------------------------") + (print "Best plushy: ") (prn (:plushy best)) + (print "Best program: ") (prn (genome/plushy->push (:plushy best))) + (println "Best total error:" (:total-error best)) + (println "Best errors:" (:errors best)) + (println "Best behaviors:" (:behaviors best)) + (println "Genotypic diversity:" + (float (/ (count (distinct (map :plushy pop))) (count pop)))) + (println "Average genome length:" + (float (/ (reduce + (map count (map :plushy pop))) (count pop)))) + (println))) + +(defn gp + "Main GP loop." + [{:keys [population-size max-generations error-function instructions + max-initial-plushy-size] + :as argmap}] + ;; + (println "Starting GP with args: " argmap) + ;; + (loop [generation 0 + population (repeatedly + population-size + #(hash-map :plushy (genome/make-random-plushy + instructions + max-initial-plushy-size)))] + (let [evaluated-pop (sort-by :total-error + (map (partial error-function argmap) + population))] + (report evaluated-pop generation) + (cond + (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") + (>= generation max-generations) nil + :else (recur (inc generation) + (if (:elitism argmap) + (conj (repeatedly (dec population-size) + #(variation/new-individual evaluated-pop argmap)) + (first evaluated-pop)) + (repeatedly population-size + #(variation/new-individual evaluated-pop argmap)))))))) diff --git a/src/propeller/problems/simple_regression.cljc b/src/propeller/problems/simple_regression.cljc new file mode 100644 index 0000000..bc734ff --- /dev/null +++ b/src/propeller/problems/simple_regression.cljc @@ -0,0 +1,61 @@ +(ns propeller.problems.simple-regression + (:require [propeller.genome :as genome] + [propeller.push.interpreter :as interpreter] + [propeller.push.state :as state] + [propeller.tools.math :as math])) + +;; ============================================================================= +;; Problem: f(x) = 7x^2 - 20x + 13 +;; ============================================================================= + +(defn- target-function-hard + "Target function: f(x) = 7x^2 - 20x + 13" + [x] + (+ (* 7 x x) (* -20 x) 13)) + +(defn- target-function + "Target function: f(x) = x^3 + x + 3" + [x] + (+ (* x x x) x 3)) + +;; Set of original propel instructions +(def instructions + (list :in1 + :integer_add + :integer_subtract + :integer_mult + :integer_quot + :integer_eq + :exec_dup + :exec_if + 'close + 0 + 1)) + +(defn error-function + "Finds the behaviors and errors of an individual. The error is the absolute + deviation between the target output value and the program's selected behavior, + or 1000000 if no behavior is produced. The behavior is here defined as the + final top item on the INTEGER stack." + [argmap individual] + (let [program (genome/plushy->push (:plushy individual)) + inputs (range -10 11) + correct-outputs (map target-function inputs) + outputs (map (fn [input] + (state/peek-stack + (interpreter/interpret-program + program + (assoc state/empty-state :input {:in1 input}) + (:step-limit argmap)) + :integer)) + inputs) + errors (map (fn [correct-output output] + (if (= output :no-stack-item) + 1000000 + (math/abs (- correct-output output)))) + correct-outputs + outputs)] + (assoc individual + :behaviors outputs + :errors errors + :total-error (apply +' errors)))) diff --git a/src/propeller/problems/software/number_io.cljc b/src/propeller/problems/software/number_io.cljc new file mode 100644 index 0000000..d21dba7 --- /dev/null +++ b/src/propeller/problems/software/number_io.cljc @@ -0,0 +1,3 @@ +(ns propeller.problems.software.number-io) + + diff --git a/src/propeller/problems/string_classification.cljc b/src/propeller/problems/string_classification.cljc new file mode 100644 index 0000000..9811d2a --- /dev/null +++ b/src/propeller/problems/string_classification.cljc @@ -0,0 +1,71 @@ +(ns propeller.problems.string-classification + (:require [propeller.genome :as genome] + [propeller.push.interpreter :as interpreter] + [propeller.push.state :as state])) + +;; ============================================================================= +;; String classification +;; ============================================================================= + +;; Set of original propel instructions +(def instructions + (list :in1 + :integer_add + :integer_subtract + :integer_mult + :integer_quot + :integer_eq + :exec_dup + :exec_if + :boolean_and + :boolean_or + :boolean_not + :boolean_eq + :string_eq + :string_take + :string_drop + :string_reverse + :string_concat + :string_length + :string_includes? + 'close + 0 + 1 + true + false + "" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "A" + "C" + "G" + "T")) + +(defn error-function + "Finds the behaviors and errors of an individual: Error is 0 if the value and + the program's selected behavior match, or 1 if they differ, or 1000000 if no + behavior is produced. The behavior is here defined as the final top item on + the BOOLEAN stack." + [argmap individual] + (let [program (genome/plushy->push (:plushy individual)) + inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"] + correct-outputs [false false false false true true true] + outputs (map (fn [input] + (state/peek-stack + (interpreter/interpret-program + program + (assoc state/empty-state :input {:in1 input}) + (:step-limit argmap)) + :boolean)) + inputs) + errors (map (fn [correct-output output] + (if (= output :no-stack-item) + 1000000 + (if (= correct-output output) + 0 + 1))) + correct-outputs + outputs)] + (assoc individual + :behaviors outputs + :errors errors + :total-error (apply +' errors)))) \ No newline at end of file diff --git a/src/propeller/push/core.cljc b/src/propeller/push/core.cljc new file mode 100644 index 0000000..624c1d9 --- /dev/null +++ b/src/propeller/push/core.cljc @@ -0,0 +1,18 @@ +(ns propeller.push.core) + +;; ============================================================================= +;; PushGP Instructions +;; +;; Instructions are represented as keywords, and stored in an atom. +;; +;; Instructions must all be either functions that take one Push state and +;; return another, or constant literals. +;; +;; TMH: ERCs? +;; ============================================================================= + +(def instruction-table (atom (hash-map))) + +;; Number of blocks opened by instructions (default = 0) +(def opens {:exec_dup 1 + :exec_if 2}) diff --git a/src/propeller/push/instructions/bool.cljc b/src/propeller/push/instructions/bool.cljc new file mode 100644 index 0000000..a44551d --- /dev/null +++ b/src/propeller/push/instructions/bool.cljc @@ -0,0 +1,69 @@ +(ns propeller.push.instructions.bool + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction + make-instruction]])) + (:require #?(:clj [propeller.push.utils :refer [def-instruction + make-instruction]]))) +;; ============================================================================= +;; BOOLEAN Instructions +;; ============================================================================= + +;; Pushes the logical AND of the top two BOOLEANs +(def-instruction + :boolean_and + ^{:stacks #{:boolean}} + (fn [state] + (make-instruction state #(and %1 %2) [:boolean :boolean] :boolean))) + +;; Pushes the logical OR of the top two BOOLEANs +(def-instruction + :boolean_or + ^{:stacks #{:boolean}} + (fn [state] + (make-instruction state #(or %1 %2) [:boolean :boolean] :boolean))) + +;; Pushes the logical NOT of the top BOOLEAN +(def-instruction + :boolean_not + ^{:stacks #{:boolean}} + (fn [state] + (make-instruction state not [:boolean] :boolean))) + +;; Pushes the logical XOR of the top two BOOLEAN +(def-instruction + :boolean_xor + ^{:stacks #{:boolean}} + (fn [state] + (make-instruction state #(or (and %1 (not %2)) + (and (not %1) %2)) + [:boolean :boolean] + :boolean))) + +;; Pushes the logical AND of the top two BOOLEANs, after applying NOT to the +;; first one +(def-instruction + :boolean_invert_first_then_and + ^{:stacks #{:boolean}} + (fn [state] + (make-instruction state #(and %1 (not %2)) [:boolean :boolean] :boolean))) + +;; Pushes the logical AND of the top two BOOLEANs, after applying NOT to the +;; second one +(def-instruction + :boolean_invert_second_then_and + ^{:stacks #{:boolean}} + (fn [state] + (make-instruction state #(and (not %1) %2) [:boolean :boolean] :boolean))) + +;; Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise +(def-instruction + :boolean_fromfloat + ^{:stacks #{:boolean :float}} + (fn [state] + (make-instruction state #(not (zero? %)) [:float] :boolean))) + +;; Pushes FALSE if the top INTEGER is 0, and TRUE otherwise +(def-instruction + :boolean_frominteger + ^{:stacks #{:boolean :integer}} + (fn [state] + (make-instruction state #(not (zero? %)) [:integer] :boolean))) diff --git a/src/propeller/push/instructions/chara.cljc b/src/propeller/push/instructions/chara.cljc new file mode 100644 index 0000000..9133035 --- /dev/null +++ b/src/propeller/push/instructions/chara.cljc @@ -0,0 +1,65 @@ +(ns propeller.push.instructions.chara + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction + make-instruction]])) + (:require [propeller.push.state :as state] + [propeller.tools.character :as char] + #?(:clj [propeller.push.utils :refer [def-instruction + make-instruction]]))) + +;; ============================================================================= +;; CHAR Instructions +;; ============================================================================= + +;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter +(def-instruction + :char_isletter + ^{:stacks #{:boolean :char}} + (fn [state] + (make-instruction state char/is-letter [:char] :boolean))) + +;; Pushes TRUE onto the BOOLEAN stack if the popped character is a digit +(def-instruction + :char_isdigit + ^{:stacks #{:boolean :char}} + (fn [state] + (make-instruction state char/is-digit [:char] :boolean))) + +;; Pushes TRUE onto the BOOLEAN stack if the popped character is whitespace +;; (newline, space, or tab) +(def-instruction + :char_iswhitespace + ^{:stacks #{:boolean :char}} + (fn [state] + (make-instruction state char/is-whitespace [:char] :boolean))) + +;; Pops the FLOAT stack, converts the top item to a whole number, and pushes +;; its corresponding ASCII value onto the CHAR stack. Whole numbers larger than +;; 128 will be reduced modulo 128. For instance, 248.45 will result in x being +;; pushed. +(def-instruction + :char_fromfloat + ^{:stacks #{:char :float}} + (fn [state] + (make-instruction state #(char (mod (long %) 128)) [:float] :char))) + +;; Pops the INTEGER stack and pushes the top element's corresponding ASCII +;; value onto the CHAR stack. Integers larger than 128 will be reduced modulo +;; 128. For instance, 248 will result in x being pushed +(def-instruction + :char_frominteger + ^{:stacks #{:char :integer}} + (fn [state] + (make-instruction state #(char (mod % 128)) [:integer] :char))) + +;; Pops the STRING stack and pushes the top element's constituent characters +;; onto the CHAR stack, in order. For instance, "hello" will result in the +;; top of the CHAR stack being \h \e \l \l \o +(def-instruction + :char_allfromstring + ^{:stacks #{:char :string}} + (fn [state] + (if (state/empty-stack? state :string) + state + (let [top-string (state/peek-stack state :string) + popped-state (state/pop-stack state :string)] + (state/push-to-stack-multiple popped-state :char (map char top-string)))))) diff --git a/src/propeller/push/instructions/code.cljc b/src/propeller/push/instructions/code.cljc new file mode 100644 index 0000000..1cfea9c --- /dev/null +++ b/src/propeller/push/instructions/code.cljc @@ -0,0 +1,111 @@ +(ns propeller.push.instructions.code + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]])) + (:require [propeller.utils :as utils] + [propeller.push.state :as state] + #?(:clj [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]]))) + +;; ============================================================================= +;; Polymorphic Instructions +;; ============================================================================= + +(def _noop + ^{:stacks #{}} + (fn [stack state] state)) + +(def _do*range + ^{:stacks #{:exec :integer}} + (fn [stack state] state)) + +(def _noop + ^{:stacks #{}} + (fn [stack state] state)) + +(def _noop + ^{:stacks #{}} + (fn [stack state] state)) + +(generate-instructions + [:exec :code] + [_noop]) + + +;; ============================================================================= +;; CODE Instructions +;; ============================================================================= + +;; Concatenates the top two instructions on the :code stack and pushes the +;; result back onto the stack +(def-instruction + :code_append + ^{:stacks #{:code}} + (fn [state] + (make-instruction state + #(utils/not-lazy + (concat (utils/ensure-list %2) + (utils/ensure-list %1))) + [:code :code] + :code))) + +(def-instruction + :code_atom + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_car + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_cdr + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_cons + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_do + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_do* + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_append + ^{:stacks #{:code}} + (fn [state] + ())) + +;; ============================================================================= +;; EXEC Instructions +;; ============================================================================= + +(def-instruction + :exec_dup + ^{:stacks #{:exec}} + (fn [state] + (if (state/empty-stack? state :exec) + state + (state/push-to-stack state :exec (first (:exec state)))))) + +(def-instruction + :exec_if + ^{:stacks #{:boolean :exec}} + (fn [state] + (make-instruction state #(if %1 %3 %2) [:boolean :exec :exec] :exec))) diff --git a/src/propeller/push/instructions/input_output.cljc b/src/propeller/push/instructions/input_output.cljc new file mode 100644 index 0000000..4753829 --- /dev/null +++ b/src/propeller/push/instructions/input_output.cljc @@ -0,0 +1,53 @@ +(ns propeller.push.instructions.input-output + #?(:cljs (:require-macros [propeller.push.utils :refer + [def-instruction generate-instructions]])) + (:require [propeller.push.state :as state] + #?(:clj [propeller.push.utils :refer [def-instruction + generate-instructions]]))) + +;; ============================================================================= +;; INPUT Instructions +;; ============================================================================= + +;; 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. +(defn handle-input-instruction + [state instruction] + (if-let [input (instruction (:input state))] + (state/push-to-stack state :exec input) + (throw (Exception. (str "Undefined input instruction " instruction))))) + +;; ============================================================================= +;; OUTPUT Instructions +;; ============================================================================= + +(def-instruction + :print_newline + ^{:stacks [:print]} + (fn [state] + (let [current-output (state/peek-stack state :output) + popped-state (state/pop-stack state :output)] + (state/push-to-stack popped-state :output (str current-output \newline))))) + +(def _print + ^{:stacks [:print]} + (fn [stack state] + (if (state/empty-stack? state stack) + state + (let [top-item (state/peek-stack state stack) + top-item-str (if (or (string? top-item) + (char? top-item)) + top-item + (pr-str top-item)) + current-output (state/peek-stack state :output) + popped-state (state/pop-stack (state/pop-stack state stack) :output)] + (state/push-to-stack popped-state + :output + (str current-output top-item-str)))))) + +(generate-instructions + [:boolean :char :code :exec :float :integer :string + :vector_boolean :vector_float :vector_integer :vector_string] + [_print]) diff --git a/src/propeller/push/instructions/numeric.cljc b/src/propeller/push/instructions/numeric.cljc new file mode 100644 index 0000000..784be70 --- /dev/null +++ b/src/propeller/push/instructions/numeric.cljc @@ -0,0 +1,174 @@ +(ns propeller.push.instructions.numeric + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]])) + (:require [propeller.tools.math :as math] + #?(:clj [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]]))) + +;; ============================================================================= +;; FLOAT and INTEGER Instructions (polymorphic) +;; ============================================================================= + +;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than the top +;; item, and FALSE otherwise +(def _gt + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state > [stack stack] :boolean))) + +;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than or +;; equal to the top item, and FALSE otherwise +(def _gte + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state >= [stack stack] :boolean))) + +;; Pushes TRUE onto the BOOLEAN stack if the second item is less than the top +;; item, and FALSE otherwise +(def _lt + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state < [stack stack] :boolean))) + +;; Pushes TRUE onto the BOOLEAN stack if the second item is less than or equal +;; to the top item, and FALSE otherwise +(def _lte + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state <= [stack stack] :boolean))) + +;; Pushes the sum of the top two items onto the same stack +(def _add + ^{:stacks #{}} + (fn [stack state] + (make-instruction state +' [stack stack] stack))) + +;; Pushes the difference of the top two items (i.e. the second item minus the +;; top item) onto the same stack +(def _subtract + ^{:stacks #{}} + (fn [stack state] + (make-instruction state -' [stack stack] stack))) + +;; Pushes the product of the top two items onto the same stack +(def _mult + ^{:stacks #{}} + (fn [stack state] + (make-instruction state *' [stack stack] stack))) + +;; Pushes the quotient of the top two items (i.e. the second item divided by the +;; top item) onto the same stack. If the top item is zero, pushes 1 +(def _quot + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(if (zero? %2) 1 (quot %1 %2)) [stack stack] stack))) + +;; Pushes the second item modulo the top item onto the same stack. If the top +;; item is zero, pushes 1. The modulus is computed as the remainder of the +;; quotient, where the quotient has first been truncated towards negative +;; infinity. +(def _mod + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(if (zero? %2) 1 (mod %1 %2)) [stack stack] stack))) + +;; Pushes the maximum of the top two items +(def _max + ^{:stacks #{}} + (fn [stack state] + (make-instruction state max [stack stack] stack))) + +;; Pushes the minimum of the top two items +(def _min + ^{:stacks #{}} + (fn [stack state] + (make-instruction state min [stack stack] stack))) + +;; Pushes 1 / 1.0 if the top BOOLEAN is TRUE, or 0 / 0.0 if FALSE +(def _fromboolean + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state + #((if (= stack :integer) int float) (if % 1 0)) + [:boolean] + stack))) + +;; Pushes the ASCII value of the top CHAR +(def _fromchar + ^{:stacks #{:char}} + (fn [stack state] + (make-instruction state (if (= stack :integer) int float) [:char] stack))) + +;; Pushes the value of the top STRING, if it can be parsed as a number. +;; Otherwise, acts as a NOOP +(def _fromstring + ^{:stacks #{:string}} + (fn [stack state] + (make-instruction state + #(try ((if (= stack :integer) int float) (read-string %)) + (catch Exception e)) + [:string] + stack))) + +;; Pushes the increment (i.e. +1) of the top item of the stack +(def _inc + ^{:stacks #{}} + (fn [stack state] + (make-instruction state inc [stack] stack))) + +;; Pushes the decrement (i.e. -1) of the top item of the stack +(def _dec + ^{:stacks #{}} + (fn [stack state] + (make-instruction state dec [stack] stack))) + +;; 2 types x 16 functions = 32 instructions +(generate-instructions + [:float :integer] + [_gt _gte _lt _lte _add _subtract _mult _quot _mod _max _min _inc _dec + _fromboolean _fromchar _fromstring]) + +;; ============================================================================= +;; FLOAT Instructions only +;; ============================================================================= + +;; Pushes the cosine of the top FLOAT +(def-instruction + :float_cos + ^{:stacks #{:float}} + (fn [state] + (make-instruction state math/cos [:float] :float))) + +;; Pushes the sine of the top FLOAT +(def-instruction + :float_sin + ^{:stacks #{:float}} + (fn [state] + (make-instruction state math/sin [:float] :float))) + +;; Pushes the tangent of the top FLOAT +(def-instruction + :float_tan + ^{:stacks #{:float}} + (fn [state] + (make-instruction state math/tan [:float] :float))) + +;; Pushes the floating point version of the top INTEGER +(def-instruction + :float_frominteger + ^{:stacks #{:float :integer}} + (fn [state] + (make-instruction state float [:integer] :float))) + +;; ============================================================================= +;; INTEGER Instructions only +;; ============================================================================= + +;; Pushes the result of truncating the top FLOAT towards negative infinity +(def-instruction + :integer_fromfloat + ^{:stacks #{:float :integer}} + (fn [state] + (make-instruction state int [:float] :integer))) diff --git a/src/propeller/push/instructions/polymorphic.cljc b/src/propeller/push/instructions/polymorphic.cljc new file mode 100644 index 0000000..b690d00 --- /dev/null +++ b/src/propeller/push/instructions/polymorphic.cljc @@ -0,0 +1,183 @@ +(ns propeller.push.instructions.polymorphic + #?(:cljs (:require-macros [propeller.push.utils :refer [generate-instructions + make-instruction]])) + (:require [propeller.utils :as utils] + [propeller.push.state :as state] + #?(:clj [propeller.push.utils :refer [generate-instructions + make-instruction]]))) + +;; ============================================================================= +;; Polymorphic Instructions +;; +;; (for all stacks, with the exception of non-data ones like auxiliary, input, +;; and output) +;; ============================================================================= + +;; Duplicates the top item of the stack. Does not pop its argument (since that +;; would negate the effect of the duplication) +(def _dup + ^{:stacks #{}} + (fn [stack state] + (let [top-item (state/peek-stack state stack)] + (if (state/empty-stack? state stack) + state + (state/push-to-stack state stack top-item))))) + +;; Duplicates n copies of the top item (i.e leaves n copies there). Does not pop +;; its argument (since that would negate the effect of the duplication). The +;; number n is determined by the top INTEGER. For n = 0, equivalent to POP. +;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values +;; of n are treated as 0 +(def _duptimes + ^{:stacks #{:integer}} + (fn [stack state] + (if (or (and (= stack :integer) + (<= 2 (count (:integer state)))) + (and (not= stack :integer) + (not (state/empty-stack? state :integer)) + (not (state/empty-stack? state stack)))) + (let [n (state/peek-stack state :integer) + popped-state (state/pop-stack state :integer) + top-item (state/peek-stack popped-state stack) + top-item-dup (take (- n 1) (repeat top-item))] + (cond + (< 0 n) (state/push-to-stack-multiple popped-state stack top-item-dup) + :else (state/pop-stack popped-state stack))) + state))) + +;; Duplicates the top n items on the stack, one time each. The number n is +;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If +;; fewer than n items are on the stack, the entire stack will be duplicated. +(def _dupitems + ^{:stacks #{:integer}} + (fn [stack state] + (if (state/empty-stack? state :integer) + state + (let [n (state/peek-stack state :integer) + popped-state (state/pop-stack state :integer) + top-items (take n (get popped-state stack))] + (state/push-to-stack-multiple popped-state stack top-items))))) + +;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE +(def _empty + ^{:stacks #{:boolean}} + (fn [stack state] + (state/push-to-stack state :boolean (state/empty-stack? state stack)))) + +;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal. +;; Otherwise FALSE +(def _eq + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state = [stack stack] :boolean))) + +;; Empties the given stack +(def _flush + ^{:stacks #{}} + (fn [stack state] + (assoc state stack '()))) + +;; Pops the given stack +(def _pop + ^{:stacks #{}} + (fn [stack state] + (state/pop-stack state stack))) + +;; Rotates the top three items on the stack (i.e. pulls the third item out and +;; pushes it on top). Equivalent to (yank state stack-type 2) +(def _rot + ^{:stacks #{}} + (fn [stack state] + (if (<= 3 (count (get state stack))) + (let [top-three (state/peek-stack-multiple state stack 3) + popped-state (state/pop-stack-multiple state stack 3) + top-three-rot (take 3 (conj top-three (last top-three)))] + (state/push-to-stack-multiple popped-state stack top-three-rot)) + state))) + +;; Inserts the top item deeper into the stack, using the top INTEGER to +;; determine how deep +(def _shove + ^{:stacks #{:integer}} + (fn [stack state] + (if (or (and (= stack :integer) + (<= 2 (count (:integer state)))) + (and (not= stack :integer) + (not (state/empty-stack? state :integer)) + (not (state/empty-stack? state stack)))) + (let [index-raw (state/peek-stack state :integer) + popped-state (state/pop-stack state :integer) + top-item (state/peek-stack popped-state stack) + popped-state (state/pop-stack popped-state stack) + index (max 0 (min index-raw (count (get popped-state stack))))] + (update popped-state stack #(utils/not-lazy (concat (take index %) + (list top-item) + (drop index %))))) + state))) + +;; Pushes the given stack's depth onto the INTEGER stack +(def _stackdepth + ^{:stacks #{:integer}} + (fn [stack state] + (let [stack-depth (count (get state stack))] + (state/push-to-stack state :integer stack-depth)))) + +;; Swaps the top two items on the stack +(def _swap + ^{:stacks #{}} + (fn [stack state] + (if (<= 2 (count (get state stack))) + (let [top-two (state/peek-stack-multiple state stack 2) + popped-state (state/pop-stack-multiple state stack 2)] + (state/push-to-stack-multiple popped-state stack (reverse top-two))) + state))) + +;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER +;; is used to determine how deep to yank from +(def _yank + ^{:stacks #{:integer}} + (fn [stack state] + (if (or (and (= stack :integer) + (<= 2 (count (:integer state)))) + (and (not= stack :integer) + (not (state/empty-stack? state :integer)) + (not (state/empty-stack? state stack)))) + (let [index-raw (state/peek-stack state :integer) + popped-state (state/pop-stack state :integer) + index (max 0 (min index-raw (count (get popped-state stack)))) + indexed-item (nth (get popped-state stack) index)] + (update popped-state stack #(utils/not-lazy + (concat (list indexed-item) + (take index %) + (rest (drop index %)))))) + state))) + +;; Pushes a copy of an indexed item from deep in the stack, without removing it. +;; The top INTEGER is used to determine how deep to yankdup from +(def _yankdup + ^{:stacks #{:integer}} + (fn [stack state] + (if (or (and (= stack :integer) + (<= 2 (count (:integer state)))) + (and (not= stack :integer) + (not (state/empty-stack? state :integer)) + (not (state/empty-stack? state stack)))) + (let [index-raw (state/peek-stack state :integer) + popped-state (state/pop-stack state :integer) + index (max 0 (min index-raw (count (get popped-state stack)))) + indexed-item (nth (get popped-state stack) index)] + (state/push-to-stack popped-state stack indexed-item)) + state))) + +;; 9 types x 1 functions = 9 instructions +(generate-instructions + [:boolean :char :float :integer :string + :vector_boolean :vector_float :vector_integer :vector_string] + [_eq]) + +;; 11 types x 12 functions = 132 instructions +(generate-instructions + [:boolean :char :code :exec :float :integer :string + :vector_boolean :vector_float :vector_integer :vector_string] + [_dup _duptimes _dupitems _empty _flush _pop _rot _shove _stackdepth + _swap _yank _yankdup]) diff --git a/src/propeller/push/instructions/random.cljc b/src/propeller/push/instructions/random.cljc new file mode 100644 index 0000000..8fb64da --- /dev/null +++ b/src/propeller/push/instructions/random.cljc @@ -0,0 +1,5 @@ +(ns propeller.push.instructions.random + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction]])) + #?(:clj (:require [propeller.push.utils :refer [def-instruction]]))) + + diff --git a/src/propeller/push/instructions/string.cljc b/src/propeller/push/instructions/string.cljc new file mode 100644 index 0000000..c2b92d2 --- /dev/null +++ b/src/propeller/push/instructions/string.cljc @@ -0,0 +1,52 @@ +(ns propeller.push.instructions.string + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction + make-instruction]])) + + (:require #?(:clj [propeller.push.utils :refer [def-instruction + make-instruction]]))) + +;; ============================================================================= +;; STRING Instructions +;; ============================================================================= + +(def-instruction + :string_= + ^{:stacks #{:boolean :string}} + (fn [state] + (make-instruction state = [:string :string] :boolean))) + +(def-instruction + :string_concat + ^{:stacks #{:string}} + (fn [state] + (make-instruction state #(apply str (concat %1 %2)) [:string :string] :string))) + +(def-instruction + :string_drop + ^{:stacks #{:integer :string}} + (fn [state] + (make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string))) + +(def-instruction + :string_includes? + ^{:stacks #{:boolean :string}} + (fn [state] + (make-instruction state clojure.string/includes? [:string :string] :boolean))) + +(def-instruction + :string_length + ^{:stacks #{:integer :string}} + (fn [state] + (make-instruction state count [:string] :integer))) + +(def-instruction + :string_reverse + ^{:stacks #{:string}} + (fn [state] + (make-instruction state #(apply str (reverse %)) [:string] :string))) + +(def-instruction + :string_take + ^{:stacks #{:integer :string}} + (fn [state] + (make-instruction state #(apply str (take %1 %2)) [:integer :string] :string))) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc new file mode 100644 index 0000000..6f7c50b --- /dev/null +++ b/src/propeller/push/instructions/vector.cljc @@ -0,0 +1,207 @@ +(ns propeller.push.instructions.vector + #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]])) + (:require [clojure.string] + [propeller.utils :as utils] + [propeller.push.state :as state] + #?(:clj [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]]))) + +;; ============================================================================= +;; VECTOR Instructions +;; ============================================================================= + +;; Pushes the butlast of the top item +(def _butlast + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (butlast %)) [stack] stack))) + +;; Concats and pushes the top two vectors of the stack +(def _concat + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (concat %2 %1)) [stack stack] stack))) + +;; Conj's the top item of the appropriately-typed literal stack onto the vector +;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER) +(def _conj + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state #(conj %2 %1) [lit-stack stack] stack)))) + +;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack +;; contains the top element of the appropriately-typed literal stack. Otherwise, +;; pushes FALSE +(def _contains + ^{:stacks #{:boolean}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean)))) + +;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector. +;; Otherwise, pushes FALSE +(def _emptyvector + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state empty? [stack] :boolean))) + +;; Pushes the first item of the top element of the vector stack onto the +;; approrpiately-typed literal stack +(def _first + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state first [stack] lit-stack)))) + +;; Pushes onto the INTEGER stack the index of the top element of the +;; appropriately-typed literal stack within the top element of the vector stack +(def _indexof + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer)))) + +;; Pushes the last item of the top element of the vector stack onto the +;; approrpiately-typed literal stack +(def _last + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state last [stack] lit-stack)))) + +;; Pushes the length of the top item onto the INTEGER stack +(def _length + ^{:stacks #{:integer}} + (fn [stack state] + (make-instruction state count [stack] :integer))) + +;; Pushes the Nth item of the top element of the vector stack onto the +;; approrpiately-typed literal stack, where N is taken from the INTEGER stack. +;; To insure the index is within bounds, N is taken mod the vector length +(def _nth + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + #(get %2 (mod %1 (count %2))) + [:integer stack] + lit-stack)))) + +;; Pushes onto the INTEGER stack the number of occurrences of the top element of +;; the appropriately-typed literal stack within the top element of the vector +;; stack +(def _occurrencesof + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit vect] (count (filter #(= lit %) vect))) + [lit-stack stack] + :integer)))) + +;; Pushes every item of the top element onto the appropriately-typed stack +(def _pushall + ^{:stacks #{}} + (fn [stack state] + (if (state/empty-stack? state stack) + state + (let [lit-stack (utils/get-vector-literal-type stack) + top-vector (state/peek-stack state stack) + popped-state (state/pop-stack state stack)] + (state/push-to-stack-multiple popped-state lit-stack top-vector))))) + +;; Removes all occurrences of the top element of the appropriately-typed literal +;; stack from the first element of the vector stack +(def _remove + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit vect] (vec (filter #(not= lit %) vect))) + [lit-stack stack] + stack)))) + +;; Replaces all occurrences of the second element of the appropriately-typed +;; literal stack with the top element of the appropriately-typed literal stack +;; within the top item of the vector stack +(def _replace + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit1 lit2 vect] + (replace {lit1 lit2} vect)) + [lit-stack lit-stack stack] + stack)))) + +;; Replaces the first occurrence of the second element of the appropriately-typed +;; literal stack with the top element of the appropriately-typed literal stack +;; within the top item of the vector stack +(def _replacefirst + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit1 lit2 vect] + (assoc vect (utils/indexof lit1 vect) lit2)) + [lit-stack lit-stack stack] + stack)))) + +;; Pushes the rest of the top item +(def _rest + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (rest %)) [stack] stack))) + +;; Pushes the reverse of the top item +(def _reverse + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (reverse %)) [stack] stack))) + +;; Replaces in the top vector the item at index N (taken from the INTEGER stack) +;; with the top item from the appropriately-typed literal stack. To insure the +;; index is within bounds, N is taken mod the vector length +(def _set + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit n vect] + (assoc vect (mod n (count vect)) lit)) + [:integer lit-stack stack] + stack)))) + +;; Pushes a subvector of the top item, with start and end indices determined by +;; the second and top items of the INTEGER stack respectively +(def _subvec + ^{:stacks #{:integer}} + (fn [stack state] + (make-instruction state + (fn [stop-raw start-raw vect] + (let [start (min (count vect) (max 0 start-raw)) + stop (min (count vect) (max start-raw stop-raw))] + (subvec vect start stop))) + [:integer :integer stack] + stack))) + +;; Pushes the first N items of the top element, where N is taken from the top of +;; the INTEGER stack +(def _take + ^{:stacks #{:integer}} + (fn [stack state] + (make-instruction state #(vec (take %1 %2)) [:integer stack] stack))) + +;; 4 types x 20 functions = 80 instructions +(generate-instructions + [:vector_boolean :vector_float :vector_integer :vector_string] + [_butlast _concat _conj _contains _emptyvector _first _indexof _last + _length _nth _occurrencesof _pushall _remove _replace _replacefirst + _rest _reverse _set _subvec _take]) + +;; Manually add extra metadata for _conj + diff --git a/src/propeller/push/interpreter.cljc b/src/propeller/push/interpreter.cljc new file mode 100644 index 0000000..d8504ca --- /dev/null +++ b/src/propeller/push/interpreter.cljc @@ -0,0 +1,44 @@ +(ns propeller.push.interpreter + (:require [propeller.push.core :as push] + [propeller.push.state :as state] + [propeller.push.utils :refer [get-literal-type]] + [propeller.push.instructions.input-output :as io])) + +(defn interpret-one-step + "Takes a Push state and executes the next instruction on the exec stack." + [state] + (let [popped-state (state/pop-stack state :exec) + instruction (first (:exec state)) + literal-type (get-literal-type instruction)] ; nil for non-literals + (cond + ;; + ;; Recognize functional instruction or input instruction + (keyword? instruction) + (if-let [function (instruction @push/instruction-table)] + (function popped-state) + (io/handle-input-instruction popped-state instruction)) + ;; + ;; Recognize constant literal instruction + literal-type + (if (= :generic-vector literal-type) + ;; Empty vector gets pushed on all vector stacks + (reduce #(update-in % [%2] conj []) popped-state + [:vector_boolean :vector_float :vector_integer :vector_string]) + (state/push-to-stack popped-state literal-type instruction)) + ;; + ;; Recognize parenthesized group of instructions + (seq? instruction) + (update popped-state :exec #(concat %2 %1) instruction) + ;; + :else + (throw (Exception. (str "Unrecognized Push instruction in program: " + (name instruction))))))) + +(defn interpret-program + "Runs the given problem starting with the stacks in start-state." + [program start-state step-limit] + (loop [state (assoc start-state :exec program :step 1)] + (if (or (empty? (:exec state)) + (> (:step state) step-limit)) + state + (recur (update (interpret-one-step state) :step inc))))) diff --git a/src/propeller/push/state.cljc b/src/propeller/push/state.cljc new file mode 100644 index 0000000..53f6da9 --- /dev/null +++ b/src/propeller/push/state.cljc @@ -0,0 +1,84 @@ +(ns propeller.push.state) + +;; Empty push state - all available stacks are empty +(defonce empty-state {:auxiliary '() + :boolean '() + :char '() + :code '() + :exec '() + :float '() + :input {} + :integer '() + :output '() + :string '() + :vector_boolean '() + :vector_float '() + :vector_integer '() + :vector_string '()}) + +(def example-push-state + {:exec '() + :integer '(1 2 3 4 5 6 7) + :string '("abc") + :input {:in1 4}}) + +(defn empty-stack? + "Returns true if the stack is empty." + [state stack] + (empty? (get state stack))) + +(defn peek-stack + "Returns the top item on a stack." + [state stack] + (let [working-stack (get state stack)] + (if (empty? working-stack) + :no-stack-item + (first working-stack)))) + +(defn peek-stack-multiple + "Returns the top n items on a stack. If there are less than n items on the + stack, returns the entire stack." + [state stack n] + (take n (get state stack))) + +(defn pop-stack + "Removes the top item of stack." + [state stack] + (update state stack rest)) + +(defn pop-stack-multiple + "Removes the top n items of a stack. If there are less than n items on the + stack, pops the entire stack." + [state stack n] + (update state stack #(drop n %))) + +(defn push-to-stack + "Pushes an item onto a stack." + [state stack item] + (update state stack conj item)) + +(defn push-to-stack-multiple + "Pushes a list of items onto a stack, leaving them in the order they are in." + [state stack items] + (let [items-list (if (coll? items) items (list items)) + items-list-no-nil (filter #(not (nil? %)) items-list)] + (update state stack into (reverse items-list-no-nil)))) + +(defn get-args-from-stacks + "Takes a state and a collection of stacks to take args from. If there are + enough args on each of the desired stacks, returns a map with keys + {:state :args}, where :state is the new state and :args is a list of args + popped from the stacks. If there aren't enough args on the stacks, returns + :not-enough-args without popping anything." + [state stacks] + (loop [state state + stacks (reverse stacks) + args '()] + (if (empty? stacks) + {:state state :args args} + (let [current-stack (first stacks)] + (if (empty-stack? state current-stack) + :not-enough-args + (recur (pop-stack state current-stack) + (rest stacks) + (conj args (peek-stack state current-stack)))))))) diff --git a/src/propeller/push/utils.cljc b/src/propeller/push/utils.cljc new file mode 100644 index 0000000..f1582e1 --- /dev/null +++ b/src/propeller/push/utils.cljc @@ -0,0 +1,79 @@ +(ns propeller.push.utils + (:require [clojure.set] + [propeller.push.core :as push] + [propeller.push.state :as state])) + +(defmacro def-instruction + [instruction definition] + `(swap! push/instruction-table assoc '~instruction ~definition)) + +;; A utility function for making Push instructions. Takes a state, a function +;; to apply to the args, the stacks to take the args from, and the stack to +;; return the result to. Applies the function to the args (popped from the +;; given stacks), and pushes the result onto the return-stack +(defn make-instruction + [state function arg-stacks return-stack] + (let [popped-args (state/get-args-from-stacks state arg-stacks)] + (if (= popped-args :not-enough-args) + state + (let [result (apply function (:args popped-args)) + new-state (:state popped-args)] + (state/push-to-stack new-state return-stack result))))) + +;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix +;; function strings, e.g. [_add, _mult, _eq], automates the generation of all +;; possible combination instructions, which here would be :float_add, :float_mult, +;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring +;; and updating the generic function's stack-type metadata +(defmacro generate-instructions [stacks functions] + `(do ~@(for [stack stacks + func functions + :let [instruction-name (keyword (str (name stack) func)) + metadata `(update-in (meta ~func) [:stacks] #(conj % ~stack)) + new-func `(with-meta (partial ~func ~stack) ~metadata)]] + `(def-instruction ~instruction-name ~new-func)))) + +;; Given a set of stacks, returns all instructions that operate on those stacks +;; only. This won't include random or parenthesis-altering instructions unless +;; :random or :parentheses respectively are in the stacks set +(defn get-stack-instructions + [stacks] + (doseq [[instruction-name function] @push/instruction-table] + (assert + (:stacks (meta function)) + (format "ERROR: Instruction %s does not have :stacks defined in metadata." + (name instruction-name)))) + (for [[instruction-name function] @push/instruction-table + :when (clojure.set/subset? (:stacks (meta function)) stacks)] + instruction-name)) + +;; If a piece of data is a literal, return its corresponding stack name, e.g. +;; :integer. Otherwise, return nil" +(defn get-literal-type + [data] + (let [literals {:boolean (fn [thing] (or (true? thing) (false? thing))) + :char char? + :float float? + :integer integer? + :string string? + :vector_boolean (fn [thing] (and (vector? thing) + (or (true? (first thing)) + (false? (first thing))))) + :vector_float (fn [thing] (and (vector? thing) + (float? (first thing)))) + :vector_integer (fn [thing] (and (vector? thing) + (integer? (first thing)))) + :vector_string (fn [thing] (and (vector? thing) + (string? (first thing)))) + :generic-vector (fn [thing] (= [] thing))}] + (first (for [[stack function] literals + :when (function data)] + stack)))) + +;; Pretty-prints a Push state, for logging or debugging purposes +(defn print-state + [state] + (doseq [stack (keys state/empty-state)] + (printf "%-15s = " stack) + (prn (if (get state stack) (get state stack) '())) + (flush))) diff --git a/src/propeller/selection.cljc b/src/propeller/selection.cljc new file mode 100644 index 0000000..d6739c2 --- /dev/null +++ b/src/propeller/selection.cljc @@ -0,0 +1,29 @@ +(ns propeller.selection) + +(defn tournament-selection + "Selects an individual from the population using a tournament." + [pop argmap] + (let [tournament-size (:tournament-size argmap) + tournament-set (take tournament-size (shuffle pop))] + (apply min-key :total-error tournament-set))) + +(defn lexicase-selection + "Selects an individual from the population using lexicase selection." + [pop argmap] + (loop [survivors pop + cases (shuffle (range (count (:errors (first pop)))))] + (if (or (empty? cases) + (empty? (rest survivors))) + (rand-nth survivors) + (let [min-err-for-case (apply min (map #(nth % (first cases)) + (map :errors survivors)))] + (recur (filter #(= (nth (:errors %) (first cases)) min-err-for-case) + survivors) + (rest cases)))))) + +(defn select-parent + "Selects a parent from the population using the specified method." + [pop argmap] + (case (:parent-selection argmap) + :tournament (tournament-selection pop argmap) + :lexicase (lexicase-selection pop argmap))) diff --git a/src/propeller/session.cljc b/src/propeller/session.cljc new file mode 100644 index 0000000..3e626db --- /dev/null +++ b/src/propeller/session.cljc @@ -0,0 +1,62 @@ +(ns propeller.session + (:require [propeller.genome :as genome] + [propeller.gp :as gp] + [propeller.selection :as selection] + [propeller.variation :as variation] + [propeller.problems.simple-regression :as regression] + [propeller.problems.string-classification :as string-classif] + [propeller.push.core :as push] + [propeller.push.interpreter :as interpreter] + [propeller.push.state :as state])) + +#_(interpreter/interpret-program + '(1 2 integer_add) state/empty-state 1000) + +#_(interpreter/interpret-program + '(3 5 :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 push/default-instructions 20)) + +#_(interpreter/interpret-program + (genome/plushy->push + (genome/make-random-plushy push/default-instructions 20)) + (assoc state/empty-state :input {:in1 "I can hear you."}) + 1000) + +;; ============================================================================= +;; Target function: f(x) = x^3 + x + 3 +;; ============================================================================= + +#_(gp/gp {:instructions push/default-instructions + :error-function regression/error-function + :max-generations 50 + :population-size 200 + :max-initial-plushy-size 50 + :step-limit 100 + :parent-selection :tournament + :tournament-size 5}) + +#_(gp/gp {:instructions push/default-instructions + :error-function string-classif/error-function + :max-generations 50 + :population-size 200 + :max-initial-plushy-size 50 + :step-limit 100 + :parent-selection :lexicase}) diff --git a/src/propeller/tools/calculus.cljc b/src/propeller/tools/calculus.cljc new file mode 100644 index 0000000..19dfc4e --- /dev/null +++ b/src/propeller/tools/calculus.cljc @@ -0,0 +1,33 @@ +(ns propeller.tools.calculus) + +(defonce ^:const dx 0.0001) + +(defn deriv + "Returns the derivative of f evaluated at c. If called with only one argument, + it returns the derivative function." + ([f c] + ((deriv f) c)) + ([f] + (fn [x] + (/ (- (f (+ x dx)) (f x)) dx)))) + +(defn integrate + "Returns the definite integral of f over [a, b] using Simpson's method. + If called with only one argument (the function), returns the indefinite + integral, which takes as input a value x and (optionally) a constant c." + ([f] + (fn this + ([x] (this x 0)) + ([x c] (+ (integrate f 0 x) c)))) + ([f a b] + (let [n (/ 1 dx) + h (/ (- b a) n)] + (loop [i 1 + sum1 (f (+ a (/ h 2))) + sum2 0] + (if (< i n) + (recur (inc i) + (+ sum1 (f (+ a (* h i) (/ h 2)))) + (+ sum2 (f (+ a (* h i))))) + (* (/ h 6) (+ (f a) (f b) (* 4 sum1) (* 2 sum2)))))))) + diff --git a/src/propeller/tools/character.cljc b/src/propeller/tools/character.cljc new file mode 100644 index 0000000..32d64d3 --- /dev/null +++ b/src/propeller/tools/character.cljc @@ -0,0 +1,18 @@ +(ns propeller.tools.character) + +(defn is-letter + "Returns true if the given character is a letter, A-Z or a-z." + [c] + (<= (int \A) (int c) (int \z))) + + +(defn is-digit + "Returns true if the given character is a digit, 0-9." + [c] + (<= (int \0) (int c) (int \9))) + + +(defn is-whitespace + "Returns true if the given character is whitespace (newline, space, tab)." + [c] + (contains? #{(int \newline) (int \tab) (int \space)} (int c))) diff --git a/src/propeller/tools/distributions.cljc b/src/propeller/tools/distributions.cljc new file mode 100644 index 0000000..e6358a3 --- /dev/null +++ b/src/propeller/tools/distributions.cljc @@ -0,0 +1,59 @@ +(ns propeller.tools.distributions + (:require [propeller.tools.calculus :as calculus] + [propeller.tools.math :as math])) + +;; ============================================================================= +;; NORMAL +;; ============================================================================= + +(defn- box-muller + "Given two uniformly distributed random variables (from 0 to 1), returns a + Standard Normal variable computed using the Box-Muller Transform." + [u1 u2] + (* (math/sqrt (* -2 (math/log u1))) + (math/cos (* 2 math/PI u2)))) + +(defn- normal-pdf + "Given a mean and standard deviation, returns the corresponding Normal + Probability Distribution Function." + [mu sigma] + (fn [x] + (* (/ 1 (* sigma (math/sqrt (* 2 math/PI)))) + (math/exp (- (/ (math/pow (/ (- x mu) sigma) 2) 2)))))) + +(defn rand-norm + "Generates n Normally-distributed random variables with given mean and + standard deviation. If no parameters are provided, defaults to a + single random observation from a Standard Normal distribution. + Accepts an argument map with optional keys :n, :mu, and :sigma." + [{:keys [n mu sigma] + :or {n 1, mu 0, sigma 1}}] + (repeatedly n #(box-muller (rand) (rand)))) + +(defn pdf-norm + "Returns the value of the Normal Probability Distribution Function at a + particular value x. If no distributional parameters are provided, defaults to + the Standard Normal PDF. + Accepts an argument map with keys :x, and optionally :mu and :sigma." + [{:keys [x mu sigma] + :or {mu 0, sigma 1}}] + ((normal-pdf mu sigma) x)) + +(defn cdf-norm + "Parameters: {:keys [x mu sigma]} + Returns the value of the Normal Cumulative Distribution Function at a + particular value x. If no distributional parameters are provided, defaults to + the Standard Normal CDF. + Accepts an argument map with keys :x, and optionally :mu and :sigma." + [{:keys [x mu sigma] + :or {mu 0, sigma 1}}] + (calculus/integrate (normal-pdf mu sigma) (- mu (* 6 sigma)) x)) + +(defn quant-norm + "For a given probability p, returns the corresponding value of the quantile + function (i.e. the inverse Cumulative Distribution Function). If no + distributional parameters are provided, defaults to Standard Normal quantiles. + Accepts an argument map with keys :p, and optionally :mu and :sigma." + [{:keys [p mu sigma] + :or {mu 0, sigma 1}}] + ()) ; unfinished... diff --git a/src/propeller/tools/math.cljc b/src/propeller/tools/math.cljc new file mode 100644 index 0000000..03ed549 --- /dev/null +++ b/src/propeller/tools/math.cljc @@ -0,0 +1,104 @@ +(ns propeller.tools.math) + +(defonce PI #?(:clj Math/PI + :cljs js/Math.PI)) + +(defonce E #?(:clj Math/E + :cljs js/Math.PI)) + +(defn abs + "Returns the absolute value of a number." + [x] + (if (neg? x) (- x) x)) + +(defn approx= [x y epsilon] + "Returns true if the absolute difference between x and y is less than or + equal to some specified error level, epsilon." + (<= (abs (- y x)) epsilon)) + +(defn ceil + "Returns the smallest integer greater than or equal to x." + [x] + #?(:clj (Math/ceil x) + :cljs (js/Math.ceil x))) + +(defn cos + "Returns the cosine of an angle (specified in radians)." + [x] + #?(:clj (Math/cos x) + :cljs (js/Math.cos x))) + +(defn div + "Returns the result of floating point division between x and y." + [x y] + (double (/ x y))) + +(defn exp + "Returns Euler's number (approx. 2.71) raised to the given power." + [x] + #?(:clj (Math/exp x) + :cljs (js/Math.exp x))) + +(defn floor + "Returns the largest integer less than or equal to x." + [x] + #?(:clj (Math/floor x) + :cljs (js/Math.floor x))) + +(defn log + "Returns the logarithm of x with the given base. If called with only one + argument, returns the natural logarithm (base e) of the given value." + ([x base] + (/ (log x) (log base))) + ([x] + #?(:clj (Math/log x) + :cljs (js/Math.log x)))) + +(defn pow + "Returns the value obtained by raising the first argument to the power of + the second argument." + [x n] + #?(:clj (Math/pow x n) + :cljs (js/Math.pow x n))) + +(defn root + "Returns the root of x with base n." + [x n] + (pow x (/ 1 n))) + +(defn round + "Returns the value of x rounded to the nearest integer." + [x] + #?(:clj (Math/round x) + :cljs (js/Math.round x))) + +(defn sign + "Returns the 1 if the argument is positive, -1 if the argument is negative, + and 0 if the argument is zero." + [x] + (cond (< x 0) -1 + (> x 0) 1 + :else 0)) + +(defn sin + "Returns the sine of an angle (specified in radians)." + [x] + #?(:clj (Math/sin x) + :cljs (js/Math.sin x))) + +(defn sqrt + "Returns the square root of the given value." + [x] + #?(:clj (Math/sqrt x) + :cljs (js/Math.sqrt x))) + +(defn square + "Returns the square of the given value." + [x] + (* x x)) + +(defn tan + "Returns the tangent of an angle (specified in radians)." + [x] + #?(:clj (Math/tan x) + :cljs (js/Math.tan x))) diff --git a/src/propeller/tools/metrics.cljc b/src/propeller/tools/metrics.cljc new file mode 100644 index 0000000..7964add --- /dev/null +++ b/src/propeller/tools/metrics.cljc @@ -0,0 +1,58 @@ +(ns propeller.tools.metrics + (:require [propeller.tools.math :as math])) + +(defn mean + "Returns the mean of a collection." + [coll] + (if (empty? coll) 0 (math/div (apply + coll) (count coll)))) + +(defn median + "Returns the median of a collection." + [coll] + (let [sorted-coll (sort coll) + count (count sorted-coll) + midpoint (quot count 2)] + (if (odd? count) + (nth sorted-coll midpoint) + (let [below (nth sorted-coll (dec midpoint)) + above (nth sorted-coll midpoint)] + (mean [below above]))))) + +(defn hamming-distance + "Calculates the Hamming distance between two sequences, including strings." + [seq1 seq2] + (apply + (map #(if (= %1 %2) 0 1) seq1 seq2))) + +(defn levenshtein-distance + "Levenshtein Distance - http://en.wikipedia.org/wiki/Levenshtein_distance + In Information Theory and Computer Science, the Levenshtein distance is a + metric for measuring the amount of difference between two sequences. This + is a functional implementation of the Levenshtein edit distance with as + little mutability as possible. Still maintains the O(nm) guarantee." + [a b & {p :predicate :or {p =}}] + (cond + (empty? a) (count b) + (empty? b) (count a) + :else (peek + (reduce + ;; we use a simple reduction to convert the previous row into the + ;; next-row using the compute-next-row which takes a current + ;; element, the previous-row computed so far, and the predicate + ;; to compare for equality + (fn [prev-row current-element] + (compute-next-row prev-row current-element b p)) + ;; we need to initialize the prev-row with the edit distance + ;; between the various prefixes of b and the empty string + (range (inc (count b))) + a)))) + +(defn sequence-similarity + "Returns a number between 0 and 1, indicating how similar the sequences are + as a normalized, inverted Levenshtein distance, with 1 indicating identity + and 0 indicating no similarity." + [seq1 seq2] + (if (and (empty? seq1) (empty? seq2)) + 1 + (let [distance (levenshtein-distance seq1 seq2) + max-distance (max (count seq1) (count seq2))] + (math/div (- max-distance distance) max-distance)))) diff --git a/src/propeller/utils.cljc b/src/propeller/utils.cljc new file mode 100644 index 0000000..492ec20 --- /dev/null +++ b/src/propeller/utils.cljc @@ -0,0 +1,36 @@ +(ns propeller.utils) + +(defn get-vector-literal-type + "Returns the literal stack corresponding to some vector stack." + [vector-stack] + (keyword (clojure.string/replace (str vector-stack) ":vector_" ""))) + +(defn indexof + "Returns the first index of an element in a collection. If the element is not + present in the collection, returns -1." + [element coll] + (or (first (keep-indexed #(if (= element %2) %1) coll)) -1)) + +(defn not-lazy + "Returns lst if it is not a seq, or a non-lazy version of lst if it is." + [lst] + (if (seq? lst) + (apply list lst) + lst)) + +(defn ensure-list + "Returns a non-lazy list if passed a seq argument. Othwrwise, returns a list + containing the argument." + [thing] + (if (seq? thing) + (not-lazy thing) + (list thing))) + +(defn random-instruction + "Returns a random instruction from a supplied pool of instructions, evaluating + ERC-producing functions to a constant literal." + [instructions] + (let [instruction (rand-nth instructions)] + (if (fn? instruction) + (instruction) + instruction))) diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc new file mode 100644 index 0000000..d04d1f3 --- /dev/null +++ b/src/propeller/variation.cljc @@ -0,0 +1,52 @@ +(ns propeller.variation + (:require [propeller.selection :as selection] + [propeller.utils :as utils])) + +(defn crossover + "Crosses over two individuals using uniform crossover. Pads shorter one." + [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 shorter (repeat length-diff :crossover-padding))] + (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." + [plushy instructions umad-rate] + (apply concat + (map #(if (< (rand) umad-rate) + (shuffle [% (utils/random-instruction instructions)]) + [%]) + plushy))) + +(defn uniform-deletion + "Randomly deletes instructions from plushy at some rate." + [plushy umad-rate] + (remove (fn [_] (< (rand) + (/ 1 (+ 1 (/ 1 umad-rate))))) + plushy)) + +(defn new-individual + "Returns a new individual produced by selection and variation of + individuals in the population." + [pop argmap] + {:plushy + (let [prob (rand)] + (cond + (< prob (:crossover (:variation argmap))) + (crossover (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) + (< prob (+ (:crossover (:variation argmap)) + (:umad (:variation argmap)) 2)) + (uniform-deletion (uniform-addition (:plushy (selection/select-parent pop argmap)) + (:instructions argmap) + (:umad-rate argmap)) + (:umad-rate argmap)) + :else (:plushy (selection/select-parent pop argmap))))})