memoizes.clj

;; an answer to http://kotka.de/blog/2010/03/The_Rule_of_Three.html#summary

;; memoize from core.clj:
(defn memoize
  [f]
  (let [mem (atom {})]
    (fn [& args]
      (if-let [e (find @mem args)]
        (val e)
        (let [ret (apply f args)]
          (swap! mem assoc args ret)
          ret)))))


(defn f [& xs]
  (println "Called with" xs)
  xs)

;; parametrized-memoize:
(defn memoize2
 ([f] (memoize2 f [{} identity assoc]))
 ([f [init cached assoc]]
  (let [mem (atom init)]
    (fn [& args]
      (if-let [e (find (cached @mem) args)]
        (val e)
        (let [ret (apply f args)]
          (swap! mem assoc args ret)
          ret))))))

(defn fifo-strategy [bound] 
  [[(into clojure.lang.PersistentQueue/EMPTY (repeat bound :dummy)) {}]
   peek
   (fn [[queue cache] args ret]
     [(-> queue pop (conj args)) 
      (-> cache (dissoc (peek queue)) (assoc args ret))])])

(comment
user=> (def g (memoize2 f (fifo-strategy 3)))
#'user/g
user=> (map g (range 3))
(Called with (0)
Called with (1)
Called with (2)
(0) (1) (2))
user=> (g 0)
(0)
user=> (g 3)
Called with (3)
(3)
user=> (g 0)
Called with (0)
(0)
)

;; but alas, no way to implement a lru-strategy

;; 2nd attempt at parametrizing memoize:
(defn memoize3
 ([f] (memoize3 f [{} identity identity assoc]))
 ([f [init cached hit assoc]]
  (let [mem (atom init)]
    (fn [& args]
      (if-let [e (find (cached @mem) args)]
        (do
          (swap! mem hit args)
          (val e))
        (let [ret (apply f args)]
          (swap! mem assoc args ret)
          ret))))))

(defn fifo-strategy [bound] 
  [[(into clojure.lang.PersistentQueue/EMPTY (repeat bound :dummy)) {}]
   peek
   (fn [mem args] mem)
   (fn [[queue cache] args ret]
     [(-> queue pop (conj args)) 
      (-> cache (dissoc (peek queue)) (assoc args ret))])])

(defn lru-strategy [bound] 
  [[bound (into (sorted-map) (for [n (range bound)] [n :dummy])) {} {}]
   peek
   (fn [[tick lru-map last-uses cache] args]
     [(inc tick)
      (-> lru-map (dissoc (last-uses args)) (assoc tick args))
      (assoc last-uses args tick)
      cache])
   (fn [[tick lru-map last-uses cache] args ret]
     (let [[ltick largs] (first lru-map)]
       [(inc tick)
        (-> lru-map (dissoc ltick) (assoc tick args))
        (-> last-uses (dissoc largs) (assoc args tick))
        (-> cache (dissoc largs) (assoc args ret))]))])

(comment
user=> (def g (memoize3 f (lru-strategy 3)))
#'user/g
user=> (map g (range 3))
(Called with (0)
Called with (1)
Called with (2)
(0) (1) (2))
user=> (g 0)
(0)
user=> (g 3)
Called with (3)
(3)
user=> (g 0)
(0)
user=> (g 1)
Called with (1)
(1)
)

;; but, wait, there's at least one bug! 
;; if two threads try to concurrently memoize the exact same call
;; the capacity of the cache may definitely decrease! 

;; so we have to verify that the entry of interest to us hasn't changed:
(defn memoize4
 ([f] (memoize4 f [{} identity identity assoc]))
 ([f [init cached hit assoc]]
  (let [mem (atom init)
        hit-or-assoc (fn [mem args ret] 
                       (if (find (cached mem) args)
                         (hit mem args)
                         (assoc mem args ret)))]
    (fn [& args]
      (if-let [e (find (cached @mem) args)]
        (let [ret (val e)]
          (swap! mem hit-or-assoc args ret)
          ret)
        (let [ret (apply f args)]
          (swap! mem hit-or-assoc args ret)
          ret))))))

;; wait, there's a repetition! let's refactor:

(defn memoize5
 ([f] (memoize5 f [{} identity (fn [mem args] mem) assoc]))
 ([f [init cached hit assoc]]
  (let [mem (atom init)
        hit-or-assoc (fn [mem args ret] 
                       (if (find (cached mem) args)
                         (hit mem args)
                         (assoc mem args ret)))]
    (fn [& args]
      (let [ret (if-let [e (find (cached @mem) args)] (val e) (apply f args))]
        (swap! mem hit-or-assoc args ret)
        ret)))))


;; and to be sure that you only compute each entry once,
;; we first change memoize5 so that the returned value *is*
;; the cached value and not another equal value.
(defn memoize6
 ([f] (memoize6 f [{} identity (fn [mem args] mem) assoc]))
 ([f [init cached hit assoc]]
  (let [mem (atom init)
        hit-or-assoc (fn [mem args ret] 
                       (if (find (cached mem) args)
                         (hit mem args)
                         (assoc mem args ret)))]
    (fn [& args]
      (let [ret (if-let [e (find (cached @mem) args)] (val e) (apply f args))
            m (swap! mem hit-or-assoc args ret)]
        (get (cached m) args))))))

;; then we can build memoize7 on memoize6:
(defn memoize7
 ([f] (memoize7 f [{} identity (fn [mem args] mem) assoc]))
 ([f strategy]
  (comp deref (memoize6 #(delay (apply f %&)) strategy))))


;; integrating memoize6 and memoize7 (inspired by Eugen Dück memoize7-variant
;; see http://groups.google.com/group/clojure/browse_thread/thread/36a13d150d830683 )
(defn memoize8
 ([f] (memoize8 f [{} identity (fn [mem args] mem) assoc]))
 ([f [init cached hit assoc]]
  (let [mem (atom init)
        hit-or-assoc (fn [mem args] 
                       (if (contains? (cached mem) args)
                         (hit mem args)
                         (assoc mem args (delay (apply f args)))))]
    (fn [& args]
      (let [m (swap! mem hit-or-assoc args)]
        (-> (cached m) (get args) deref))))))