Mercurial > vba-clojure
changeset 316:d263df762c59
greatly speed up scroll-text by using binary-search.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Mon, 02 Apr 2012 21:20:54 -0500 |
parents | 363b650a77cc |
children | 3c5bf2221ea0 |
files | clojure/com/aurellem/gb/gb_driver.clj clojure/com/aurellem/gb/saves.clj clojure/com/aurellem/gb/util.clj clojure/com/aurellem/run/util.clj save-states/oak-battle.sav |
diffstat | 5 files changed, 65 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
1.1 --- a/clojure/com/aurellem/gb/gb_driver.clj Mon Apr 02 20:30:28 2012 -0500 1.2 +++ b/clojure/com/aurellem/gb/gb_driver.clj Mon Apr 02 21:20:54 2012 -0500 1.3 @@ -142,7 +142,7 @@ 1.4 ([] 1.5 (continue! @current-state))) 1.6 1.7 -(defn run-moves [state moves] 1.8 +(defn run-moves [moves state] 1.9 (set-state! state) 1.10 (dorun (map #(Gb/step (button-mask %)) 1.11 moves))
2.1 --- a/clojure/com/aurellem/gb/saves.clj Mon Apr 02 20:30:28 2012 -0500 2.2 +++ b/clojure/com/aurellem/gb/saves.clj Mon Apr 02 21:20:54 2012 -0500 2.3 @@ -15,4 +15,7 @@ 2.4 (read-state "talk-to-oak")) 2.5 2.6 (defn normal-conv [] 2.7 - (read-state "normal-conversation")) 2.8 \ No newline at end of file 2.9 + (read-state "normal-conversation")) 2.10 + 2.11 +(defn oak-battle [] 2.12 + (read-state "oak-battle")) 2.13 \ No newline at end of file
3.1 --- a/clojure/com/aurellem/gb/util.clj Mon Apr 02 20:30:28 2012 -0500 3.2 +++ b/clojure/com/aurellem/gb/util.clj Mon Apr 02 21:20:54 2012 -0500 3.3 @@ -154,7 +154,7 @@ 3.4 (zipmap backbone 3.5 (apply (partial map list) seqs)))))) 3.6 3.7 -(defn temporal-compare [& states] 3.8 +(defn memory-compare [& states] 3.9 (apply common-differences 3.10 (map (comp vec memory) 3.11 states)))
4.1 --- a/clojure/com/aurellem/run/util.clj Mon Apr 02 20:30:28 2012 -0500 4.2 +++ b/clojure/com/aurellem/run/util.clj Mon Apr 02 21:20:54 2012 -0500 4.3 @@ -30,6 +30,55 @@ 4.4 [new-actions new-state] 4.5 (recur new-actions new-state)))))) 4.6 4.7 + 4.8 +(defn binary-search [metric] 4.9 + (let [baseline (metric 0)] 4.10 + (loop [low 1 4.11 + high 2] 4.12 + (let [low-val (metric low) 4.13 + high-val (metric high)] 4.14 + (println low high) 4.15 + (cond 4.16 + ;; base case 4.17 + (and (= low (dec high)) 4.18 + (not= low-val high-val)) 4.19 + high 4.20 + ;; exponential growth 4.21 + (= baseline high-val low-val) 4.22 + (recur high (* high 2)) 4.23 + 4.24 + ;; binary search 4.25 + (and (= baseline low-val) 4.26 + (not= baseline high-val)) 4.27 + (let [test (int (/ (+ low high) 2)) 4.28 + test-val (metric test)] 4.29 + (if (= test-val baseline) 4.30 + (recur test high) 4.31 + (recur low test)))))))) 4.32 + 4.33 +(defn delayed-difference 4.34 + [base alt delay difference-metric [moves root :as script]] 4.35 + (let [generator 4.36 + (memoize 4.37 + (fn [n] 4.38 + (run-moves 4.39 + root 4.40 + (repeat n base)))) 4.41 + len 4.42 + (binary-search 4.43 + (fn [n] 4.44 + (= (difference-metric 4.45 + (run-moves 4.46 + (generator n) 4.47 + (concat [alt] (repeat delay base)))) 4.48 + (difference-metric 4.49 + (run-moves 4.50 + (generator n) 4.51 + (repeat (inc delay) base)))))) 4.52 + new-moves (concat moves (repeat len base) [alt]) 4.53 + new-state (run-moves (generator len) [alt])] 4.54 + [new-moves new-state])) 4.55 + 4.56 (defn delayed-difference 4.57 [base alt delay difference-metric [moves root :as script]] 4.58 (loop [branch-point root 4.59 @@ -49,6 +98,10 @@ 4.60 (recur base-branch (conj actions base)))))) 4.61 4.62 4.63 + 4.64 + 4.65 + 4.66 + 4.67 4.68 ;; (defn advance 4.69 ;; ([base alt difference-metric [commands state]] 4.70 @@ -146,9 +199,12 @@ 4.71 4.72 4.73 4.74 -(common-differences 4.75 - (vec (memory (step (talk-to-oak) [:a]))) 4.76 - (vec (memory (step (talk-to-oak) [])))) 4.77 +(memory-compare 4.78 + (step (talk-to-oak) [:a]) 4.79 + (step (talk-to-oak) []) 4.80 + (step (oak-battle) []) 4.81 + (step (oak-battle) [:a])) 4.82 + 4.83 4.84 4.85
5.1 Binary file save-states/oak-battle.sav has changed