配列用のクイックソート(簡単版)

昨日に引き続き、今日はクイックソートを書いてみる。

一口にクイックソートと云っても、一番内部のループ(配列を二つに分割する処理)の実装方法にいろいろ変種があるので、とりあえず一番楽に実装できそうなものを思い出しつつ書いてみる。

(defun qsort (as <)
  (qsort-impl as 0 (length as) <)
  as)

(defun qsort-impl (as beg end <)
  (macrolet ((ref (x) `(aref as ,x)))
    (when (< beg end)
      (let ((v (ref beg))
	    (cur beg))
	(loop for i from (1+ beg) to (1- end) do
	  (when (funcall < (ref i) v)
	    (rotatef (ref i) (ref (incf cur)))))
	(rotatef (ref beg) (ref cur))
	(qsort-impl as beg cur <)
	(qsort-impl as (1+ cur) end <)))))

ちゃんと実装できたか試してみる。

;;; ランダム配列用意
(defparameter *as* (coerce (loop for i from 0 to 500000 collect (random 100000000)) 'vector))

;;; 標準のソートと結果比較
> (equalp (sort (copy-seq *as*) #'<) (qsort (copy-seq *as*) #'<))
--> T

大丈夫っぽい。

今度もsbclの標準sortと比較してみる。

(defparameter fastest '(optimize (debug 0) (speed 3) (safety 0)))

(defun qsort-impl (as beg end <)
  ;; 宣言追加
  (declare #.fastest
	   (fixnum beg end)
	   (function <))
  ;; 以下同
  ...)

;;; 比較用関数
(defun fixnum-< (a b)
  (declare #.fastest (fixnum a b))
  (< a b))

;;;
(defvar *copy-as*)
(defun init () (setf *copy-as* (copy-seq *as*))

;;; profile
;; 標準sort
> (progn (init) (time (sort *copy-as* #'fixnum-<)) 'done)
;Evaluation took:
;  0.205 seconds of real time
;  0.208013 seconds of total run time (0.208013 user, 0.000000 system)
;  101.46% CPU
;  650,974,618 processor cycles
;  0 bytes consed

;; qsort
> (progn (init) (time (qsort *copy-as* #'fixnum-<)) 'done)
;Evaluation took:
;  0.273 seconds of real time
;  0.272017 seconds of total run time (0.272017 user, 0.000000 system)
;  99.63% CPU
;  867,590,264 processor cycles
;  0 bytes consed

標準sort関数の方が早い。
ただ、qsort-implコンパイル時に、次のようなメッセージが出るので、変数asにも型宣言を追加してみた。

;;; コンパイル時のメッセージ(最適化のための警告 -> 宣言に'(unmuffle-conditions compiler-note)'を追加する必要有り)
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument(= as) is a VECTOR, not a SIMPLE-STRING.

;;; 上記メッセージをもとに、qsort-implを修正
(defun qsort-impl (as beg end <)
  (declare #.fastest
           (fixnum beg end)
           (function <)
           (simple-vector as))         ; 宣言追加
  (macrolet ((ref (x) `(svref as ,x))) ; ついでに、aref -> svrefに変更
    (when (< beg end)
      (let ((v (ref beg))
	    (c beg))
	(declare (fixnum c))           ; これも追加
	(loop for i from (1+ beg) to (1- end) do
	  (when (funcall < (ref i) v)
	    (rotatef (ref i) (ref (incf c)))))
	(rotatef (ref beg) (ref c))
	(qsort-impl as beg c <) 
	(qsort-impl as (1+ c) end <)))))

これだとメッセージは出力されず、実効速度も大分早くなった。

;; 修正版qsort
> (progn (init) (time (qsort *copy-as* #'fixnum-<)) 'done)
;Evaluation took:
;  0.103 seconds of real time
;  0.104007 seconds of total run time (0.104007 user, 0.000000 system)
;  100.97% CPU
;  327,680,222 processor cycles
;  0 bytes consed

標準sortに比べても2倍くらい早い。
前回もそうだが、lisp(sbcl)だとソートなどの場合、型宣言でかなり速度が変わるようだ。

今回作成したクイックソートは、十分な最適化(及び最悪のケースへの対処)が行われていないし、
sort関数との比較方法もテキトウなので、あまりはっきりとしたことは云えないが、
自分でソート関数を書くことも、場合よっては結構有用かもしれない。
(それにしても、sbclはあまりソートに力を入れていないのだろうか? 結構簡単に、組み込みのものより-特定の条件の下で?-早い関数が書けてしまった)
そのうち、余裕があったら、もっと最適化された(かつできれば汎用的な)ソート関数(群)を書いてパッケージにまとめよう。