diff clojure/com/aurellem/run/util.clj @ 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 073600cba28a
children 3c5bf2221ea0
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/run/util.clj	Mon Apr 02 20:30:28 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 21:20:54 2012 -0500
     1.3 @@ -30,6 +30,55 @@
     1.4            [new-actions new-state]
     1.5            (recur new-actions new-state))))))
     1.6  
     1.7 +
     1.8 +(defn binary-search [metric]
     1.9 +  (let [baseline (metric 0)]
    1.10 +    (loop [low 1
    1.11 +           high 2]
    1.12 +      (let [low-val (metric low)
    1.13 +            high-val (metric high)]
    1.14 +        (println low high)
    1.15 +        (cond
    1.16 +          ;; base case
    1.17 +          (and (= low (dec high))
    1.18 +               (not= low-val high-val))
    1.19 +          high
    1.20 +          ;; exponential growth
    1.21 +          (= baseline high-val low-val)
    1.22 +          (recur high (* high 2))
    1.23 +
    1.24 +          ;; binary search
    1.25 +          (and (= baseline low-val)
    1.26 +               (not= baseline high-val))
    1.27 +          (let [test (int (/ (+ low high) 2))
    1.28 +                test-val (metric test)]
    1.29 +            (if (= test-val baseline)
    1.30 +              (recur test high)
    1.31 +              (recur low test))))))))
    1.32 +
    1.33 +(defn delayed-difference
    1.34 +  [base alt delay difference-metric [moves root :as script]]
    1.35 +  (let [generator
    1.36 +        (memoize
    1.37 +         (fn [n]
    1.38 +           (run-moves
    1.39 +            root
    1.40 +            (repeat n base))))
    1.41 +        len
    1.42 +        (binary-search
    1.43 +         (fn [n]
    1.44 +           (= (difference-metric
    1.45 +               (run-moves
    1.46 +                (generator n)
    1.47 +                (concat [alt] (repeat delay base))))
    1.48 +              (difference-metric
    1.49 +               (run-moves
    1.50 +                (generator n)
    1.51 +                (repeat (inc delay) base))))))
    1.52 +        new-moves (concat moves (repeat len base) [alt])
    1.53 +        new-state (run-moves (generator len) [alt])]
    1.54 +    [new-moves new-state]))
    1.55 +
    1.56  (defn delayed-difference
    1.57    [base alt delay difference-metric [moves root :as script]]
    1.58    (loop [branch-point root
    1.59 @@ -49,6 +98,10 @@
    1.60          (recur base-branch (conj actions base))))))
    1.61  
    1.62  
    1.63 +            
    1.64 +
    1.65 +
    1.66 +
    1.67    
    1.68  ;; (defn advance
    1.69  ;;   ([base alt difference-metric [commands state]]
    1.70 @@ -146,9 +199,12 @@
    1.71  
    1.72  
    1.73  
    1.74 -(common-differences
    1.75 - (vec (memory (step (talk-to-oak) [:a])))
    1.76 - (vec (memory (step (talk-to-oak) []))))
    1.77 +(memory-compare 
    1.78 + (step (talk-to-oak) [:a])
    1.79 + (step (talk-to-oak) [])
    1.80 + (step (oak-battle) [])
    1.81 + (step (oak-battle) [:a]))
    1.82 +
    1.83   
    1.84  
    1.85