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

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

@ -4,7 +4,7 @@
[propeller.push.interpreter :as interpreter] [propeller.push.interpreter :as interpreter]
[propeller.problems.data-creation :as dc] [propeller.problems.data-creation :as dc]
[propeller.utils :as utils] [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.push.state :as state]
[propeller.tools.math :as math] [propeller.tools.math :as math]
[propeller.gp :as gp] [propeller.gp :as gp]
@ -25,11 +25,29 @@
[i] [i]
(vals (select-keys i [:output1 :output2]))) (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 (def instructions
(utils/not-lazy (utils/not-lazy
(concat (concat
;;; stack-specific instructions ;;; 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 ;;; input instructions
(list :in1 :in2) (list :in1 :in2)
;;; close ;;; close
@ -43,31 +61,24 @@
inputs (map (fn [i] (map-vals-input i)) data) inputs (map (fn [i] (map-vals-input i)) data)
correct-outputs (map (fn [i] (map-vals-output i)) data) correct-outputs (map (fn [i] (map-vals-output i)) data)
outputs (map (fn [input] outputs (map (fn [input]
(state/peek-stack (:output
(interpreter/interpret-program (interpreter/interpret-program
program program
(assoc state/empty-state :input {:in1 (nth input 0) (assoc state/empty-state :input {:in1 (nth input 0)
:in2 (nth input 1)}) :in2 (nth input 1)})
(:step-limit argmap)) (:step-limit argmap))))
:print))
inputs) inputs)
parsed-outputs (map (fn [output] outputs-1 (map #(:out1 %) outputs)
(try (read-string (str "(" output ")")) outputs-2 (map #(:out2 %) outputs)
#?(:clj (catch Exception e 1000000.0) _ (prn {:o1 outputs-1 :o2 outputs-2})
:cljs (catch js/Error. e 1000000.0)))) errors (map (fn [correct-output output-1 output-2]
outputs) (if (not (and (number? output-2) (number? output-1)))
errors (map (fn [correct-output output] 100000
(if (not= (count output) (count correct-output)) (+ (math/abs (- (first correct-output) output-1))
1000000.0 (math/abs (- (second correct-output) output-2)))))
(apply + (map (fn [c o] (if (and (number? c) (number? o)) correct-outputs outputs-1 outputs-2)]
(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)})
]
(assoc individual (assoc individual
:behaviors parsed-outputs :behavior outputs
:errors errors :errors errors
:total-error #?(:clj (apply +' errors) :total-error #?(:clj (apply +' errors)
:cljs (apply + errors))))) :cljs (apply + errors)))))