[plt-scheme] Do no evil

Continuing my contrarianocity: When I was taught the bubble sort, I
wish that my teacher had taken the time to explain bubble sort's place
in the pantheon of sorting algorithms (there is essentially no metric
under which it better than some other sort, with the possible
exception of ease of implementation in Fortran 70).

Robby

On Mon, Mar 8, 2010 at 9:39 AM, Matthias Felleisen <matthias at ccs.neu.edu> wrote:
>
> 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)
>
> _________________________________________________
>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>