## Engineering A Sort Function

### February 23, 2010

Scheme doesn’t provide pointers, so we use indexes into the vector. `Swap!` is a macro that causes its code to be inlined, in the spirit of the Bentley/McIlroy original. Where the original had the pivot selection in-line, we write `pv-init` and `mid3` as functions to simplify the main body of the code. We store the pivot element in `a[0]`, which is one of the options provided by the appendix. We perform an infinite loop with `let loop ()`, and break out of the loop with an `unless` that calls `(loop)` but exits the loop if its condition is not satisfied. Otherwise, we have been very faithful to the Bentley/McIlroy original. Here is our solution:

```(define (vector-sort! vec comp)   (define len (vector-length vec))   (define-syntax v (syntax-rules () ((v k) (vector-ref vec k))))   (define-syntax v! (syntax-rules () ((v! k x) (vector-set! vec k x))))   (define-syntax cmp (syntax-rules () ((cmp a b) (comp (v a) (v b)))))   (define-syntax lt? (syntax-rules () ((lt? a b) (negative? (cmp a b)))))   (define-syntax swap! (syntax-rules () ((swap! a b)     (let ((t (v a))) (v! a (v b)) (v! b t)))))   (define (vecswap! a b s)     (do ((a a (+ a 1)) (b b (+ b 1)) (s s (- s 1))) ((zero? s))       (swap! a b)))```

```  (define (med3 a b c)     (if (lt? b c)         (if (lt? b a) (if (lt? c a) c a) b)         (if (lt? c a) (if (lt? b a) b a) c)))   (define (pv-init a n)     (let ((pm (+ a (quotient n 2))))       (when (> n 7)         (let ((pl a) (pn (+ a n -1)))           (when (> n 40)             (let ((s (quotient n 8)))               (set! pl (med3 pl (+ pl s) (+ pl s s)))               (set! pm (med3 (- pm s) pm (+ pm s)))               (set! pn (med3 (- pn s s) (- pn s) pn))))           (set! pm (med3 pl pm pn))))       pm))```

```  (let qsort ((a 0) (n len))     (if (< n 7)         (do ((pm (+ a 1) (+ pm 1))) ((not (< pm (+ a n))))           (do ((pl pm (- pl 1)))               ((not (and (> pl a) (> (cmp (- pl 1) pl) 0))))             (swap! pl (- pl 1))))         (let ((pv (pv-init a n)) (r #f)               (pa a) (pb a) (pc (+ a n -1)) (pd (+ a n -1)))           (swap! a pv) (set! pv a)           (let loop ()             (while (and (<= pb pc) (<= (assign! r (cmp pb pv)) 0))               (when (= r 0) (swap! pa pb) (set! pa (+ pa 1)))               (set! pb (+ pb 1)))             (while (and (>= pc pb) (>= (assign! r (cmp pc pv)) 0))               (when (= r 0) (swap! pc pd) (set! pd (- pd 1)))               (set! pc (- pc 1)))             (unless (> pb pc)               (swap! pb pc) (set! pb (+ pb 1)) (set! pc (- pc 1)) (loop)))           (let ((pn (+ a n)))             (let ((s (min (- pa a) (- pb pa)))) (vecswap! a (- pb s) s))             (let ((s (min (- pd pc) (- pn pd 1)))) (vecswap! pb (- pn s) s))             (let ((s (- pb pa))) (when (> s 1) (qsort a s)))             (let ((s (- pd pc))) (when (> s 1) (qsort (- pn s) s))))))))```

`While`, `when` and `unless` are from the Standard Prelude. `Assign!` mimics the C in-line assignment syntax; it is a macro because the variable being assigned cannot be evaluated at the time it is called:

```(define-syntax assign!   (syntax-rules ()     ((assign! var expr)       (begin (set! var expr) var))))```

Testing is done with vectors of integers:

```(define (make-rand-vec n)   (let ((v (make-vector n)))     (do ((i 0 (+ i 1))) ((= i n) v)       (vector-set! v i (randint n)))))```

```(define (check-sort? v)   (let ((n (vector-length v)))     (let loop ((i 1))       (cond ((= i n) #t)             ((< (vector-ref v i)                 (vector-ref v (- i 1))) #f)             (else (loop (+ i 1)))))))```

Here’s an example:

```> (define x (make-rand-vec 1024)) > (vector-sort! x (lambda (a b) (- a b))) > (check-sort? x) #t```

As a test, we instrumented the code by adding a counter to the comparison function. Averaged over ten runs, sorting a vector with 220 = 1048576 random integers uses less than 1.1 n log n= 23068672 comparisons per run, as predicted by Bentley and McIlroy.

You can run the program at http://programmingpraxis.codepad.org/WrCRgnp4. We’ll add `vector-sort!` to the Standard Prelude.