(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