マージソート(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程度に削減できていることが分かる。
マージソート(2): 要素数が少ない部分リストの特別扱い
昨日に作成したマージソートに手を加えたもの。
要素数が少ない部分リスト*1には、(再帰的な)マージソートではなく、ソーティングネットワーク的なソートを適用することで高速化を図った。
けど、結果的にはほとんど効果がなかった。
計時
まず計測結果から載せる。
;;; 大量データのソート速度 ;;; 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 #'<))) (r2 (time (merge-sort:sort d2 #'<)))) ; 更新版: 実装は末尾に掲載 (equal r1 r2))) Evaluation took: 2.542 seconds of real time ; stable-sort# 2.542秒 (前回 2.484秒) 2.536158 seconds of total run time (2.536158 user, 0.000000 system) 99.76% CPU 5,071,126,128 processor cycles 0 bytes consed Evaluation took: 1.691 seconds of real time ; merge-sort:sort# 1.691秒 (前回 1.662秒) 1.688106 seconds of total run time (1.688106 user, 0.000000 system) 99.82% CPU 3,373,722,509 processor cycles 0 bytes consed --> 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)) (r1 (time (loop FOR d IN d1 COLLECT (stable-sort d #'<)))) (r2 (time (loop FOR d IN d2 COLLECT (merge-sort:sort d #'<))))) (equal r1 r2))) Evaluation took: 0.207 seconds of real time ; stable-sort# 0.207秒 (前回 0.204秒) 0.204013 seconds of total run time (0.204013 user, 0.000000 system) 98.55% CPU 414,010,874 processor cycles 327,680 bytes consed Evaluation took: 0.174 seconds of real time ; merge-sort:sort# 0.174秒 (前回 0.176秒) 0.172011 seconds of total run time (0.172011 user, 0.000000 system) 98.85% CPU 346,667,396 processor cycles 163,840 bytes consed --> T
見ての通り、全くと云って良いほど(前回と)結果に差異がない。
少しくらいは速くなるかと期待していたのだけれど・・・。
ソースコード
今回の実装のソースコード。
特に何かが改善されたということでもないので、コメントはいつも以上に手抜き。
(defpackage merge-sort (:use common-lisp) (:shadow :common-lisp sort) (:export sort)) (in-package :merge-sort) (declaim (inline halve last! merge-lists less-equal-than sort2 sort3 sort4 sort5) (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)) (defun last! (list) (prog1 (cdr list) (cdr! list nil))) (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 less-equal-than (list1 list2 test key) (declare (function test key)) (not (funcall test (funcall key (car list2)) (funcall key (car list1))))) (defun merge-lists (list1 list2 test key) (declare (function test key)) (labels ((recur (head tail l1 l2) (cond ((null l1) (cdr! tail l2) head) ((null l2) (cdr! tail l1) head) ((less-equal-than l1 l2 test key) (recur head (cdr! tail l1) (cdr l1) l2)) (t (recur head (cdr! tail l2) l1 (cdr l2)))))) (if (less-equal-than list1 list2 test key) (recur list1 list1 (cdr list1) list2) (recur list2 list2 list1 (cdr list2))))) (eval-when (:compile-toplevel :load-toplevel :execute) (defun symb (&rest args) (intern (format nil "~{~a~}" args)))) (defun sort2 (list test key &aux (l1 list) (l2 (cdr list))) (unless (less-equal-than l1 l2 test key) (rotatef (car l1) (car l2))) (values l1 (last! l2))) ;; (vars (a b c) (list key) ;; body) ;; ;; => ;; (let* ((a list) ;; (b (cdr a)) ;; (c (cdr b))) ;; (let ((_a (funcall key (car a))) ;; (_b (funcall key (car b))) ;; (_c (funcall key (car c)))) ;; body)) (macrolet ((vars (vars (list key) &body body) `(let* ,(loop FOR prev = nil THEN var FOR var IN vars FOR i fixnum FROM 0 COLLECT (if prev `(,var (cdr ,prev)) `(,var ,list))) (declare (function ,key)) (let ,(loop FOR var IN vars COLLECT `(,(symb '_ var) (funcall ,key (car ,var)))) ,@body))) (swap-if-greater-than (x y test) `(unless (less-equal-than ,x ,y ,test #'identity) (rotatef (car ,x) (car ,y)) (rotatef ,(symb '_ x) ,(symb '_ y))))) (defun sort3 (list test key) (vars (a b c) (list key) (swap-if-greater-than a c test) (swap-if-greater-than a b test) (swap-if-greater-than b c test) (values a (last! c)))) (defun sort4 (list test key) (vars (a b c d) (list key) (swap-if-greater-than a c test) (swap-if-greater-than b d test) (swap-if-greater-than a b test) (swap-if-greater-than c d test) (swap-if-greater-than b c test) (values a (last! d)))) (defun sort5 (list test key) (vars (a b c d e) (list key) (swap-if-greater-than a b test) (swap-if-greater-than d e test) (swap-if-greater-than a c test) (swap-if-greater-than b c test) (swap-if-greater-than a d test) (swap-if-greater-than c d test) (swap-if-greater-than b e test) (swap-if-greater-than b c test) (swap-if-greater-than d e test) (values a (last! e))))) (defun sort-impl (list size test key) (declare (fixnum size)) (case size (5 (sort5 list test key)) (4 (sort4 list test key)) (3 (sort3 list test key)) (otherwise (multiple-value-let* (((size1 size2) (halve size)) ((list1 rest) (sort-impl list size1 test key)) ((list2 rest) (sort-impl rest size2 test key))) (values (merge-lists list1 list2 test key) rest))))) (defun sort (list test &key (key #'identity) &aux (size (length list))) (declare (list list) (function test key) (optimize (speed 3) (safety 2) (debug 2))) (case size ((0 1) list) (2 (values (sort2 list test key))) (otherwise (values (sort-impl list size test key)))))
マージソート(1)
久々にマージソートを実装してみたら、結構良いものができたので載せておく。
まずはパッケージ定義とグルーバルな宣言。
;;;; SBCL-1.0.51 (x86-64) (defpackage merge-sort (:use common-lisp) (:shadow :common-lisp sort) (:export sort)) (in-package :merge-sort) (declaim (inline halve merge-lists) (optimize (speed 3) (debug 0) (safety 0)))
ユーティリティ関数とマクロ。
;; 整数nを二分割する関数 ;; => (values n1 n2) ;; ;; nが奇数の場合は (= (1+ n1) n2) となる (defun halve (n) (declare (fixnum n)) (multiple-value-bind (n1 x) (floor n 2) (values (+ n1 x) n1))) ;; listのcdr部を更新するマクロ (defmacro cdr! (list new-cdr) `(setf (cdr ,list) ,new-cdr)) ;; 複数のmultiple-value-bindの使用を簡略化するためのマクロ ;; ;; (multiple-value-let* (((a b) (values 1 2)) ;; ((c d) (values 3 4))) ;; (list a b c d)) ;; => ;; (multiple-value-bind (a b) (values 1 2) ;; (multiple-value-bind (c d) (values 3 4) ;; (list a b c d))) (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)))))
マージソート実装。
;; list1とlist2をマージしたリストを返す (defun merge-lists (list1 list2 test key) (declare (function test key)) (labels ((not-less-than (l1 l2) (not (funcall test (funcall key (car l1)) (funcall key (car l2))))) ; XXX: これでは安定ソートにならない！ (recur (head tail l1 l2) (cond ((null l1) (cdr! tail l2) head) ((null l2) (cdr! tail l1) head) ((not-less-than l1 l2) (recur head (cdr! tail l2) l1 (cdr l2))) (t (recur head (cdr! tail l1) (cdr l1) l2))))) (declare (inline not-less-than)) (if (not-less-than list1 list2) (recur list2 list2 list1 (cdr list2)) (recur list1 list1 (cdr list1) list2)))) ;; マージソート ;; => (values ソート済みリスト=(subseq list 0 size) ;; 未ソートリスト=(subseq list size)) (defun sort-impl (list size test key) (declare (fixnum size)) (if (= 1 size) (values list (prog1 (cdr list) (cdr! list nil))) (multiple-value-let* (((size1 size2) (halve size)) ((list1 rest) (sort-impl list size1 test key)) ((list2 rest) (sort-impl rest size2 test key))) (values (merge-lists list1 list2 test key) rest)))) ;; 公開用の関数: listが空でなければ、sort-implに処理を任せる (defun sort (list test &key (key #'identity)) (declare (list list) (function test key) (optimize (speed 3) (safety 2) (debug 2))) (when list (values (sort-impl list (length list) test key))))
以上。
計時
SBCLの組み込みのマージソート(stable-sort関数)との比較。
;;; 大量データのソート速度 ;;; 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 #'<))) (r2 (time (merge-sort:sort d2 #'<)))) (equal r1 r2))) ; ソート結果が正しいかの確認 Evaluation took: 2.484 seconds of real time ; stable-sort# 2.484秒 2.476154 seconds of total run time (2.368148 user, 0.108006 system) 99.68% CPU 4,955,234,522 processor cycles 0 bytes consed Evaluation took: 1.662 seconds of real time ; merge-sort:sort# 1.662秒 1.652103 seconds of total run time (1.592099 user, 0.060004 system) 99.40% CPU 3,315,393,750 processor cycles 0 bytes consed --> 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)) (r1 (time (loop FOR d IN d1 COLLECT (stable-sort d #'<)))) (r2 (time (loop FOR d IN d2 COLLECT (merge-sort:sort d #'<))))) (equal r1 r2))) Evaluation took: 0.204 seconds of real time ; stable-sort# 0.204秒 0.204012 seconds of total run time (0.204012 user, 0.000000 system) 100.00% CPU 407,272,146 processor cycles 294,912 bytes consed Evaluation took: 0.176 seconds of real time ; merge-sort:sort# 0.176秒 0.172010 seconds of total run time (0.172010 user, 0.000000 system) 97.73% CPU 351,409,803 processor cycles 163,840 bytes consed --> T
自分の環境で試した限りでは、なかなか良好な結果となった。
=関数よりもeql関数の方が速かった(間接呼び出し時)
以下、sbcl-1.0.51-x86-64-linuxでの実行結果。
;; 計時用関数 (defun compare-time (fn nums1 nums2) (declare (optimize (speed 3) (safety 0) (debug 0)) (function fn)) (time (loop FOR n1 fixnum IN nums1 FOR n2 fixnum IN nums2 WHEN (funcall fn n1 n2) SUM 1))) ;; fixnum用の=関数 (declaim (inline fixnum=)) (defun fixnum= (a b) (declare (fixnum a b) (optimize (speed 3) (safety 0) (debug 0))) (= a b)) ;; データ (defparameter *nums1* (loop REPEAT 10000000 COLLECT (random 1000000))) (defparameter *nums2* (loop REPEAT 10000000 COLLECT (random 1000000)))
;;;; 比較 ;; =関数 (compare-time #'= *nums1* *nums2*) Evaluation took: 1.312 seconds of real time 1.300000 seconds of total run time (1.300000 user, 0.000000 system) 99.09% CPU 2,616,703,170 processor cycles 0 bytes consed ==> 12 ;; fixnum=関数 (compare-time #'fixnum= *nums1* *nums2*) Evaluation took: 0.367 seconds of real time 0.350000 seconds of total run time (0.320000 user, 0.030000 system) 95.37% CPU 732,105,438 processor cycles 0 bytes consed ==> 12 ;; eql関数 (compare-time #'eql *nums1* *nums2*) Evaluation took: 0.202 seconds of real time 0.190000 seconds of total run time (0.190000 user, 0.000000 system) 94.06% CPU 403,706,880 processor cycles 0 bytes consed ==>
eql関数の方がだいぶ効率的。少し意外。
直接使用するなら=関数とeqlの間に差異はない。(fixnum=関数はなぜか遅い)
;; = (time (locally (declare (optimize (speed 3) (safety 0) (debug 0))) (loop FOR n1 fixnum IN *nums1* FOR n2 fixnum IN *nums2* WHEN (= n1 n2) SUM 1))) Evaluation took: 0.074 seconds of real time 0.080000 seconds of total run time (0.080000 user, 0.000000 system) 108.11% CPU 147,692,292 processor cycles 0 bytes consed ==> 12 ;; fixnum= (time (locally (declare (optimize (speed 3) (safety 0) (debug 0))) (loop FOR n1 fixnum IN *nums1* FOR n2 fixnum IN *nums2* WHEN (fixnum= n1 n2) SUM 1))) Evaluation took: 0.299 seconds of real time 0.300000 seconds of total run time (0.300000 user, 0.000000 system) 100.33% CPU 595,071,324 processor cycles 0 bytes consed ==> 12 ;; eql (time (locally (declare (optimize (speed 3) (safety 0) (debug 0))) (loop FOR n1 fixnum IN *nums1* FOR n2 fixnum IN *nums2* WHEN (eql n1 n2) SUM 1))) Evaluation took: 0.076 seconds of real time 0.070000 seconds of total run time (0.070000 user, 0.000000 system) 92.11% CPU 150,384,648 processor cycles 0 bytes consed ==> 12
Cの定数値や型のサイズを取得するための関数
sb-alienパッケージとかを使ってネイティブライブラリを使用していると、ちょくちょくCの定数の値や型の定義(型のサイズ)を知りたくなることがある。
毎回ヘッダファイルを調べるのも面倒なので、lisp上から取得出来るように関数を用意してみた。
(defun c-inspect (&key include type value) (flet ((gen-source () (with-output-to-string (out) (format out "~&#include <iostream>~%") (dolist (inc include) (format out "~&#include <~a>~%" inc)) (format out "~%int main() {~%") (dolist (ty type) (format out " std::cout << \"sizeof(~a) = \" << sizeof(~a) << std::endl;~%" ty ty)) (dolist (val value) (format out " std::cout << \"~a = \" << ~a << std::endl;~%" val val)) (format out "}~%")))) ;; 定数や型の情報を出力するためのC++ソースを生成 (with-input-from-string (in (gen-source)) ;; 生成したソースをコンパイル (let ((ret (sb-ext:run-program "g++" `("-x" "c++" "-" "-o" "/tmp/c.inspect.tmp") :search t :input in :output t))) ;; コンパイルに成功しているなら、コマンドを実行 (when (zerop (sb-ext:process-exit-code ret)) (sb-ext:run-program "/tmp/c.inspect.tmp" '() :output t))))) (values))
使用例。
> (c-inspect :type '("int" "unsigned long" "void *") :value '("NULL")) sizeof(int) = 4 sizeof(unsigned long) = 8 sizeof(void *) = 8 NULL = 0 > (c-inspect :include '("sys/socket.h") :value '("PF_UNIX" "SO_ACCEPTCONN" "SO_ERROR")) PF_UNIX = 1 SO_ACCEPTCONN = 30 SO_ERROR = 4 ;; エラー > (c-inspect :type '("undefined_type")) <stdin>: In function ‘int main()’: <stdin>:4: error: ‘undefined_type’ was not declared in this scope
再帰関数(ハノイの塔)にinline宣言をつけたら・・・
Forthでハノイの塔 - sileの日記でハノイの塔を解くcommon lispプログラムを載せたら「inline宣言を付けるともっと早くなりますよ」というコメントを頂いたので試してみた。
inline宣言付与結果
再帰関数をinline展開する際の深さはsb-ext:*inline-expansion-limit*変数で制御できるらしい。
今回はデフォルトの設定値をそのまま利用した。
;; sbcl-1.0.49(linux/64bit) > sb-ext:*inline-expansion-limit* --> 200 ;; inline宣言 (declaim (inline hanoi-impl)) ;; 前回定義したhanoi-impl関数とhanoi関数を再コンパイル ;; (*inline-expansion-limit*を越えました、という長いメッセージが出力される) ;; ... 略 ... ;; 実行 > (time (hanoi 'a 'b 'c 25)) Evaluation took: 0.271 seconds of real time ; 約 2.7 秒 0.270000 seconds of total run time (0.270000 user, 0.000000 system) 99.63% CPU 541,031,826 processor cycles 0 bytes consed --> (:COUNT 33554431)
確かに速くなっている。
ついでにhanoi関数にもinline宣言をつけてみた。
;; inline宣言 (declaim (inline hanoi)) ;; hanoi関数を再コンパイル ;; ... 略 ... ;; 実行 > (time (hanoi 'a 'b 'c 25)) ; 実行時にinline展開される ;; (*inline-expansion-limit*を越えました、という長いメッセージが出力される) Evaluation took: 0.169 seconds of real time ; 約 0.17 秒 0.170000 seconds of total run time (0.170000 user, 0.000000 system) 100.59% CPU 337,858,167 processor cycles 0 bytes consed --> (:COUNT 33554431)
hanoi関数を実行時に展開するようにしたら、C++と同じくらいに高速になった。
ただsbclのtime関数はinline関数の展開時間は所要時間に含めていないようで、少し不公平な感があるので、別の方法でも図ってみた。
;; 実行時のinline展開時間も含めて図ってみる > (get-internal-real-time) (hanoi 'a 'b 'c 25) (get-internal-real-time) (- * ***) --> 304455 ; 開始時間 --> (:COUNT 33554431) --> 304730 ; 終了時間 --> 275 ; 終了 - 開始 = 0.275 秒
展開時間も含めると、特別速いということはなさそう。
それでもinline宣言を全く使用しない場合に比べるとだいぶ良い。
表
各言語でのハノイの塔の処理時間をまとめておく。
| C++ gcc | Forth gforth | Forth VFX-Forth | common lisp sbcl(宣言無) | common lisp sbcl(hanoi-implをinline宣言) | common lisp sbcl(hanoiとhanoi-implをinline宣言) |
| 0.168s | 3.359s | 0.190s | 0.403s | 0.271s | 0.169s (0.275s*1 ) |
教訓
再帰関数でもinline展開すると速くなることがある。
覚えておこう。
*1:実行時のinline展開処理も含めて計測した場合の数値
Forthでハノイの塔
Forthを触ってみたくなったので、試しにハノイの塔を実装してみた。
ついでにcommon lispとC++でも実装し、Forthとの処理速度を比較してみた。
※ common lispの処理系にはSBCLを、Forthの処理系にはgforth及びVFX-Forthを使用した
Forthでの実装(gforth)
gforthはバイトコードタイプのForth実装。
\ gforth-0.7.0 (linux/64bit) \ Forth版のハノイの塔 variable cnt \ 再帰呼び出しの数をカウント用の変数 : hanoi-print ( to from -- to from ) cr 2dup . ." -> " . ; : hanoi-impl ( to tmp from level -- to tmp from ) dup >r 0> if rot swap r@ 1- recurse ( tmp to from ) cnt @ 1+ cnt ! ( hanoi-print 計時用にコメントアウト ) ( tmp to from ) rot r@ 1- recurse ( to from tmp ) swap ( to tmp from ) then r> drop ; : hanoi ( to tmp from level -- ) 0 cnt ! \ カウント初期化 hanoi-impl drop drop drop cr ." count: " cnt @ . cr ; \ 再帰数表示
hanoi-printワードをコメントアウトしなかった場合の実行結果。
$ gforth # shellからgforthコマンドを起動 1 2 3 3 hanoi 3 -> 1 3 -> 2 1 -> 2 3 -> 1 2 -> 3 2 -> 1 3 -> 1 count: 7 ok
gforthでの計時。
$ gforth-fast # 高速版のコマンドを使用する \ 計時用のワードを定義 : time ( word_pointer -- ) utime drop >r execute utime drop r> - 1000 / ." elapsed " . ." ms " cr ; \ 計時 1 2 3 25 ' hanoi time count: 33554431 elapsed 3359 ms \ 結果: 3.34秒 ok
Forthでの実装(VFX-Forth)
VFX-ForthはネイティブコードタイプのForth実装(? 不確か)。
ワードの定義はgforthのそれと同様なので計時部分だけ掲載。
# VFX-Forth-4.43 (linux/32bit ?) $ vfxlin \ 計時用のワードを定義 : time ( word_pointer -- ) ticks >r execute ticks r> - ." elapsed " . ." ms " cr ; \ 計時 1 2 3 25 ' hanoi time count: 33554431 elapsed 190 ms \ 結果: 0.19秒 ok
common lispでの実装(SBCL)
実装及び計時結果。
;;;; sbcl-1.0.49 (linux/64bit) ;; 関数定義 (defvar *count*) (defun hanoi-impl (from tmp to level) (declare (fixnum level) (optimize (speed 3) (safety 0) (debug 0)) (sb-ext:unmuffle-conditions sb-ext:compiler-note)) (when (plusp level) (hanoi-impl from to tmp (1- level)) (incf (the fixnum *count*)) ; (format t "~&~a => ~a~%" from to) (hanoi-impl tmp from to (1- level)))) (defun hanoi (from tmp to level) (let ((*count* 0)) (hanoi-impl from tmp to level) `(:count ,*count*))) ;; 計時 (time (hanoi 'a 'b 'c 25)) Evaluation took: 0.403 seconds of real time ; 結果: 0.40秒 0.390000 seconds of total run time (0.390000 user, 0.000000 system) 96.77% CPU 804,338,623 processor cycles 0 bytes consed (:COUNT 33554431)
C++での実装(GCC)
/* ファイル名: hanoi.cc * コンパイル: g++ -O3 -o hanoi hanoi.cc * バージョン: gcc-4.4.3 (linux/64bit) */ #include <iostream> int count; void hanoi(int from, int tmp, int to, int level) { if(level > 0) { hanoi(from, to, tmp, level-1); count++; hanoi(tmp, from, to, level-1); } } int main() { count=0; hanoi(1, 2, 3, 25); std::cout << "count: " << count << std::endl; return 0; }
コンパイル & 実行。
$ g++ -O3 -o hanoi hanoi.cc $ time ./hanoi count: 33554431 real 0m0.168s # 結果: 0.17秒 user 0m0.170s sys 0m0.000s
ハノイの塔での処理速度比較した結果は、C++(0.17秒)、Forth-VFX(0.20秒)、lisp(0.40秒)、Forth-gforth(3.34秒)、の順となった。
Forthも処理系によっては、C++と同程度の速度がでるみたい。※ 雑な比較なので正確なところは分からないけど・・・
おまけ: 末尾再帰 => ループ変換 版
末尾再帰部分を手動でループに変換したソースコードも書いてみたので、載せておく。
variable cnt : 3dup ( a b c -- a b c a b c ) dup 2over rot ; : hanoi-impl ( to tmp from level -- ) begin dup >r 0> while rot swap 3dup r@ 1- recurse ( tmp to from ) cnt @ 1+ cnt ! rot r> 1- ( to from tmp ) repeat r> drop drop drop drop ; : hanoi ( to tmp from level -- ) 0 cnt ! hanoi-impl cr ." count: " cnt @ . cr ;
この変換によって、gforthの場合は処理時間が短く(2.32秒)なったけど、VFX-Forthでは逆に長く(0.35秒)なってしまった。
