Workshop on Scheme

Answers to exercises: Tuesday, July 18

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 (fibonacci n)
  (if (<= n 1)
      n
      (let loop ((index 2)
                 (previous 0)
                 (current 1))
        (if (= index n)
            current
            (loop (+ index 1) current (+ previous current)))))


;; Construct the numeral for the correctly rounded
;; approximation to num, then (if necessary) pad it on the
;; left with spaces until it is field-width columns wide.

(define (fixed-point num field-width fraction-length)
  (pad-on-left (rounded-numeral num fraction-length)
               #\space
               field-width))

;; To construct the numeral for a real number, rounded to a
;; specified number of places after the decimal point:
;;
;; (1) If fraction-length is zero, so that no decimals
;; should appear, just round off the number and push it
;; through number->string.
;;
;; (2) Otherwise, determine the sign, separate the integer
;; part of the number's absolute value from its fractional
;; part, multiply the fractional part by the power of ten
;; that will push the required number of decimal places to
;; the left-hand side of the decimal point, and round it
;; off.  Check whether this generates a carry; if so, the
;; integer part should be one larger and the digits after
;; the decimal point should be 0.  Call the empoint
;; procedure to put the pieces of the numeral together and
;; attach the sign.

(define (rounded-numeral num fraction-length)
  (if (zero? fraction-length)
      (number->string (inexact->exact (round num)))
      (let* ((sign (if (negative? num) "-" ""))
             (abs-num (abs num))
             (integer-part
              (inexact->exact (truncate (abs-num))))
             (fractional-part
              (- abs-num integer-part)))
             (frac-multiplier
              (expt 10 fraction-length))
             (postpoint
              (inexact->exact 
               (round (* fractional-part
                         frac-multiplier)))))
        (string-append
         sign
         (if (= postpoint frac-multiplier)
            (empoint (+ integer-part 1) 0 fraction-length)
            (empoint integer-part postpoint fraction-length)))))

;; Given an integer to print to the left of a decimal point
;; and an integer representing a decimal fraction to print
;; to the right of a decimal point, convert both to strings
;; and pad the latter on the left with enough zeroes to
;; bring it up to the specified fraction-length, then
;; concatenate the strings, inserting a decimal point
;; between them.

(define (empoint int frac fraction-length)
  (string-append (number->string int)
                 "."
                 (pad-on-left (number->string frac)
                              #\0
                              fraction-length)))

;; To pad a string on the left with copies of a specified
;; character in order to bring it up to a specified minimum
;; length, check whether any padding is needed, and if it
;; is, prepend a string consisting of copies of the pad
;; character and equal in length to the difference between
;; the specified minimum length and the current length.

(define (pad-on-left str pad-char desired-length)
  (let ((len (string-length str)))
    (if (<= desired-length len)
        str
        (string-append (make-string (- desired-length len)
                                    pad-char)
                       str))))


;; Build a translation table from the second and third
;; arguments, then traverse the first argument, looking
;; up each character in the translation table and appending
;; the appropriate copy or replacement to the result.

(define (translate template outs ins)
  (let ((translation-table (build-table outs ins))
        (len (string-length template)))

    (define (translate-char ch)
      (let ((assoc-result (assv ch translation-table)))
        (if assoc-result (cdr assoc-result) ch)))

    (let loop ((index 0)
               (result ""))
      (if (= index len)
          result
          (loop (+ index 1)
                (string-append
                 result
                 (string
                  (translate-char (string-ref template
                                              index)))))))))

;; To build the table, traverse the strings in parallel,
;; adding an entry for each character.  The table is
;; maintained as a list of pairs -- out-character in the
;; car of the pair, in-character in its cdr.  Traversing
;; the strings from left to right ensures that the first
;; entry that will be found for any character that is
;; repeated in outs will be the entry generated by its
;; rightmost occurrence, as required in the specification.

(define (build-table outs ins)
  (let ((len (string-length outs)))
    (let loop ((index 0)
               (result '()))
      (if (= index len)
          result
          (loop (+ index 1)
                (cons (cons (string-ref outs index)
                            (string-ref ins index))
                      result))))))


This document is available on the World Wide Web as

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


created July 17, 1995
last revised July 20, 1995

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