バケットソート習作

(defun max-elements (&optional (list) (elm 0))
  (if (not list)
      elm
      (max-elements (cdr list) (if (> elm (car list)) elm (car list)))))

(defun vector-to-list (&optional (array) (num 0))
  (if (< num (length array))
      (let ((anum (svref array num)))
	(cond ((= 0 anum) (vector-to-list array (1+ num)))
	      ((< 1 anum) (progn
	 		    (setf (svref array num) (1- anum))
			    (cons (1+ num) (vector-to-list array num))))
	      (t (cons (1+ num) (vector-to-list array (1+ num))))))))

(defun list-to-vector (list array)
  (if list
      (progn
	(setf (svref array (1- (car list))) 1)
	(list-to-vector (cdr list) array))
      array))

(defun bucket-sort (list)
  (setf ary (make-array (list (max-elements list)) :initial-element 0))
  (vector-to-list (list-to-vector list ary)))

; 結果
; * (bucket-sort '(11 8 10 13 4 15 1 12 2))
;
; (1 2 4 8 10 11 12 13 15)
; * 

　これまで書いたソートアルゴリズムを見れば分かるけど、極力vector mapは使わず、Lisp特有のプリミティブな処理で表現しようと努力してきた。が、このアルゴリズムは配列の要素番号がキモなので、やむなくvector mapを採用することに。
　あ、でも、もうちょっと頑張れば、これも単方向リストのみで表現できるかも。
（追記）
　いや、やっぱ俺の技量だと相当頑張る必要があるので、時間的制約から、とりあえずここで止める。
（追記 3/25）
　要素が重複している時に対応できるようにした。