diff clojure/com/aurellem/run/util.clj @ 329:a452deec2882

improved efficiency of delayed-difference
author Robert McIntyre <rlm@mit.edu>
date Fri, 06 Apr 2012 07:22:18 -0500
parents 35960b03693f
children abd1ca8a25cc
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/run/util.clj	Thu Apr 05 15:05:08 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/util.clj	Fri Apr 06 07:22:18 2012 -0500
     1.3 @@ -38,50 +38,76 @@
     1.4            (recur new-actions new-state))))))
     1.5  
     1.6  (defn binary-search [metric]
     1.7 -  (let [baseline (metric 0)]
     1.8 -    (loop [low 1
     1.9 -           high 2]
    1.10 -      (let [low-val (metric low)
    1.11 -            high-val (metric high)]
    1.12 -        (println low high)
    1.13 -        (cond
    1.14 -          ;; base case
    1.15 -          (and (= low (dec high))
    1.16 -               (not= low-val high-val))
    1.17 -          high
    1.18 -          ;; exponential growth
    1.19 -          (= baseline high-val low-val)
    1.20 -          (recur high (* high 2))
    1.21 -
    1.22 -          ;; binary search
    1.23 -          (and (= baseline low-val)
    1.24 -               (not= baseline high-val))
    1.25 -          (let [test (int (/ (+ low high) 2))
    1.26 -                test-val (metric test)]
    1.27 -            (if (= test-val baseline)
    1.28 -              (recur test high)
    1.29 -              (recur low test))))))))
    1.30 +  (loop [low 0
    1.31 +         high 1]
    1.32 +    (let [low-val (metric low)
    1.33 +          high-val (metric high)]
    1.34 +      (println "(" low high ")")
    1.35 +      (cond
    1.36 +       ;; base case
    1.37 +       (and (= low (dec high))
    1.38 +            (not= low-val high-val))
    1.39 +       high
    1.40 +       ;; exponential growth
    1.41 +       (= high-val low-val)
    1.42 +       (recur high (* high 2))
    1.43 +       
    1.44 +       ;; binary search
    1.45 +       (not= low-val high-val)
    1.46 +       (let [test (int (/ (+ low high) 2))
    1.47 +             test-val (metric test)]
    1.48 +         (if (= test-val low-val)
    1.49 +           (recur test high)
    1.50 +           (recur low test)))))))
    1.51  
    1.52  
    1.53  (defn delayed-difference
    1.54 +  "determine the shortest sequence of the form:
    1.55 +
    1.56 +   sequence = (concat (repeat n base) alt)
    1.57 +    which will cause difference-metric
    1.58 +   to yield a different value between.
    1.59 +
    1.60 +   (concat sequence (repeat delay base))
    1.61 +   and
    1.62 +   (repeat (+ n 1 delay base))
    1.63 +
    1.64 +   This search function is good for finding the optimum keypresses
    1.65 +   whose effect on the game is not revealed until several frames after
    1.66 +   those keys have been pressed (such as scrolling text)."
    1.67    [base alt delay difference-metric [moves root :as script]]
    1.68 -  (let [generator
    1.69 -        (memoize
    1.70 -         (fn gen [n] 
    1.71 -           (run-moves
    1.72 +  (let [states-cache (atom {})
    1.73 +        generator 
    1.74 +        ;; (memoize  ;; 32947 msecs
    1.75 +        ;;  (fn gen [n] 
    1.76 +        ;;    (run-moves
    1.77 +        ;;     root
    1.78 +        ;;     (repeat n base))))
    1.79 +
    1.80 +        (fn gen [n]  ;; 21150 msecs
    1.81 +          (if (= 0 n)
    1.82              root
    1.83 -            (repeat n base))))
    1.84 +            (if-let [cached (@states-cache n)]
    1.85 +              cached
    1.86 +              (do (swap!
    1.87 +                   states-cache
    1.88 +                   #(assoc % n
    1.89 +                           (run-moves
    1.90 +                            (gen (dec n))
    1.91 +                            [base])))
    1.92 +                  (gen n)))))
    1.93 +            
    1.94          len
    1.95          (binary-search
    1.96 -         (memoize (fn [n]
    1.97 -           (= (difference-metric
    1.98 -               (run-moves
    1.99 -                (generator n)
   1.100 -                (concat [alt] (repeat delay base))))
   1.101 -              (difference-metric
   1.102 -               (run-moves
   1.103 -                (generator n)
   1.104 -                (repeat (inc delay) base)))))))
   1.105 +         (memoize
   1.106 +          (fn [n]
   1.107 +            (if (= n 0) true
   1.108 +                (=(difference-metric
   1.109 +                   (run-moves
   1.110 +                    (generator n)
   1.111 +                    (concat [alt] (repeat delay base))))
   1.112 +                  (difference-metric
   1.113 +                    (generator (+ n 1 delay))))))))
   1.114          new-moves (concat moves (repeat len base) [alt])
   1.115          new-state (run-moves (generator len) [alt])]
   1.116      [new-moves new-state]))
   1.117 @@ -135,8 +161,8 @@
   1.118    ([^SaveState state]
   1.119       (character-codes->str
   1.120        (subvec (vec (memory state))
   1.121 -              text-address
   1.122 -              (+ text-address 82))))
   1.123 +              (+ text-address 0)
   1.124 +              (+ text-address  90))))
   1.125    ([] (displayed-text @current-state)))
   1.126  
   1.127  (defn scroll-text