1.1 --- a/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 21:25:24 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 23:13:49 2012 -0500
     1.3 @@ -18,4 +18,8 @@
     1.4    (read-state "normal-conversation"))
     1.5  
     1.6  (defn oak-battle []
     1.7 -  (read-state "oak-battle"))
     1.8 \ No newline at end of file
     1.9 +  (read-state "oak-battle"))
    1.10 +
    1.11 +(defn crit-fight []
    1.12 +  (read-state "battle-rival"))
    1.13 +  
    1.14 \ No newline at end of file

     2.1 --- a/clojure/com/aurellem/run/save_corruption.clj	Mon Apr 02 21:25:24 2012 -0500
     2.2 +++ b/clojure/com/aurellem/run/save_corruption.clj	Mon Apr 02 23:13:49 2012 -0500
     2.3 @@ -1,54 +1,33 @@
     2.4  (ns com.aurellem.run.save-corruption
     2.5    (:use (com.aurellem.gb gb-driver vbm))
     2.6 -  (:use (com.aurellem.run title)))
     2.7 +  (:use (com.aurellem.run util title)))
     2.8  
     2.9 -(defn-memo start-walking
    2.10 -  ([script] 
    2.11 -     (->> script
    2.12 -          (advance [:b] [:b :r])))
    2.13 -  ([] (start-walking (finish-title))))
    2.14 -  
    2.15  (defn-memo walk-to-stairs
    2.16 -  ([] (walk-to-stairs (start-walking)))
    2.17 +  ([] (walk-to-stairs (finish-title)))
    2.18    ([script]
    2.19       (->> script
    2.20 -          (move [:u])
    2.21 -          (move [:u])
    2.22 -          (move [:u])
    2.23 -          (move [:u])
    2.24 -          (move [:u])
    2.25 -          (move [:r])
    2.26 -          (move [:r])
    2.27 -          (move [:r]))))
    2.28 +          (walk [→ ↑ ↑ ↑ ↑ ↑ → → →]))))
    2.29  
    2.30  (defn-memo walk-to-door
    2.31    ([] (walk-to-door (walk-to-stairs)))
    2.32    ([script]
    2.33       (->> script
    2.34 -          (move [:d])
    2.35 -          (move [:d])
    2.36 -          (move [:d])
    2.37 -          (move [:d])
    2.38 -          (move [:d])
    2.39 -          (move [:d])
    2.40 -          (move [:l])
    2.41 -          (move [:l])
    2.42 -          (move [:l])
    2.43 -          (move [:l]))))
    2.44 +          (walk [↓ ↓ ↓ ↓ ↓ ← ← ← ←])))) 
    2.45  
    2.46  (defn-memo activate-menu
    2.47    ([] (activate-menu (walk-to-door)))
    2.48    ([script]
    2.49       (->> script
    2.50 -          (advance [:b] [:a :b :start]))))
    2.51 +          (first-difference [:b] [:a :b :start] AF))))
    2.52  
    2.53  (defn-memo save-game
    2.54    ([] (save-game (activate-menu)))
    2.55    ([script]
    2.56       (->> script
    2.57 -          (advance [] [:d])
    2.58 +          (first-difference [] [:d] AF)
    2.59            (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]])
    2.60 -          scroll-text)))
    2.61 +          (do-nothing 200)
    2.62 +          (play-moves [[:a]]))))
    2.63  
    2.64  (defn-memo corrupt-save
    2.65    ([] (corrupt-save (save-game)))
    2.66 @@ -67,9 +46,9 @@
    2.67    ([script]
    2.68       (->> script
    2.69            (title)
    2.70 -          (advance [] [:start])
    2.71 -          (advance [] [:a])
    2.72 -          (advance [:a] [:a :start]))))
    2.73 +          (first-difference [] [:start] AF)
    2.74 +          (first-difference [] [:a] AF)
    2.75 +          (first-difference [:a] [:a :start] AF))))
    2.76  
    2.77  (defn-memo destroy-item-end-of-list-marker
    2.78    ([] (destroy-item-end-of-list-marker (start-game)))

     3.1 --- a/clojure/com/aurellem/run/title.clj	Mon Apr 02 21:25:24 2012 -0500
     3.2 +++ b/clojure/com/aurellem/run/title.clj	Mon Apr 02 23:13:49 2012 -0500
     3.3 @@ -1,6 +1,6 @@
     3.4  (ns com.aurellem.run.title
     3.5 -  (:use (com.aurellem.gb gb-driver vbm)))
     3.6 -
     3.7 +  (:use (com.aurellem.gb gb-driver vbm))
     3.8 +  (:use (com.aurellem.run util)))
     3.9  
    3.10  (defn start [] [[] (root)])
    3.11  
    3.12 @@ -8,10 +8,10 @@
    3.13    ([] (title (start)))
    3.14    ([script]
    3.15       (->> script
    3.16 -          (advance [] [:a])
    3.17 -          (advance [] [:start])
    3.18 -          (advance [] [:a])
    3.19 -          (advance [] [:start]))))
    3.20 +          (first-difference [] [:a] AF)
    3.21 +          (first-difference [] [:start] AF)
    3.22 +          (first-difference [] [:a] AF)
    3.23 +          (first-difference [] [:start] AF))))
    3.24  
    3.25  (defn-memo oak
    3.26    ([] (oak (title)))
    3.27 @@ -23,8 +23,8 @@
    3.28    ([] (name-entry-rlm (oak)))
    3.29    ([script]
    3.30       (->> script
    3.31 -          (advance [] [:a])
    3.32 -          (advance [] [:r] DE)
    3.33 +          (first-difference [] [:a] AF)
    3.34 +          (first-difference [] [:r] DE)
    3.35            (play-moves
    3.36             [[]
    3.37              [:r] [] [:r] [] [:r] [] [:r] []
    3.38 @@ -38,26 +38,26 @@
    3.39    ([] (name-entry-ash (oak)))
    3.40    ([script]
    3.41       (->> script
    3.42 -          (advance [] [:d])
    3.43 -          (advance [] [:d])
    3.44 -          (advance [] [:a]))))
    3.45 +          (first-difference [] [:d] AF)
    3.46 +          (first-difference [] [:d] AF)
    3.47 +          (first-difference [] [:a] AF))))
    3.48         
    3.49  (defn-memo rival-name-entry-gary
    3.50    ([] (rival-name-entry-gary (name-entry-ash)))
    3.51    ([script]
    3.52       (->> script
    3.53            (scroll-text 5)
    3.54 -          (advance [] [:d])
    3.55 -          (advance [] [:d])
    3.56 -          (advance [] [:a]))))
    3.57 +          (first-difference [] [:d] AF)
    3.58 +          (first-difference [] [:d] AF)
    3.59 +          (first-difference [] [:a] AF))))
    3.60    
    3.61  (defn-memo rival-name-entry-blue
    3.62    ([] (rival-name-entry-blue (name-entry-ash)))
    3.63    ([script]
    3.64       (->> script
    3.65            (scroll-text 5)
    3.66 -          (advance [] [:d])
    3.67 -          (advance [] [:a]))))
    3.68 +          (first-difference [] [:d] AF)
    3.69 +          (first-difference [] [:a] AF))))
    3.70  
    3.71  (defn-memo finish-title
    3.72    ([] (finish-title (rival-name-entry-blue)))

     4.1 --- a/clojure/com/aurellem/run/util.clj	Mon Apr 02 21:25:24 2012 -0500
     4.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 23:13:49 2012 -0500
     4.3 @@ -7,6 +7,8 @@
     4.4  (def ← [:l])
     4.5  (def → [:r])
     4.6  
     4.7 +[↑ ↓ ← →]
     4.8 +
     4.9  (defn first-difference
    4.10    [base alt difference-metric [moves root :as script]]
    4.11    (loop [branch-point root
    4.12 @@ -145,6 +147,25 @@
    4.13         (play-moves
    4.14          (repeat n []))))
    4.15  
    4.16 +(defn delayed-improbability-search
    4.17 +  "insert blank frames before calling script-fn until
    4.18 +   metric returns true."
    4.19 +  [delay metric script-fn script]
    4.20 +  (loop [blanks 0]
    4.21 +    (let [new-script
    4.22 +          (->> script
    4.23 +               (play-moves
    4.24 +                (concat (repeat blanks [])))
    4.25 +               script-fn)
    4.26 +          future-state
    4.27 +          (run-moves (second new-script)
    4.28 +                     (repeat delay []))
    4.29 +          result (metric future-state)]
    4.30 +      (if result
    4.31 +        (do
    4.32 +          (println "improbability factor:" blanks)
    4.33 +          new-script)
    4.34 +        (recur (inc blanks))))))
    4.35  
    4.36  (defn critical-hit
    4.37    "Put the cursor over the desired attack. This program will
    4.38 @@ -152,46 +173,19 @@
    4.39     insert before pressing [:a] to ensure that the attack is
    4.40     a critical hit."
    4.41    [script]
    4.42 -  (loop [blanks 6]
    4.43 -    (let [new-script
    4.44 -          (->> script
    4.45 -               (play-moves
    4.46 -                (concat (repeat blanks [])
    4.47 -                        [[:a][]])))]
    4.48 -      (if (let [future-state
    4.49 -                (run-moves (second new-script)
    4.50 -                           (repeat 400 []))
    4.51 -
    4.52 -                result (search-string (memory future-state)
    4.53 -                                      "Critical")]
    4.54 -            (if result
    4.55 -              (println "critical hit with" blanks "blank frames"))
    4.56 -            result) 
    4.57 -        new-script
    4.58 -        (recur (inc blanks))))))  
    4.59 +  (delayed-improbability-search
    4.60 +   400
    4.61 +   #(search-string  % "Critical")
    4.62 +   (partial play-moves [[:a][]])
    4.63 +   script))
    4.64  
    4.65  (defn move-thru-grass
    4.66    [direction script]
    4.67 -  (loop [blanks 0]
    4.68 -    (let [new-script
    4.69 -          (->> script
    4.70 -               (play-moves (repeat blanks []))
    4.71 -               (move direction))
    4.72 -
    4.73 -          future-state
    4.74 -          (run-moves (second new-script)
    4.75 -                     (repeat 600 []))
    4.76 -          
    4.77 -          result (search-string (memory future-state)
    4.78 -                                "Wild")]
    4.79 -      (if (nil? result)
    4.80 -        (do
    4.81 -          (if (< 0 blanks)
    4.82 -            (do
    4.83 -              (println "avoided pokemon with"
    4.84 -                       blanks "blank frames")))
    4.85 -             new-script)
    4.86 -        (recur (inc blanks))))))
    4.87 +  (delayed-improbability-search
    4.88 +   600
    4.89 +   #(nil? (search-string % "Wild"))
    4.90 +   (partial move direction)
    4.91 +   script))
    4.92  
    4.93  (defn walk-thru-grass
    4.94    [directions script]

     5.1 Binary file save-states/battle-rival.sav has changed

     6.1 Binary file save-states/grass' edge.sav has changed