[plt-scheme] Do no evil

I have taken Veer's understanding to derive a relatively short
form of bubble sort in the plain Scheme language:

(define (bsort v)
   (define (sweep v i clean?)
     (cond
       [(= i (- n 1)) (if clean? v (sweep v 0 true))]
       [else (if (<= (vector-ref v i) (vector-ref v (+ i 1)))
                 (sweep v (+ i 1) clean?)
                 (sweep (swap v i) (+ i 1) false))]))
   (define n (vector-length v))
   ;; IN
   (sweep v 0 true))

;; swap: factored out as suggested by Noel,
;; do it with build-vector and weep! bubble
;; demos how bad FP's performance can be :-)

But I have done so in ASL just to demonstrate that it is feasible.

You start with the generative recursion idea of bubbling through
the array until there are no more out of place items left. Then
you're done. Then you 'edit' the program with two observation.
If you were in #lang scheme, you'd come up with the above

The derivation is appended below. -- Matthias



;; [Vec Number] -> [Vec Number]
;; create a sorted version of v
;; effect: modify v
(define (bsort.v0 v)
   (local (;; Result = (list [Vec Number] Boolean)

           ;; [Vec Number] -> [Vec Number]
           ;; (effect) create a sorted version of v
           ;; generative recursion: swap-all until nothing to swap  
anymore
           ;; termination: there are only a finite number of swaps
           (define (generative-driver v)
             (local ((define v+flag (sweep v))
                     (define newv   (first v+flag))
                     (define clean? (second v+flag)))
               (if clean? v (generative-driver v))))

           ;; [Vec Number] -> Result
           ;; (effect) swap all out of place neighbors throughout vector
           (define (sweep v)
             (local (;; [Vec Number] N Boolean -> Result
                     ;; accumulators: [0,i) is bubbled -- clean? no  
swaps so far
                     (define (sweep v i clean?)
                       (cond
                         [(= i (- (vector-length v) 1)) (list v clean?)]
                         [else (if (<= (vector-ref v i) (vector-ref v  
(+ i 1)))
                                   (sweep v (+ i 1) clean?)
                                   (sweep (swap v i) (+ i 1) false))])))
               (sweep v 0 true))))
     ;; IN
     (generative-driver v)))

;; fold the geneative-driver into the sweep function
;; observation: the base case packages up the result,
;; which is immediately unfolded and used for another call

(define (bsort.v1 v)
   (local (;; [Vec Number] -> [Vec Number]
           ;; (effect) swap all out of place neighbors throughout vector
           (define (sweep v)
             (local (;; [Vec Number] N Boolean -> Result
                     ;; accumulators: [0,i) is bubbled -- clean? no  
swaps so far
                     (define (sweep v i clean?)
                       (cond
                         [(= i (- (vector-length v) 1))
                          (if clean? v (sweep v 0 true))]
                         [else (if (<= (vector-ref v i) (vector-ref v  
(+ i 1)))
                                   (sweep v (+ i 1) clean?)
                                   (sweep (swap v i) (+ i 1) false))])))
               (sweep v 0 true))))
     ;; IN
     (sweep v)))

;; eliminate the indirection from 1-ary sweep through 1-ary sweep
;; lift the vector-length computation

(define (bsort v)
   (local (;; [Vec Number] N Boolean -> Result
           ;; accumulators: [0,i) is bubbled -- clean? no swaps so far
           (define (sweep v i clean?)
             (cond
               [(= i (- n 1)) (if clean? v (sweep v 0 true))]
               [else (if (<= (vector-ref v i) (vector-ref v (+ i 1)))
                         (sweep v (+ i 1) clean?)
                         (sweep (swap v i) (+ i 1) false))]))
           ;; where
           (define n (vector-length v)))
     ;; IN
     (sweep v 0 true)))

;;  
-----------------------------------------------------------------------------
;; auxiliaries

;; [Vec Number] N -> [Vec Number]
;; swap items i and i+1 in v
(define (swap v i)
   (local ((define v at i (vector-ref v i)))
     (begin
       (vector-set! v i (vector-ref v (+ i 1)))
       (vector-set! v (+ i 1) v at i)
       v)))

;;  
-----------------------------------------------------------------------------
;; tests

(define (generate-test) (vector 3 1 9 8 5 6 7 0 4 2))
(define swapped0 (vector 1 3 9 8 5 6 7 0 4 2))
(define swapped2 (vector 3 1 8 9 5 6 7 0 4 2))
(define sorted (vector 0 1 2 3 4 5 6 7 8 9))

(check-expect (swap (generate-test) 0) swapped0)
(check-expect (swap (generate-test) 2) swapped2)

(check-expect (bsort (generate-test)) sorted)