バケツソート

(define (bucket-sort list n cmp-fn)
  (define (insertsort l)
    (let ((i 1))
      (while (< i (length l))
             (let ((j (- i 1))
                   (v (ref l i)))
               (while (and (>= j 0) (> (ref l j) v))
                      (swap l (+ 1 j) j)
                      (set! j (- j 1)))
               (set! (ref l (+ 1 j)) v))
             (set! i (+ i 1))))
    l)
  (define (hash x)
    (floor (/ x 3)))
  (define (extract B A)
    (let ((idx 0)
          (i 0))
      (while (< i (vector-length A))
             (set! (ref B i) (insertsort (ref B i)))
             (let ((m 0))
               (while (< m (length (ref B i)))
                      (set! (ref A idx) (ref (ref B i) m))
                      (set! idx (+ 1 idx))
                      (set! m (+ 1 m))))
             (set! i (+ 1 i)))))
  (let ((vec (list->vector list))
        (bucket (make-vector n (make-list 0)))
        (i 0))
    (while (< i (length list))
           (let* ((a_i (ref vec i))
                  (k (hash a_i))
                  (b_k (ref bucket k)))
             (set! (ref bucket k) (append b_k (make-list 1 a_i))))
           (set! i (+ 1 i)))
    (extract bucket vec)
    (vector->list vec)))