Skip to content

Commit

Permalink
More performance tweaks
Browse files Browse the repository at this point in the history 
- Use digits for nodes.
- Delay and cache measure for digits and deep trees.
- Skip assert in 'deep'
- Restructure deep split to avoid some calculation.
- Document details of perf tweaks in notes.txt
  • Loading branch information
@Chouser
Chouser committed Sep 15, 2009
1 parent 7df6083 commit 3b9be5b
Show file tree
Hide file tree
Showing 2 changed files with 93 additions and 82 deletions.
127 changes: 45 additions & 82 deletions finger_tree.clj
View file
Expand Up @@ -40,10 +40,6 @@
clojure.lang.Indexed
clojure.lang.fingertree.ISplit])

(gen-interface
:name clojure.lang.fingertree.INode
:extends [clojure.lang.fingertree.Measured clojure.lang.Seqable])

(gen-interface
:name clojure.lang.fingertree.ITree
:extends [clojure.lang.IDoubleSeq
Expand Down Expand Up @@ -75,7 +71,7 @@
:methods [[print [java.io.Writer] Object]])

(import '(clojure.lang ISeq IDoubleSeq IPersistentCollection IPrintable)
'(clojure.lang.fingertree Measured ISplit IDigit INode ITree IDeepTree))
'(clojure.lang.fingertree Measured ISplit IDigit ITree IDeepTree))

;(defmethod print-method IPrintable [x w] (.print #^IPrintable x w))
;(prefer-method print-method IPrintable ISeq)
Expand All @@ -86,10 +82,11 @@

(defmacro #^{:private true} make-digit [measure-fns & items]
(let [i (gensym "i_"), p (gensym "p_")]
`(new [IDigit IPrintable] this#
`(let [mval# (delay (~'mes* ~measure-fns ~@items))]
(new [IDigit IPrintable] this#
(consLeft [x#] (~'digit ~measure-fns x# ~@items))
(consRight [x#] (~'digit ~measure-fns ~@items x#))
(measure [] (~'mes* ~measure-fns ~@items))
(measure [] @mval#)
(measureFns [] ~measure-fns)
(split [~p ~i] ~(letfn [(step [ips [ix & ixs]]
(if (empty? ixs)
Expand Down Expand Up @@ -122,7 +119,7 @@
`(~'digit ~measure-fns ~@(drop-last items))
`(~'empty-ft ~measure-fns)))
(toString [] (str ~@(interpose " " items)))
(print [w#] (.write w# (str "#<digit " this# ">"))))))
(print [w#] (.write w# (str "#<digit " this# ">")))))))

(letfn
[(iden* [measure-fns]
Expand All @@ -148,26 +145,6 @@
(consl [t a] (.consLeft #^IDoubleSeq t a))
(conjr [t a] (.consRight #^IDoubleSeq t a))

(node
([measure-fns a b]
(let [mval (mes* measure-fns a b)
lst (list a b)]
(new [INode IPrintable] this
(measure [] mval)
(measureFns [] measure-fns)
(seq [] lst)
(toString [] (str lst mval))
(print [w] (.write w (str "#<node " this ">"))))))
([measure-fns a b c]
(let [mval (mes* measure-fns a b c)
lst (list a b c)]
(new [INode IPrintable] this
(measure [] mval)
(measureFns [] measure-fns)
(seq [] lst)
(toString [] (str lst mval))
(print [w] (.write w (str "#<node " this ">")))))))

(digit
([measure-fns a] (make-digit measure-fns a))
([measure-fns a b] (make-digit measure-fns a b))
Expand All @@ -177,32 +154,19 @@
(nodes [mfns xs]
(let [v #^clojure.lang.Indexed (vec xs)
c (clojure.lang.RT/count v)]
(loop [i (int 0), nds []]
(condp == (- c i)
(int 2) (-> nds (conj (node mfns (.nth v i) (.nth v (+ (int 1) i)))))
(int 3) (-> nds (conj (node mfns (.nth v i) (.nth v (+ (int 1) i))
(.nth v (+ (int 2) i)))))
(int 4) (-> nds (conj (node mfns (.nth v i) (.nth v (+ (int 1) i))))
(conj (node mfns (.nth v (+ (int 2) i))
(.nth v (+ (int 3) i)))))
(recur (+ (int 3) i)
(-> nds
(conj (node mfns (.nth v i) (.nth v (+ (int 1) i))
(.nth v (+ (int 2) i))))))))))

#_(nodes [mfns xs] (loop [xs xs, nds []]
(condp == (- c i)
(int 2) (-> nds (conj (node mfns (.nth v i) (.nth v (+ (int 1) i)))))
(int 3) (-> nds (conj (node mfns (.nth v i) (.nth v (+ (int 1) i))
(.nth v (+ (int 2) i)))))
(int 4) (-> nds (conj (node mfns (.nth v i) (.nth v (+ (int 1) i))))
(conj (node mfns (.nth v (+ (int 2) i))
(.nth v (+ (int 3) i)))))
(recur (+ (int 4) i)
(-> nds
(conj (node mfns (.nth v i) (.nth v (+ (int 1) i))))
(conj (node mfns (.nth v (+ (int 2) i))
(.nth v (+ (int 3) i)))))))))
(seq
(loop [i (int 0), nds []]
(condp == (- c i)
(int 2) (-> nds (conj (digit mfns (v i) (v (+ (int 1) i)))))
(int 3) (-> nds (conj (digit mfns (v i) (v (+ (int 1) i))
(v (+ (int 2) i)))))
(int 4) (-> nds (conj (digit mfns (v i) (v (+ (int 1) i))))
(conj (digit mfns (v (+ (int 2) i))
(v (+ (int 3) i)))))
(recur (+ (int 3) i)
(-> nds
(conj (digit mfns (v i) (v (+ (int 1) i))
(v (+ (int 2) i)))))))))))

(empty-ft [measure-fns]
(new [ISeq ITree IPrintable] this
Expand Down Expand Up @@ -287,7 +251,7 @@
(cond
(seq pre) (deep pre m suf)
(empty? (.first m)) (to-tree (.measureFns suf) suf)
:else (deep (apply digit (.measureFns m) (.first m))
:else (deep (first m)
(delay-ft (.more m) (.measureMore m))
suf)))

Expand All @@ -297,57 +261,56 @@
(empty? (.peek m)) (to-tree (.measureFns pre) pre)
:else (deep pre
(delay-ft (.pop m) (.measurePop m))
(apply digit (.measureFns m) (.peek m)))))
(peek m))))

(deep [#^IDigit pre, #^ITree m, #^IDigit suf]
;(print "\ndeep ")
(assert (= (.measureFns pre) (.measureFns suf)))
;(assert (= (.measureFns pre) (.measureFns suf)))
(let [measure-fns (.measureFns pre)
mval (if (.seq m)
(mes* measure-fns pre m suf)
(mes* measure-fns pre suf))]
mval (delay (if (.seq m)
(mes* measure-fns pre m suf)
(mes* measure-fns pre suf)))]
(new [IDeepTree IPrintable] this
(pre [] pre)
(mid [] m)
(suf [] suf)
(consLeft [a] (if (< (count pre) 4)
(deep (.consLeft pre a) m suf)
(let [[b c d e] pre
n (node measure-fns c d e)]
n (digit measure-fns c d e)]
(deep (digit measure-fns a b) (.consLeft m n) suf))))
(consRight [a] (if (< (count suf) 4)
(deep pre m (conjr suf a))
(let [[e d c b] suf
n (node measure-fns e d c)]
n (digit measure-fns e d c)]
(deep pre (conjr m n) (digit measure-fns b a)))))
(measureMore [] (mes* measure-fns (next pre) m suf))
(measurePop [] (mes* measure-fns pre m (pop suf)))
(app3 [ts t2] (.app3deep t2 ts this))
(app3deep [ts t1] (let [t2 #^IDeepTree this]
(deep (.pre t1)
(.app3 (.mid t1)
(seq (nodes
measure-fns
(concat (.suf t1) ts (.pre t2))))
(.mid t2))
(nodes measure-fns
(concat (.suf t1) ts (.pre t2)))
(.mid t2))
(.suf t2))))
(measure [] mval)
(measure [] @mval)
(measureFns [] measure-fns)
(split [p i]
(let [vpr (red* measure-fns i (.measure pre))
vm (red* measure-fns vpr (.measure m))]
(cond
(p vpr) (let [[sl sx sr] (.split pre p i)]
[(to-tree measure-fns sl) sx (deep-left sr m suf)])
(p vm) (let [[ml xs mr] (.split m p vpr)
[sl sx sr]
(.split
#^IDigit (apply digit measure-fns xs)
p
(red* measure-fns vpr (mes* measure-fns ml)))]
[(deep-right pre ml sl) sx (deep-left sr mr suf)])
:else (let [[sl sx sr] (.split suf p vm)]
[(deep-right pre m sl) sx (to-tree measure-fns sr)]))))
(let [vpr (red* measure-fns i (.measure pre))]
(if (p vpr)
(let [[sl sx sr] (.split pre p i)]
[(to-tree measure-fns sl) sx (deep-left sr m suf)])
(let [vm (red* measure-fns vpr (.measure m))]
(if (p vm)
(let [[ml xs mr] (.split m p vpr)
[sl sx sr]
(.split
#^IDigit (apply digit measure-fns xs)
p
(red* measure-fns vpr (mes* measure-fns ml)))]
[(deep-right pre ml sl) sx (deep-left sr mr suf)])
(let [[sl sx sr] (.split suf p vm)]
[(deep-right pre m sl) sx (to-tree measure-fns sr)]))))))
(seq [] this)
(rseq [] (lazy-seq (cons (.peek #^IDeepTree this)
(rseq (.pop #^IDeepTree this)))))
Expand Down
48 changes: 48 additions & 0 deletions notes.txt
View file
@@ -0,0 +1,48 @@
Queue:
(time (count (reduce #(-> % (conjr %2) rest) (reduce consl (empty-ft nil) (range 1e4)) (range 1e6))))

letfn: "Elapsed time: 5043.853495 msecs"
digit macro: "Elapsed time: 3411.159957 msecs"
32% better


Split:
(time (let [n 1e4, t (to-tree {:size [(constantly 1) + 0]} (range n))] (dotimes [i n] (split-tree t #(< i (:size %))))))

"Elapsed time: 4408.469664 msecs"
loopless split digit: "Elapsed time: 4102.303245 msecs"
later got this for the same code: "Elapsed time: 3976.687969 msecs"

7% better


Concat:
(time (let [t (to-tree nil (range 1e5))] (dotimes [_ 3e4] (ft-concat t t))))
"Elapsed time: 2402.644912 msecs"
nodes without apply: "Elapsed time: 2004.185324 msecs"
16% better


Using digit for node and always using a delayed measure cache:
queue: 3302.095682 (3% better)
split: 3096.94213 (22% better)
concat: 1680.462405 (16% better)
...it's also less code.

Removing the assert in 'deep' helps a bit too:
queue: 2934.046655
split: 3086.496488
concat: 1631.712977

Delay deep's measure:
queue: 2156.064809
split: 2471.035156
concat: 1510.606604

Slightly better 'split' only calling measure/reduce on middle tree when needed.
split: 2347.711168


Note PersistentQueue does queue test in 363.281297 msecs
(defn t [] (count (reduce #(-> % (conj %2) pop) (reduce conj clojure.lang.PersistentQueue/EMPTY (range 1e4)) (range 1e6))))

0 comments on commit 3b9be5b

Please sign in to comment.