リスト用のマージソート-若干改良-
前回書いたマージソートを、ちょこちょこ修正。
まずは、安定なマージ関数を少しすっきりさせてみる。
(defmacro with-null-check ((var1 var2) &body body) `(cond ((null ,var1) ,var2) ((null ,var2) ,var1) (t ,@body))) ;; 多重評価の問題あり (defmacro poplist (lst) `(prog1 ,lst (setf ,lst (cdr ,lst)))) (defun stable-merge-list (lst1 lst2 <) (declare #.fastest (function <)) (with-null-check (lst1 lst2) (let ((cur (if (funcall < (car lst2) (car lst1)) (poplist lst2) (poplist lst1)))) (prog1 cur (macrolet ((next (x) `(setf (cdr cur) ,x cur ,x ,x (cdr ,x)))) (while (cdr cur) (if (funcall < (car lst2) (car lst1)) (next lst2) (next lst1)))) (setf (cdr cur) (or lst1 lst2))))))
次は、list-merge-sortでのconsを減らす。nletマクロについては、ここを参照。
(defmacro nlet-acc (fn-name letargs &body body) (let ((acc (gensym))) `(let ((,acc '())) (flet ((accumulate (x) (push x ,acc))) (nlet ,fn-name ,letargs ,@body)) (nreverse ,acc)))) ; <- 上記リンクのnlet-acc-revとの違い: nreverseがあるかないか (defun maplist-by-cddr (fn lst) (declare #.fastest (function fn)) (nlet-acc self ((rest lst)) (when rest (self (prog1 (cddr rest) (accumulate (funcall fn rest))))))) ;;; マージソートを行う (defun list-merge-sort (list <) (declare #.fastest (function <)) (labels ((impl (lst) (if (null (cdr lst)) (car lst) (impl (map-pair (lambda (a b) (merge-list a b <)) lst))))) ;; implへの第一引数が、前回のものと異なる (impl (maplist-by-cddr (lambda (lst) (if (null (cdr lst)) lst (progn (when (< (second lst) (first lst)) (rotatef (first lst) (second lst))) (setf (cddr lst) nil) lst))) list))))
前回は、だいたい対象リストの要素数(length list)だけcons*1を行っていたが、上記ソースでは要素数の1/2回のcons*2しか必要ではない。本当は0にしたいが、現状のやり方をベースにしている限りは厳しいかもしれない。
cons回数が減れば、GCのための時間も減るはずなので、これで平均的には少し早くなっただろう。
ちなみに、stable-merge-listとmerge-listの実行時間にはほとんどが差がないので、わざわざunstableなmerge-listを使う理由はないかもしれない。
