;; Median of 3 (good in practice, use median-of-medians for guaranteed
;; linear time).
(define (choose-pivot vec < left right)
(let* ((mid (quotient (+ left right) 2))
(a (vector-ref vec left))
(b (vector-ref vec mid))
(c (vector-ref vec right)))
(if (< a b)
(if (< b c) mid (if (< a c) right left))
(if (< a c) left (if (< b c) right mid)))))
;; Partitions around elt and returns the resulting median index.
(define (vector-partition! vec < left right pivot)
(define (swap! i j)
(let ((tmp (vector-ref vec i)))
(vector-set! vec i (vector-ref vec j))
(vector-set! vec j tmp)))
(let ((elt (vector-ref vec pivot)))
(swap! pivot right)
(let lp ((i left)
(j left))
(cond
((= i right)
(swap! i j)
j)
((< (vector-ref vec i) elt)
(swap! i j)
(lp (+ i 1) (+ j 1)))
(else
(lp (+ i 1) j))))))
;; Permutes vec in-place to move the n smallest elements as ordered by
;; < to the beginning of the vector (unsorted). Returns the nth smallest.
(define (vector-select! vec n <)
(if (not (<= 0 n (vector-length vec)))
(error "n out of range" vec n))
(let select ((left 0)
(right (- (vector-length vec) 1)))
(if (= left right)
(vector-ref vec left)
(let* ((pivot (choose-pivot vec < left right))
(pivot-index (vector-partition! vec < left right pivot)))
(cond
((= n pivot-index)
(vector-ref vec n))
((< n pivot-index)
(select left (- pivot-index 1)))
(else
(select (+ pivot-index 1) right)))))))
--
Alex