Workshop on Scheme

Answers to exercises: Wednesday, July 19

The authors' answers to the exercises from Scheme and the art of programming are available only on MathLAN and only during the week of the workshop. Click here.


(define (vector-generator gen-proc)
  (lambda (size)
    (let ((result (make-vector size)))
      (do ((index 0 (+ index 1)))
          ((= index size) result)
        (vector-set! result index (gen-proc index))))))


For the bubblesort fan:

(define (bubblesort! vec . opt)

  (define precedes? (if (null? opt) < (car opt)))

  (define (swap! index-1 index-2)
    (let ((temp (vector-ref vec index-1)))
      (vector-set! vec index-1 (vector-ref vec index-2))
      (vector-set! vec index-2 temp)))

  (define len (vector-length vec))
 
  (do ((stop (- len 1) (- stop 1)))
      ((zero? stop))
    (do ((current 0 next)
         (next 1 (+ next 1)))
        ((= current stop))
      (if (precedes? (vector-ref vec next)
                     (vector-ref vec current))
          (swap! current next)))))
For others:
(define (heapsort! vec . opt)

  (define precedes? (if (null? opt) < (car opt)))

  (define (move! index-1 index-2)
    (vector-set! vec index-2 (vector-ref vec index-1)))

  (define (swap! index-1 index-2)
    (let ((temp (vector-ref vec index-1)))
      (vector-set! vec index-1 (vector-ref vec index-2))
      (vector-set! vec index-2 temp)))

  (define (parent-of index)
    (quotient (- index 1) 2))

  (define (downheap! index heap-boundary)

    (define (greater-child index)
      (let* ((left-child (+ index index 1))
             (right-child (+ left-child 1)))
        (cond ((<= heap-boundary left-child) #f) ; no child
              ((= heap-boundary right-child) left-child)
              ((precedes? (vector-ref vec left-child)
                          (vector-ref vec right-child))
               right-child)
              (else left-child))))

    ; body of downheap!
    (let ((temp (vector-ref vec index)))
      (let loop ((parent index)
                 (child (greater-child index)))
        (if (and child
                 (precedes? temp
                            (vector-ref vec child)))
            (begin
              (move! child parent)
              (loop child (greater-child child)))
            (vector-set! vec parent temp)))))

  ; body of heapsort!
  (let ((heap-boundary (vector-length vec)))
    (do ((index (parent-of (- heap-boundary 1))
                (- index 1)))
        ((negative? index))
      (downheap! index heap-boundary))
    (do ((last-index (- heap-boundary 1) (- last-index 1)))
        ((negative? last-index))
      (swap! 0 last-index)
      (downheap! 0 last-index))))


(define rnd
  (make-rng (+ (* 100000 (get-internal-run-time))
               (current-time))))

(define (random-vector size)
  ((vector-generator (lambda (index) (rnd))) size))


This document is available on the World Wide Web as

http://www.math.grin.edu/~stone/events/scheme-workshop/Wednesday-answers.html


created July 19, 1995
last revised July 19, 1995

John David Stone (stone@math.grin.edu)