diff options
Diffstat (limited to 'src/cache_dot_clj/cache.clj')
| -rw-r--r-- | src/cache_dot_clj/cache.clj | 241 |
1 files changed, 241 insertions, 0 deletions
diff --git a/src/cache_dot_clj/cache.clj b/src/cache_dot_clj/cache.clj new file mode 100644 index 0000000..7dcfbfe --- /dev/null +++ b/src/cache_dot_clj/cache.clj @@ -0,0 +1,241 @@ +;; Release 0.0.3 +;; https://github.com/alienscience/cache-dot-clj/tree/master/src + +(ns cache-dot-clj.cache "Resettable memoize") + +(declare naive-strategy) + +(defn- external-memoize + "Conventional memoize for use with external caching packages" + [f f-name strategy] + (let [{:keys [init lookup miss! invalidate!]} strategy + cache (init f-name)] + {:memoized + (fn [& args] + (let [[in-cache? res] (lookup cache args)] + (if in-cache? + res + (miss! cache args (apply f args))))) + :invalidate + (fn [args] + (invalidate! cache args)) + })) + +;; TODO Move some of doc up a level +(defn- internal-memoize + "Returns a map containing: + + {:memoized fn ;; Memoized version of given function + :invalidate fn ;; Invalidate arguments in the cache + } + + The memoized version of the function keeps a cache of the mapping from + arguments to results and, when calls with the same arguments are repeated + often, has higher performance at the expense of higher memory use. + + The invalidation function takes a set of function arguments and causes + the appropriate cache entry to re-evaluate the memoized function. + Invalidation can be used to support the memoization of functions + that can be effected by external events. + + Takes a cache strategy. The strategy is provided as a map + containing the following keys. All keys are mandatory! + + - :init – the initial value for the cache and strategy state + - :cache – access function to access the cache + - :lookup – determines whether a value is in the cache or not + - :hit – a function called with the cache state and the argument + list in case of a cache hit + - :miss – a function called with the cache state, the argument list + and the computation result in case of a cache miss + - :invalidate - a function called with the cache state, the argument + list and the computation result that is used to + invalidate the cache entry for the computation. + " + [f _ strategy] + (let [{:keys [init cache lookup hit miss invalidate]} strategy + cache-state (atom init) + hit-or-miss (fn [state args] + (if (lookup state args) + (hit state args) + (miss state args (delay (apply f args))))) + mark-dirty (fn [state args] + (if (lookup state args) + (invalidate state args (delay (apply f args))) + state))] + {:memoized + (fn [& args] + (let [cs (swap! cache-state hit-or-miss args)] + (-> cs cache (get args) deref))) + :invalidate + (fn [args] + (swap! cache-state mark-dirty args) + nil)})) + +(defmacro defn-cached + "Defines a cached function, like defn-memo from clojure.contrib.def + e.g + (defn-cached fib + (lru-cache-strategy 10) + [n] + (if (<= n 1) + n + (+ (fib (dec n)) (fib (- n 2)))))" + [fn-name cache-strategy & defn-stuff] + `(let [f-name# (str *ns* "." '~fn-name)] + (defn ~fn-name ~@defn-stuff) + (alter-var-root (var ~fn-name) + cached* f-name# ~cache-strategy) + (var ~fn-name))) + +(def function-utils* (atom {})) + +(def memoizers* {:external-memoize external-memoize + :internal-memoize internal-memoize}) + +(defn cached* + "Sets up a cache for the given function with the given name" + [f f-name strategy] + (let [memoizer (-> strategy :plugs-into memoizers*) + internals (memoizer f f-name strategy) + cached-f (:memoized internals) + utils (dissoc internals :memoized)] + (if (and (= memoizer external-memoize) + (= f-name :anon)) + (throw (Exception. (str (strategy :description) + " does not support anonymous functions")))) + (if-not (empty? utils) + (swap! function-utils* assoc cached-f utils)) + cached-f)) + +(defmacro cached + "Returns a cached function that can be invalidated by calling + invalidate-cache e.g + (def fib (cached fib (lru-cache-stategy 5)))" + [f strategy] + (if-not (symbol? f) + `(cached* ~f :anon ~strategy) + `(let [f-name# (str *ns* "." '~f)] + (cached* ~f f-name# ~strategy)))) + +(defn invalidate-cache + "Invalidates the cache for the function call with the given arguments + causing it to be re-evaluated e.g + (invalidate-cache fib 30) ;; A call to (fib 30) will not use the cache + (invalidate-cache fib 29) ;; A call to (fib 29) will not use the cache + (fib 18) ;; A call to (fib 18) will use the cache" + [cached-f & args] + (if-let [inv-fn (:invalidate (@function-utils* cached-f))] + (inv-fn args))) + + +;;======== Stategies for for memoize ========================================== + +(def #^{:doc "A naive strategy for testing external-memoize"} + naive-external-strategy + {:init (fn [_] (atom {})) + :lookup (fn [m args] + (let [v (get @m args ::not-found)] + (if (= v ::not-found) + [false nil] + [true v]))) + :miss! (fn [m args res] + (swap! m assoc args res) + res) + :invalidate! (fn [m args] + (swap! m dissoc args) + nil) + :description "Naive external strategy" + :plugs-into :external-memoize}) + +(def #^{:doc "The naive save-all cache strategy for memoize."} + naive-strategy + {:init {} + :cache identity + :lookup contains? + :hit (fn [state _] state) + :miss assoc + :invalidate assoc + :plugs-into :internal-memoize}) + +(defn lru-cache-strategy + "Implements a LRU cache strategy, which drops the least recently used + argument lists from the cache. If the given limit of items in the cache + is reached, the longest unaccessed item is removed from the cache. In + case there is a tie, the removal order is unspecified." + [limit] + {:init {:lru (into {} (for [x (range (- limit) 0)] [x x])) + :tick 0 + :cache {}} + :cache :cache + :lookup (fn [state k] (contains? (:cache state) k)) + :hit (fn [state args] + (-> state + (assoc-in [:lru args] (:tick state)) + (update-in [:tick] inc))) + :miss (fn [state args result] + (let [k (apply min-key (:lru state) (keys (:lru state)))] + (-> state + (update-in [:lru] dissoc k) + (update-in [:cache] dissoc k) + (assoc-in [:lru args] (:tick state)) + (update-in [:tick] inc) + (assoc-in [:cache args] result)))) + :invalidate (fn [state args placeholder] + (if (contains? (:lru state) args) + (assoc-in state [:cache args] placeholder))) + :plugs-into :internal-memoize}) + + +(defn ttl-cache-strategy + "Implements a time-to-live cache strategy. Upon access to the cache + all expired items will be removed. The time to live is defined by + the given expiry time span. Items will only be removed on function + call. No background activity is done." + [ttl] + (let [dissoc-dead (fn [state now] + (let [ks (map key (filter #(> (- now (val %)) ttl) + (:ttl state))) + dissoc-ks #(apply dissoc % ks)] + (-> state + (update-in [:ttl] dissoc-ks) + (update-in [:cache] dissoc-ks))))] + {:init {:ttl {} :cache {}} + :cache :cache + :lookup (fn [state args] + (when-let [t (get (:ttl state) args)] + (< (- (System/currentTimeMillis) t) ttl))) + :hit (fn [state args] + (dissoc-dead state (System/currentTimeMillis))) + :miss (fn [state args result] + (let [now (System/currentTimeMillis)] + (-> state + (dissoc-dead now) + (assoc-in [:ttl args] now) + (assoc-in [:cache args] result)))) + :invalidate (fn [state args placeholder] + (if (contains? (:ttl state) args) + (assoc-in state [:cache args] placeholder))) + :plugs-into :internal-memoize})) + +(defn lu-cache-strategy + "Implements a least-used cache strategy. Upon access to the cache + it will be tracked which items are requested. If the cache size reaches + the given limit, items with the lowest usage count will be removed. In + case of ties the removal order is unspecified." + [limit] + {:init {:lu (into {} (for [x (range (- limit) 0)] [x x])) :cache {}} + :cache :cache + :lookup (fn [state k] (contains? (:cache state) k)) + :hit (fn [state args] (update-in state [:lu args] inc)) + :miss (fn [state args result] + (let [k (apply min-key (:lu state) (keys (:lu state)))] + (-> state + (update-in [:lu] dissoc k) + (update-in [:cache] dissoc k) + (assoc-in [:lu args] 0) + (assoc-in [:cache args] result)))) + :invalidate (fn [state args placeholder] + (if (contains? (:lu state) args) + (assoc-in state [:cache args] placeholder))) + :plugs-into :internal-memoize})
\ No newline at end of file |