rowan.a.tl/propeller
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Converted files to cljc & ns changes for cljs

Browse Source
This commit is contained in:
Sunghoon Kwak 2020-06-30 20:39:36 +09:00 committed by GitHub
parent 9eae13a89d
commit b555e1300e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
28 changed files with 1853 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/propeller/core.cljc Normal file
View File

@ -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)))

35
src/propeller/genome.cljc Normal file
View File

@ -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 <n>] 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

60
src/propeller/gp.cljc Normal file
View File

@ -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))))))))

61
src/propeller/problems/simple_regression.cljc Normal file
View File

@ -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))))

3
src/propeller/problems/software/number_io.cljc Normal file
View File

@ -0,0 +1,3 @@
(ns propeller.problems.software.number-io)

71
src/propeller/problems/string_classification.cljc Normal file
View File

@ -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))))

18
src/propeller/push/core.cljc Normal file
View File

@ -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})

69
src/propeller/push/instructions/bool.cljc Normal file
View File

@ -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)))

65
src/propeller/push/instructions/chara.cljc Normal file
View File

@ -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))))))

111
src/propeller/push/instructions/code.cljc Normal file
View File

@ -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)))

53
src/propeller/push/instructions/input_output.cljc Normal file
View File

@ -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])

174
src/propeller/push/instructions/numeric.cljc Normal file
View File

@ -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)))

183
src/propeller/push/instructions/polymorphic.cljc Normal file
View File

@ -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])

5
src/propeller/push/instructions/random.cljc Normal file
View File

@ -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]])))

52
src/propeller/push/instructions/string.cljc Normal file
View File

@ -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)))

207
src/propeller/push/instructions/vector.cljc Normal file
View File

@ -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

44
src/propeller/push/interpreter.cljc Normal file
View File

@ -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)))))

84
src/propeller/push/state.cljc Normal file
View File

@ -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))))))))

79
src/propeller/push/utils.cljc Normal file
View File

@ -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)))

29
src/propeller/selection.cljc Normal file
View File

@ -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)))

62
src/propeller/session.cljc Normal file
View File

@ -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})

33
src/propeller/tools/calculus.cljc Normal file
View File

@ -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))))))))

18
src/propeller/tools/character.cljc Normal file
View File

@ -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)))

59
src/propeller/tools/distributions.cljc Normal file
View File

@ -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...

104
src/propeller/tools/math.cljc Normal file
View File

@ -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)))

58
src/propeller/tools/metrics.cljc Normal file
View File

@ -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))))

36
src/propeller/utils.cljc Normal file
View File

@ -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)))

52
src/propeller/variation.cljc Normal file
View File

@ -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))))})