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

New structure

Browse Source
This commit is contained in:
mcgirjau 2020-06-23 11:09:15 -04:00
parent c6f9b58556
commit af033c1b0e
17 changed files with 573 additions and 325 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/propeller/core.clj
View File

@ -1,6 +1,8 @@
(ns propeller.core (ns propeller.core
(:gen-class) (:gen-class)
(:use [propeller instructions gp problems])) (:use propeller.gp
propeller.push.instructions
[propeller.problems simple-regression string-classification]))
(defn -main (defn -main
"Runs propel-gp, giving it a map of arguments." "Runs propel-gp, giving it a map of arguments."
@ -14,8 +16,8 @@
:step-limit 100 :step-limit 100
:parent-selection :lexicase :parent-selection :lexicase
:tournament-size 5 :tournament-size 5
:UMADRate 0.1 :umad-rate 0.1
:variation {:UMAD 0.5 :crossover 0.5} :variation {:umad 0.5 :crossover 0.5}
:elitism false} :elitism false}
(apply hash-map (apply hash-map
(map read-string args))) (map read-string args)))

2
src/propeller/genome.clj
View File

@ -1,5 +1,5 @@
(ns propeller.genome (ns propeller.genome
(:use [propeller instructions])) (:use propeller.push.instructions))
(defn push-from-plushy (defn push-from-plushy
"Returns the Push program expressed by the given plushy representation." "Returns the Push program expressed by the given plushy representation."

7
src/propeller/gp.clj
View File

@ -1,7 +1,6 @@
(ns propeller.gp (ns propeller.gp
(:use [propeller genome variation])) (:use [propeller genome variation]))
(defn report (defn report
"Reports information each generation." "Reports information each generation."
[pop generation] [pop generation]
@ -14,8 +13,10 @@
(println "Best total error:" (:total-error best)) (println "Best total error:" (:total-error best))
(println "Best errors:" (:errors best)) (println "Best errors:" (:errors best))
(println "Best behaviors:" (:behaviors best)) (println "Best behaviors:" (:behaviors best))
(println "Genotypic diversity:" (float (/ (count (distinct (map :plushy pop))) (count pop)))) (println "Genotypic diversity:"
(println "Average genome length:" (float (/ (reduce + (map count (map :plushy pop))) (count pop)))) (float (/ (count (distinct (map :plushy pop))) (count pop))))
(println "Average genome length:"
(float (/ (reduce + (map count (map :plushy pop))) (count pop))))
(println))) (println)))
(defn gp (defn gp

163
src/propeller/instructions.clj
View File

@ -1,163 +0,0 @@
(ns propeller.instructions
(:use [propeller util pushstate]))
; Instructions must all be either functions that take one Push state and return another
; or constant literals.
; TMH: ERCs?
(def default-instructions
(list
'in1
'integer_+
'integer_-
'integer_*
'integer_%
'integer_=
'exec_dup
'exec_if
'boolean_and
'boolean_or
'boolean_not
'boolean_=
'string_=
'string_take
'string_drop
'string_reverse
'string_concat
'string_length
'string_includes?
'close
0
1
true
false
""
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"A"
"C"
"G"
"T"))
(def opens ; number of blocks opened by instructions (default = 0)
{'exec_dup 1
'exec_if 2})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; actual instructions
(defn make-push-instruction
"A utility function for making Push instructions. Takes a state, the 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 (taken from the stacks) and pushes
the return value onto return-stack."
[state function arg-stacks return-stack]
(let [args-pop-result (get-args-from-stacks state arg-stacks)]
(if (= args-pop-result :not-enough-args)
state
(let [result (apply function (:args args-pop-result))
new-state (:state args-pop-result)]
(push-to-stack new-state return-stack result)))))
;;;;;;;;;
;; Instructions
(defn in1
"Pushes the input labeled :in1 on the inputs map onto the :exec stack."
[state]
(push-to-stack state :exec (:in1 (:input state))))
(defn integer_+
[state]
(make-push-instruction state +' [:integer :integer] :integer))
(defn integer_-
[state]
(make-push-instruction state -' [:integer :integer] :integer))
(defn integer_*
[state]
(make-push-instruction state *' [:integer :integer] :integer))
(defn integer_%
[state]
(make-push-instruction state
(fn [int1 int2]
(if (zero? int2)
int1
(quot int1 int2)))
[:integer :integer]
:integer))
(defn integer_=
[state]
(make-push-instruction state = [:integer :integer] :boolean))
(defn exec_dup
[state]
(if (empty-stack? state :exec)
state
(push-to-stack state :exec (first (:exec state)))))
(defn exec_if
[state]
(make-push-instruction state
#(if %1 %3 %2)
[:boolean :exec :exec]
:exec))
(defn boolean_and
[state]
(make-push-instruction state #(and %1 %2) [:boolean :boolean] :boolean))
(defn boolean_or
[state]
(make-push-instruction state #(or %1 %2) [:boolean :boolean] :boolean))
(defn boolean_not
[state]
(make-push-instruction state not [:boolean] :boolean))
(defn boolean_=
[state]
(make-push-instruction state = [:boolean :boolean] :boolean))
(defn string_=
[state]
(make-push-instruction state = [:string :string] :boolean))
(defn string_take
[state]
(make-push-instruction state
#(apply str (take %1 %2))
[:integer :string]
:string))
(defn string_drop
[state]
(make-push-instruction state
#(apply str (drop %1 %2))
[:integer :string]
:string))
(defn string_reverse
[state]
(make-push-instruction state
#(apply str (reverse %))
[:string]
:string))
(defn string_concat
[state]
(make-push-instruction state
#(apply str (concat %1 %2))
[:string :string]
:string))
(defn string_length
[state]
(make-push-instruction state count [:string] :integer))
(defn string_includes?
[state]
(make-push-instruction state clojure.string/includes? [:string :string] :boolean))

74
src/propeller/problems.clj
View File

@ -1,74 +0,0 @@
(ns propeller.problems
(:use [propeller util genome pushstate interpreter]))
;;;;;;;;;
;; 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))
(defn regression-error-function
"Finds the behaviors and errors of an individual: 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 (push-from-plushy (:plushy individual))
inputs (range -10 11)
correct-outputs (map target-function inputs)
outputs (map (fn [input]
(peek-stack
(interpret-program
program
(assoc empty-push-state :input {:in1 input})
(:step-limit argmap))
:integer))
inputs)
errors (map (fn [correct-output output]
(if (= output :no-stack-item)
1000000
(abs (- correct-output output))))
correct-outputs
outputs)]
(assoc individual
:behaviors outputs
:errors errors
:total-error (apply +' errors))))
;;;;;;;;;
;; String classification
(defn string-classification-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 (push-from-plushy (:plushy individual))
inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"]
correct-outputs [false false false false true true true]
outputs (map (fn [input]
(peek-stack
(interpret-program
program
(assoc empty-push-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))))

46
src/propeller/problems/simple_regression.clj Normal file
View File

@ -0,0 +1,46 @@
(ns propeller.problems.simple-regression
(:use propeller.genome
[propeller.push state interpreter])
(:require [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))
(defn regression-error-function
"Finds the behaviors and errors of an individual: 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 (push-from-plushy (:plushy individual))
inputs (range -10 11)
correct-outputs (map target-function inputs)
outputs (map (fn [input]
(peek-stack
(interpret-program
program
(assoc 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))))

37
src/propeller/problems/string_classification.clj Normal file
View File

@ -0,0 +1,37 @@
(ns propeller.problems.string-classification
(:use propeller.genome
[propeller.push state interpreter]))
;; =============================================================================
;; String classification
;; =============================================================================
(defn string-classification-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 (push-from-plushy (:plushy individual))
inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"]
correct-outputs [false false false false true true true]
outputs (map (fn [input]
(peek-stack
(interpret-program
program
(assoc 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))))

294
src/propeller/push/instructions.clj Normal file
View File

@ -0,0 +1,294 @@
(ns propeller.push.instructions
(:use propeller.push.state)
(:require [tools.character :as char]))
;; =============================================================================
;; PushGP Instructions
;;
;; Instructions must all be either functions that take one Push state and
;; return another, or constant literals.
;;
;; TMH: ERCs?
;; =============================================================================
(defn make-instruction
"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."
[state function arg-stacks return-stack]
(let [popped-args (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)]
(push-to-stack new-state return-stack result)))))
;; Original propel instructions
(def default-instructions
(list
'in1
'integer_+
'integer_-
'integer_*
'integer_%
'integer_=
'exec_dup
'exec_if
'boolean_and
'boolean_or
'boolean_not
'boolean_=
'string_=
'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})
;; =============================================================================
;; BOOLEAN
;; =============================================================================
(defn boolean_=
"Pushes TRUE if the top two BOOLEANs are equal, and FALSE otherwise."
[state]
(make-instruction state = [:boolean :boolean] :boolean))
(defn boolean_and
[state]
"Pushes the logical AND of the top two BOOLEANs."
(make-instruction state #(and %1 %2) [:boolean :boolean] :boolean))
(defn boolean_or
[state]
"Pushes the logical OR of the top two BOOLEANs."
(make-instruction state #(or %1 %2) [:boolean :boolean] :boolean))
(defn boolean_not
[state]
"Pushes the logical NOT of the top BOOLEAN."
(make-instruction state not [:boolean] :boolean))
(defn boolean_xor
[state]
"Pushes the logical XOR of the top two BOOLEANs."
(make-instruction state #(or (and %1 (not %2))
(and (not %1) %2))
[:boolean :boolean]
:boolean))
(defn boolean_invert_first_then_and
[state]
"Pushes the logical AND of the top two BOOLEANs, after applying NOT to the
first one."
(make-instruction state #(and %1 (not %2)) [:boolean :boolean] :boolean))
(defn boolean_invert_second_then_and
[state]
"Pushes the logical AND of the top two BOOLEANs, after applying NOT to the
second one."
(make-instruction state #(and (not %1) %2) [:boolean :boolean] :boolean))
(defn boolean_fromfloat
[state]
"Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise."
(make-instruction state #(not (zero? %)) [:float] :boolean))
(defn boolean_frominteger
[state]
"Pushes FALSE if the top INTEGER is 0, and TRUE otherwise."
(make-instruction state #(not (zero? %)) [:integer] :boolean))
;; =============================================================================
;; CHAR
;; =============================================================================
(defn char_isletter
"Pushes TRUE onto the BOOLEAN stack if the popped character is a letter."
[state]
(make-instruction state char/is-letter [:char] :boolean))
(defn char_isdigit
"Pushes TRUE onto the BOOLEAN stack if the popped character is a digit."
[state]
(make-instruction state char/is-digit [:char] :boolean))
(defn char_iswhitespace
"Pushes TRUE onto the BOOLEAN stack if the popped character is whitespace
(newline, space, or tab)."
[state]
(make-instruction state char/is-whitespace [:char] :boolean))
(defn char_allfromstring
"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."
[state]
(make-instruction state #(map char %) [:string] :char))
(defn char_frominteger
"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."
[state]
(make-instruction state #(char (mod % 128)) [:integer] :char))
(defn char_fromfloat
"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."
[state]
(make-instruction state #(char (mod (long %) 128)) [:float] :char))
;; =============================================================================
;; CODE
;; =============================================================================
;; ...to be added
;; =============================================================================
;; EXEC
;; =============================================================================
(defn exec_dup
[state]
(if (empty-stack? state :exec)
state
(push-to-stack state :exec (first (:exec state)))))
(defn exec_if
[state]
(make-instruction state #(if %1 %3 %2) [:boolean :exec :exec] :exec))
;; =============================================================================
;; ENVIRONMENT
;; =============================================================================
;; ...to be added
;; =============================================================================
;; GENETIC TURING MACHINE
;; =============================================================================
;; ...to be added
;; =============================================================================
;; GENOME
;; =============================================================================
;; ...to be added
;; =============================================================================
;; INPUT-OUTPUT
;; =============================================================================
(defn in1
"Pushes the input labeled :in1 on the inputs map onto the :exec stack."
[state]
(push-to-stack state :exec (:in1 (:input state))))
;; =============================================================================
;; INTEGER AND FLOAT
;; =============================================================================
(defn integer_=
[state]
(make-instruction state = [:integer :integer] :boolean))
(defn integer_+
[state]
(make-instruction state +' [:integer :integer] :integer))
(defn integer_-
[state]
(make-instruction state -' [:integer :integer] :integer))
(defn integer_*
[state]
(make-instruction state *' [:integer :integer] :integer))
(defn integer_%
[state]
(make-instruction state
(fn [int1 int2]
(if (zero? int2) int1 (quot int1 int2)))
[:integer :integer]
:integer))
;; =============================================================================
;; RANDOM
;; =============================================================================
(defn boolean_rand
[state]
"Pushes a random BOOLEAN."
(make-instruction state #(rand-nth [true false]) [] :boolean))
;; =============================================================================
;; STRING
;; =============================================================================
(defn string_=
[state]
(make-instruction state = [:string :string] :boolean))
(defn string_concat
[state]
(make-instruction state #(apply str (concat %1 %2)) [:string :string] :string))
(defn string_drop
[state]
(make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string))
(defn string_includes?
[state]
(make-instruction state clojure.string/includes? [:string :string] :boolean))
(defn string_length
[state]
(make-instruction state count [:string] :integer))
(defn string_reverse
[state]
(make-instruction state #(apply str (reverse %)) [:string] :string))
(defn string_take
[state]
(make-instruction state #(apply str (take %1 %2)) [:integer :string] :string))
;; =============================================================================
;; TAG
;; =============================================================================
;; ...to be added
;; =============================================================================
;; VECTOR
;; =============================================================================
;; ...to be added
;; =============================================================================
;; ZIP
;; =============================================================================
;; ...to be added

6
src/propeller/interpreter.clj → src/propeller/push/interpreter.clj
View File

@ -1,5 +1,5 @@
(ns propeller.interpreter (ns propeller.push.interpreter
(:use [propeller util pushstate instructions])) (:use [propeller.push state instructions]))
(defn interpret-one-step (defn interpret-one-step
"Takes a Push state and executes the next instruction on the exec stack." "Takes a Push state and executes the next instruction on the exec stack."
@ -37,5 +37,3 @@
(> (:step state) step-limit)) (> (:step state) step-limit))
state state
(recur (update (interpret-one-step state) :step inc))))) (recur (update (interpret-one-step state) :step inc)))))

88
src/propeller/push/state.clj Normal file
View File

@ -0,0 +1,88 @@
(ns propeller.push.state)
;; Set of all stacks used by the Push interpreter
(defonce ^:private stack-types #{:auxiliary
:boolean
:char
:code
:environment
:exec
:float
:genome
:gtm
:input
:integer
:output
:return
:string
:tag
:vector_boolean
:vector_float
:vector_integer
:vector_string
:zip})
;; Record-based states for performance
(defmacro define-push-state []
`(defrecord ~'State [~@(map #(symbol (name %)) stack-types)]))
(define-push-state)
;; Empty push state - each stack type is nil
(defonce empty-state (map->State {}))
(def example-push-state
{:exec '()
:integer '(1 2 3 4 5 6 7)
:string '("abc")
:input {:in1 4}})
(defn print-state
"Pretty-prints a Push state, for logging or debugging purposes."
[state]
(doseq [stack stack-types]
(printf "%-15s = " stack)
(prn (if (get state stack) (get state stack) '()))
(flush)))
(defn empty-stack?
"Returns true if the stack is empty."
[state stack]
(empty? (get state stack)))
(defn peek-stack
"Returns top item on a stack."
[state stack]
(let [working-stack (get state stack)]
(if (empty? working-stack)
:no-stack-item
(first working-stack))))
(defn pop-stack
"Removes top item of stack."
[state stack]
(update state stack rest))
(defn push-to-stack
"Pushes item(s) onto stack."
[state stack items]
(update state stack (if (seq? items) into conj) items))
(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))))))))

55
src/propeller/pushstate.clj
View File

@ -1,55 +0,0 @@
(ns propeller.pushstate
(:use [propeller util]))
(def example-push-state
{:exec '()
:integer '(1 2 3 4 5 6 7)
:string '("abc")
:input {:in1 4}})
(def empty-push-state
{:exec '()
:integer '()
:string '()
:boolean '()
:input {}})
(defn push-to-stack
"Pushes item onto stack in state"
[state stack item]
(update state stack conj item))
(defn pop-stack
"Removes top item of stack."
[state stack]
(update state stack rest))
(defn peek-stack
"Returns top item on a stack."
[state stack]
(if (empty? (get state stack))
:no-stack-item
(first (get state stack))))
(defn empty-stack?
"Returns true if the stack is empty."
[state stack]
(empty? (get state stack)))
(defn get-args-from-stacks
"Takes a state and a list of stacks to take args from. If there are enough args
on each of the desired stacks, returns a map of the form {:state :args}, where
:state is the new state and :args is a list of args from the stacks. If there
aren't enough args on the stacks, returns :not-enough-args."
[state stacks]
(loop [state state
stacks (reverse stacks)
args '()]
(if (empty? stacks)
{:state state :args args}
(let [stack (first stacks)]
(if (empty-stack? state stack)
:not-enough-args
(recur (pop-stack state stack)
(rest stacks)
(conj args (peek-stack state stack))))))))

5
src/propeller/session.clj
View File

@ -1,6 +1,7 @@
(ns propeller.session (ns propeller.session
(:use [propeller core problems gp variation selection genome interpreter instructions pushstate util])) (:use [propeller core gp variation selection genome]
[propeller.push interpreter instructions state]
[propeller.problems simple-regression string-classification]))
#_(interpret-program '(1 2 integer_+) empty-push-state 1000) #_(interpret-program '(1 2 integer_+) empty-push-state 1000)

9
src/propeller/util.clj
View File

@ -1,14 +1,5 @@
(ns propeller.util) (ns propeller.util)
(defn abs
"Absolute value."
[x]
(if (neg? x)
(- x)
x))
(defn not-lazy (defn not-lazy
"Returns lst if it is not a list, or a non-lazy version of lst if it is." "Returns lst if it is not a list, or a non-lazy version of lst if it is."
[lst] [lst]

17
src/propeller/variation.clj
View File

@ -16,19 +16,20 @@
longer)))) longer))))
(defn uniform-addition (defn uniform-addition
"Returns plushy with new instructions possibly added before or after each existing instruction." "Returns plushy with new instructions possibly added before or after each
[plushy instructions UMADRate] existing instruction."
[plushy instructions umad-rate]
(apply concat (apply concat
(map #(if (< (rand) UMADRate) (map #(if (< (rand) umad-rate)
(shuffle [% (rand-nth instructions)]) (shuffle [% (rand-nth instructions)])
[%]) [%])
plushy))) plushy)))
(defn uniform-deletion (defn uniform-deletion
"Randomly deletes instructions from plushy at some rate." "Randomly deletes instructions from plushy at some rate."
[plushy UMADRate] [plushy umad-rate]
(remove (fn [_] (< (rand) (remove (fn [_] (< (rand)
(/ 1 (+ 1 (/ 1 UMADRate))))) (/ 1 (+ 1 (/ 1 umad-rate)))))
plushy)) plushy))
(defn new-individual (defn new-individual
@ -42,9 +43,9 @@
(crossover (:plushy (select-parent pop argmap)) (crossover (:plushy (select-parent pop argmap))
(:plushy (select-parent pop argmap))) (:plushy (select-parent pop argmap)))
(< prob (+ (:crossover (:variation argmap)) (< prob (+ (:crossover (:variation argmap))
(:UMAD (:variation argmap)) 2)) (:umad (:variation argmap)) 2))
(uniform-deletion (uniform-addition (:plushy (select-parent pop argmap)) (uniform-deletion (uniform-addition (:plushy (select-parent pop argmap))
(:instructions argmap) (:instructions argmap)
(:UMADRate argmap)) (:umad-rate argmap))
(:UMADRate argmap)) (:umad-rate argmap))
:else (:plushy (select-parent pop argmap))))}) :else (:plushy (select-parent pop argmap))))})

18
src/tools/character.clj Normal file
View File

@ -0,0 +1,18 @@
(ns 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)))

5
src/tools/math.cljc
View File

@ -28,6 +28,11 @@
#?(:clj (Math/cos x) #?(:clj (Math/cos x)
:cljs (js/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 (defn exp
"Returns Euler's number (approx. 2.71) raised to the given power." "Returns Euler's number (approx. 2.71) raised to the given power."
[x] [x]

58
src/tools/metrics.clj Normal file
View File

@ -0,0 +1,58 @@
(ns tools.metrics
(:require [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))))