changeset 316:d263df762c59

greatly speed up scroll-text by using binary-search.
author Robert McIntyre <rlm@mit.edu>
date Mon, 02 Apr 2012 21:20:54 -0500
parents 363b650a77cc
children 3c5bf2221ea0
files clojure/com/aurellem/gb/gb_driver.clj clojure/com/aurellem/gb/saves.clj clojure/com/aurellem/gb/util.clj clojure/com/aurellem/run/util.clj save-states/oak-battle.sav
diffstat 5 files changed, 65 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/gb/gb_driver.clj	Mon Apr 02 20:30:28 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/gb_driver.clj	Mon Apr 02 21:20:54 2012 -0500
     1.3 @@ -142,7 +142,7 @@
     1.4    ([]
     1.5      (continue! @current-state)))
     1.6  
     1.7 -(defn run-moves [state moves]
     1.8 +(defn run-moves [moves state]
     1.9    (set-state! state)
    1.10    (dorun (map #(Gb/step (button-mask %))
    1.11                moves))
     2.1 --- a/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 20:30:28 2012 -0500
     2.2 +++ b/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 21:20:54 2012 -0500
     2.3 @@ -15,4 +15,7 @@
     2.4    (read-state "talk-to-oak"))
     2.5  
     2.6  (defn normal-conv []
     2.7 -  (read-state "normal-conversation"))
     2.8 \ No newline at end of file
     2.9 +  (read-state "normal-conversation"))
    2.10 +
    2.11 +(defn oak-battle []
    2.12 +  (read-state "oak-battle"))
    2.13 \ No newline at end of file
     3.1 --- a/clojure/com/aurellem/gb/util.clj	Mon Apr 02 20:30:28 2012 -0500
     3.2 +++ b/clojure/com/aurellem/gb/util.clj	Mon Apr 02 21:20:54 2012 -0500
     3.3 @@ -154,7 +154,7 @@
     3.4        (zipmap backbone
     3.5                (apply (partial map list) seqs))))))
     3.6  
     3.7 -(defn temporal-compare [& states]
     3.8 +(defn memory-compare [& states]
     3.9    (apply common-differences
    3.10           (map (comp vec memory)
    3.11                states)))
     4.1 --- a/clojure/com/aurellem/run/util.clj	Mon Apr 02 20:30:28 2012 -0500
     4.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 21:20:54 2012 -0500
     4.3 @@ -30,6 +30,55 @@
     4.4            [new-actions new-state]
     4.5            (recur new-actions new-state))))))
     4.6  
     4.7 +
     4.8 +(defn binary-search [metric]
     4.9 +  (let [baseline (metric 0)]
    4.10 +    (loop [low 1
    4.11 +           high 2]
    4.12 +      (let [low-val (metric low)
    4.13 +            high-val (metric high)]
    4.14 +        (println low high)
    4.15 +        (cond
    4.16 +          ;; base case
    4.17 +          (and (= low (dec high))
    4.18 +               (not= low-val high-val))
    4.19 +          high
    4.20 +          ;; exponential growth
    4.21 +          (= baseline high-val low-val)
    4.22 +          (recur high (* high 2))
    4.23 +
    4.24 +          ;; binary search
    4.25 +          (and (= baseline low-val)
    4.26 +               (not= baseline high-val))
    4.27 +          (let [test (int (/ (+ low high) 2))
    4.28 +                test-val (metric test)]
    4.29 +            (if (= test-val baseline)
    4.30 +              (recur test high)
    4.31 +              (recur low test))))))))
    4.32 +
    4.33 +(defn delayed-difference
    4.34 +  [base alt delay difference-metric [moves root :as script]]
    4.35 +  (let [generator
    4.36 +        (memoize
    4.37 +         (fn [n]
    4.38 +           (run-moves
    4.39 +            root
    4.40 +            (repeat n base))))
    4.41 +        len
    4.42 +        (binary-search
    4.43 +         (fn [n]
    4.44 +           (= (difference-metric
    4.45 +               (run-moves
    4.46 +                (generator n)
    4.47 +                (concat [alt] (repeat delay base))))
    4.48 +              (difference-metric
    4.49 +               (run-moves
    4.50 +                (generator n)
    4.51 +                (repeat (inc delay) base))))))
    4.52 +        new-moves (concat moves (repeat len base) [alt])
    4.53 +        new-state (run-moves (generator len) [alt])]
    4.54 +    [new-moves new-state]))
    4.55 +
    4.56  (defn delayed-difference
    4.57    [base alt delay difference-metric [moves root :as script]]
    4.58    (loop [branch-point root
    4.59 @@ -49,6 +98,10 @@
    4.60          (recur base-branch (conj actions base))))))
    4.61  
    4.62  
    4.63 +            
    4.64 +
    4.65 +
    4.66 +
    4.67    
    4.68  ;; (defn advance
    4.69  ;;   ([base alt difference-metric [commands state]]
    4.70 @@ -146,9 +199,12 @@
    4.71  
    4.72  
    4.73  
    4.74 -(common-differences
    4.75 - (vec (memory (step (talk-to-oak) [:a])))
    4.76 - (vec (memory (step (talk-to-oak) []))))
    4.77 +(memory-compare 
    4.78 + (step (talk-to-oak) [:a])
    4.79 + (step (talk-to-oak) [])
    4.80 + (step (oak-battle) [])
    4.81 + (step (oak-battle) [:a]))
    4.82 +
    4.83   
    4.84  
    4.85  
     5.1 Binary file save-states/oak-battle.sav has changed