diff --git a/.idea/codeStyles/Project.xml b/.idea/codeStyles/Project.xml new file mode 100644 index 0000000..919ce1f --- /dev/null +++ b/.idea/codeStyles/Project.xml @@ -0,0 +1,7 @@ + + + + + + \ No newline at end of file diff --git a/.idea/codeStyles/codeStyleConfig.xml b/.idea/codeStyles/codeStyleConfig.xml new file mode 100644 index 0000000..a55e7a1 --- /dev/null +++ b/.idea/codeStyles/codeStyleConfig.xml @@ -0,0 +1,5 @@ + + + + \ No newline at end of file diff --git a/project.clj b/project.clj index 7f1c2f1..ae2d7d2 100644 --- a/project.clj +++ b/project.clj @@ -2,7 +2,8 @@ :description "FIXME: write description" :url "http://example.com/FIXME" :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0" - :url "https://www.eclipse.org/legal/epl-2.0/"} - :dependencies [[org.clojure/clojure "1.10.0"]] + :url "https://www.eclipse.org/legal/epl-2.0/"} + :dependencies [[org.clojure/clojure "1.10.0"] + [org.clojure/clojurescript "1.9.946"]] :main ^:skip-aot propeller.core :repl-options {:init-ns propeller.core}) diff --git a/propeller-cli b/propeller-cli new file mode 100755 index 0000000..956a9f5 --- /dev/null +++ b/propeller-cli @@ -0,0 +1,5 @@ +#!/usr/bin/env bash + +# Bash script utility for running propeller for people unfamiliar with Clojure + + diff --git a/src/propeller/core.clj b/src/propeller/core.clj index 15e24d0..5f4ac2a 100644 --- a/src/propeller/core.clj +++ b/src/propeller/core.clj @@ -2,8 +2,7 @@ (:gen-class) (:require [propeller.gp :as gp] [propeller.problems.simple-regression :as regression] - [propeller.problems.string-classification :as string-classif] - [propeller.push.core :as push])) + [propeller.problems.string-classification :as string-classif])) (defn -main "Runs propel-gp, giving it a map of arguments." @@ -11,7 +10,7 @@ (gp/gp (update-in (merge - {:instructions push/default-instructions + {:instructions regression/instructions :error-function regression/error-function :max-generations 500 :population-size 500 @@ -25,4 +24,4 @@ (apply hash-map (map read-string args))) [:error-function] - #(if (fn? %) % (eval %))))) + identity))) diff --git a/src/propeller/genome.clj b/src/propeller/genome.clj index b8a60e7..6c460e2 100644 --- a/src/propeller/genome.clj +++ b/src/propeller/genome.clj @@ -1,5 +1,13 @@ (ns propeller.genome - (:require [propeller.push.core :as push])) + (:require [propeller.push.core :as push] + [propeller.utils :as utils])) + +(defn make-random-plushy + "Creates and returns a new plushy." + [instructions max-initial-plushy-size] + (repeatedly + (rand-int max-initial-plushy-size) + #(utils/random-instruction instructions))) (defn plushy->push "Returns the Push program expressed by the given plushy representation." @@ -25,9 +33,3 @@ (rest plushy)) (recur push (rest plushy))) ;; unmatched close, ignore (recur (concat push [i]) (rest plushy)))))))) ;; anything else - -(defn make-random-plushy - "Creates and returns a new plushy." - [instructions max-initial-plushy-size] - (repeatedly (rand-int max-initial-plushy-size) - #(rand-nth instructions))) diff --git a/src/propeller/gp.clj b/src/propeller/gp.clj index eb476ef..9a36b4b 100644 --- a/src/propeller/gp.clj +++ b/src/propeller/gp.clj @@ -7,8 +7,10 @@ [propeller.push.instructions.code] [propeller.push.instructions.input-output] [propeller.push.instructions.numeric] + [propeller.push.instructions.random] [propeller.push.instructions.polymorphic] - [propeller.push.instructions.string])) + [propeller.push.instructions.string] + [propeller.push.instructions.vector])) (defn report "Reports information each generation." @@ -36,15 +38,12 @@ ;; (println "Starting GP with args: " argmap) ;; - (do (println "Registered instructions:") - (println (sort (keys @push/instruction-table)))) - ;; (loop [generation 0 population (repeatedly population-size - #(hash-map :plushy - (genome/make-random-plushy instructions - max-initial-plushy-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))] diff --git a/src/propeller/problems/simple_regression.clj b/src/propeller/problems/simple_regression.clj index 1b710a2..a1d2801 100644 --- a/src/propeller/problems/simple_regression.clj +++ b/src/propeller/problems/simple_regression.clj @@ -18,6 +18,39 @@ [x] (+ (* x x x) x 3)) +;; Set of original propel instructions +(def instructions + (list :in1 + :integer_add + :integer_subtract + :integer_mult + :integer_quot + :integer_eq + :exec_dup + :exec_if + :boolean_and + :boolean_or + :boolean_not + :boolean_eq + :string_eq + :string_take + :string_drop + :string_reverse + :string_concat + :string_length + :string_includes? + 'close + 0 + 1 + true + false + "" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "A" + "C" + "G" + "T")) + (defn error-function "Finds the behaviors and errors of an individual. The error is the absolute deviation between the target output value and the program's selected behavior, diff --git a/src/propeller/problems/string_classification.clj b/src/propeller/problems/string_classification.clj index 4d1edf0..9811d2a 100644 --- a/src/propeller/problems/string_classification.clj +++ b/src/propeller/problems/string_classification.clj @@ -7,6 +7,39 @@ ;; String classification ;; ============================================================================= +;; Set of original propel instructions +(def instructions + (list :in1 + :integer_add + :integer_subtract + :integer_mult + :integer_quot + :integer_eq + :exec_dup + :exec_if + :boolean_and + :boolean_or + :boolean_not + :boolean_eq + :string_eq + :string_take + :string_drop + :string_reverse + :string_concat + :string_length + :string_includes? + 'close + 0 + 1 + true + false + "" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "A" + "C" + "G" + "T")) + (defn error-function "Finds the behaviors and errors of an individual: Error is 0 if the value and the program's selected behavior match, or 1 if they differ, or 1000000 if no diff --git a/src/propeller/push/core.clj b/src/propeller/push/core.clj index 8834759..624c1d9 100644 --- a/src/propeller/push/core.clj +++ b/src/propeller/push/core.clj @@ -13,39 +13,6 @@ (def instruction-table (atom (hash-map))) -;; Set of original propel instructions -(def default-instructions - (list :in1 - :integer_add - :integer_subtract - :integer_mult - :integer_quot - :integer_eq - :exec_dup - :exec_if - :boolean_and - :boolean_or - :boolean_not - :boolean_eq - :string_eq - :string_take - :string_drop - :string_reverse - :string_concat - :string_length - :string_includes? - 'close - 0 - 1 - true - false - "" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "A" - "C" - "G" - "T")) - ;; Number of blocks opened by instructions (default = 0) (def opens {:exec_dup 1 :exec_if 2}) diff --git a/src/propeller/push/instructions/boolean.clj b/src/propeller/push/instructions/boolean.clj index c412c3e..a4a0528 100644 --- a/src/propeller/push/instructions/boolean.clj +++ b/src/propeller/push/instructions/boolean.clj @@ -9,24 +9,28 @@ ;; Pushes the logical AND of the top two BOOLEANs (def-instruction :boolean_and + ^{:stacks #{:boolean}} (fn [state] (make-instruction state #(and %1 %2) [:boolean :boolean] :boolean))) ;; Pushes the logical OR of the top two BOOLEANs (def-instruction :boolean_or + ^{:stacks #{:boolean}} (fn [state] (make-instruction state #(or %1 %2) [:boolean :boolean] :boolean))) ;; Pushes the logical NOT of the top BOOLEAN (def-instruction :boolean_not + ^{:stacks #{:boolean}} (fn [state] (make-instruction state not [:boolean] :boolean))) ;; Pushes the logical XOR of the top two BOOLEAN (def-instruction :boolean_xor + ^{:stacks #{:boolean}} (fn [state] (make-instruction state #(or (and %1 (not %2)) (and (not %1) %2)) @@ -37,6 +41,7 @@ ;; first one (def-instruction :boolean_invert_first_then_and + ^{:stacks #{:boolean}} (fn [state] (make-instruction state #(and %1 (not %2)) [:boolean :boolean] :boolean))) @@ -44,17 +49,20 @@ ;; second one (def-instruction :boolean_invert_second_then_and + ^{:stacks #{:boolean}} (fn [state] (make-instruction state #(and (not %1) %2) [:boolean :boolean] :boolean))) ;; Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise (def-instruction :boolean_fromfloat + ^{:stacks #{:boolean :float}} (fn [state] (make-instruction state #(not (zero? %)) [:float] :boolean))) ;; Pushes FALSE if the top INTEGER is 0, and TRUE otherwise (def-instruction :boolean_frominteger + ^{:stacks #{:boolean :integer}} (fn [state] (make-instruction state #(not (zero? %)) [:integer] :boolean))) diff --git a/src/propeller/push/instructions/char.clj b/src/propeller/push/instructions/char.clj index 3078774..c411b15 100644 --- a/src/propeller/push/instructions/char.clj +++ b/src/propeller/push/instructions/char.clj @@ -1,5 +1,6 @@ (ns propeller.push.instructions.char - (:require [propeller.push.utils :refer [def-instruction + (:require [propeller.push.state :as state] + [propeller.push.utils :refer [def-instruction make-instruction]] [propeller.tools.character :as char])) @@ -10,12 +11,14 @@ ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter (def-instruction :char_isletter + ^{:stacks #{:boolean :char}} (fn [state] (make-instruction state char/is-letter [:char] :boolean))) ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a digit (def-instruction :char_isdigit + ^{:stacks #{:boolean :char}} (fn [state] (make-instruction state char/is-digit [:char] :boolean))) @@ -23,6 +26,7 @@ ;; (newline, space, or tab) (def-instruction :char_iswhitespace + ^{:stacks #{:boolean :char}} (fn [state] (make-instruction state char/is-whitespace [:char] :boolean))) @@ -32,6 +36,7 @@ ;; pushed. (def-instruction :char_fromfloat + ^{:stacks #{:char :float}} (fn [state] (make-instruction state #(char (mod (long %) 128)) [:float] :char))) @@ -40,13 +45,19 @@ ;; 128. For instance, 248 will result in x being pushed (def-instruction :char_frominteger + ^{:stacks #{:char :integer}} (fn [state] (make-instruction state #(char (mod % 128)) [:integer] :char))) ;; Pops the STRING stack and pushes the top element's constituent characters ;; onto the CHAR stack, in order. For instance, "hello" will result in the -;; top of the CHAR stack being o l l e h +;; top of the CHAR stack being \h \e \l \l \o (def-instruction :char_allfromstring + ^{:stacks #{:char :string}} (fn [state] - (make-instruction state #(map char %) [:string] :char))) + (if (state/empty-stack? state :string) + state + (let [top-string (state/peek-stack state :string) + popped-state (state/pop-stack state :string)] + (state/push-to-stack-multiple popped-state :char (map char top-string)))))) diff --git a/src/propeller/push/instructions/code.clj b/src/propeller/push/instructions/code.clj index b822596..c52051f 100644 --- a/src/propeller/push/instructions/code.clj +++ b/src/propeller/push/instructions/code.clj @@ -1,14 +1,101 @@ (ns propeller.push.instructions.code - (:require [propeller.push.state :as state] + (:require [propeller.utils :as utils] + [propeller.push.state :as state] [propeller.push.utils :refer [def-instruction + generate-instructions make-instruction]])) ;; ============================================================================= -;; CODE and EXEC Instructions +;; Polymorphic Instructions +;; ============================================================================= + +(def _noop + ^{:stacks #{}} + (fn [stack state] state)) + +(def _do*range + ^{:stacks #{:exec :integer}} + (fn [stack state] state)) + +(def _noop + ^{:stacks #{}} + (fn [stack state] state)) + +(def _noop + ^{:stacks #{}} + (fn [stack state] state)) + +(generate-instructions + [:exec :code] + [_noop]) + + +;; ============================================================================= +;; CODE Instructions +;; ============================================================================= + +;; Concatenates the top two instructions on the :code stack and pushes the +;; result back onto the stack +(def-instruction + :code_append + ^{:stacks #{:code}} + (fn [state] + (make-instruction state + #(utils/not-lazy + (concat (utils/ensure-list %2) + (utils/ensure-list %1))) + [:code :code] + :code))) + +(def-instruction + :code_atom + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_car + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_cdr + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_cons + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_do + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_do* + ^{:stacks #{:code}} + (fn [state] + ())) + +(def-instruction + :code_append + ^{:stacks #{:code}} + (fn [state] + ())) + +;; ============================================================================= +;; EXEC Instructions ;; ============================================================================= (def-instruction :exec_dup + ^{:stacks #{:exec}} (fn [state] (if (state/empty-stack? state :exec) state @@ -16,5 +103,6 @@ (def-instruction :exec_if + ^{:stacks #{:boolean :exec}} (fn [state] (make-instruction state #(if %1 %3 %2) [:boolean :exec :exec] :exec))) diff --git a/src/propeller/push/instructions/numeric.clj b/src/propeller/push/instructions/numeric.clj index a91a87c..20e17a7 100644 --- a/src/propeller/push/instructions/numeric.clj +++ b/src/propeller/push/instructions/numeric.clj @@ -1,6 +1,6 @@ (ns propeller.push.instructions.numeric (:require [propeller.push.utils :refer [def-instruction - generate-functions + generate-instructions make-instruction]] [propeller.tools.math :as math])) @@ -10,103 +10,119 @@ ;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than the top ;; item, and FALSE otherwise -(defn- _gt - [stack state] - (make-instruction state > [stack stack] :boolean)) +(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 -(defn- _gte - [stack state] - (make-instruction state >= [stack stack] :boolean)) +(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 -(defn- _lt - [stack state] - (make-instruction state < [stack stack] :boolean)) +(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 -(defn- _lte - [stack state] - (make-instruction state <= [stack stack] :boolean)) +(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 -(defn- _add - [stack state] - (make-instruction state +' [stack stack] 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 -(defn- _subtract - [stack state] - (make-instruction state -' [stack stack] 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 -(defn- _mult - [stack state] - (make-instruction state *' [stack stack] 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 -(defn- _quot - [stack state] - (make-instruction state #(if (zero? %2) 1 (quot %1 %2)) [stack stack] stack)) +(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. -(defn- _mod - [stack state] - (make-instruction state #(if (zero? %2) 1 (mod %1 %2)) [stack stack] stack)) +(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 -(defn- _max - [stack state] - (make-instruction state max [stack stack] stack)) +(def _max + ^{:stacks #{}} + (fn [stack state] + (make-instruction state max [stack stack] stack))) ;; Pushes the minimum of the top two items -(defn- _min - [stack state] - (make-instruction state min [stack stack] stack)) +(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 -(defn- _fromboolean - [stack state] - (make-instruction state - #((if (= stack :integer) int float) (if % 1 0)) - [:boolean] - stack)) +(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 -(defn- _fromchar - [stack state] - (make-instruction state (if (= stack :integer) int float) [:char] stack)) +(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 -(defn- _fromstring - [stack state] - (make-instruction state - #(try ((if (= stack :integer) int float) (read-string %)) - (catch Exception e)) - [:string] - stack)) +(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 -(defn- _inc - [stack state] - (make-instruction state inc [stack] 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 -(defn- _dec - [stack state] - (make-instruction state dec [stack] stack)) +(def _dec + ^{:stacks #{}} + (fn [stack state] + (make-instruction state dec [stack] stack))) ;; 2 types x 16 functions = 32 instructions -(generate-functions +(generate-instructions [:float :integer] [_gt _gte _lt _lte _add _subtract _mult _quot _mod _max _min _inc _dec _fromboolean _fromchar _fromstring]) @@ -118,24 +134,28 @@ ;; Pushes the cosine of the top FLOAT (def-instruction :float_cos + ^{:stacks #{:float}} (fn [state] (make-instruction state math/cos [:float] :float))) ;; Pushes the sine of the top FLOAT (def-instruction :float_sin + ^{:stacks #{:float}} (fn [state] (make-instruction state math/sin [:float] :float))) ;; Pushes the tangent of the top FLOAT (def-instruction :float_tan + ^{:stacks #{:float}} (fn [state] (make-instruction state math/tan [:float] :float))) ;; Pushes the floating point version of the top INTEGER (def-instruction :float_frominteger + ^{:stacks #{:float :integer}} (fn [state] (make-instruction state float [:integer] :float))) @@ -146,5 +166,6 @@ ;; Pushes the result of truncating the top FLOAT towards negative infinity (def-instruction :integer_fromfloat + ^{:stacks #{:float :integer}} (fn [state] (make-instruction state int [:float] :integer))) diff --git a/src/propeller/push/instructions/polymorphic.clj b/src/propeller/push/instructions/polymorphic.clj index 0fd207b..ca0d8da 100644 --- a/src/propeller/push/instructions/polymorphic.clj +++ b/src/propeller/push/instructions/polymorphic.clj @@ -1,107 +1,181 @@ (ns propeller.push.instructions.polymorphic - (:require [propeller.push.state :as state] - [propeller.push.utils :refer [def-instruction - generate-functions - make-instruction]])) + (:require [propeller.utils :as utils] + [propeller.push.state :as state] + [propeller.push.utils :refer [generate-instructions + make-instruction]])) ;; ============================================================================= ;; Polymorphic Instructions ;; -;; (for all types, with the exception of non-data stacks like auxiliary, tag, -;; input, and output) +;; (for all stacks, with the exception of non-data ones like auxiliary, input, +;; and output) ;; ============================================================================= -;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal. -;; Otherwise FALSE -(defn- _eq - [stack state] - (make-instruction state = [stack stack] :boolean)) - ;; Duplicates the top item of the stack. Does not pop its argument (since that ;; would negate the effect of the duplication) -(defn- _dup - [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)))) +(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. -(defn- _duptimes - [stack state] - (if (or (and (= stack :integer) - (>= (count (:integer state)) 2)) - (and (not= stack :integer) - (not (state/empty-stack? state :integer)) - (not (state/empty-stack? state stack)))) - (let [n (state/peek-stack state :integer) - item-to-duplicate (state/peek-stack state stack)] - nil) - state)) +;; 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))) - -(defn- _dupitems - [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 -(defn- _empty - [stack state] - (state/push-to-stack state :boolean (state/empty-stack? state stack))) +(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 -(defn- _flush - [stack state] - ()) +(def _flush + ^{:stacks #{}} + (fn [stack state] + (assoc state stack '()))) ;; Pops the given stack -(defn- _pop - [stack state] - (state/pop-stack state 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) -(defn- _rot - [stack state] - ()) +(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 -(defn- _shove - [stack state] - ()) +(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 -(defn- _stackdepth - [stack state] - ()) +(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 -(defn- _swap - [stack state] - ()) +(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))) -;; Removes an indexed item from deep in the stack. The top INTEGER is used to -;; determine how deep to yank from -(defn- _yank - [stack 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 deep in the stack, without removing it. +;; Pushes a copy of an indexed item from deep in the stack, without removing it. ;; The top INTEGER is used to determine how deep to yankdup from -(defn- _yankdup - [stack state] - ()) +(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))) -;; 5 types x 1 function = 5 instructions -(generate-functions [:boolean :char :float :integer :string] [_eq]) +;; 9 types x 1 functions = 9 instructions +(generate-instructions + [:boolean :char :float :integer :string + :vector_boolean :vector_float :vector_integer :vector_string] + [_eq]) -;; 7 types x 12 function = 84 instructions -(generate-functions - [:boolean :char :code :exec :float :integer :string] +;; 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 new file mode 100644 index 0000000..87a83e8 --- /dev/null +++ b/src/propeller/push/instructions/random.clj @@ -0,0 +1,4 @@ +(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 index 16d28ad..aa1f839 100644 --- a/src/propeller/push/instructions/string.clj +++ b/src/propeller/push/instructions/string.clj @@ -8,35 +8,42 @@ (def-instruction :string_= + ^{:stacks #{:boolean :string}} (fn [state] (make-instruction state = [:string :string] :boolean))) (def-instruction :string_concat + ^{:stacks #{:string}} (fn [state] (make-instruction state #(apply str (concat %1 %2)) [:string :string] :string))) (def-instruction :string_drop + ^{:stacks #{:integer :string}} (fn [state] (make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string))) (def-instruction :string_includes? + ^{:stacks #{:boolean :string}} (fn [state] (make-instruction state clojure.string/includes? [:string :string] :boolean))) (def-instruction :string_length + ^{:stacks #{:integer :string}} (fn [state] (make-instruction state count [:string] :integer))) (def-instruction :string_reverse + ^{:stacks #{:string}} (fn [state] (make-instruction state #(apply str (reverse %)) [:string] :string))) (def-instruction :string_take + ^{:stacks #{:integer :string}} (fn [state] (make-instruction state #(apply str (take %1 %2)) [:integer :string] :string))) diff --git a/src/propeller/push/instructions/vector.clj b/src/propeller/push/instructions/vector.clj new file mode 100644 index 0000000..6891504 --- /dev/null +++ b/src/propeller/push/instructions/vector.clj @@ -0,0 +1,204 @@ +(ns propeller.push.instructions.vector + (:require [clojure.string] + [propeller.utils :as utils] + [propeller.push.state :as state] + [propeller.push.utils :refer [def-instruction + generate-instructions + make-instruction]])) + +;; ============================================================================= +;; VECTOR Instructions +;; ============================================================================= + +;; Pushes the butlast of the top item +(def _butlast + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (butlast %)) [stack] stack))) + +;; Concats and pushes the top two vectors of the stack +(def _concat + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (concat %2 %1)) [stack stack] stack))) + +;; Conj's the top item of the appropriately-typed literal stack onto the vector +;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER) +(def _conj + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state #(conj %2 %1) [lit-stack stack] stack)))) + +;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack +;; contains the top element of the appropriately-typed literal stack. Otherwise, +;; pushes FALSE +(def _contains + ^{:stacks #{:boolean}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean)))) + +;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector. +;; Otherwise, pushes FALSE +(def _emptyvector + ^{:stacks #{:boolean}} + (fn [stack state] + (make-instruction state empty? [stack] :boolean))) + +;; Pushes the first item of the top element of the vector stack onto the +;; approrpiately-typed literal stack +(def _first + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state first [stack] lit-stack)))) + +;; Pushes onto the INTEGER stack the index of the top element of the +;; appropriately-typed literal stack within the top element of the vector stack +(def _indexof + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer)))) + +;; Pushes the last item of the top element of the vector stack onto the +;; approrpiately-typed literal stack +(def _last + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state last [stack] lit-stack)))) + +;; Pushes the length of the top item onto the INTEGER stack +(def _length + ^{:stacks #{:integer}} + (fn [stack state] + (make-instruction state count [stack] :integer))) + +;; Pushes the Nth item of the top element of the vector stack onto the +;; approrpiately-typed literal stack, where N is taken from the INTEGER stack. +;; To insure the index is within bounds, N is taken mod the vector length +(def _nth + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + #(get %2 (mod %1 (count %2))) + [:integer stack] + lit-stack)))) + +;; Pushes onto the INTEGER stack the number of occurrences of the top element of +;; the appropriately-typed literal stack within the top element of the vector +;; stack +(def _occurrencesof + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit vect] (count (filter #(= lit %) vect))) + [lit-stack stack] + :integer)))) + +;; Pushes every item of the top element onto the appropriately-typed stack +(def _pushall + ^{:stacks #{}} + (fn [stack state] + (if (state/empty-stack? state stack) + state + (let [lit-stack (utils/get-vector-literal-type stack) + top-vector (state/peek-stack state stack) + popped-state (state/pop-stack state stack)] + (state/push-to-stack-multiple popped-state lit-stack top-vector))))) + +;; Removes all occurrences of the top element of the appropriately-typed literal +;; stack from the first element of the vector stack +(def _remove + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit vect] (vec (filter #(not= lit %) vect))) + [lit-stack stack] + stack)))) + +;; Replaces all occurrences of the second element of the appropriately-typed +;; literal stack with the top element of the appropriately-typed literal stack +;; within the top item of the vector stack +(def _replace + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit1 lit2 vect] + (replace {lit1 lit2} vect)) + [lit-stack lit-stack stack] + stack)))) + +;; Replaces the first occurrence of the second element of the appropriately-typed +;; literal stack with the top element of the appropriately-typed literal stack +;; within the top item of the vector stack +(def _replacefirst + ^{:stacks #{}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit1 lit2 vect] + (assoc vect (utils/indexof lit1 vect) lit2)) + [lit-stack lit-stack stack] + stack)))) + +;; Pushes the rest of the top item +(def _rest + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (rest %)) [stack] stack))) + +;; Pushes the reverse of the top item +(def _reverse + ^{:stacks #{}} + (fn [stack state] + (make-instruction state #(vec (reverse %)) [stack] stack))) + +;; Replaces in the top vector the item at index N (taken from the INTEGER stack) +;; with the top item from the appropriately-typed literal stack. To insure the +;; index is within bounds, N is taken mod the vector length +(def _set + ^{:stacks #{:integer}} + (fn [stack state] + (let [lit-stack (utils/get-vector-literal-type stack)] + (make-instruction state + (fn [lit n vect] + (assoc vect (mod n (count vect)) lit)) + [:integer lit-stack stack] + stack)))) + +;; Pushes a subvector of the top item, with start and end indices determined by +;; the second and top items of the INTEGER stack respectively +(def _subvec + ^{:stacks #{:integer}} + (fn [stack state] + (make-instruction state + (fn [stop-raw start-raw vect] + (let [start (min (count vect) (max 0 start-raw)) + stop (min (count vect) (max start-raw stop-raw))] + (subvec vect start stop))) + [:integer :integer stack] + stack))) + +;; Pushes the first N items of the top element, where N is taken from the top of +;; the INTEGER stack +(def _take + ^{:stacks #{:integer}} + (fn [stack state] + (make-instruction state #(vec (take %1 %2)) [:integer stack] stack))) + +;; 4 types x 20 functions = 80 instructions +(generate-instructions + [:vector_boolean :vector_float :vector_integer :vector_string] + [_butlast _concat _conj _contains _emptyvector _first _indexof _last + _length _nth _occurrencesof _pushall _remove _replace _replacefirst + _rest _reverse _set _subvec _take]) + +;; Manually add extra metadata for _conj + diff --git a/src/propeller/push/state.clj b/src/propeller/push/state.clj index 95876cf..53f6da9 100644 --- a/src/propeller/push/state.clj +++ b/src/propeller/push/state.clj @@ -5,15 +5,12 @@ :boolean '() :char '() :code '() - :environment '() :exec '() :float '() - :genome '() :input {} :integer '() - :return '() + :output '() :string '() - :tag '() :vector_boolean '() :vector_float '() :vector_integer '() @@ -31,24 +28,41 @@ (empty? (get state stack))) (defn peek-stack - "Returns top item on a stack." + "Returns the top item on a stack." [state stack] (let [working-stack (get state stack)] (if (empty? working-stack) :no-stack-item (first working-stack)))) +(defn peek-stack-multiple + "Returns the top n items on a stack. If there are less than n items on the + stack, returns the entire stack." + [state stack n] + (take n (get state stack))) + (defn pop-stack - "Removes top item of stack." + "Removes the top item of stack." [state stack] (update state stack rest)) +(defn pop-stack-multiple + "Removes the top n items of a stack. If there are less than n items on the + stack, pops the entire stack." + [state stack n] + (update state stack #(drop n %))) + (defn push-to-stack - "Pushes item(s) onto stack." + "Pushes an item onto a stack." + [state stack item] + (update state stack conj item)) + +(defn push-to-stack-multiple + "Pushes a list of items onto a stack, leaving them in the order they are in." [state stack items] (let [items-list (if (coll? items) items (list items)) items-list-no-nil (filter #(not (nil? %)) items-list)] - (update state stack into items-list-no-nil))) + (update state stack into (reverse items-list-no-nil)))) (defn get-args-from-stacks "Takes a state and a collection of stacks to take args from. If there are diff --git a/src/propeller/push/utils.clj b/src/propeller/push/utils.clj index edc378a..16ef1c8 100644 --- a/src/propeller/push/utils.clj +++ b/src/propeller/push/utils.clj @@ -1,5 +1,6 @@ (ns propeller.push.utils - (:require [propeller.push.core :as push] + (:require [clojure.set] + [propeller.push.core :as push] [propeller.push.state :as state])) (defmacro def-instruction @@ -20,14 +21,44 @@ (state/push-to-stack new-state return-stack result))))) ;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix -;; function strings, e.g. [_+, _*, _=], automates the generation of all possible -;; combination instructions, which here would be :float_+, :float_*, :float_=, -;; :integer_+, :integer_*, and :integer_= -(defmacro generate-functions [stacks functions] +;; 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 - function functions - :let [instruction-name (keyword (str (name stack) function))]] - `(def-instruction ~instruction-name (partial ~function ~stack))))) + 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?}] + (first (for [[stack function] literals + :when (function data)] + stack)))) ;; Pretty-prints a Push state, for logging or debugging purposes (defn print-state diff --git a/src/propeller/tools/distributions.cljc b/src/propeller/tools/distributions.cljc index 8f69bc2..e6358a3 100644 --- a/src/propeller/tools/distributions.cljc +++ b/src/propeller/tools/distributions.cljc @@ -28,7 +28,7 @@ Accepts an argument map with optional keys :n, :mu, and :sigma." [{:keys [n mu sigma] :or {n 1, mu 0, sigma 1}}] - (repeatedly n #(box-muller (rand 1) (rand 1)))) + (repeatedly n #(box-muller (rand) (rand)))) (defn pdf-norm "Returns the value of the Normal Probability Distribution Function at a diff --git a/src/propeller/util.clj b/src/propeller/util.clj deleted file mode 100644 index 1feb2d3..0000000 --- a/src/propeller/util.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns propeller.util) - -(defn not-lazy - "Returns lst if it is not a list, or a non-lazy version of lst if it is." - [lst] - (if (seq? lst) - (apply list lst) - lst)) diff --git a/src/propeller/utils.clj b/src/propeller/utils.clj new file mode 100644 index 0000000..d532327 --- /dev/null +++ b/src/propeller/utils.clj @@ -0,0 +1,34 @@ +(ns propeller.utils) + +(defn indexof + "Returns the first index of an element in a collection. If the element is not + present in the collection, returns -1." + [element coll] + (or (first (keep-indexed #(if (= element %2) %1) coll)) -1)) + +(defn not-lazy + "Returns lst if it is not a seq, or a non-lazy version of lst if it is." + [lst] + (if (seq? lst) + (apply list lst) + lst)) + +(defn ensure-list + "Returns a non-lazy list if passed a seq argument. Othwrwise, returns a list + containing the argument." + [thing] + (if (seq? thing) + (not-lazy thing) + (list thing))) + +(defn random-instruction + "Returns a random instruction from a supplied pool of instructions, evaluating + ERC-producing functions to a constant literal." + [instructions] + (let [instruction (rand-nth instructions)] + (if (fn? instruction) (instruction) instruction))) + +(defn get-vector-literal-type + "Returns the literal stack corresponding to some vector stack." + [vector-stack] + (keyword (clojure.string/replace (str vector-stack) ":vector_" ""))) diff --git a/src/propeller/variation.clj b/src/propeller/variation.clj index 4bac3f5..d04d1f3 100644 --- a/src/propeller/variation.clj +++ b/src/propeller/variation.clj @@ -1,5 +1,6 @@ (ns propeller.variation - (:require [propeller.selection :as selection])) + (:require [propeller.selection :as selection] + [propeller.utils :as utils])) (defn crossover "Crosses over two individuals using uniform crossover. Pads shorter one." @@ -21,7 +22,7 @@ [plushy instructions umad-rate] (apply concat (map #(if (< (rand) umad-rate) - (shuffle [% (rand-nth instructions)]) + (shuffle [% (utils/random-instruction instructions)]) [%]) plushy)))