Mercurial > vba-clojure
diff clojure/com/aurellem/run/util.clj @ 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 | 073600cba28a |
children | 3c5bf2221ea0 |
line wrap: on
line diff
1.1 --- a/clojure/com/aurellem/run/util.clj Mon Apr 02 20:30:28 2012 -0500 1.2 +++ b/clojure/com/aurellem/run/util.clj Mon Apr 02 21:20:54 2012 -0500 1.3 @@ -30,6 +30,55 @@ 1.4 [new-actions new-state] 1.5 (recur new-actions new-state)))))) 1.6 1.7 + 1.8 +(defn binary-search [metric] 1.9 + (let [baseline (metric 0)] 1.10 + (loop [low 1 1.11 + high 2] 1.12 + (let [low-val (metric low) 1.13 + high-val (metric high)] 1.14 + (println low high) 1.15 + (cond 1.16 + ;; base case 1.17 + (and (= low (dec high)) 1.18 + (not= low-val high-val)) 1.19 + high 1.20 + ;; exponential growth 1.21 + (= baseline high-val low-val) 1.22 + (recur high (* high 2)) 1.23 + 1.24 + ;; binary search 1.25 + (and (= baseline low-val) 1.26 + (not= baseline high-val)) 1.27 + (let [test (int (/ (+ low high) 2)) 1.28 + test-val (metric test)] 1.29 + (if (= test-val baseline) 1.30 + (recur test high) 1.31 + (recur low test)))))))) 1.32 + 1.33 +(defn delayed-difference 1.34 + [base alt delay difference-metric [moves root :as script]] 1.35 + (let [generator 1.36 + (memoize 1.37 + (fn [n] 1.38 + (run-moves 1.39 + root 1.40 + (repeat n base)))) 1.41 + len 1.42 + (binary-search 1.43 + (fn [n] 1.44 + (= (difference-metric 1.45 + (run-moves 1.46 + (generator n) 1.47 + (concat [alt] (repeat delay base)))) 1.48 + (difference-metric 1.49 + (run-moves 1.50 + (generator n) 1.51 + (repeat (inc delay) base)))))) 1.52 + new-moves (concat moves (repeat len base) [alt]) 1.53 + new-state (run-moves (generator len) [alt])] 1.54 + [new-moves new-state])) 1.55 + 1.56 (defn delayed-difference 1.57 [base alt delay difference-metric [moves root :as script]] 1.58 (loop [branch-point root 1.59 @@ -49,6 +98,10 @@ 1.60 (recur base-branch (conj actions base)))))) 1.61 1.62 1.63 + 1.64 + 1.65 + 1.66 + 1.67 1.68 ;; (defn advance 1.69 ;; ([base alt difference-metric [commands state]] 1.70 @@ -146,9 +199,12 @@ 1.71 1.72 1.73 1.74 -(common-differences 1.75 - (vec (memory (step (talk-to-oak) [:a]))) 1.76 - (vec (memory (step (talk-to-oak) [])))) 1.77 +(memory-compare 1.78 + (step (talk-to-oak) [:a]) 1.79 + (step (talk-to-oak) []) 1.80 + (step (oak-battle) []) 1.81 + (step (oak-battle) [:a])) 1.82 + 1.83 1.84 1.85