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

fix find-pair (maybe)

Browse Source
This commit is contained in:
Ryan Boldi 2022-08-16 11:13:25 -04:00
parent 239de881ce
commit 0ffed2b56c
1 changed files with 61 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
src/propeller/problems/PSB2/find_pair.cljc
View File

@ -4,7 +4,7 @@
[propeller.push.interpreter :as interpreter]
[propeller.problems.data-creation :as dc]
[propeller.utils :as utils]
[propeller.push.instructions :refer [get-stack-instructions]]
[propeller.push.instructions :refer [def-instruction get-stack-instructions]]
[propeller.push.state :as state]
[propeller.tools.math :as math]
[propeller.gp :as gp]
@ -25,17 +25,35 @@
[i]
(vals (select-keys i [:output1 :output2])))
(def-instruction :output-one
^{:stacks #{:integer :output}}
(fn [state]
(if (empty? (:integer state))
state
(let [top-int (state/peek-stack state :input)]
(assoc-in state [:output :out1] top-int)))))
(def-instruction :output-two
^{:stacks #{:integer :output}}
(fn [state]
(if (empty? (:integer state))
state
(let [top-int (state/peek-stack state :input)]
(assoc-in state [:output :out2] top-int)))))
(def instructions
(utils/not-lazy
(concat
(concat
;;; stack-specific instructions
(get-stack-instructions #{:exec :integer :vector_integer :boolean :print})
(get-stack-instructions #{:exec :integer :vector_integer :boolean})
(list :output-one :output-two)
;;; input instructions
(list :in1 :in2)
(list :in1 :in2)
;;; close
(list 'close)
(list 'close)
;;; ERCs (constants)
(list -1 0 1 2 random-int))))
(list -1 0 1 2 random-int))))
(defn error-function
[argmap data individual]
@ -43,55 +61,48 @@
inputs (map (fn [i] (map-vals-input i)) data)
correct-outputs (map (fn [i] (map-vals-output i)) data)
outputs (map (fn [input]
(state/peek-stack
(interpreter/interpret-program
program
(assoc state/empty-state :input {:in1 (nth input 0)
:in2 (nth input 1)})
(:step-limit argmap))
:print))
(:output
(interpreter/interpret-program
program
(assoc state/empty-state :input {:in1 (nth input 0)
:in2 (nth input 1)})
(:step-limit argmap))))
inputs)
parsed-outputs (map (fn [output]
(try (read-string (str "(" output ")"))
#?(:clj (catch Exception e 1000000.0)
:cljs (catch js/Error. e 1000000.0))))
outputs)
errors (map (fn [correct-output output]
(if (not= (count output) (count correct-output))
1000000.0
(apply + (map (fn [c o] (if (and (number? c) (number? o))
(math/abs (- c o))
1000000.0)) correct-output output))))
correct-outputs
parsed-outputs)
;null (prn {:output (first outputs) :correct-output (first correct-outputs) :parsed (first parsed-outputs) :error (first errors)})
]
outputs-1 (map #(:out1 %) outputs)
outputs-2 (map #(:out2 %) outputs)
_ (prn {:o1 outputs-1 :o2 outputs-2})
errors (map (fn [correct-output output-1 output-2]
(if (not (and (number? output-2) (number? output-1)))
100000
(+ (math/abs (- (first correct-output) output-1))
(math/abs (- (second correct-output) output-2)))))
correct-outputs outputs-1 outputs-2)]
(assoc individual
:behaviors parsed-outputs
:errors errors
:total-error #?(:clj (apply +' errors)
:cljs (apply + errors)))))
:behavior outputs
:errors errors
:total-error #?(:clj (apply +' errors)
:cljs (apply + errors)))))
(defn -main
"Runs propel-gp, giving it a map of arguments."
[& args]
(gp/gp
(merge
{:instructions instructions
:error-function error-function
:training-data train-data
:testing-data test-data
:case-t-size (count train-data)
:ds-parent-rate 0
:ds-parent-gens 1
:max-generations 300
:population-size 1000
:max-initial-plushy-size 250
:step-limit 2000
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:variation {:umad 1.0 :crossover 0.0}
:elitism false}
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
(merge
{:instructions instructions
:error-function error-function
:training-data train-data
:testing-data test-data
:case-t-size (count train-data)
:ds-parent-rate 0
:ds-parent-gens 1
:max-generations 300
:population-size 1000
:max-initial-plushy-size 250
:step-limit 2000
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:variation {:umad 1.0 :crossover 0.0}
:elitism false}
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
(#?(:clj shutdown-agents)))