Lispでバケツソート

日経ソフトウェアの2014年6月号で、バケツソートが紹介されていました。
興味深かったので、Lispで実装してみました。

ソース

(defun backet-sort (v backet-count)
  "バケツソート"
  (let ((backet (array-to-backet v backet-count)))
    (backet-to-array backet (length v))))

(defun array-to-backet (arr backet-count)
  "配列からバケツを構成する"
  (let ((backet (make-array backet-count :initial-element 0)))
    (dotimes (i (length arr) backet)
      (let ((n (aref arr i)))
        (setf (aref backet n) (1+ (aref backet n)))))))

(defun backet-to-array (backet array-length)
  "バケツからソート済みの配列を構成する"
  (let ((arr (make-array array-length)))
    (loop with arr-index = 0
          for i below (length backet)
          when (< 0 (aref backet i))
          do (loop repeat (aref backet i)
                   do (setf (aref arr arr-index) i)
                      (setq arr-index (1+ arr-index))))
    arr))


(defun main ()
  "動作確認のための関数"
  (let ((l (loop with state = (make-random-state t)
                 repeat 10
                 collect (random 10 state))))
    (print (sort (make-array (length l) :initial-contents l) #'<))
    (print (backet-sort (make-array (length l) :initial-contents l) 10))))

(main)

なんとなく汚い感じがするのは、きっと自分の腕が未熟だからでしょう。