comparison clojure/com/aurellem/run/util.clj @ 329:a452deec2882

improved efficiency of delayed-difference
author Robert McIntyre <rlm@mit.edu>
date Fri, 06 Apr 2012 07:22:18 -0500
parents 35960b03693f
children abd1ca8a25cc
comparison
equal deleted inserted replaced
328:35960b03693f 329:a452deec2882
36 (if (not= (metric new-state) baseline) 36 (if (not= (metric new-state) baseline)
37 [new-actions new-state] 37 [new-actions new-state]
38 (recur new-actions new-state)))))) 38 (recur new-actions new-state))))))
39 39
40 (defn binary-search [metric] 40 (defn binary-search [metric]
41 (let [baseline (metric 0)] 41 (loop [low 0
42 (loop [low 1 42 high 1]
43 high 2] 43 (let [low-val (metric low)
44 (let [low-val (metric low) 44 high-val (metric high)]
45 high-val (metric high)] 45 (println "(" low high ")")
46 (println low high) 46 (cond
47 (cond 47 ;; base case
48 ;; base case 48 (and (= low (dec high))
49 (and (= low (dec high)) 49 (not= low-val high-val))
50 (not= low-val high-val)) 50 high
51 high 51 ;; exponential growth
52 ;; exponential growth 52 (= high-val low-val)
53 (= baseline high-val low-val) 53 (recur high (* high 2))
54 (recur high (* high 2)) 54
55 55 ;; binary search
56 ;; binary search 56 (not= low-val high-val)
57 (and (= baseline low-val) 57 (let [test (int (/ (+ low high) 2))
58 (not= baseline high-val)) 58 test-val (metric test)]
59 (let [test (int (/ (+ low high) 2)) 59 (if (= test-val low-val)
60 test-val (metric test)] 60 (recur test high)
61 (if (= test-val baseline) 61 (recur low test)))))))
62 (recur test high)
63 (recur low test))))))))
64 62
65 63
66 (defn delayed-difference 64 (defn delayed-difference
65 "determine the shortest sequence of the form:
66
67 sequence = (concat (repeat n base) alt)
68 which will cause difference-metric
69 to yield a different value between.
70
71 (concat sequence (repeat delay base))
72 and
73 (repeat (+ n 1 delay base))
74
75 This search function is good for finding the optimum keypresses
76 whose effect on the game is not revealed until several frames after
77 those keys have been pressed (such as scrolling text)."
67 [base alt delay difference-metric [moves root :as script]] 78 [base alt delay difference-metric [moves root :as script]]
68 (let [generator 79 (let [states-cache (atom {})
69 (memoize 80 generator
70 (fn gen [n] 81 ;; (memoize ;; 32947 msecs
71 (run-moves 82 ;; (fn gen [n]
83 ;; (run-moves
84 ;; root
85 ;; (repeat n base))))
86
87 (fn gen [n] ;; 21150 msecs
88 (if (= 0 n)
72 root 89 root
73 (repeat n base)))) 90 (if-let [cached (@states-cache n)]
91 cached
92 (do (swap!
93 states-cache
94 #(assoc % n
95 (run-moves
96 (gen (dec n))
97 [base])))
98 (gen n)))))
99
74 len 100 len
75 (binary-search 101 (binary-search
76 (memoize (fn [n] 102 (memoize
77 (= (difference-metric 103 (fn [n]
78 (run-moves 104 (if (= n 0) true
79 (generator n) 105 (=(difference-metric
80 (concat [alt] (repeat delay base)))) 106 (run-moves
81 (difference-metric 107 (generator n)
82 (run-moves 108 (concat [alt] (repeat delay base))))
83 (generator n) 109 (difference-metric
84 (repeat (inc delay) base))))))) 110 (generator (+ n 1 delay))))))))
85 new-moves (concat moves (repeat len base) [alt]) 111 new-moves (concat moves (repeat len base) [alt])
86 new-state (run-moves (generator len) [alt])] 112 new-state (run-moves (generator len) [alt])]
87 [new-moves new-state])) 113 [new-moves new-state]))
88 114
89 (def x-position-address 0xD361) 115 (def x-position-address 0xD361)
133 159
134 (defn displayed-text 160 (defn displayed-text
135 ([^SaveState state] 161 ([^SaveState state]
136 (character-codes->str 162 (character-codes->str
137 (subvec (vec (memory state)) 163 (subvec (vec (memory state))
138 text-address 164 (+ text-address 0)
139 (+ text-address 82)))) 165 (+ text-address 90))))
140 ([] (displayed-text @current-state))) 166 ([] (displayed-text @current-state)))
141 167
142 (defn scroll-text 168 (defn scroll-text
143 ([script] 169 ([script]
144 (delayed-difference 170 (delayed-difference