# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1333714938 18000
# Node ID a452deec28827743af5ef1ea5320f962689e6d53
# Parent  35960b03693fc0b53f2148a78d89c4d0d1dedab2
improved efficiency of delayed-difference

diff -r 35960b03693f -r a452deec2882 clojure/com/aurellem/run/bootstrap_0.clj
--- a/clojure/com/aurellem/run/bootstrap_0.clj	Thu Apr 05 15:05:08 2012 -0500
+++ b/clojure/com/aurellem/run/bootstrap_0.clj	Fri Apr 06 07:22:18 2012 -0500
@@ -368,6 +368,7 @@
 
 (defn item-quantity-selected
   ([^SaveState state]
+     (println "items:" (aget (memory state) item-quantity-selected-address))
      (aget (memory state) item-quantity-selected-address))
   ([] (item-quantity-selected @current-state)))
 
@@ -393,162 +394,39 @@
         difference (- n current-position)]
     (println difference)
     (set-cursor-relative difference script)))
-  
-(defn buy-item
-  "Assumes that the main item-screen is up, and buys
-   quantity of the nth item in the list, assuming that you
-   have enough money."
-  [n quantity script]
-  (if (= 0  quantity)
-    script
-    (let [after-initial-pause
-          (do-nothing 20  script)
-          move-to-item
-          (reduce (fn [script _]
-                    (->> script
-                         (play-moves [[:d]])
-                         (do-nothing 3)))
-                  after-initial-pause
-                  (range n))
-          select-item
-          (play-moves [[:a]] move-to-item)
-          request-items
-          (reduce (fn [script _]
-                    (->> script
-                         (play-moves [[:u]])
-                         (do-nothing 1)))
-                  select-item
-                  (range (dec quantity)))
-          buy-items
-          (->> request-items
-               (do-nothing 10)
-               (play-moves [[:a]])
-               (scroll-text)
-               (scroll-text)
-               (do-nothing 10)
-               (play-moves [[:a]])
-               (scroll-text))]
-      buy-items)))
+
+(defn set-quantity
+  "Set the quantity of an item to buy or sell to the desired value
+  using the fewest possible button presses."
+  [total-quantity desired-quantity [moves state :as script]]
+  (let [current-quantity (item-quantity-selected state)
+        loop-point (if (> total-quantity 99) 0xFF 99)
+        distance (- desired-quantity current-quantity)
+        loop-distance (int(* -1 (Math/signum (float distance))
+                             (- loop-point (Math/abs distance))))
+        best-path (first (sort-by #(Math/abs %)
+                                  [distance loop-distance]))
+        direction (if (< 0 best-path) ↑ ↓)]
+    (println "best-path" best-path)
+    (reduce
+     (fn [script _]
+       (delayed-difference [] direction 200 item-quantity-selected
+                               script))
      
+     script
+     (range (Math/abs best-path)))))
 
-(defn buy-items
-  "Given a list of [item-no quantity], buys the quantity
-   from the shop's list. Assumes that the item list is
-   already up."
-  [item-pairs script]
-  (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
-        initial-purchase
-        (->> script
-             (buy-item 0 (item-lookup 0))
-             (buy-item 1 (item-lookup 1))
-             (buy-item 2 (item-lookup 2)))]
-    (cond
-      (and
-       (not= 0 (item-lookup 3))
-       (not= 0 (item-lookup 4)))
-      (->> initial-purchase
-           (do-nothing 20)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 10)
-           (buy-item 0 (item-lookup 3))
-           (do-nothing 20)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 10)
-           (buy-item 0 (item-lookup 4)))
-      (and (= 0 (item-lookup 3))
-           (not= 0 (item-lookup 4)))
-      (->> initial-purchase
-           (do-nothing 20)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 10)
-           (play-moves [[:d]])
-           (do-nothing 10)
-           (buy-item 0 (item-lookup 4)))
-      (and (not= 0 (item-lookup 3))
-           (= 0 (item-lookup 4)))
-      (->> initial-purchase
-           (do-nothing 20)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 3)
-           (play-moves [[:d]])
-           (do-nothing 10)
-           (buy-item 0 (item-lookup 3)))
-      (and (= 0 (item-lookup 3))
-           (= 0 (item-lookup 4)))
-      initial-purchase)))
-
-
-(defn test-buy-items
-  ([] (test-buy-items
-       (walk-to-counter)))
-  ([script]
-     (->> [(first script) (set-money (second script)
-                                     999999)]
-          (play-moves
-           [[] [:a] []])
-          (scroll-text)
-          (do-nothing 100)
-          (play-moves [[:a]])
-          (do-nothing 100)
-          (buy-items
-           [[0 1]
-            [1 15]
-            [2 1]
-            [3 20]
-            [4 95]
-            ]))))
-
-(defn-memo buy-initial-items
-  ([] (buy-initial-items
+(defn-memo do-save-corruption
+  ([] (do-save-corruption
        (walk-to-counter)))
   ([script]
      (->> script
-          (play-moves
-           [[] [:a] []])
-          (scroll-text)
-          (do-nothing 100)
+          (first-difference [] [:start] AF)
+          (set-cursor 4)
+          (do-nothing 5)
           (play-moves [[:a]])
-          (do-nothing 100)
-          (buy-items
-           [[0 1]
-            [1 1]
-            [2 1]
-            [3 1]
-            [4 1]])
-          (do-nothing 100)
-          (play-moves [[:b]])
-          (do-nothing 100)
-          (play-moves [[:b]])
-          (do-nothing 100)
-          (play-moves [[:b] []])
-          (first-difference [:b] [:b :start] AF))))
-
-
-(defn-memo do-save-corruption
-  ([] (do-save-corruption
-       (buy-initial-items)))
-  ([script]
-     (->> script
-          (first-difference [] [:d] AF)
-          (play-moves [[] [] [] [:d]
-                       [] [] [] [:d]
-                       [] [] [] [:d]
-                       [] [] [:a]])
-          scroll-text
+          (play-moves (repeat 85 [:b]))
+          (play-moves [[:a]])
           (play-moves
            ;; this section is copied from speedrun-2942 and corrupts
            ;; the save so that the total number of pokemon is set to
@@ -558,25 +436,59 @@
             [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
           (title)
           (first-difference [] [:start] AF)
-          (first-difference [] [:a] AF)
-          (first-difference [:a] [:a :start] AF))))
+          (first-difference [] [:a] AF))))
+          
+(defn gen-corrupted-checkpoint! []
+  (let [[cor-moves cor-save] (do-save-corruption)]
+    (write-moves! cor-moves "cor-checkpoint")
+    (write-state! cor-save "cor-checkpoint")))
+
+(defn corrupted-checkpoint []
+  [(read-moves "cor-checkpoint")
+   (read-state "cor-checkpoint")])
 
 (def menu do-nothing )
 
 (defn-memo corrupt-item-list
+  "Corrupt the num-of-items variable by switching a corrupted pokemon
+   into out-of-bounds memory."
   ([] (corrupt-item-list
-       (do-save-corruption)))
+       (corrupted-checkpoint)))
   ([script]
      (->> script
-          (do-nothing 200)
-          (menu [↓ [:a]])               ; select "POKEMON" from
-                                        ; from main menu
-          (menu [↓ ↓ ↓ ↓ ↓ ↓            ; go to 6th pokemon
-                 [:a] ↓ [:a]            ; select "switch"
-                 ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"
-                 
-          (do-nothing 1))))
-                     
+          (first-difference [:a] [:a :start] AF)
+          (set-cursor 1)                    ; select "POKEMON" from
+          (first-difference [] [:a] AF)     ; from main menu
+          (set-cursor 5)                    ; select 6th pokemon
+          (first-difference [] [:a] AF)
+          (set-cursor 1)
+          (first-difference [] [:a] AF)     
+          (repeat-until-different [] list-offset) 
+          (set-cursor 9)
+          (first-difference [] [:a] AF)     ; switch 6th with 10th
+          (first-difference [] [:b] AF)
+          (first-difference [] [:b] AF))))
+
+(defn get-lots-of-money
+  "Sell 0xFE cancel buttons to make a tremendous amount of money."
+  ([] (get-lots-of-money (corrupt-item-list)))
+  ([script]
+     (->> script
+          (first-difference [] [:a] AF)
+          (repeat-until-different [] list-offset)
+          (set-cursor 1)
+          (first-difference [] [:a] AF)
+          (repeat-until-different [] list-offset)
+          (first-difference [] [:a] AF)
+          (set-quantity 0xFF 0xFE)
+          (do-nothing 1)
+          )))
+
+
+
+
+(def buy-items do-nothing)
+
 (defn-memo get-burn-heals
   ([] (get-burn-heals
        (corrupt-item-list)))
diff -r 35960b03693f -r a452deec2882 clojure/com/aurellem/run/title.clj
--- a/clojure/com/aurellem/run/title.clj	Thu Apr 05 15:05:08 2012 -0500
+++ b/clojure/com/aurellem/run/title.clj	Fri Apr 06 07:22:18 2012 -0500
@@ -13,7 +13,7 @@
           (first-difference [] [:a] AF)
           (first-difference [] [:start] AF))))
 
-(defn-memo oak
+(defn oak
   ([] (oak (title)))
   ([script]
      (->> script
diff -r 35960b03693f -r a452deec2882 clojure/com/aurellem/run/util.clj
--- a/clojure/com/aurellem/run/util.clj	Thu Apr 05 15:05:08 2012 -0500
+++ b/clojure/com/aurellem/run/util.clj	Fri Apr 06 07:22:18 2012 -0500
@@ -38,50 +38,76 @@
           (recur new-actions new-state))))))
 
 (defn binary-search [metric]
-  (let [baseline (metric 0)]
-    (loop [low 1
-           high 2]
-      (let [low-val (metric low)
-            high-val (metric high)]
-        (println low high)
-        (cond
-          ;; base case
-          (and (= low (dec high))
-               (not= low-val high-val))
-          high
-          ;; exponential growth
-          (= baseline high-val low-val)
-          (recur high (* high 2))
-
-          ;; binary search
-          (and (= baseline low-val)
-               (not= baseline high-val))
-          (let [test (int (/ (+ low high) 2))
-                test-val (metric test)]
-            (if (= test-val baseline)
-              (recur test high)
-              (recur low test))))))))
+  (loop [low 0
+         high 1]
+    (let [low-val (metric low)
+          high-val (metric high)]
+      (println "(" low high ")")
+      (cond
+       ;; base case
+       (and (= low (dec high))
+            (not= low-val high-val))
+       high
+       ;; exponential growth
+       (= high-val low-val)
+       (recur high (* high 2))
+       
+       ;; binary search
+       (not= low-val high-val)
+       (let [test (int (/ (+ low high) 2))
+             test-val (metric test)]
+         (if (= test-val low-val)
+           (recur test high)
+           (recur low test)))))))
 
 
 (defn delayed-difference
+  "determine the shortest sequence of the form:
+
+   sequence = (concat (repeat n base) alt)
+    which will cause difference-metric
+   to yield a different value between.
+
+   (concat sequence (repeat delay base))
+   and
+   (repeat (+ n 1 delay base))
+
+   This search function is good for finding the optimum keypresses
+   whose effect on the game is not revealed until several frames after
+   those keys have been pressed (such as scrolling text)."
   [base alt delay difference-metric [moves root :as script]]
-  (let [generator
-        (memoize
-         (fn gen [n] 
-           (run-moves
+  (let [states-cache (atom {})
+        generator 
+        ;; (memoize  ;; 32947 msecs
+        ;;  (fn gen [n] 
+        ;;    (run-moves
+        ;;     root
+        ;;     (repeat n base))))
+
+        (fn gen [n]  ;; 21150 msecs
+          (if (= 0 n)
             root
-            (repeat n base))))
+            (if-let [cached (@states-cache n)]
+              cached
+              (do (swap!
+                   states-cache
+                   #(assoc % n
+                           (run-moves
+                            (gen (dec n))
+                            [base])))
+                  (gen n)))))
+            
         len
         (binary-search
-         (memoize (fn [n]
-           (= (difference-metric
-               (run-moves
-                (generator n)
-                (concat [alt] (repeat delay base))))
-              (difference-metric
-               (run-moves
-                (generator n)
-                (repeat (inc delay) base)))))))
+         (memoize
+          (fn [n]
+            (if (= n 0) true
+                (=(difference-metric
+                   (run-moves
+                    (generator n)
+                    (concat [alt] (repeat delay base))))
+                  (difference-metric
+                    (generator (+ n 1 delay))))))))
         new-moves (concat moves (repeat len base) [alt])
         new-state (run-moves (generator len) [alt])]
     [new-moves new-state]))
@@ -135,8 +161,8 @@
   ([^SaveState state]
      (character-codes->str
       (subvec (vec (memory state))
-              text-address
-              (+ text-address 82))))
+              (+ text-address 0)
+              (+ text-address  90))))
   ([] (displayed-text @current-state)))
 
 (defn scroll-text
diff -r 35960b03693f -r a452deec2882 moves/cor-checkpoint.vbm
Binary file moves/cor-checkpoint.vbm has changed
diff -r 35960b03693f -r a452deec2882 save-states/cor-checkpoint.sav
Binary file save-states/cor-checkpoint.sav has changed