Answers to Selected Exercises

Exercise 2.2.1. (Page 20)

Exercise 2.2.2. (Page 20)
See Section 6.4.

Exercise 2.2.3. (Page 20)

Exercise 2.2.4. (Page 20)

(car (cdr (car '((a b) (c d)))))  b
(car (car (cdr '((a b) (c d)))))  c
(car (cdr (car (cdr '((a b) (c d))))))  d

Exercise 2.2.5. (Page 20)

'((a . b) ((c) d) ())

Exercise 2.2.6. (Page 21)

Exercise 2.2.7. (Page 21)

(car '((a b) (c d)))  (a b)
(car (car '((a b) (c d))))  a
(cdr (car '((a b) (c d))))  (b)
(car (cdr (car '((a b) (c d)))))  b
(cdr (cdr (car '((a b) (c d)))))  ()
(cdr '((a b) (c d)))  ((c d))
(car (cdr '((a b) (c d))))  (c d)
(car (car (cdr '((a b) (c d)))))  c
(cdr (car (cdr '((a b) (c d)))))  (d)
(car (cdr (car (cdr '((a b) (c d))))))  d
(cdr (cdr (car (cdr '((a b) (c d))))))  ()
(cdr (cdr '((a b) (c d))))  ()

Exercise 2.2.8. (Page 21)
See Section 2.3.

Exercise 2.3.1. (Page 22)

1. Evaluate the variables list, +, -, *, and /, yielding the list, addition, subtraction, multiplication, and division procedures.
2. Apply the list procedure to the addition, subtraction, multiplication, and division procedures, yielding a list containing these procedures in order.
3. Evaluate the variable cdr, yielding the cdr procedure.
4. Apply the cdr procedure to the list produced in step 2, yielding a list containing the subtraction, multiplication, and division procedures.
5. Evaluate the variable car, yielding the car procedure.
6. Apply the car procedure to the list produced in step 4, yielding the subtraction procedure.
7. Evaluate the constants 17 and 5, yielding 17 and 5.
8. Apply the subtraction procedure to 17 and 5, yielding 12.

Other orders are possible. For example, the variable car could have been evaluated before its argument.

Exercise 2.4.1. (Page 24)

Exercise 2.4.2. (Page 25)
The value is 54. The outer let binds x to 9, while the inner let binds x to 3 (9/3). The inner let evaluates to 6 (3 + 3), and the outer let evaluates to 54 (9 × 6).

Exercise 2.4.3. (Page 25)

Exercise 2.5.1. (Page 29)

Exercise 2.5.2. (Page 29)
See page 30.

Exercise 2.5.3. (Page 29)

Exercise 2.6.1. (Page 32)
The program would loop indefinitely.

Exercise 2.6.2. (Page 33)

(define compose
  (lambda (p1 p2)
    (lambda (x)
      (p1 (p2 x)))))

(define cadr (compose car cdr))
(define cddr (compose cdr cdr))

Exercise 2.6.3. (Page 33)

(define caar (compose car car))
(define cadr (compose car cdr))

(define cdar (compose cdr car))
(define cddr (compose cdr cdr))

(define caaar (compose car caar))
(define caadr (compose car cadr))
(define cadar (compose car cdar))
(define caddr (compose car cddr))

(define cdaar (compose cdr caar))
(define cdadr (compose cdr cadr))
(define cddar (compose cdr cdar))
(define cdddr (compose cdr cddr))

(define caaaar (compose caar caar))
(define caaadr (compose caar cadr))
(define caadar (compose caar cdar))
(define caaddr (compose caar cddr))
(define cadaar (compose cadr caar))
(define cadadr (compose cadr cadr))
(define caddar (compose cadr cdar))
(define cadddr (compose cadr cddr))

(define cdaaar (compose cdar caar))
(define cdaadr (compose cdar cadr))
(define cdadar (compose cdar cdar))
(define cdaddr (compose cdar cddr))
(define cddaar (compose cddr caar))
(define cddadr (compose cddr cadr))
(define cdddar (compose cddr cdar))
(define cddddr (compose cddr cddr))

Exercise 2.7.1. (Page 39)

(define atom?
  (lambda (x)
    (not (pair? x))))

Exercise 2.7.2. (Page 39)

(define shorter
  (lambda (ls1 ls2)
    (if (< (length ls2) (length ls1))
        ls2
        ls1)))

Exercise 2.8.1. (Page 44)
The structure of the output would be the mirror image of the structure of the input. For example, (a . b) would become (b . a) and ((a . b) . (c . d)) would become ((d . c) . (b . a)).

Exercise 2.8.2. (Page 44)

(define append
  (lambda (ls1 ls2)
    (if (null? ls1)
        ls2
        (cons (car ls1) (append (cdr ls1) ls2)))))

Exercise 2.8.3. (Page 44)

(define make-list
  (lambda (n x)
    (if (= n 0)
        '()
        (cons x (make-list (- n 1) x)))))

Exercise 2.8.4. (Page 45)
See pages 135 and 136.

Exercise 2.8.5. (Page 45)

(define shorter?
  (lambda (ls1 ls2)
    (and (not (null? ls2))
         (or (null? ls1)
             (shorter? (cdr ls1) (cdr ls2))))))

(define shorter
  (lambda (ls1 ls2)
    (if (shorter? ls2 ls1)
        ls2
        ls1)))

Exercise 2.8.6. (Page 45)

(define even?
  (lambda (x)
    (or (= x 0)
        (odd? (- x 1)))))
(define odd?
  (lambda (x)
    (and (not (= x 0))
         (even? (- x 1)))))

Exercise 2.8.7. (Page 45)

(define transpose
  (lambda (ls)
    (cons (map car ls) (map cdr ls))))

Exercise 2.9.1. (Page 52)

(define make-counter
  (lambda (init incr)
    (let ((next init))
      (lambda ()
        (let ((v next))
          (set! next (+ next incr))
          v)))))

Exercise 2.9.2. (Page 52)

(define make-stack
  (lambda ()
    (let ((ls '()))
      (lambda (msg . args)
        (case msg
          ((empty? mt?) (null? ls))
          ((push!) (set! ls (cons (car args) ls)))
          ((top) (car ls))
          ((pop!) (set! ls (cdr ls)))
          (else "oops"))))))

Exercise 2.9.3. (Page 53)

(define make-stack
  (lambda ()
    (let ((ls '()))
      (lambda (msg . args)
        (case msg
          ((empty? mt?) (null? ls))
          ((push!) (set! ls (cons (car args) ls)))
          ((top) (car ls))
          ((pop!) (set! ls (cdr ls)))
          ((ref) (list-ref ls (car args)))
          ((set!) (set-car! (list-tail ls (car args)) (cadr args)))
          (else "oops"))))))

Exercise 2.9.4. (Page 53)

(define make-stack
  (lambda (n)
    (let ((v (make-vector n)) (i -1))
      (lambda (msg . args)
        (case msg
          ((empty? mt?) (= i -1))
          ((push!)
           (set! i (+ i 1))
           (vector-set! v i (car args)))
          ((top) (vector-ref v i))
          ((pop!) (set! i (- i 1)))
          ((ref) (vector-ref v (- i (car args))))
          ((set!) (vector-set! v (- i (car args)) (cadr args)))
          (else "oops"))))))

Exercise 2.9.5. (Page 53)
Using Chez Scheme's error:

(define emptyq?
  (lambda (q)
    (eq? (car q) (cdr q))))

(define getq
  (lambda (q)
    (if (emptyq? q)
        (error 'getq "the queue is empty")
        (car (car q)))))

(define delq!
  (lambda (q)
    (if (emptyq? q)
        (error 'delq! "the queue is empty")
        (set-car! q (cdr (car q))))))

Exercise 2.9.6. (Page 53)

(define make-queue
  (lambda ()
    (cons '() '())))

(define putq!
  (lambda (q v)
    (let ((p (cons v '())))
      (if (null? (car q))
          (begin
            (set-car! q p)
            (set-cdr! q p))
          (begin
            (set-cdr! (cdr q) p)
            (set-cdr! q p))))))

(define getq
  (lambda (q)
    (car (car q))))

(define delq!
  (lambda (q)
    (if (eq? (car q) (cdr q))
        (begin
          (set-car! q '())
          (set-cdr! q '()))
        (set-car! q (cdr (car q))))))

Exercise 2.9.7. (Page 54)
The behavior depends upon the Scheme implementation. When asked to print a cyclic structure, Chez Scheme prints a warning that the output is cyclic, then proceeds to print a representation of the output that reflects its cyclic structure. Similarly, when the built-in length is passed a cyclic list, Chez Scheme signals an error to that effect. The definition of length on page 40 will simply loop indefinitely.

Exercise 2.9.8. (Page 54)

(define race
  (lambda (hare tortoise)
    (if (pair? hare)
        (let ((hare (cdr hare)))
          (if (pair? hare)
              (and (not (eq? hare tortoise))
                   (race (cdr hare) (cdr tortoise)))
              (null? hare)))
        (null? hare))))

(define list?
  (lambda (x)
    (race x x)))

Exercise 3.1.1. (Page 61)

(let ((x (memv 'a ls))) (and x (memv 'b x))) 
  ((lambda (x) (and x (memv 'b x))) (memv 'a ls)) 
  ((lambda (x) (if x (and (memv 'b x)) #f)) (memv 'a ls)) 
  ((lambda (x) (if x (memv 'b x) #f)) (memv 'a ls))

Exercise 3.1.2. (Page 61)

(or (memv x '(a b c)) (list x)) 
  (let ((t (memv x '(a b c)))) (if t t (or (list x)))) 
  ((lambda (t) (if t t (or (list x)))) (memv x '(a b c))) 
  ((lambda (t) (if t t (list x))) (memv x '(a b c)))

Exercise 3.1.3. (Page 61)
See page 88.

Exercise 3.1.4. (Page 62)

(define-syntax when
  (syntax-rules ()
    ((_ e0 e1 e2 ...)
     (if e0 (begin e1 e2 ...)))))

(define-syntax unless
  (syntax-rules ()
    ((_ e0 e1 e2 ...)
     (when (not e0) e1 e2 ...))))

Exercise 3.2.1. (Page 69)
Tail-recursive: even? and odd?, race, fact in second definition of factorial, fib in second version of fibonacci. Nontail-recursive: sum, factorial, fib in first version of fibonacci. Both: factor.

Exercise 3.2.2. (Page 69)

(define factor
  (lambda (n)
    (letrec ((f (lambda (n i)
                  (cond
                    ((>= i n) (list n))
                    ((integer? (/ n i))
                     (cons i (f (/ n i) i)))
                    (else (f n (+ i 1)))))))
      (f n 2))))

Exercise 3.2.3. (Page 69)
Yes, but we need two named let expressions, one for even? and one for odd?.

(let even? ((x 20))
  (or (= x 0)
      (let odd? ((x (- x 1)))
        (and (not (= x 0))
             (even? (- x 1))))))

Exercise 3.2.4. (Page 70)

(define fibcount1 0)
(define fibonacci1
  (lambda (n)
    (let fib ((i n))
      (set! fibcount1 (+ fibcount1 1))
      (cond
        ((= i 0) 0)
        ((= i 1) 1)
        (else (+ (fib (- i 1)) (fib (- i 2))))))))

(define fibcount2 0)
(define fibonacci2
  (lambda (n)
    (if (= n 0)
        0
        (let fib ((i n) (a1 1) (a2 0))
          (set! fibcount2 (+ fibcount2 1))
          (if (= i 1)
              a1
              (fib (- i 1) (+ a1 a2) a1))))))

The counts for (fibonacci 10) are 177 and 10, for (fibonacci 20) are 21891 and 20, and for (fibonacci 30) are 2692537 and 30. While the number of calls made by the second is directly proportional to the input, the number of calls made by the first grows rapidly (exponentially, in fact) as the input value increases.

Exercise 3.2.5. (Page 70)
See page 201.

Exercise 3.2.6. (Page 70)
A call in the last subexpression of an or expression in tail position would not be a tail call with the modified definition of or. For the even?/odd? example, the resulting definition of even? would no longer be tail recursive and for very large inputs might exhaust available space.

Exercise 3.2.7. (Page 70)
The first of the three versions of factor below directly addresses the identified problems by stopping at , avoiding the redundant division, and skipping the even factors after 2. Stopping at probably yields the biggest savings, followed by skipping even factors greater than 2. Avoiding the redundant division is less important, since it occurs only when a factor is found.

(define factor
  (lambda (n)
    (let f ((n n) (i 2) (step 1))
      (if (> i (sqrt n))
          (list n)
          (let ((n/i (/ n i)))
            (if (integer? n/i)
                (cons i (f n/i i step))
                (f n (+ i step) 2)))))))

The second version replaces (> i (sqrt n)) with (> (* i i) n), since * is typically much faster than sqrt.

(define factor
  (lambda (n)
    (let f ((n n) (i 2) (step 1))
      (if (> (* i i) n)
          (list n)
          (let ((n/i (/ n i)))
            (if (integer? n/i)
                (cons i (f n/i i step))
                (f n (+ i step) 2)))))))

The third version uses gcd (see page 147) to avoid most of the divisions, since gcd should be faster than /.

(define factor
  (lambda (n)
    (let f ((n n) (i 2) (step 1))
      (if (> (* i i) n)
          (list n)
          (if (= (gcd n i) 1)
              (f n (+ i step) 2)
              (cons i (f (/ n i) i step)))))))

To see the difference these changes make, time each version of factor, including the original, in your Scheme system to see which performs better. Try a variety of inputs, including larger ones like (+ (expt 2 100) 1).

Exercise 3.3.1. (Page 74)

(let ((k.n (call/cc (lambda (k) (cons k 0)))))
  (let ((k (car k.n)) (n (cdr k.n)))
    (write n)
    (newline)
    (k (cons k (+ n 1)))))

Or with multiple values (see Section 5.7):

(call-with-values
  (lambda () (call/cc (lambda (k) (values k 0))))
  (lambda (k n)
    (write n)
    (newline)
    (k k (+ n 1))))

Exercise 3.3.2. (Page 74)

(define product
  (lambda (ls)
    (if (null? ls)
        1
        (if (= (car ls) 0)
            0
            (let ((n (product (cdr ls))))
              (if (= n 0) 0 (* n (car ls))))))))

Exercise 3.3.3. (Page 74)
If one of the processes returns without calling pause, it returns to the call to pause that first caused it to run, or to the original call to start if it was the first process in the list. Here is a reimplementation of the system that allows a process to quit explicitly. If other processes are active, the lwp system continues to run. Otherwise, control returns to the continuation of the original call to start.

(define lwp-list '())
(define lwp
  (lambda (thunk)
    (set! lwp-list (append lwp-list (list thunk)))))
(define start
  (lambda ()
    (call/cc
      (lambda (k)
        (set! quit-k k)
        (next)))))
(define next
  (lambda ()
    (let ((p (car lwp-list)))
      (set! lwp-list (cdr lwp-list))
      (p))))
(define pause
  (lambda ()
    (call/cc
      (lambda (k)
        (lwp (lambda () (k #f)))
        (next)))))
(define quit
  (lambda (v)
    (if (null? lwp-list)
        (quit-k v)
        (next))))

Exercise 3.3.4. (Page 74)

(define lwp-queue (make-queue))
(define lwp
  (lambda (thunk)
    (putq! lwp-queue thunk)))
(define start
  (lambda ()
    (let ((p (getq lwp-queue)))
      (delq! lwp-queue)
      (p))))
(define pause
  (lambda ()
    (call/cc
      (lambda (k)
        (lwp (lambda () (k #f)))
        (start)))))

Exercise 3.4.1. (Page 77)

(define reciprocal
  (lambda (n success failure)
    (if (= n 0)
        (failure)
        (success (/ 1 n)))))

Exercise 3.4.2. (Page 77)

(define retry #f)

(define factorial
  (lambda (x)
    (let f ((x x) (k (lambda (x) x)))
      (if (= x 0)
          (begin (set! retry k) (k 1))
          (f (- x 1) (lambda (y) (k (* x y))))))))

Exercise 3.4.3. (Page 77)

(define map/k
  (lambda (p ls k)
    (if (null? ls)
        (k '())
        (p (car ls)
           (lambda (x)
             (map/k p (cdr ls)
               (lambda (ls)
                 (k (cons x ls)))))))))

(define reciprocals
  (lambda (ls)
    (map/k (lambda (x k) (if (= x 0) "zero found" (k (/ 1 x))))
           ls
           (lambda (x) x))))

Exercise 3.5.1. (Page 81)

(define-syntax complain
  (syntax-rules ()
    ((_ ek msg exp) (ek (list msg exp)))))

Exercise 3.5.2. (Page 81)

(define calc
  (lambda (exp)
    (call/cc
      (lambda (ek)
        (define do-calc
          (lambda (exp)
            (cond
              ((number? exp) exp)
              ((and (list? exp) (= (length exp) 3))
               (let ((op (car exp)) (args (cdr exp)))
                 (case op
                   ((add) (apply-op + args))
                   ((sub) (apply-op - args))
                   ((mul) (apply-op * args))
                   ((div) (apply-op / args))
                   (else (complain "invalid operator" op)))))
              (else (complain "invalid expression" exp)))))
        (define apply-op
          (lambda (op args)
            (op (do-calc (car args)) (do-calc (cadr args)))))
        (define complain
          (lambda (msg exp)
            (ek (list msg exp))))
        (do-calc exp)))))

Exercise 3.5.3. (Page 81)
Using Chez Scheme's error:

(define calc #f)
(let ()
  (define do-calc
    (lambda (exp)
      (cond
        ((number? exp) exp)
        ((and (list? exp) (= (length exp) 3))
         (let ((op (car exp)) (args (cdr exp)))
           (case op
             ((add) (apply-op + args))
             ((sub) (apply-op - args))
             ((mul) (apply-op * args))
             ((div) (apply-op / args))
             (else (complain "invalid operator" op)))))
        (else (complain "invalid expression" exp)))))
  (define apply-op
    (lambda (op args)
      (op (do-calc (car args)) (do-calc (cadr args)))))
  (define complain
    (lambda (msg exp)
      (error 'calc "~a ~s" msg exp)))
  (set! calc
    (lambda (exp)
      (do-calc exp))))

Exercise 3.5.4. (Page 81)
This adds sqrt, times (an alias for mul), and expt along with minus.

(let ()
  (define do-calc
    (lambda (ek exp)
      (cond
        ((number? exp) exp)
        ((and (list? exp) (= (length exp) 2))
         (let ((op (car exp)) (args (cdr exp)))
           (case op
             ((minus) (apply-op1 ek - args))
             ((sqrt) (apply-op1 ek sqrt args))
             (else (complain ek "invalid unary operator" op)))))
        ((and (list? exp) (= (length exp) 3))
         (let ((op (car exp)) (args (cdr exp)))
           (case op
             ((add) (apply-op2 ek + args))
             ((sub) (apply-op2 ek - args))
             ((mul times) (apply-op2 ek * args))
             ((div) (apply-op2 ek / args))
             ((expt) (apply-op2 ek expt args))
             (else (complain ek "invalid binary operator" op)))))
        (else (complain ek "invalid expression" exp)))))
  (define apply-op1
    (lambda (ek op args)
      (op (do-calc ek (car args)))))
  (define apply-op2
    (lambda (ek op args)
      (op (do-calc ek (car args)) (do-calc ek (cadr args)))))
  (define complain
    (lambda (ek msg exp)
      (ek (list msg exp))))
  (set! calc
    (lambda (exp)
      (call/cc
        (lambda (ek)
          (do-calc ek exp))))))

R. Kent Dybvig / The Scheme Programming Language, Third Edition
Copyright © 2003 The MIT Press. Electronically reproduced by permission.
Illustrations © 2003 Jean-Pierre Hébert
ISBN 0-262-54148-3 / LOC QA76.73.S34D93
to order this book / about this book

http://www.scheme.com