SOLUTIONS FOR EXERCISE SET #6

1. A translation table is a list of pairs of characters. Within each pair, the character in the left field can be regarded as eligible for replacement or translation into the character in the right field.

Define a Scheme procedure uc-to-lc-table that takes no arguments and constructs and returns a translation table containing twenty-six pairs, permitting the replacement of each upper-case letter of the alphabet with the corresponding lower-case letter.

(define uc-to-lc-table
  (lambda ()
    (let loop ((ch #\Z)
               (table '()))
      (if (char<? ch #\A)
          table
          (loop (predecessor ch)
                (cons (cons ch (char-downcase ch))
                      table))))))

(define predecessor
  (lambda (ch)
    (let ((ord (char->integer ch)))
      (if (zero? ord)
          (integer->char 255)
          (integer->char (- ord 1))))))
2. Define a Scheme procedure translate that takes two arguments, a string and a translation table, and returns a new string, similar to the given string except that each of the characters that the table makes eligible for translation has been replaced by the corresponding character in the right field of the same pair in the translation table. For instance, after exercise 1, the result of the call (translate "DeForest Kelley" (uc-to-lc-table)) should be "deforest kelley". (Hint: look at the entry for the assv procedure in section 6.3 of the Revised(4) report.)

(define translate
  (lambda (str table)
    (let* ((len (string-length str))
           (result (make-string len)))
      (let loop ((remaining len))
        (if (zero? remaining)
            result
            (let* ((position (- remaining 1))
                   (ch (string-ref str position))
                   (mapping (assv ch table)))
              (string-set! result
                           position
                           (if mapping (cdr mapping) ch))
              (loop position)))))))
3. Define a Scheme procedure write-in-reverse that takes a string as argument and writes it out backwards, last character first and first character last, without changing the string. I don't care what the procedure returns.

(define write-in-reverse
  (lambda (str)
    (let loop ((remaining (string-length str)))
      (if (not (zero? remaining))
          (let ((position (- remaining 1)))
            (write-char (string-ref str position))
            (loop position))))))
4. Define a Scheme procedure that takes a string str as its first argument and a natural number field as its second argument and prints str, using exactly field columns. If str contains fewer than field characters, enough spaces should be printed after it to pad it out to the desired length; if str contains more than field characters, the extra characters at the right end of str should be suppressed. I don't care what the procedure returns.

(define display-in-field
  (lambda (str field)
    (let ((len (string-length str)))
      (if (< field len)
          (display (substring str 0 field))
          (begin
            (display str)
            (display (make-string (- field len) #\space)))))))
5. Define a Scheme procedure substrings that constructs and returns a list containing all of the distinct substrings of a given string, in any order. For instance, given the string "alfalfa", the procedure might return ("" "a" "al" "alf" "alfa" "alfal" "alfalf" "alfalfa" "l" "lf" "lfa" "lfal" "lfalf" "lfalfa" "f" "fa" "fal" "falf" "falfa").

(define substrings
  (lambda (str)
    (let outer ((aft (string-length str))
               (result '()))
      (if (negative? aft)
          result
          (let inner ((fore aft)
                      (result result))
            (if (negative? fore)
                (outer (- aft 1) result)
                (let ((ss (substring str fore aft)))
                  (inner (- fore 1)
                         (if (member? ss result)
                             result
                             (cons ss result))))))))))

(define member?
  (lambda (obj ls)
    (and (not (null? ls))
         (or (equal? obj (car ls))
             (member obj (cdr ls))))))
6. Define a Scheme predicate every? that takes two arguments, a predicate and a list, and determines whether or not every element of the given list satisfies the given predicate. If the list is empty, every? should return #t. Also define the dual predicate some? that takes the same two arguments and determines whether at least one element of the given list satisfies the given predicate.

(define every?
  (lambda (pred? ls)
    (or (null? ls)
        (and (pred? (car ls))
             (every? pred? (cdr ls))))))

(define some?
  (lambda (pred? ls)
    (and (not (null? ls))
         (or (pred? (car ls))
             (some? pred? (cdr ls))))))
7. Define a Scheme procedure map-over-structure that, given a procedure proc and a numeric structure struct, as described in exercise set #4, builds and returns a similar structure, except that each number in the given structure has been replaced with the result of applying proc to that number. (So proc must be a procedure of one argument that can be applied to numbers.) For example, the value of the call (map-over-structure sqrt '((25 . 36) . 81)) should be the structure ((5 . 6) . 9).

(define map-over-structure
  (lambda (proc struct)
    (cond ((null? struct) '())
          ((real? struct) (proc struct))
          ((pair? struct)
           (cons (map-over-structure proc (car struct))
                 (map-over-structure proc (cdr struct))))
          (else
           (error "map-over-structure: requires numeric structure")))))
8. Define a Scheme procedure try that takes as arguments a procedure proc and a list ls and applies proc to each of the elements of ls in turn, returning the first result that is not #f, or #f if all of the results are #f.

(define try
  (lambda (proc ls)
    (and (not (null? ls))
         (or (proc (car ls))
             (try proc (cdr ls))))))
9. Define a Scheme procedure map-over-pairs that returns a list formed by applying a given procedure (of arity 2) to the left and right fields of each pair on a given list of pairs. For instance, the value of the call (map-over-pairs = '((4 . 3) (2 . 2) (5 . 7))) should be (#f #t #f).

(define map-over-pairs
  (lambda (proc ls)
    (let loop ((rest ls)
               (result '()))
      (if (null? rest)
          (reverse result)
          (loop (cdr rest)
                (cons (proc (caar rest) (cdar rest))
                      result))))))
10. Using the read-char procedure described in section 6.10.2 in the Revised(4) report, define a Scheme procedure read-line, of arity 0, that reads in all the characters up to and including the next #\newline character and returns a string comprising all of those characters except the #\newline.

(define read-line
  (lambda ()
    (let loop ((ch (read-char))
               (ch-list '()))
      (if (or (eof-object? ch)
              (char=? ch #\newline))
          (list->string (reverse ch-list))
          (loop (read-char) (cons ch ch-list))))))

created June 18, 1996
last revised June 18, 1996

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