More powerful memoize for Clojure

smart_memoize.clj

(def ^:private gc-sm-cache!                                                                                                                                                          
  "Maintains maximum cache size by intelligently pruning less valuable items."
  (let [gc-running? (atom false)]                                                                                                                                                 
    (fn [cache ttl max-items now]                                                                                                                                                  
      (when-not @gc-running?                                                                                                                                                      
        (reset! gc-running? true)                                                                                                                                                 
        (let [snapshot @cache                                                                                                                                                     
              prune-count (- (count snapshot) max-items)]                                                                                                                         
          (when (pos? prune-count)                                                                                                                                                
            (let [scored-keys                                                                                                                                                     
                  (->> (for [key (keys snapshot)]                                                                                                                                 
                         (let [;; Simple algo to assign value to cached items                                                                                                     
                               score (let [{:keys [time-cached lru-tick lfu-tick]}                                                                                                
                                           (snapshot key)]                                                                                                                        
                                       (if (and ttl (> (- now time-cached) ttl))                                                                                                  
                                         (- time-cached now) ; Already expired                                                                                                    
                                         (+ lru-tick lfu-tick)))]                                                                                                                 
                           [score key]))                                                                                                                                          
                       (sort-by first))                                                                                                                                           
                                                                                                                                                                                  
                  expired-keys (->> scored-keys                                                                                                                                   
                                    (take-while #(neg? (first %)))                                                                                                                
                                    (map second))                                                                                                                                 
                  worst-keys   (->> scored-keys                                                                                                                                   
                                    (take prune-count)                                                                                                                            
                                    (map second))]                                                                                                                                
                                                                                                                                                                                  
              (apply swap! cache dissoc                                                                                                                                           
                     (into #{} (concat expired-keys                                                                                                                               
                                       worst-keys))))))                                                                                                                           
        (reset! gc-running? false)))))

(defn smart-memoize                                                                                                                                                               
  "Like 'memoize' but provides some additional facilities:                                                                                                                        
  1. When 'ttl' is given, cached items will be invalidated after this many msecs.                                                                                                 
  2. When 'max-items' is given, intelligent pruning will be used to try and                                                                                                       
     maintain at most this many cached items.                                                                                                                                     
  3. Cached items can be invalidated by prepending with :sm-invalidate:                                                                                                           
     (smart-memoize :sm-invalidate arg1 arg2 ...)."                                                                                                                               
  ([f] (smart-memoize {} f))                                                                                                                                                      
  ([{:keys [cache ttl max-items gc-rate gc-fn]                                                                                                                                    
     :or   {cache (atom {}) gc-rate 0.01 gc-fn gc-sm-cache!}} f]                                                                                                                     
     (let [current-tick (atom 0)]                                                                                                                                                 
       (fn ^{:arglists '([command target] [& args])} [& args]                                                                                                                      
         (let [{:keys [time-cached lru-tick lfu-tick d-result]} (@cache args)                                                                                                     
               now (System/currentTimeMillis)]                                                                                                                                    
                                                                                                                                                                                  
           ;; Check if we have a useable payload                                                                                                                                  
           (if (and time-cached (or (not ttl) (< (- now time-cached) ttl)))                                                                                                       
             (do (swap! current-tick inc)                                                                                                                                         
                 (swap! cache assoc args {:time-cached time-cached                                                                                                                
                                          :lru-tick    @current-tick                                                                                                              
                                          :lfu-tick    (inc lfu-tick)                                                                                                             
                                          :d-result    d-result})                                                                                                                 
                 @d-result)                                                                                                                                                       
                                                                                                                                                                                  
             (do                                                                                                                                                                  
               ;; Parse args to look for special commands                                                                                                                         
               (let [[command & target] args]                                                                                                                                     
                 (case command                                                                                                                                                    
                   :sm-invalidate     (do (swap! cache dissoc target) nil)                                                                                                        
                   :sm-invalidate-all (do (reset! cache {})                                                                                                                       
                                          (reset! current-tick 0) nil)                                                                                                            
                                                                                                                                                                                  
                   ;; No special commands:                                                                                                                                        
                   (let [d-result (delay (apply f args))]                                                                                                                         
                     (swap! cache assoc args {:time-cached now                                                                                                                    
                                              :lru-tick    @current-tick                                                                                                          
                                              :lfu-tick    1                                                                                                                      
                                              :d-result    d-result})                                                                                                             

                     ;; Garbage collection                                                                                                                                        
                     (when (and max-items (<= (rand) gc-rate))                                                                                                                    
                       (future (gc-fn cache ttl max-items now)))                                                                                                                  

                     @d-result))))))))))

(comment                                                                                                                                                                          
  (def memfn  (memoize          (fn [x] (Thread/sleep 3000) (str x))))                                                                                                             
  (def smemfn (smart-memoize    (fn [x] (Thread/sleep 3000) (str x))))                                                                                                             
  (def smemfn-ttl                                                                                                                                                                 
    (smart-memoize {:ttl 10000} (fn [x] (Thread/sleep 3000) (str x))))                                                                                                             
                                                                                                                                                                                  
  (time (dotimes [n 10000] (memfn  "Hello!")))     ; 3.3ms                                                                                                                        
  (time (dotimes [n 10000] (smemfn "Hello!")))     ; 15ms                                                                                                                         
  (time (dotimes [n 10000] (smemfn-ttl "Hello!"))) ; 18ms                                                                                                                         
                                                                                                                                                                                  
  (smemfn-ttl "This will expire")                                                                                                                                                 
  (smemfn :sm-invalidate "Hello!")                                                                                                                                                
  (smemfn "Hello!"))

If you want something even more flexible, check out https://github.com/clojure/core.memoize

For my own purposes, often found I needed something relatively simple + lightweight. Having said that, the gc is pluggable so you've actually got quite a bit of flexibility here in terms of cache strategies, etc. The default strategy is a combination LRU/LFU, subject to TTL.

Hope someone finds this useful!

Peter Taoussanis