読者です 読者をやめる 読者になる 読者になる

リスト用のマージソート-若干改良-

common lisp algorithm

前回書いたマージソートを、ちょこちょこ修正。


まずは、安定なマージ関数を少しすっきりさせてみる。

(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を使う理由はないかもしれない。

*1:最初のmap-pairに渡す関数内で使っていたlist関数の呼び出し回数

*2:maplist-by-cddr内のaccumulateマクロ=cons関数の呼び出し回数