Mercurial > vba-clojure

comparison clojure/com/aurellem/run/util.clj @ 316:d263df762c59

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
315:363b650a77cc 316:d263df762c59
27 (let [new-state (step state buttons) 27 (let [new-state (step state buttons)
28 new-actions (conj actions buttons)] 28 new-actions (conj actions buttons)]
29 (if (not= (metric new-state) baseline) 29 (if (not= (metric new-state) baseline)
30 [new-actions new-state] 30 [new-actions new-state]
31 (recur new-actions new-state)))))) 31 (recur new-actions new-state))))))
32
33
34 (defn binary-search [metric]
35 (let [baseline (metric 0)]
36 (loop [low 1
37 high 2]
38 (let [low-val (metric low)
39 high-val (metric high)]
40 (println low high)
41 (cond
42 ;; base case
43 (and (= low (dec high))
44 (not= low-val high-val))
45 high
46 ;; exponential growth
47 (= baseline high-val low-val)
48 (recur high (* high 2))
49
50 ;; binary search
51 (and (= baseline low-val)
52 (not= baseline high-val))
53 (let [test (int (/ (+ low high) 2))
54 test-val (metric test)]
55 (if (= test-val baseline)
56 (recur test high)
57 (recur low test))))))))
58
59 (defn delayed-difference
60 [base alt delay difference-metric [moves root :as script]]
61 (let [generator
62 (memoize
63 (fn [n]
64 (run-moves
65 root
66 (repeat n base))))
67 len
68 (binary-search
69 (fn [n]
70 (= (difference-metric
71 (run-moves
72 (generator n)
73 (concat [alt] (repeat delay base))))
74 (difference-metric
75 (run-moves
76 (generator n)
77 (repeat (inc delay) base))))))
78 new-moves (concat moves (repeat len base) [alt])
79 new-state (run-moves (generator len) [alt])]
80 [new-moves new-state]))
32 81
33 (defn delayed-difference 82 (defn delayed-difference
34 [base alt delay difference-metric [moves root :as script]] 83 [base alt delay difference-metric [moves root :as script]]
35 (loop [branch-point root 84 (loop [branch-point root
36 actions moves] 85 actions moves]
47 (if (not= base-val alt-val) 96 (if (not= base-val alt-val)
48 [(conj actions alt) alt-branch] 97 [(conj actions alt) alt-branch]
49 (recur base-branch (conj actions base)))))) 98 (recur base-branch (conj actions base))))))
50 99
51 100
101
102
103
104
52 105
53 ;; (defn advance 106 ;; (defn advance
54 ;; ([base alt difference-metric [commands state]] 107 ;; ([base alt difference-metric [commands state]]
55 ;; (let [[c s] 108 ;; (let [[c s]
56 ;; (first-difference base alt difference-metric state)] 109 ;; (first-difference base alt difference-metric state)]
144 (scroll-text) 197 (scroll-text)
145 (play-moves [[] [:a]]))) 198 (play-moves [[] [:a]])))
146 199
147 200
148 201
149 (common-differences 202 (memory-compare
150 (vec (memory (step (talk-to-oak) [:a]))) 203 (step (talk-to-oak) [:a])
151 (vec (memory (step (talk-to-oak) [])))) 204 (step (talk-to-oak) [])
205 (step (oak-battle) [])
206 (step (oak-battle) [:a]))
207
152 208
153 209
154 210
155 211
156 212