(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