Mercurial > vba-clojure
view clojure/com/aurellem/run/util.clj @ 328:35960b03693f
improved delayed-difference with memoization
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Thu, 05 Apr 2012 15:05:08 -0500 |
parents | fe6fd2323264 |
children | a452deec2882 |
line wrap: on
line source
1 (ns com.aurellem.run.util2 (:use (com.aurellem.gb util gb-driver vbm characters saves))3 (:import [com.aurellem.gb.gb_driver SaveState]))5 (def ↑ [:u])6 (def ↓ [:d])7 (def ← [:l])8 (def → [:r])10 [↑ ↓ ← →]12 (defn do-nothing [n script]13 (->> script14 (play-moves15 (repeat n []))))17 (defn first-difference18 [base alt difference-metric [moves root :as script]]19 (loop [branch-point root20 actions moves]21 (let [base-branch (step branch-point base)22 base-val (difference-metric base-branch)23 alt-branch (step branch-point alt)24 alt-val (difference-metric alt-branch)]25 (if (not= base-val alt-val)26 [(conj actions alt) alt-branch]27 (recur base-branch (conj actions base))))))29 (defn repeat-until-different30 [buttons metric [moves root :as script]]31 (let [baseline (metric root)]32 (loop [actions (vec moves)33 state root]34 (let [new-state (step state buttons)35 new-actions (conj actions buttons)]36 (if (not= (metric new-state) baseline)37 [new-actions new-state]38 (recur new-actions new-state))))))40 (defn binary-search [metric]41 (let [baseline (metric 0)]42 (loop [low 143 high 2]44 (let [low-val (metric low)45 high-val (metric high)]46 (println low high)47 (cond48 ;; base case49 (and (= low (dec high))50 (not= low-val high-val))51 high52 ;; exponential growth53 (= baseline high-val low-val)54 (recur high (* high 2))56 ;; binary search57 (and (= baseline low-val)58 (not= baseline high-val))59 (let [test (int (/ (+ low high) 2))60 test-val (metric test)]61 (if (= test-val baseline)62 (recur test high)63 (recur low test))))))))66 (defn delayed-difference67 [base alt delay difference-metric [moves root :as script]]68 (let [generator69 (memoize70 (fn gen [n]71 (run-moves72 root73 (repeat n base))))74 len75 (binary-search76 (memoize (fn [n]77 (= (difference-metric78 (run-moves79 (generator n)80 (concat [alt] (repeat delay base))))81 (difference-metric82 (run-moves83 (generator n)84 (repeat (inc delay) base)))))))85 new-moves (concat moves (repeat len base) [alt])86 new-state (run-moves (generator len) [alt])]87 [new-moves new-state]))89 (def x-position-address 0xD361)90 (def y-position-address 0xD362)92 (defn x-position93 ([^SaveState state]94 (aget (memory state) x-position-address))95 ([] (x-position @current-state)))97 (defn y-position98 ([^SaveState state]99 (aget (memory state) y-position-address))100 ([] (y-position @current-state)))102 (defn move103 [dir script]104 (let [current-position-fn105 (cond (#{← →} dir) x-position106 (#{↑ ↓} dir) y-position)]107 (repeat-until-different dir current-position-fn script)))109 (defn walk110 "Move the character along the given directions."111 [directions script]112 (reduce (fn [script dir]113 (move dir script)) script directions))115 (defn search-string116 ([^SaveState state string]117 (let [codes118 (str->character-codes string)119 codes-length (count codes)120 mem (vec (memory state))121 mem-length (count mem)]122 (loop [idx 0]123 (if (< (- mem-length idx) codes-length)124 nil125 (if (= (subvec mem idx (+ idx codes-length))126 codes)127 idx128 (recur (inc idx)))))))129 ([string]130 (search-string @current-state string)))132 (def text-address 0x9DC1)134 (defn displayed-text135 ([^SaveState state]136 (character-codes->str137 (subvec (vec (memory state))138 text-address139 (+ text-address 82))))140 ([] (displayed-text @current-state)))142 (defn scroll-text143 ([script]144 (delayed-difference145 [:b] [:a :b] 25 displayed-text script))146 ([n script]147 (reduce (fn [script _]148 (scroll-text script))149 script150 (range n))))152 (defn end-text153 ([script]154 (->>155 script156 (do-nothing 150)157 (play-moves [[:b]]))))159 (defn delayed-improbability-search160 "insert blank frames before calling script-fn until161 metric returns true."162 [delay metric script-fn script]163 (loop [blanks 0]164 (let [new-script165 (->> script166 (play-moves167 (concat (repeat blanks [])))168 script-fn)169 future-state170 (run-moves (second new-script)171 (repeat delay []))172 result (metric future-state)]173 (if result174 (do175 (println "improbability factor:" blanks)176 new-script)177 (recur (inc blanks))))))179 (defn critical-hit180 "Put the cursor over the desired attack. This program will181 determine the appropriate amount of blank frames to182 insert before pressing [:a] to ensure that the attack is183 a critical hit."184 [script]185 (delayed-improbability-search186 400187 #(search-string % "Critical")188 (partial play-moves [[:a][]])189 script))191 (defn move-thru-grass192 [direction script]193 (delayed-improbability-search194 600195 #(nil? (search-string % "Wild"))196 (partial move direction)197 script))199 (defn walk-thru-grass200 [directions script]201 (reduce (fn [script direction]202 (move-thru-grass direction script))203 script directions))205 (defn slowly206 [delay moves script]207 (reduce208 (fn [script move]209 (->> script210 (do-nothing delay)211 (play-moves (vector move))))212 script moves))214 (defn multiple-times215 ([n command args script]216 (reduce (fn [script _]217 (apply command (concat args [script])))218 script219 (range n)))220 ([n command script]221 (multiple-times n command [] script)))