Create a gist now

Instantly share code, notes, and snippets.

@cgrand /decay.clj
Last active Jul 12, 2016

What would you like to do?
(ns net.cgrand.decay
"Exponentially decaying lists. See http://awelonblue.wordpress.com/2013/01/24/exponential-decay-of-history-improved/
for background and http://clj-me.cgrand.net/2013/02/12/decaying-lists-log-scale-for-lists/ for documentation")
;; PRNG, formulas straight from java.util.Random javadoc
(defn- seed ^long [^long n]
(bit-and (unchecked-multiply n 0x5DEECE66D)
(unchecked-dec (bit-shift-left 1 48))))
(defn- next-seed ^long [^long seed]
(bit-and (unchecked-add (unchecked-multiply seed 0x5DEECE66D) 0xB)
(unchecked-dec (bit-shift-left 1 48))))
(defn- take-bits ^long [^long n ^long cnt]
(bit-shift-right n (- 48 cnt)))
(defn- next-double ^double [^long s1 ^long s2]
(/ (+ (bit-shift-left (take-bits s1 26) 27) (take-bits s2 27))
(unchecked-double (bit-shift-left 1 53))))
(defn- geometric ^long [^double r ^double lambda]
(unchecked-long (/ (Math/log (- 1.0 r)) lambda)))
(defn- decay-split [l ^long n]
(let [left (doto (object-array (inc n)) (aset n (first l)))]
(loop [right (next l) n n]
(if (pos? n)
(let [n (dec n)]
(aset left n (first right))
(recur (next right) n))
[(seq left) right]))))
(defprotocol DecayingCollection
(decay-loc [coll]
"returns nil or [left right], a split view of the collection where the next
collapse is going to happen. (first left) and (first right) are the items
being collapsed." )
(state [coll]))
(deftype DecayingList [lambda ^clojure.lang.ISeq l ^long seed collapse
^:volatile-mutable ^long nnseed ^:volatile-mutable split
state0 state plus minus capacity]
DecayingCollection
(decay-loc [coll]
(or split
(let [nseed (next-seed seed)
d (next-double seed nseed)
n (min (geometric d lambda) (- capacity 2))]
(set! nnseed (next-seed nseed))
(when (> (count l) (inc n))
(decay-split l n)))))
(state [coll] state)
clojure.lang.IPersistentCollection
(count [this] (.count l))
(cons [this x]
(let [state (plus state x)
[state l]
(if-let [[[left :as lefts] [right :as rights]](set! split (decay-loc this))]
(let [mid (collapse this)
state (cond
(= mid left) (minus state right)
(= mid right) (minus state left)
:else (-> state (minus left) (minus right) (plus mid)))]
[state (-> (next rights) (conj mid) (into (next lefts)))])
[state l])
dl (DecayingList. lambda (conj l x) nnseed collapse 0 nil
state0 state plus minus capacity)]
(set! split nil) ; clearing the cache
dl))
(empty [this] (DecayingList. lambda () seed collapse 0 nil
state0 state0 plus minus capacity))
(equiv [this that] (.equiv l that))
clojure.lang.Sequential
clojure.lang.Seqable
(seq [this] (.seq l))
clojure.lang.IHashEq
(hasheq [this] (.hasheq ^clojure.lang.IHashEq l))
Object
(hashCode [this] (.hashCode l))
(equals [this that] (.equals this that)))
(defn keep-latest
"Returns the most recent of the two candidates to decay."
[coll] (ffirst (decay-loc coll)))
(defn pass-first [x y] x)
(defn decaying-list
"Returns a new decaying list with specified half-life (10 by default.
Supported options are:
* :capacity specifies the maximum length of the list (unlimited by default),
* :collapse a function taking the decaying list to be decayed and returning
one item to be inserted in lieu of the two candidates to decay (keep-latest
by default),
* :state a state maintained after each update (insertion and decay) with :plus
and :minus,
* :plus and :minus functions taking the state and one item and returning the
updated state; :plus is called when an item is added to the list (conj and
return value of :collapse) and :minus when one is removed (decay)."
([] (decaying-list 10))
([half-life & {:keys [collapse state minus plus capacity]
:or {collapse keep-latest
state nil
minus pass-first
plus pass-first
capacity Long/MAX_VALUE}}]
(DecayingList. (- (/ (Math/log 2) half-life)) ()
(seed (System/currentTimeMillis)) collapse
0 nil
state state plus minus capacity)))
;; example
(defn decaying-memoize [f half-life]
(let [cache (atom (decaying-list half-life
:state {}
:plus (fn [m [args r]]
(if-let [[r n] (m args)]
(assoc m args [r (inc n)])
(assoc m args [r 1])))
:minus (fn [m [args r]]
(let [[r n] (m args)
n (dec n)]
(if (zero? n)
(dissoc m args)
(assoc m args [r n]))))))]
(fn [& args]
(let [m (doto (state @cache) (-> count prn))
r (m args)
r (if r (first r) (apply f args))]
(swap! cache conj [args r])
r))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment