This version of the file performs an in-place iterative quicksort on a mutable vector.

qsort-with-mutation-original.rkt

#lang plai-typed

#;(require rackunit)

(require (typed-in
          racket (round : (number -> number))))

;; let's implement quicksort. Using mutation.


;; quicksort takes a mutable vector of numbers, and sorts them
;; destructively
(define (quicksort [vec : (vectorof number)]) : (vectorof number)
  (begin
    (qsort-helper vec 0 (vector-length vec))
    vec))

;; qsort-helper takes a mutable vector of numbers and a start
;; and end index, and sorts the numbers in the range [start .. end).
;; it returns nothing.
(define (qsort-helper [vec : (vectorof number)] [start : number] [end : number]) : void
  (cond [(< (- end start) 2) (void)]
        [else
         (local
           [(define pivot-posn (round (/ (+ start end) 2)))
            (define pivot-value (vector-ref vec pivot-posn))
            (define first-larger-posn
              (do-qsort-loop-1 vec start (sub1 end) pivot-value
                               pivot-posn))]
         ;; since the element before first-larger-posn
         ;; is known to be the pivot, we can shrink the recursive
         ;; call on the first half by at least one.
         (begin
           (qsort-helper vec start (sub1 first-larger-posn))
           (qsort-helper vec first-larger-posn end)))]))

;; do-qsort-loop-1 takes an array and two array indexes and a
;; pivot value, and
;; scans for elements to be swapped, so that at the end
;; all of the elements <= the pivot are to the left of those
;; greater. it returns the smallest index such that all
;; lower indexes are known to be smaller than or equal to
;; the pivot.
;;
;; NB: the pivot value *must* occur in the range, or things
;; break.
;;
;; the invariant here is that the elements to the left of
;; the 'first' are known to be <= the pivot, and those to
;; the right of the 'last' are known to be larger than the
;; pivot.
;;
;; the 'progress' argument here involves induction on (last-first).
;; specifically, if (last-first) is less than zero, then both
;; of the following two functions halt. Otherwise, suppose
;; that the induction hypothesis holds for (last-first-1).
;; it turns out that we want to consider the second function first.
;; the second function can either halt, or it can decrease 'last',
;; which allows us to use the induction hypothesis, or it can perform
;; a swap and both increase first and reduce last, which uses the
;; induction hypothesis. This proves that the *second* helper function
;; always halts.
;; for the first function, it can either halt immediately, or it
;; can increase first (and then the induction hypothesis applies), or
;; it can make a call with the same value of (last-first) to the
;; second function, for which we've already proved the lemma. QED!
;; And: what a pain in the rear!
;;
;; painfully, we have a problem that we may wind up discovering
;; that all of the elements are <= the pivot, meaning that the
;; parent function is going to recur on a "sub-array" that is of
;; the same size. In order to ensure that the parent function makes
;; progress, we need to ensure that the pivot itself winds up
;; at a known location, so that we can guarantee that this element
;; won't be visited again. Blecch.
(define (do-qsort-loop-1 [vec : (vectorof number)] [first : number] [last : number]
                         [pivot-value : number] [pivot-index : number]) : number
  (cond [(< last first)
         (begin
           ;; ensure that the pivot is just before the split.
           (vec-swap vec pivot-index (sub1 first))
           first)]
        [(<= (vector-ref vec first) pivot-value)
         (do-qsort-loop-1 vec (add1 first) last pivot-value pivot-index)]
        [else ;; found an element that needs to be swapped
         (do-qsort-loop-2 vec first last pivot-value pivot-index)]))

;; do-qsort-loop-2 does the "second half" of the qsort loop,
;; where we're scanning for an element to swap with the one
;; found by the first loop.
;;
;; the invariant here, along with the invariant from the prior
;; function, is that 'first' is known to point to an element
;; that is larger than the pivot.
(define (do-qsort-loop-2 [vec : (vectorof number)] [first : number] [last : number]
                         [pivot-value : number] [pivot-index : number]) : number
  (cond [(< last first)
         (begin
           (vec-swap vec pivot-index (sub1 first))
           first)]
        [(< pivot-value (vector-ref vec last))
         (do-qsort-loop-2 vec first (sub1 last) pivot-value
                          pivot-index)]
        [else ;;found two elements that need to be swapped
           ;; they can't be the same, if the invariants hold.
         (begin  
           (vec-swap vec first last)
           ;; oh no! if the newly swapped element is = to the pivot,
           ;; we need to know that:
           (local
             [(define new-pivot-index
                (cond [(= last pivot-index) first]
                      [else pivot-index]))]
             (do-qsort-loop-1 vec (add1 first) (sub1 last) pivot-value
                              new-pivot-index)))]))

;; swap two elements in a mutable array
(define (vec-swap [vec : (vectorof number)] [a : number] [b : number])
  (let ([tmp (vector-ref vec a)])
    (begin
      (vector-set! vec a (vector-ref vec b))
      (vector-set! vec b tmp))))


(test (do-qsort-loop-1 (vector 23 4 6 8 5 9 22) 1 5 9 5) 6)
(test (do-qsort-loop-1 (vector 23 4 6 8 5 9 22) 1 5 5 4) 3)
(test (do-qsort-loop-1 (vector 23 4 6 8 5 9 22) 1 5 4 1) 2)