マージソート(3): 高階関数呼び出し最適化
マージソート(1)の改良版。
ソートのような高階関数では、引数で渡した比較関数の間接呼び出しのコストも実行速度にそれなりの影響を与えるので、それを(マクロをほとんど使わずに)できるだけ低く抑えるための試み。
比較関数最適化
まず、比較関数自体の実行コストを下げるために、汎用的な数値比較関数ではなく、より特殊化されたものを使用するようにする。
;; fixnum用の比較関数 (define-symbol-macro fixnum< (lambda (x y) (declare (fixnum x y)) (< x y))) ;;; fixnum< を使用した場合の処理時間 ;;; ;;; 大量データのソート速度 ;;; 100万要素のリストが対象 (sb-sys:without-gcing (let* ((data (loop REPEAT 1000000 COLLECT (random 10000000))) (d1 (copy-seq data)) (d2 (copy-seq data)) (r1 (time (stable-sort d1 fixnum<))) (r2 (time (merge-sort:sort d2 fixnum<)))) (equal r1 r2))) Evaluation took: 1.366 seconds of real time ; stable-sort# 1.366秒 (前回 2.484秒) 1.360085 seconds of total run time (1.360085 user, 0.000000 system) 99.56% CPU 2,723,515,890 processor cycles 0 bytes consed Evaluation took: 0.541 seconds of real time ; merge-sort:sort# 0.541秒 (前回 1.662秒) 0.540034 seconds of total run time (0.540034 user, 0.000000 system) 99.82% CPU 1,079,254,874 processor cycles 0 bytes consed --> T
後は、ここからどれだけ短縮できるか。
実装
今回のマージソート実装。
八割方は前と同じ。
まず、ほとんど変更がない前半部分から載せる。(変更箇所はコメントで記載)
(defpackage merge-sort (:use common-lisp) (:shadow :common-lisp sort) (:export sort)) (in-package :merge-sort) ;; inline-sort関数とsort-impl関数がinline宣言に加わっている。前者は今回新たに追加される関数 (declaim (inline halve merge-lists inline-sort sort-impl) (optimize (speed 3) (debug 0) (safety 0))) (defun halve (n) (declare (fixnum n)) (multiple-value-bind (n1 x) (floor n 2) (values (+ n1 x) n1))) (defmacro cdr! (list new-cdr) `(setf (cdr ,list) ,new-cdr)) (defmacro multiple-value-let* (bind-specs &body body) (if (null bind-specs) `(locally ,@body) (destructuring-bind ((vars exp) . rest) bind-specs `(multiple-value-bind ,vars ,exp (multiple-value-let* ,rest ,@body))))) (defun merge-lists (list1 list2 test key) (declare (function test key)) (labels ((less-equal-than (list1 list2) ; 安定ソートになるように比較方法が若干修正されている (not (funcall test (funcall key (car list2)) (funcall key (car list1))))) (recur (head tail l1 l2) (cond ((null l1) (cdr! tail l2) head) ((null l2) (cdr! tail l1) head) ((less-equal-than l1 l2) (recur head (cdr! tail l1) (cdr l1) l2)) (t (recur head (cdr! tail l2) l1 (cdr l2)))))) (declare (inline less-equal-than)) (if (less-equal-than list1 list2) (recur list1 list1 (cdr list1) list2) (recur list2 list2 list1 (cdr list2)))))
次はsort-impl関数。
量は多くないけど、ここが一番重要な変更箇所。
;; 前回は、sort-impl関数自体で再帰処理を行っていたのを、 ;; 再帰部分をrecur関数に括り出すように修正。 ;; ;; これによって、sort-impl関数に対してinline宣言を行うことが可能になる。 ;; ;; sort-impl関数がinline展開可能となると、 ;; inline-sort関数(後述) => sort-impl関数 => merge-lists関数、の ;; 全てがinline展開されるようになるため、 ;; コンパイラが(inline-sort関数の引数で渡され)merge-lists関数内でfuncallされている ;; testとkeyの情報を知ることができるようになり、間接呼び出しを除去する等といった ;; 最適化が可能となる(と思っている)。 (defun sort-impl (list size test key) (labels ((recur (list size) (declare (fixnum size)) (if (= 1 size) (values list (prog1 (cdr list) (cdr! list nil))) (multiple-value-let* (((size1 size2) (halve size)) ((list1 rest) (recur list size1)) ((list2 rest) (recur rest size2))) (values (merge-lists list1 list2 test key) rest))))) (recur list size)))
最後はsort関数。
inline展開の有無を選択するための引数を追加してみた。
※ 単にsort関数をinline宣言するだけでも良いのだが、常に展開されるようになってしまうのも避けたかったの若干(無駄に)凝ってみた
;; inline引数を追加。これが真の場合は、inline展開される。 (defun sort (list test &key (key #'identity) inline) (declare (list list) (function test key) (ignore inline) (optimize (speed 3) (safety 2) (debug 2))) (when list (values (sort-impl list (length list) test key)))) ;; sort関数のinline展開版。上でinline宣言されている以外は、sort関数と基本的に同様。 (defun inline-sort (list test &key (key #'identity)) (declare (list list) (optimize (speed 3) (safety 0) (debug 0))) (when list (values (sort-impl list (length list) test key)))) ;; sort関数のinline引数が真の場合に、(sort関数の代わりに)inline-sort関数を呼び出すためのコンパイラマクロ (define-compiler-macro sort (&whole form list test &key (key '#'identity) inline) (if inline `(inline-sort ,list ,test :key ,key) form))
前回*1と比べて、本質的に異なるのは、sort-impl関数がinline展開可能になった、という点だけ。
計時
今回追加した関数(オプション)を加えて、再度計測。
;;; 大量データのソート速度 ;;; 100万要素のリストが対象 (sb-sys:without-gcing (let* ((data (loop REPEAT 1000000 COLLECT (random 10000000))) (d1 (copy-seq data)) (d2 (copy-seq data)) (d3 (copy-seq data)) (r1 (time (stable-sort d1 fixnum<))) (r2 (time (merge-sort:sort d2 fixnum<))) (r3 (time (merge-sort:sort d3 fixnum< :inline t)))) (list (equal r1 r2) (equal r1 r3)))) Evaluation took: 1.336 seconds of real time ; stable-sort# 1.336秒 1.332083 seconds of total run time (1.332083 user, 0.000000 system) 99.70% CPU 2,664,840,158 processor cycles 0 bytes consed Evaluation took: 0.555 seconds of real time ; merge-sort:sort# 0.555秒 0.552034 seconds of total run time (0.552034 user, 0.000000 system) 99.46% CPU 1,107,829,062 processor cycles 0 bytes consed Evaluation took: 0.382 seconds of real time ; merge-sort:sort(inline)# 0.382秒 0.376024 seconds of total run time (0.376024 user, 0.000000 system) 98.43% CPU 761,537,180 processor cycles 0 bytes consed --> (T T) ;;; 少量データのソート速度 ;;; 平均50要素のリスト x 1万 が対象 (sb-sys:without-gcing (let* ((data (loop REPEAT 10000 COLLECT (loop REPEAT (random 100) COLLECT (random 10000)))) (d1 (copy-tree data)) (d2 (copy-tree data)) (d3 (copy-tree data)) (r1 (time (loop FOR d IN d1 COLLECT (stable-sort d fixnum<)))) (r2 (time (loop FOR d IN d2 COLLECT (merge-sort:sort d fixnum<)))) (r3 (time (loop FOR d IN d3 COLLECT (merge-sort:sort d fixnum< :inline t))))) (list (equal r1 r2) (equal r1 r3)))) Evaluation took: 0.072 seconds of real time ; stable-sort# 0.072秒 0.072004 seconds of total run time (0.072004 user, 0.000000 system) 100.00% CPU 144,958,896 processor cycles 327,680 bytes consed Evaluation took: 0.058 seconds of real time ; merge-sort:sort# 0.058秒 0.056003 seconds of total run time (0.056003 user, 0.000000 system) 96.55% CPU 116,927,902 processor cycles 163,840 bytes consed Evaluation took: 0.036 seconds of real time ; merge-sort:sort(inline)# 0.036秒 0.032002 seconds of total run time (0.032002 user, 0.000000 system) 88.89% CPU 72,255,454 processor cycles 163,840 bytes consed --> (T T)
今回のように比較関数自体の実行コストが低い場合だと、関数呼び出し(funcall)部分を含めてinline化するだけで、処理時間が2/3程度に削減できていることが分かる。
