1.1 --- a/clojure/com/aurellem/run/bootstrap_0.clj	Thu Apr 05 15:05:08 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/bootstrap_0.clj	Fri Apr 06 07:22:18 2012 -0500
     1.3 @@ -368,6 +368,7 @@
     1.4  
     1.5  (defn item-quantity-selected
     1.6    ([^SaveState state]
     1.7 +     (println "items:" (aget (memory state) item-quantity-selected-address))
     1.8       (aget (memory state) item-quantity-selected-address))
     1.9    ([] (item-quantity-selected @current-state)))
    1.10  
    1.11 @@ -393,162 +394,39 @@
    1.12          difference (- n current-position)]
    1.13      (println difference)
    1.14      (set-cursor-relative difference script)))
    1.15 -  
    1.16 -(defn buy-item
    1.17 -  "Assumes that the main item-screen is up, and buys
    1.18 -   quantity of the nth item in the list, assuming that you
    1.19 -   have enough money."
    1.20 -  [n quantity script]
    1.21 -  (if (= 0  quantity)
    1.22 -    script
    1.23 -    (let [after-initial-pause
    1.24 -          (do-nothing 20  script)
    1.25 -          move-to-item
    1.26 -          (reduce (fn [script _]
    1.27 -                    (->> script
    1.28 -                         (play-moves [[:d]])
    1.29 -                         (do-nothing 3)))
    1.30 -                  after-initial-pause
    1.31 -                  (range n))
    1.32 -          select-item
    1.33 -          (play-moves [[:a]] move-to-item)
    1.34 -          request-items
    1.35 -          (reduce (fn [script _]
    1.36 -                    (->> script
    1.37 -                         (play-moves [[:u]])
    1.38 -                         (do-nothing 1)))
    1.39 -                  select-item
    1.40 -                  (range (dec quantity)))
    1.41 -          buy-items
    1.42 -          (->> request-items
    1.43 -               (do-nothing 10)
    1.44 -               (play-moves [[:a]])
    1.45 -               (scroll-text)
    1.46 -               (scroll-text)
    1.47 -               (do-nothing 10)
    1.48 -               (play-moves [[:a]])
    1.49 -               (scroll-text))]
    1.50 -      buy-items)))
    1.51 +
    1.52 +(defn set-quantity
    1.53 +  "Set the quantity of an item to buy or sell to the desired value
    1.54 +  using the fewest possible button presses."
    1.55 +  [total-quantity desired-quantity [moves state :as script]]
    1.56 +  (let [current-quantity (item-quantity-selected state)
    1.57 +        loop-point (if (> total-quantity 99) 0xFF 99)
    1.58 +        distance (- desired-quantity current-quantity)
    1.59 +        loop-distance (int(* -1 (Math/signum (float distance))
    1.60 +                             (- loop-point (Math/abs distance))))
    1.61 +        best-path (first (sort-by #(Math/abs %)
    1.62 +                                  [distance loop-distance]))
    1.63 +        direction (if (< 0 best-path) ↑ ↓)]
    1.64 +    (println "best-path" best-path)
    1.65 +    (reduce
    1.66 +     (fn [script _]
    1.67 +       (delayed-difference [] direction 200 item-quantity-selected
    1.68 +                               script))
    1.69       
    1.70 +     script
    1.71 +     (range (Math/abs best-path)))))
    1.72  
    1.73 -(defn buy-items
    1.74 -  "Given a list of [item-no quantity], buys the quantity
    1.75 -   from the shop's list. Assumes that the item list is
    1.76 -   already up."
    1.77 -  [item-pairs script]
    1.78 -  (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
    1.79 -        initial-purchase
    1.80 -        (->> script
    1.81 -             (buy-item 0 (item-lookup 0))
    1.82 -             (buy-item 1 (item-lookup 1))
    1.83 -             (buy-item 2 (item-lookup 2)))]
    1.84 -    (cond
    1.85 -      (and
    1.86 -       (not= 0 (item-lookup 3))
    1.87 -       (not= 0 (item-lookup 4)))
    1.88 -      (->> initial-purchase
    1.89 -           (do-nothing 20)
    1.90 -           (play-moves [[:d]])
    1.91 -           (do-nothing 3)
    1.92 -           (play-moves [[:d]])
    1.93 -           (do-nothing 3)
    1.94 -           (play-moves [[:d]])
    1.95 -           (do-nothing 10)
    1.96 -           (buy-item 0 (item-lookup 3))
    1.97 -           (do-nothing 20)
    1.98 -           (play-moves [[:d]])
    1.99 -           (do-nothing 3)
   1.100 -           (play-moves [[:d]])
   1.101 -           (do-nothing 3)
   1.102 -           (play-moves [[:d]])
   1.103 -           (do-nothing 10)
   1.104 -           (buy-item 0 (item-lookup 4)))
   1.105 -      (and (= 0 (item-lookup 3))
   1.106 -           (not= 0 (item-lookup 4)))
   1.107 -      (->> initial-purchase
   1.108 -           (do-nothing 20)
   1.109 -           (play-moves [[:d]])
   1.110 -           (do-nothing 3)
   1.111 -           (play-moves [[:d]])
   1.112 -           (do-nothing 3)
   1.113 -           (play-moves [[:d]])
   1.114 -           (do-nothing 10)
   1.115 -           (play-moves [[:d]])
   1.116 -           (do-nothing 10)
   1.117 -           (buy-item 0 (item-lookup 4)))
   1.118 -      (and (not= 0 (item-lookup 3))
   1.119 -           (= 0 (item-lookup 4)))
   1.120 -      (->> initial-purchase
   1.121 -           (do-nothing 20)
   1.122 -           (play-moves [[:d]])
   1.123 -           (do-nothing 3)
   1.124 -           (play-moves [[:d]])
   1.125 -           (do-nothing 3)
   1.126 -           (play-moves [[:d]])
   1.127 -           (do-nothing 10)
   1.128 -           (buy-item 0 (item-lookup 3)))
   1.129 -      (and (= 0 (item-lookup 3))
   1.130 -           (= 0 (item-lookup 4)))
   1.131 -      initial-purchase)))
   1.132 -
   1.133 -
   1.134 -(defn test-buy-items
   1.135 -  ([] (test-buy-items
   1.136 -       (walk-to-counter)))
   1.137 -  ([script]
   1.138 -     (->> [(first script) (set-money (second script)
   1.139 -                                     999999)]
   1.140 -          (play-moves
   1.141 -           [[] [:a] []])
   1.142 -          (scroll-text)
   1.143 -          (do-nothing 100)
   1.144 -          (play-moves [[:a]])
   1.145 -          (do-nothing 100)
   1.146 -          (buy-items
   1.147 -           [[0 1]
   1.148 -            [1 15]
   1.149 -            [2 1]
   1.150 -            [3 20]
   1.151 -            [4 95]
   1.152 -            ]))))
   1.153 -
   1.154 -(defn-memo buy-initial-items
   1.155 -  ([] (buy-initial-items
   1.156 +(defn-memo do-save-corruption
   1.157 +  ([] (do-save-corruption
   1.158         (walk-to-counter)))
   1.159    ([script]
   1.160       (->> script
   1.161 -          (play-moves
   1.162 -           [[] [:a] []])
   1.163 -          (scroll-text)
   1.164 -          (do-nothing 100)
   1.165 +          (first-difference [] [:start] AF)
   1.166 +          (set-cursor 4)
   1.167 +          (do-nothing 5)
   1.168            (play-moves [[:a]])
   1.169 -          (do-nothing 100)
   1.170 -          (buy-items
   1.171 -           [[0 1]
   1.172 -            [1 1]
   1.173 -            [2 1]
   1.174 -            [3 1]
   1.175 -            [4 1]])
   1.176 -          (do-nothing 100)
   1.177 -          (play-moves [[:b]])
   1.178 -          (do-nothing 100)
   1.179 -          (play-moves [[:b]])
   1.180 -          (do-nothing 100)
   1.181 -          (play-moves [[:b] []])
   1.182 -          (first-difference [:b] [:b :start] AF))))
   1.183 -
   1.184 -
   1.185 -(defn-memo do-save-corruption
   1.186 -  ([] (do-save-corruption
   1.187 -       (buy-initial-items)))
   1.188 -  ([script]
   1.189 -     (->> script
   1.190 -          (first-difference [] [:d] AF)
   1.191 -          (play-moves [[] [] [] [:d]
   1.192 -                       [] [] [] [:d]
   1.193 -                       [] [] [] [:d]
   1.194 -                       [] [] [:a]])
   1.195 -          scroll-text
   1.196 +          (play-moves (repeat 85 [:b]))
   1.197 +          (play-moves [[:a]])
   1.198            (play-moves
   1.199             ;; this section is copied from speedrun-2942 and corrupts
   1.200             ;; the save so that the total number of pokemon is set to
   1.201 @@ -558,25 +436,59 @@
   1.202              [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
   1.203            (title)
   1.204            (first-difference [] [:start] AF)
   1.205 -          (first-difference [] [:a] AF)
   1.206 -          (first-difference [:a] [:a :start] AF))))
   1.207 +          (first-difference [] [:a] AF))))
   1.208 +          
   1.209 +(defn gen-corrupted-checkpoint! []
   1.210 +  (let [[cor-moves cor-save] (do-save-corruption)]
   1.211 +    (write-moves! cor-moves "cor-checkpoint")
   1.212 +    (write-state! cor-save "cor-checkpoint")))
   1.213 +
   1.214 +(defn corrupted-checkpoint []
   1.215 +  [(read-moves "cor-checkpoint")
   1.216 +   (read-state "cor-checkpoint")])
   1.217  
   1.218  (def menu do-nothing )
   1.219  
   1.220  (defn-memo corrupt-item-list
   1.221 +  "Corrupt the num-of-items variable by switching a corrupted pokemon
   1.222 +   into out-of-bounds memory."
   1.223    ([] (corrupt-item-list
   1.224 -       (do-save-corruption)))
   1.225 +       (corrupted-checkpoint)))
   1.226    ([script]
   1.227       (->> script
   1.228 -          (do-nothing 200)
   1.229 -          (menu [↓ [:a]])               ; select "POKEMON" from
   1.230 -                                        ; from main menu
   1.231 -          (menu [↓ ↓ ↓ ↓ ↓ ↓            ; go to 6th pokemon
   1.232 -                 [:a] ↓ [:a]            ; select "switch"
   1.233 -                 ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"
   1.234 -                 
   1.235 -          (do-nothing 1))))
   1.236 -                     
   1.237 +          (first-difference [:a] [:a :start] AF)
   1.238 +          (set-cursor 1)                    ; select "POKEMON" from
   1.239 +          (first-difference [] [:a] AF)     ; from main menu
   1.240 +          (set-cursor 5)                    ; select 6th pokemon
   1.241 +          (first-difference [] [:a] AF)
   1.242 +          (set-cursor 1)
   1.243 +          (first-difference [] [:a] AF)     
   1.244 +          (repeat-until-different [] list-offset) 
   1.245 +          (set-cursor 9)
   1.246 +          (first-difference [] [:a] AF)     ; switch 6th with 10th
   1.247 +          (first-difference [] [:b] AF)
   1.248 +          (first-difference [] [:b] AF))))
   1.249 +
   1.250 +(defn get-lots-of-money
   1.251 +  "Sell 0xFE cancel buttons to make a tremendous amount of money."
   1.252 +  ([] (get-lots-of-money (corrupt-item-list)))
   1.253 +  ([script]
   1.254 +     (->> script
   1.255 +          (first-difference [] [:a] AF)
   1.256 +          (repeat-until-different [] list-offset)
   1.257 +          (set-cursor 1)
   1.258 +          (first-difference [] [:a] AF)
   1.259 +          (repeat-until-different [] list-offset)
   1.260 +          (first-difference [] [:a] AF)
   1.261 +          (set-quantity 0xFF 0xFE)
   1.262 +          (do-nothing 1)
   1.263 +          )))
   1.264 +
   1.265 +
   1.266 +
   1.267 +
   1.268 +(def buy-items do-nothing)
   1.269 +
   1.270  (defn-memo get-burn-heals
   1.271    ([] (get-burn-heals
   1.272         (corrupt-item-list)))

     2.1 --- a/clojure/com/aurellem/run/title.clj	Thu Apr 05 15:05:08 2012 -0500
     2.2 +++ b/clojure/com/aurellem/run/title.clj	Fri Apr 06 07:22:18 2012 -0500
     2.3 @@ -13,7 +13,7 @@
     2.4            (first-difference [] [:a] AF)
     2.5            (first-difference [] [:start] AF))))
     2.6  
     2.7 -(defn-memo oak
     2.8 +(defn oak
     2.9    ([] (oak (title)))
    2.10    ([script]
    2.11       (->> script

     3.1 --- a/clojure/com/aurellem/run/util.clj	Thu Apr 05 15:05:08 2012 -0500
     3.2 +++ b/clojure/com/aurellem/run/util.clj	Fri Apr 06 07:22:18 2012 -0500
     3.3 @@ -38,50 +38,76 @@
     3.4            (recur new-actions new-state))))))
     3.5  
     3.6  (defn binary-search [metric]
     3.7 -  (let [baseline (metric 0)]
     3.8 -    (loop [low 1
     3.9 -           high 2]
    3.10 -      (let [low-val (metric low)
    3.11 -            high-val (metric high)]
    3.12 -        (println low high)
    3.13 -        (cond
    3.14 -          ;; base case
    3.15 -          (and (= low (dec high))
    3.16 -               (not= low-val high-val))
    3.17 -          high
    3.18 -          ;; exponential growth
    3.19 -          (= baseline high-val low-val)
    3.20 -          (recur high (* high 2))
    3.21 -
    3.22 -          ;; binary search
    3.23 -          (and (= baseline low-val)
    3.24 -               (not= baseline high-val))
    3.25 -          (let [test (int (/ (+ low high) 2))
    3.26 -                test-val (metric test)]
    3.27 -            (if (= test-val baseline)
    3.28 -              (recur test high)
    3.29 -              (recur low test))))))))
    3.30 +  (loop [low 0
    3.31 +         high 1]
    3.32 +    (let [low-val (metric low)
    3.33 +          high-val (metric high)]
    3.34 +      (println "(" low high ")")
    3.35 +      (cond
    3.36 +       ;; base case
    3.37 +       (and (= low (dec high))
    3.38 +            (not= low-val high-val))
    3.39 +       high
    3.40 +       ;; exponential growth
    3.41 +       (= high-val low-val)
    3.42 +       (recur high (* high 2))
    3.43 +       
    3.44 +       ;; binary search
    3.45 +       (not= low-val high-val)
    3.46 +       (let [test (int (/ (+ low high) 2))
    3.47 +             test-val (metric test)]
    3.48 +         (if (= test-val low-val)
    3.49 +           (recur test high)
    3.50 +           (recur low test)))))))
    3.51  
    3.52  
    3.53  (defn delayed-difference
    3.54 +  "determine the shortest sequence of the form:
    3.55 +
    3.56 +   sequence = (concat (repeat n base) alt)
    3.57 +    which will cause difference-metric
    3.58 +   to yield a different value between.
    3.59 +
    3.60 +   (concat sequence (repeat delay base))
    3.61 +   and
    3.62 +   (repeat (+ n 1 delay base))
    3.63 +
    3.64 +   This search function is good for finding the optimum keypresses
    3.65 +   whose effect on the game is not revealed until several frames after
    3.66 +   those keys have been pressed (such as scrolling text)."
    3.67    [base alt delay difference-metric [moves root :as script]]
    3.68 -  (let [generator
    3.69 -        (memoize
    3.70 -         (fn gen [n] 
    3.71 -           (run-moves
    3.72 +  (let [states-cache (atom {})
    3.73 +        generator 
    3.74 +        ;; (memoize  ;; 32947 msecs
    3.75 +        ;;  (fn gen [n] 
    3.76 +        ;;    (run-moves
    3.77 +        ;;     root
    3.78 +        ;;     (repeat n base))))
    3.79 +
    3.80 +        (fn gen [n]  ;; 21150 msecs
    3.81 +          (if (= 0 n)
    3.82              root
    3.83 -            (repeat n base))))
    3.84 +            (if-let [cached (@states-cache n)]
    3.85 +              cached
    3.86 +              (do (swap!
    3.87 +                   states-cache
    3.88 +                   #(assoc % n
    3.89 +                           (run-moves
    3.90 +                            (gen (dec n))
    3.91 +                            [base])))
    3.92 +                  (gen n)))))
    3.93 +            
    3.94          len
    3.95          (binary-search
    3.96 -         (memoize (fn [n]
    3.97 -           (= (difference-metric
    3.98 -               (run-moves
    3.99 -                (generator n)
   3.100 -                (concat [alt] (repeat delay base))))
   3.101 -              (difference-metric
   3.102 -               (run-moves
   3.103 -                (generator n)
   3.104 -                (repeat (inc delay) base)))))))
   3.105 +         (memoize
   3.106 +          (fn [n]
   3.107 +            (if (= n 0) true
   3.108 +                (=(difference-metric
   3.109 +                   (run-moves
   3.110 +                    (generator n)
   3.111 +                    (concat [alt] (repeat delay base))))
   3.112 +                  (difference-metric
   3.113 +                    (generator (+ n 1 delay))))))))
   3.114          new-moves (concat moves (repeat len base) [alt])
   3.115          new-state (run-moves (generator len) [alt])]
   3.116      [new-moves new-state]))
   3.117 @@ -135,8 +161,8 @@
   3.118    ([^SaveState state]
   3.119       (character-codes->str
   3.120        (subvec (vec (memory state))
   3.121 -              text-address
   3.122 -              (+ text-address 82))))
   3.123 +              (+ text-address 0)
   3.124 +              (+ text-address  90))))
   3.125    ([] (displayed-text @current-state)))
   3.126  
   3.127  (defn scroll-text

     4.1 Binary file moves/cor-checkpoint.vbm has changed

     5.1 Binary file save-states/cor-checkpoint.sav has changed