The HTML for this page has been automatically generated by parsing the loosely formatted source code & comments included in my solutions repository (https://github.com/zv/SICP-guile), if you encounter any unformatted solutions, you think you've spotted an error or you have something you'd like to share about the exercises, don't hesitate to leave a comment below (or a pull request on the source repo).

Exercises Chapter 2

Exercise: 2.1

Define a better version of `make-rat' that handles both positive and
negative arguments. `Make-rat' should normalize the sign so that if the
rational number is positive, both the numerator and denominator are
positive, and if the rational number is negative, only the numerator is
negative.

Answer

(define (make-rat n d)
  (let* [(g (abs (gcd n d)))
         (nsign (xor (negative? d)
                     (negative? n)))
         (num (/ (abs n) g))
         (den (/ (abs d) g))]
    (if nsign (cons (* -1 num) den)
        (cons num den))))

Exercise: 2.2

Consider the problem of representing line segments in a plane. Each segment
is represented as a pair of points: a starting point and an ending point.
Define a constructor `make-segment' and selectors `start-segment' and
`end-segment' that define the representation of segments in terms of
points. Furthermore, a point can be represented as a pair of numbers: the x
coordinate and the y coordinate. Accordingly, specify a constructor
`make-point' and selectors `x-point' and `y-point' that define this
representation. Finally, using your selectors and constructors, define a
procedure `midpoint-segment' that takes a line segment as argument and
returns its midpoint (the point whose coordinates are the average of the
coordinates of the endpoints). To try your procedures, you'll need a way to
print points:

       (define (print-point p)
       (newline)
       (display "(")
       (display (x-point p))
       (display ",")
       (display (y-point p))
       (display ")"))

Answer

(struct coordinate (x y) #:transparent)
(struct segment (start end) #:transparent)

(define (midpoint segment)
  (let [(mid-x (/ (+ (coordinate-x (segment-start segment))
                     (coordinate-x (segment-end segment))) 2))
        (mid-y (/ (+ (coordinate-y (segment-start segment))
                     (coordinate-y (segment-end segment))) 2))]
    (coordinate mid-x mid-y)))

;; alternative scheme
(define (make-point x y) `(,x . ,y))
(define (make-segment s e) `(,s . ,e))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (start-segment segment) (car segment))
(define (end-segment segment) (cdr segment))

(define (print-point p)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")")
  (newline))

(define (midpoint-s segment)
  (make-segment
   (/ (+ (x-point (start-segment segment))
         (x-point (end-segment segment)))
      2)
   (/ (+ (y-point (start-segment segment))
         (y-point (end-segment segment)))
      2)))

Exercise 2.3

Implement a representation for rectangles in a plane. (Hint: You may want
to make use of *Note Exercise 2-2::.) In terms of your constructors and
selectors, create procedures that compute the perimeter and the area of a
given rectangle. Now implement a different representation for rectangles.
Can you design your system with suitable abstraction barriers, so that the

Answer

s(struct rectangle-s (height width)
   #:guard (λ (height width type-name)
             (if [and (segment? height) (segment? width)]
                 (values height width)
                 (error "not a valid rectangle"))))

(struct rectangle (a b)
  #:guard (λ (a b type-name)
            (if [and (coordinate? a) (coordinate? b)]
                (values a b)
                (error "not a valid rectangle"))))

(define (area rect)
  (* (rect-height rect) (rect-width rect)))

(define (rect-height rect)
  (abs (if (rectangle-s? rect)
           (- (coordinate-y (segment-start (rectangle-s-height rect)))
              (coordinate-y (segment-end   (rectangle-s-height rect))))
           (- (coordinate-y (rectangle-a rect))
              (coordinate-y (rectangle-b rect))))))

(define (rect-width rect)
  (abs (if (rectangle-s? rect)
           (- (coordinate-x (segment-start (rectangle-s-width rect)))
              (coordinate-x (segment-end   (rectangle-s-width rect))))
           (- (coordinate-x (rectangle-a rect))
              (coordinate-x (rectangle-b rect))))))

Exercise: 2.4

Here is an alternative procedural representation
of pairs. For this representation, verify that `(car (cons x y))'
yields `x' for any objects `x' and `y'.

       (define (cons x y)
       (lambda (m) (m x y)))

       (define (car z)
       (z (lambda (p q) p)))

What is the corresponding definition of `cdr'? (Hint: To verify that this
works, make use of the substitution model of section *Note 1-1-5.)

Answer

;;; whoa!!!
(define (recons x y)
  (λ (m) (m x y)))

(define (recar z)
  (z (λ (p q) p)))

(define (recdr z)
  (z (λ (p q) q)))

Exercise: 2.5

Show that we can represent pairs of nonnegative integers using only numbers
and arithmetic operations if we represent the pair a and b as the integer
that is the product 2a 3b. Give the corresponding definitions of the

Answer

p(define lower-expt 2)
(define higher-expt 5)
(define (pack-pair a b)
  (* (expt lower-expt a)
     (expt higher-expt b)))

(define (unpack-base x base)
  (if [= 0 (remainder x base)]
      (+ 1 (unpack-base (/ x base) base))
      0))

(define (unpack-pair d)
  `(,(unpack-base d lower-expt)
    ,(unpack-base d higher-expt)))

Exercise: 2.6

In case representing pairs as procedures wasn't mind-boggling enough,
consider that, in a language that can manipulate procedures, we can get by
without numbers (at least insofar as nonnegative integers are concerned) by
implementing 0 and the operation of adding 1 as

Answer

((define church-zero (λ (f) (λ (x) x)))

 (define (church-add-1 n)
   (λ (f) (λ (x) (f ((n f) x)))))

 (define church-one
   (λ (f)
     (λ (x)
       (f x))))

 (define church-two
   (λ (f)
     (λ (x)
       (f
        (f x)))))

 (define (church-addition m n)
   (λ (f)
     (λ (x)
       ((n f)
        ((m f)
         x)))))

Exercise: 2.7

Alyssa's program is incomplete because she has not specified the
implementation of the interval abstraction. Here is a definition of the
interval constructor:

       (define (make-interval a b) (cons a b))

Define selectors `upper-bound' and `lower-bound' to complete the

Answer

i;; (module interval racket
;;   (provide add-interval mul-interval div-interval)
;;   (define (add-interval x y)
;;     (make-interval (+ (lower-bound x) (lower-bound y))
;;                    (+ (upper-bound x) (upper-bound y))))
;;   )

(define (make-interval a b) (cons a b))
(define (upper-bound interval) (cdr interval))
(define (lower-bound interval) (car interval))

Exercise: 2.8

Using reasoning analogous to Alyssa's, describe how the difference of two
intervals may be computed. Define a corresponding subtraction procedure,

Answer

c(define (sub-interval x y)
   (let ((p1 (- (lower-bound x) (lower-bound y)))
         (p2 (- (lower-bound y) (upper-bound x))))
     (make-interval (min p1 p2)
                    (max p1 p2))))

Exercise: 2.9

The "width" of an interval is half of the difference between its upper and
lower bounds. The width is a measure of the uncertainty of the number
specified by the interval. For some arithmetic operations the width of the
result of combining two intervals is a function only of the widths of the
argument intervals, whereas for others the width of the combination is not
a function of the widths of the argument intervals. Show that the width of
the sum (or difference) of two intervals is a function only of the widths
of the intervals being added (or subtracted). Give quotes to show that

Answer

t

Exercise: 2.10

Ben Bitdiddle, an expert systems programmer, looks over Alyssa's shoulder
and comments that it is not clear what it means to divide by an interval
that spans zero. Modify Alyssa's code to check for this condition and to

Answer

s(define (div-interval x y)
   (cond ((or (= 0 (upper-bound y)) (= 0 (lower-bound y)))
          (error "attempted to divide by the zero"))
         (else (mul-interval x
                             (make-interval (/ 1.0 (upper-bound y))
                                            (/ 1.0 (lower-bound y)))))))

Exercise: 2.11

In passing, Ben also cryptically comments: "By testing the signs of the
endpoints of the intervals, it is possible to break `mul-interval' into
nine cases, only one of which requires more than two multiplications."
Rewrite this procedure using Ben's suggestion.

After debugging her program, Alyssa shows it to a potential user, who
complains that her program solves the wrong problem. He wants a program
that can deal with numbers represented as a center value and an additive
tolerance; for quote, he wants to work with intervals such as 3.5 +/-
0.15 rather than [3.35, 3.65]. Alyssa returns to her desk and fixes this
problem by supplying an alternate constructor and alternate selectors:

       (define (make-center-width c w) (make-interval (- c w) (+ c w)))

       (define (center i) (/ (+ (lower-bound i) (upper-bound i)) 2))

       (define (width i) (/ (- (upper-bound i) (lower-bound i)) 2))

Unfortunately, most of Alyssa's users are engineers. Real engineering
situations usually involve measurements with only a small uncertainty,
measured as the ratio of the width of the interval to the midpoint of the
interval. Engineers usually specify percentage tolerances on the parameters

Answer

(define (mul-interval x y)
    (let ((p1 (* (lower-bound x) (lower-bound y)))
          (p2 (* (lower-bound x) (upper-bound y)))
          (p3 (* (upper-bound x) (lower-bound y)))
          (p4 (* (upper-bound x) (upper-bound y))))
      (make-interval (min p1 p2 p3 p4)
                     (max p1 p2 p3 p4))))

Exercise: 2.17

Define a procedure `last-pair' that returns the list that contains only the
last element of a given (nonempty) list:

Answer

((define (last-pair lst)
   (let [(lastls (cdr lst))]
     (if (null? lastls) (car lst)
         (last-pair lastls))))

Exercise: 2.18

Define a procedure `reverse' that takes a list as argument and returns a
list of the same elements in reverse order:

Answer

((define (reverse-l lst)
   (if (null? lst) null
       (append (reverse-l (cdr lst)) (list (car lst)))))

 (define (reverse-ls xs [result null])
   (cond [(null? xs) result]
         [else (reverse-ls (cdr xs) (cons (car xs) result))]))

Exercise: 2.19

Consider the change-counting program of section *Note 1-2-2::. It would be
nice to be able to easily change the currency used by the program, so that
we could compute the number of ways to change a British pound, for quote.
As the program is written, the knowledge of the currency is distributed
partly into the procedure `first-denomination' and partly into the
procedure `count-change' (which knows that there are five kinds of U.S.
coins). It would be nicer to be able to supply a list of coins to be used
for making change.

We want to rewrite the procedure `cc' so that its second argument is a list
of the values of the coins to use rather than an integer specifying which
coins to use. We could then have lists that defined each kind of currency:

       (define us-coins (list 50 25 10 5 1))

       (define uk-coins (list 100 50 20 10 5 2 1 0.5))

We could then call `cc' as follows:

       (cc 100 us-coins) 292

To do this will require changing the program `cc' somewhat. It will still
have the same form, but it will access its second argument differently, as
follows:

       (define (cc amount coin-values) (cond ((= amount 0) 1) ((or (< amount 0)
       (no-more? coin-values)) 0) (else (+ (cc amount (except-first-denomination
       coin-values)) (cc (- amount (first-denomination coin-values))
       coin-values)))))

Define the procedures `first-denomination', `except-first-denomination',
and `no-more?' in terms of primitive operations on list structures. Does
the order of the list `coin-values' affect the answer produced by `cc'? Why

Answer

(define (valid-change n types)
   (filter (lambda (x) (<= x n)) types))

(define (zv-count-change amt types)
  (cond ((= amt 0) 1)
        ((or (< amt 0) (empty? (valid-change amt types))) 0)
        (else (foldr (lambda (x res) (+ res (zv-count-change (- amt x))))
                     0
                     (valid-change amt types)))))

Exercise: 2.20

The procedures `+', `*', and `list' take arbitrary numbers of arguments.
One way to define such procedures is to use `define' with notation
"dotted-tail notation". In a procedure definition, a parameter list that
has a dot before the last parameter name indicates that, when the procedure
is called, the initial parameters (if any) will have as values the initial
arguments, as usual, but the final parameter's value will be a "list" of
any remaining arguments. For instance, given the definition

         (define (f x y . z) <QUOTE>)

the procedure `f' can be called with two or more arguments. If we evaluate

       (f 1 2 3 4 5 6)

then in the body of `f', `x' will be 1, `y' will be 2, and `z' will be the
list `(3 4 5 6)'. Given the definition

       (define (g . w) <QUOTE>)

the procedure `g' can be called with zero or more arguments. If we evaluate

       (g 1 2 3 4 5 6)

then in the body of `g', `w' will be the list `(1 2 3 4 5 6)'.(4)

Use this notation to write a procedure `same-parity' that takes one or more
integers and returns a list of all the arguments that have the same
even-odd parity as the first argument. For quote,

       (same-parity 1 2 3 4 5 6 7) (1 3 5 7)

Answer

(
 (define (same-parity elt . xs)
   (define (test-parity n) (= (remainder elt 2) (remainder n 2)))
   (filter test-parity xs))

Exercise: 2.21

The procedure `square-list' takes a list of numbers as argument and returns
a list of the squares of those numbers.

       (square-list (list 1 2 3 4)) (1 4 9 16)

Here are two different definitions of `square-list'. Complete both of them
by filling in the missing expressions:

       (define (square-list items) (if (null? items) nil (cons <??> <??>)))

Answer

((define (square n) (* n n))

 (define (square-list items)
   (if (null? items) null
       (cons (square (car items)) (square-list (cdr items)))))

 (define (square-list-x items)
   (map square items))

Exercise: 2.22

Louis Reasoner tries to rewrite the first `square-list' procedure of *Note
Exercise 2-21:: so that it evolves an iterative process:

(define (square-list items) (define (iter things answer) (if (null?
things) answer (iter (cdr things) (cons (square (car things)) answer))))
(iter items nil))

Unfortunately, defining `square-list' this way produces the answer list in
the reverse order of the one desired. Why?

Louis then tries to fix his bug by interchanging the arguments to `cons':

(define (square-list items) (define (iter things answer) (if (null? things)
answer (iter (cdr things) (cons answer (square (car things)))))) (iter
items nil))

Answer

T;;; Louis Reasoner has mixed up the arguments `answer' and `(square (car things))'
;;; In his second attempt
;; correct version of iterative
;; (define (square-list-b things [answer null])
;;     (if (null? things) answer
;;         (square-list-b (cdr things)
;;                        (append answer (list (square (car things)))))))

Exercise: 2.23

The procedure `for-each' is similar to `map'. It takes as arguments a
procedure and a list of elements. However, rather than forming a list of
the results, `for-each' just applies the procedure to each of the elements
in turn, from left to right. The values returned by applying the procedure
to the elements are not used at all–`for-each' is used with procedures
that perform an action, such as printing. For quote,

       (for-each (lambda (x) (newline) (display x)) (list 57 321 88)) 57 321 88

The value returned by the call to `for-each' (not illustrated above) can be

Answer

s
(define (for-each-zv fn xs)
  (if [empty? xs] null
      (cons (fn (car xs))
            (for-each-zv fn (cdr xs))))
  #t)


;; not a exercize
(define (closest a b x)
  (if (< (abs (- x (/ (numer a) (denom a))))
         (abs (- x (/ (numer b) (denom b))))) a
      b))

(define (find-closest-rational x limit)
  (define (search-rationals n d top)
    (cond [(> n limit) (search-rationals 0 (inc d) top)]
          [(> d limit) top]
          [else
           (search-rationals (inc n)
                             d
                             (closest (make-rat n d) top x))]))
  (search-rationals 1 1 (make-rat 1 1)))

(define (find-closest-rational-t x limit)
  (define (search-rationals n d)
    (if (or (> n limit) (> d limit)) (make-rat n d)
        (closest (make-rat n d)
                 (closest
                  (search-rationals (inc n) d)
                  (search-rationals n (inc d))
                  x) x)))
  (search-rationals 1 1))

(define (count-leaves x)
  (cond ((null? x) 0)
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

Exercise: 2.24

Suppose we evaluate the expression `(list 1 (list 2 (list 3 4)))'. Give the
result printed by the interpreter, the corresponding box-and-pointer
structure, and the interpretation of this as a tree (as in *Note Figure

Answer

2

Exercise: 2.25

Give combinations of `car's and `cdr's that will pick 7 from each of the
following lists:

       (1 3 (5 7) 9)

       ((7))

Answer

((define (is-sevens)
   [ printf "~a\n" (car (cdaddr '(1 3 (5 7) 9)))]
   [ printf "~a\n" (caar '((7)))]
   [ printf "~a\n" (cadadr (cadadr (cadadr '(1 (2 (3 (4 (5 (6 7)))))))))])

Exercise: 2.26

Suppose we define `x' and `y' to be two lists:

       (define x (list 1 2 3))

       (define y (list 4 5 6))

What result is printed by the interpreter in response to evaluating each of
the following expressions:

       (append x y)

       (cons x y)

Answer

((define two-twentysix-x (list 1 2 3))
 (define two-twentysix-y (list 4 5 6))
 ;;; (append two-twentysix-x two-twentysix-y) => '(1 2 3 4 5 6)
 ;;; (cons two-twentysix-x two-twentysix-y)   => '((1 2 3) 4 5 6)
 ;;;  (list two-twentysix-x two-twentysix-y)  => '((1 2 3) (4 5 6))

Exercise: 2.27

Modify your `reverse' procedure of *Note Exercise 2-18:: to produce a
`deep-reverse' procedure that takes a list as argument and returns as its
value the list with its elements reversed and with all sublists
deep-reversed as well. For quote,

       (define x (list (list 1 2) (list 3 4)))

       x ((1 2) (3 4))

       (reverse x) ((3 4) (1 2))

Answer

((define (deep-reverse-l lst)
   (cond [(null? lst) null]
         [(list? lst) (append
                       (deep-reverse-l (rest lst))
                       (list (deep-reverse-l (first lst))))]
         [else lst]))

Exercise: 2.28

Write a procedure `fringe' that takes as argument a tree (represented as a
list) and returns a list whose elements are all the leaves of the tree
arranged in left-to-right order. For quote,

       (define x (list (list 1 2) (list 3 4)))

       (fringe x) (1 2 3 4)

Answer

((define (fringe xs)
   (cond [(null? xs) null]
         [(list? xs) (append (fringe (first xs))
                             (fringe (rest xs)))]
         [else (list xs)]))


Exercise: 2.29

A binary mobile consists of two branches, a left branch and a right branch.
Each branch is a rod of a certain length, from which hangs either a weight
or another binary mobile. We can represent a binary mobile using compound
data by constructing it from two branches (for quote, using `list'):

(define (make-mobile left right) (list left right))

A branch is constructed from a `length' (which must be a number) together
with a `structure', which may be either a number (representing a simple
weight) or another mobile:

       (define (make-branch length structure) (list length structure))

a. Write the corresponding selectors `left-branch' and `right-branch',
which return the branches of a mobile, and `branch-length' and
`branch-structure', which return the components of a branch.

b. Using your selectors, define a procedure `total-weight' that returns the
total weight of a mobile.

c. A mobile is said to be "balanced" if the torque applied by its top-left
branch is equal to that applied by its top-right branch (that is, if the
length of the left rod multiplied by the weight hanging from that rod is
equal to the corresponding product for the right side) and if each of the
submobiles hanging off its branches is balanced. Design a predicate that
tests whether a binary mobile is balanced.

d. Suppose we change the representation of mobiles so that the constructors
are

       (define (make-mobile left right) (cons left right))

       (define (make-branch length structure) (cons length structure))

How much do you need to change your programs to convert to the new

Answer

r;; Racket Style
(struct mobile (l r)
  #:transparent)
(struct mbranch (len structure)
  #:transparent)

(define (total-weight node)
  (let [(mstruct (mbranch-structure node))]
    (if (mobile? mstruct)
        (+ (total-weight (mobile-l node))
           (total-weight (mobile-r node)))
        mstruct)))

(define (balanced-mobile? mbl)
  (= (total-weight (mobile-l mbl))
     (total-weight (mobile-r mbl))))

;;; Guile Style
(define (make-mobile left right) '(left right))
(define (make-branch len structure) '(len structure))

(define (sip-total-weight node)
  (let [(mstruct (cadr node))]
    (if (number? mstruct) mstruct
        (+ (sip-total-weight (left-branch node))
           (sip-total-weight (right-branch node))))))

(define (sip-balanced-mobile? mbl)
  (= (total-weight (left-branch mbl))
     (total-weight (right-branch mbl))))

Exercise: 2.30

Define a procedure `square-tree' analogous to the `square-list' procedure
of *Note Exercise 2-21::. That is, `square-list' should behave as follows:

       (square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))) (1 (4 (9 16) 25)
       (36 49))

Define `square-tree' both directly (i.e., without using any higher-order

Answer

p(define (square-tree tree)
   (map (λ (node)
          (if (list? node) (square-tree node)
              (* node node))) tree))

Exercise: 2.31

Abstract your answer to *Note Exercise 2-30:: to produce a procedure
`tree-map' with the property that `square-tree' could be defined as

       (define (square-tree tree) (tree-map square tree))

We can represent a set as a list of distinct elements, and we can represent
the set of all subsets of the set as a list of lists. For quote, if the
set is `(1 2 3)', then the set of all subsets is `(() (3) (2) (2 3) (1) (1
3) (1 2) (1 2 3))'. Complete the following definition of a procedure that
generates the set of subsets of a set and give a clear explanation of why
it works:

       (define (subsets s) (if (null? s) (list nil) (let ((rest (subsets (cdr

Answer

s(define (tree-map fn tree)
   (map (λ (node)
          (if (list? node) (tree-map fn node)
              (fn node))) tree))

Exercise: 2.32

       (define (subsets s)
       (if (null? s) (list null)
       (let [(restl (subsets (cdr s)))]
       (append restl (map (λ (x) (cons (car s) x)) restl)))))

       ;; – UTILITIES --------------------------------–—
       (define (filter predicate sequence)
       (cond ((null? sequence) null)
       ((predicate (car sequence))
       (cons (car sequence)
       (filter predicate (cdr sequence))))
       (else (filter predicate (cdr sequence)))))

       (define (accumulate op initial sequence)
       (if (null? sequence)
       initial
       (op (car sequence)
       (accumulate op initial (cdr sequence)))))

       (define (flatmap proc seq)
       (accumulate append null (map proc seq)))

       (define (permutations s)
       (if (null? s) ; empty set?
       (list null) ; sequence containing empty set
       (flatmap (lambda (x)
       (map (lambda (p) (cons x p))
       (permutations (remove x s))))
       s)))
;; ---------------------------------------------–—

Answer

#
(define (map-z p sequence)
  (accumulate (λ (x y) (cons (p x) y)) null sequence))

(define (append-z seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length-z sequence)
  (accumulate (λ (x y) (+ y 1)) 0 sequence))


Exercise: 2.34

Evaluating a polynomial in x at a given value of x can be formulated as an
accumulation. We evaluate the polynomial

       an rn | a(n-1) r(n-1) + … + a1 r + a0

using a well-known algorithm called "Horner's rule", which structures the
computation as

       (… (an r + a(n-1)) r + … + a1) r + a0

In other words, we start with an, multiply by x, add a(n-1), multiply by
x, and so on, until we reach a0.(3)

Fill in the following template to produce a procedure that evaluates a
polynomial using Horner's rule. Assume that the coefficients of the
polynomial are arranged in a sequence, from a0 through an.

(define (horner-eval x coefficient-sequence) (accumulate (lambda
(this-coeff higher-terms) <??>) 0 coefficient-sequence))

For quote, to compute 1 + 3x + 5x3 + x(5) at x = 2 you would evaluate

Answer

((define (horner-eval x coefficient-sequence)
   (accumulate (λ (this-coeff higher-terms)
                 (+ this-coeff (* x higher-terms)))
               0
               coefficient-sequence))


Exercise: 2.35

Redefine `count-leaves' from section *Note 2-2-2 as an accumulation:

Answer

((define (count-leaves-z t)
   (accumulate + 0 (map count-leaves t)))

Exercise: 2.36

Exercise: 2.37

Suppose we represent vectors v = (vi) as sequences of numbers, and
matrices m = (m(ij)) as sequences of vectors (the rows of the matrix). For
quote, the matrix

        - - | 1 2 3 4 | | 4 5 6 6 | | 6 7 8 9 | - -

is represented as the sequence `((1 2 3 4) (4 5 6 6) (6 7 8 9))'. With this
representation, we can use sequence operations to concisely express the
basic matrix and vector operations. These operations (which are described
in any book on matrix algebra) are the following:

        __ (dot-product v w) returns the sum >i vi wi

(matrix-*-vector m v) returns the vector t, __ where ti = >j m(ij) vj

(matrix-*-matrix m n) returns the matrix p, __ where p(ij) = >k m(ik)
n(kj)

(transpose m) returns the matrix n, where n(ij) = m(ji)

We can define the dot product as(4)

(define (dot-product v w) (accumulate + 0 (map * v w)))

Fill in the missing expressions in the following procedures for computing
the other matrix operations. (The procedure `accumulate-n' is defined in
*Note Exercise 2-36::.)

        (define (matrix-*-vector m v) (map <??> m))

        (define (transpose mat) (accumulate-n <??> <??> mat))

        (define (matrix-*-matrix m n) (let ((cols (transpose n))) (map <??> m)))

Answer

(define zv-matrix '((1 2 3 4) (4 5 6 6) (6 7 8 9)))
(define zv-square '((1 2 3) (4 5 6) (6 7 8)))

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(define (matrix-*-vector m v)
  (map (lambda (row) (dot-product row v)) m))

(define (transpose mat)
  (accumulate-n cons '() mat))

(define (matrix-*-matrix m n)
   (let [(elems (transpose n))]
     (map (λ (row) (matrix-*-vector elems row)) m)))

Exercise: 2.38

The `accumulate' procedure is also known as `fold-right', because it
combines the first element of the sequence with the result of combining all
the elements to the right. There is also a `fold-left', which is similar to
`fold-right', except that it combines elements working in the opposite
direction:

        (define (fold-left op initial sequence) (define (iter result rest) (if
        (null? rest) result (iter (op result (car rest)) (cdr rest)))) (iter
        initial sequence))

What are the values of

        (fold-right / 1 (list 1 2 3))

        (fold-left / 1 (list 1 2 3))

        (fold-right list nil (list 1 2 3))

        (fold-left list nil (list 1 2 3))

Give a property that `op' should satisfy to guarantee that `fold-right' and
`fold-left' will produce the same values for any sequence.

Answer


Exercise: 2.39

Complete the following definitions of `reverse' (*Note Exercise 2-18::) in
terms of `fold-right' and `fold-left' from *Note Exercise 2-38:::

        (define (reverse sequence) (fold-right (lambda (x y) <??>) nil sequence))

        (define (reverse sequence) (fold-left (lambda (x y) <??>) nil sequence))

Answer

(define (reverse-fr sequence)
  (foldr (lambda (x y) (append y `(,x))) null sequence))

(define (reverse-fl sequence)
  (foldl (lambda (x y) (cons x y)) null sequence))

Exercise: 2.40

Define a procedure `unique-pairs' that, given an integer n, generates the
sequence of pairs (i,j) with 1 <= j< i <= n. Use `unique-pairs' to simplify
the definition of `prime-sum-pairs' given above.

Answer

(define (unique-pairs n)
  (flatmap (λ (i)
             (map (λ (j) (list i j))
                  (range i n)))
           (range 1 n)))

(define (prime? n)
  (empty?
   (filter (lambda (p) (= n (* (car p) (cadr p))))
           (unique-pairs n))))

(define (prime-sum? pair) (prime? (+ (car pair) (cadr pair))))

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

(define (prime-sum-pairs n)
  (map make-pair-sum (filter prime-sum? (unique-pairs n))))

Exercise: 2.41

Write a procedure to find all ordered triples of distinct positive integers
i, j, and k less than or equal to a given integer n that sum to a given
integer s.

Answer

(define (triplets-summing-to s n)
  (define (unique-triplets n)
    (flatmap (λ (i)
               (flatmap (λ (j)
                          (map (λ (k)
                                 (list i j k))
                               (range j n)))
                        (range i n)))
             (range 0 n)))

  (filter (λ (t) (= s (foldr + 0 t)))
          (unique-triplets n)))

Exercise: 2.41

The "eight-queens puzzle" asks how to place eight queens on a chessboard so
that no queen is in check from any other (i.e., no two queens are in the
same row, column, or diagonal). One possible solution is shown in *Note
Figure 2-8. One way to solve the puzzle is to work across the board,
placing a queen in each column. Once we have placed k - 1 queens, we must
place the kth queen in a position where it does not check any of the queens
already on the board. We can formulate this approach recursively: Assume
that we have already generated the sequence of all possible ways to place k
- 1 queens in the first k - 1 columns of the board. For each of these ways,
generate an extended set of positions by placing a queen in each row of the
kth column. Now filter these, keeping only the positions for which the
queen in the kth column is safe with respect to the other queens. This
produces the sequence of all ways to place k queens in the first k columns.
By continuing this process, we will produce not only one solution, but all
solutions to the puzzle.

We implement this solution as a procedure `queens', which returns a
sequence of all solutions to the problem of placing n queens on an n*n
chessboard. `Queens' has an internal procedure `queen-cols' that returns
the sequence of all ways to place queens in the first k columns of the
board.

        (define (queens board-size) (define (queen-cols k) (if (= k 0) (list
        empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap
        (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k
        rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k
        1)))))) (queen-cols board-size))

In this procedure `rest-of-queens' is a way to place k - 1 queens in the
first k - 1 columns, and `new-row' is a proposed row in which to place the
queen for the kth column. Complete the program by implementing the
representation for sets of board positions, including the procedure
`adjoin-position', which adjoins a new row-column position to a set of
positions, and `empty-board', which represents an empty set of positions.
You must also write the procedure `safe?', which determines for a set of
positions, whether the queen in the kth column is safe with respect to the
others. (Note that we need only check whether the new queen is safe–the
other queens are already guaranteed safe with respect to each other.)

Answer

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (range 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;; (struct posn (row col)
;;   #:transparent)

;; (define (make-position row col) (cons row col))

;; (define empty-board null)

;; (define (adjoin-position row col positions)
;;   (append positions (list (posn row col))))

;; (define (safe? col positions)
;;   (let ((kth-queen (list-ref positions (- col 1)))
;;         (other-queens (filter (λ (q)
;;                                 (not (= col (posn-col q))))
;;                               positions)))
;;     (define (attacks? q1 q2)
;;       ;; what the fuck???
;;       (or (= (posn-row q1) (posn-row q2))
;;           (= (abs (- (posn-row q1) (posn-row q2)))
;;              (abs (- (posn-col q1) (posn-col q2))))))

;;     (define (iter q board)
;;       (or (null? board)
;;           (and (not (attacks? q (car board)))
;;                (iter q (cdr board)))))
;;     (iter kth-queen other-queens)))
(define empty-board null)

(define (adjoin-position row positions)
  (cons row positions))

(define (safe? position)

  (define board-size (length position))

  (define (safe-diagonal? position)

    ; test the position for the newly placed queen
    (define (col-safe? new-row col position)
      (cond ((> col board-size) true)
            ((= (abs (- new-row (car position)))
                ; the new qeeen's position is always on column 1
                (abs (- col 1))) false)
            (else (col-safe? new-row (+ col 1) (cdr position)))))

    ; the new queen's position is always in column 1
    ; so the initial column to check is always 2
    (col-safe? (car position) 2 (cdr position)))

  (define (safe-horizontal? position)
    ; does the new row (car) appear anywhere else?
    (not (member (car position) (cdr position))))

  (or (= (length position) 1)  ; 1x1 board
      (and (safe-horizontal? position)
           (safe-diagonal?   position))))

Exercise: 2.53

What would the interpreter print in response to evaluating each of the
following expressions?

        (list 'a 'b 'c)

        (list (list 'george))

        (cdr '((x1 x2) (y1 y2)))

        (cadr '((x1 x2) (y1 y2)))

        (pair? (car '(a short list)))

        (memq 'red '((red shoes) (blue socks)))

        (memq 'red '(red shoes blue socks))

Answer

;;; (list 'a 'b 'c)                         => '(a b c)
;;; (list (list 'george))                   => '((georger))
;;; (cdr '((x1 x2) (y1 y2)))                => '(y1 y2)
;;; (cadr '((x1 x2) (y1 y2)))               => '(y1 y2)
;;; (pair? (car '(a short list)))           => 'a
;;; (memq 'red '((red shoes) (blue socks))) => null
;;; (memq 'red '(red shoes blue socks))     => '(shoes blue socks)

Exercise: 2.54

Two lists are said to be `equal?' if they contain equal elements arranged
in the same order. For quote,

        (equal? '(this is a list) '(this is a list))

is true, but

        (equal? '(this is a list) '(this (is a) list))

is false. To be more precise, we can define `equal?' recursively in terms
of the basic `eq?' equality of symbols by saying that `a' and `b' are
`equal?' if they are both symbols and the symbols are `eq?', or if they are
both lists such that `(car a)' is `equal?' to `(car b)' and `(cdr a)' is
`equal?' to `(cdr b)'. Using this idea, implement `equal?' as a
procedure.(5)

Answer

(define (zv-equal? a b)
  (cond [(or (empty? a) (empty? b)) (eq? a b)]
        [(and (list? a) (list? b))
         (and (eq? (car a) (car b))
              (zv-equal? (cdr a) (cdr b)))]
        [(or (list? a) (list? b)) false]
        [else (eq? a b)]))

Exercise: 2.55

Eva Lu Ator types to the interpreter the expression

        (car ''abracadabra)

To her surprise, the interpreter prints back `quote'. Explain.

Answer

;; It is a "double quoted" item, e.g the symbols (quote abracadabra) resolve to
;; the *function* quote, which is created from syntax sugar.


;; Utilities
(define (deriv expr var)
  (cond [(number? expr) 0]
        [(variable? expr)
         (if (same-variable? expr var) 1 0)]
        [(sum? expr)
         (make-sum (deriv (addend expr) var)
                   (deriv (augend expr) var))]
        [(product? expr)
         (make-sum
          (make-product
           (multiplier expr)
           (deriv (multiplicand expr) var))
          (make-product
           (deriv (multiplier expr) var)
           (multiplicand expr)))]
        [(exponentiation? expr)
         (make-product
          (make-product
           (exponent expr)
           (make-exponent (base expr)
                          (- (exponent expr) 1)))
          (deriv (base expr) var))]
        [else (error "unknown exprression type: DERIV" expr)]))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1)
       (variable? v2)
       (eq? v1 v2)))

(define (=number? exp num)
  (and (number? exp) (= exp num)))
;; A sum is a list whose first element is the symbol +:
;; TODO
(define (sum? x)
  (and (list? x) (eq? (car x) '+)))

(define (product? x)
  (and (list? x) (eq? (car x) '*)))


Exercise: 2.56

Show how to extend the basic differentiator to handle more kinds of
expressions. For instance, implement the differentiation rule

        n1 n2 — = — if and only if n1 d2 = n2 d1 d1 d2

by adding a new clause to the `deriv' program and defining appropriate
procedures `exponentiation?', `base', `exponent', and
`make-exponentiation'. (You may use the symbol `**' to denote
exponentiation.) Build in the rules that anything raised to the power 0 is
1 and anything raised to the power 1 is the thing itself.

Answer

(define (exponentiation? x)
  (and (list? x) (eq? (car x) 'expt)))
(define (base p) (cadr p))
(define (exponent p) (caddr p))

(define (make-exponent e1 e2)
  (cond [(=number? e1 0) 1]
        [(=number? e2 0) 1]
        [(and (number? e1) (number? e2)
              (expt e1 e2))]
        [else `(expt ,e1 ,e2)]))

Exercise: 2.57

Extend the differentiation program to handle sums and products of arbitrary
numbers of (two or more) terms. Then the last quote above could be
expressed as

(deriv '(* x y (+ x 3)) 'x)

Try to do this by changing only the representation for sums and products,
without changing the `deriv' procedure at all. For quote, the `addend' of
a sum would be the first term, and the `augend' would be the sum of the
rest of the terms.

Answer

(define (make-sum a1 a2)
  (cond [(=number? a1 0) a2]
        [(=number? a2 0) a1]
        [(and (number? a1) (number? a2)
              (+ a1 a2))]
        [else `(+ ,a1 ,a2)]))

(define (make-product m1 m2)
  (cond [(or (=number? m1 0)
             (=number? m2 0))
         0]
        [(=number? m1 1) m2]
        [(=number? m2 1) m1]
        [(and (number? m1) (number? m2))
         (* m1 m2)]
        [else (list '* m1 m2)]))

(define (addend s) (cadr s))
(define (augend s)
  (if (null? (cdddr s))
      (caddr s)
      `(+ ,@(cddr s))))
(define (multiplier s) (cadr s))
(define (multiplicand s)
  (if (null? (cdddr s))
      (caddr s)
      `(* ,@(cddr s))))

Exercise: 2.58

Suppose we want to modify the differentiation program so that it works with
ordinary mathematical notation, in which `+' and `*' are infix rather than
prefix operators. Since the differentiation program is defined in terms of
abstract data, we can modify it to work with different representations of
expressions solely by changing the predicates, selectors, and constructors
that define the representation of the algebraic expressions on which the
differentiator is to operate.

a. Show how to do this in order to differentiate algebraic expressions
presented in infix form, such as `(x + (3 * (x + (y + 2))))'. To simplify
the task, assume that `+' and `*' always take two arguments and that
expressions are fully parenthesized.

b. The problem becomes substantially harder if we allow standard algebraic
notation, such as `(x + 3 * (x + y + 2))', which drops unnecessary
parentheses and assumes that multiplication is done before addition. Can
you design appropriate predicates, selectors, and constructors for this
notation such that our derivative program still works?


Answer

;;; 1.
(define (infix-addend s) (car s))
(define (infix-augend s) (caddr s))
(define (infix-multiplier s) (car s))
(define (infix-multiplicand s) (caddr s))

(define (infix-sum? x)
  (and (list? x) (eq? (cadr x) '+)))

(define (infix-product? x)
  (and (list? x) (eq? (cadr x) '*)))

(define (infix-make-sum a1 a2)
  (cond [(=number? a1 0) a2]
        [(=number? a2 0) a1]
        [(and (number? a1) (number? a2)
              (+ a1 a2))]
        [else `(,a1 + ,a2)]))

(define (infix-make-product m1 m2)
  (cond [(or (=number? m1 0)
             (=number? m2 0)) 0]
        [(=number? m1 1) m2]
        [(=number? m2 1) m1]
        [(and (number? m1) (number? m2))
         (* m1 m2)]
        [else `(,m1 * ,m2)]))

(define (infix-deriv expr var)
  "This function is for computing the derivative of a simple, infix'd function"
  (cond [(number? expr) 0]
        [(variable? expr)
         (if (same-variable? expr var) 1 0)]
        [(infix-sum? expr)
         (infix-make-sum (infix-deriv (infix-addend expr) var)
                         (infix-deriv (infix-augend expr) var))]
        [(infix-product? expr)
         (infix-make-sum
          (infix-make-product
           (infix-multiplier expr)
           (infix-deriv (infix-multiplicand expr) var))
          (infix-make-product
           (infix-deriv (infix-multiplier expr) var)
           (infix-multiplicand expr)))]
        [else (error "unknown exprression type: DERIV" expr)]))

Exercise:

Answer


;; Set Utils
(define (element-of-set? elt ss)
  (cond [(empty? ss) false]
        [(equal? elt (car ss)) true]
        [else (element-of-set? elt (cdr ss))]))

(define (adjoin-set elt ss)
  (if (element-of-set? elt ss)
      set
      (cons elt ss)))

(define (intersection ss1 ss2)
  (cond [(or (empty? ss1) (empty? ss2)) null]
        [(element-of-set? (car ss1) ss2)
         (cons (car ss1)
               (intersection (cdr ss1) ss2))]
        [else (intersection (cdr ss1) ss2)]))

Exercise: 2.59

Implement the `union-set' operation for the unordered-list representation
of sets.

Answer

(define (union-set ss1 ss2)
  (cond [(or (empty? ss1) (empty? ss2)) (append ss1 ss2)]
        [(element-of-set? (car ss1) ss2)
         (union-set (cdr ss1) ss2)]
        [else
         (cons (car ss1) (union-set (cdr ss1) ss2))]))

Exercise: 2.60

We specified that a set would be represented as a list with no duplicates.
Now suppose we allow duplicates. For instance, the set {1,2,3} could be
represented as the list `(2 3 2 1 3 2 2)'. Design procedures
`element-of-set?', `adjoin-set', `union-set', and `intersection-set' that
operate on this representation. How does the efficiency of each compare
with the corresponding procedure for the non-duplicate representation? Are
there applications for which you would use this representation in
preference to the non-duplicate one?

Answer

(define (element-of-joined-set? elt ss)
  (element-of-set? elt ss))

(define (adjoin-joined-set elt ss)
  (cons elt ss))

(define (adjoin-intersection ss1 ss2)
  (intersection ss1 ss2))

(define (adjoin-union-set ss1 ss2)
  (append ss1 ss2))

;; Much cheaper, but to be useful it would require another deduplication pass.
(define (element-of-set-ordered? elt ss)
  (cond [(empty? ss) false]
        [(= elt (car ss)) true]
        [(< elt (car ss)) false]
        [else (element-of-set-ordered? elt (cdr ss))]))

(define (intersection-ordered-set set1 set2)
  "Begin by comparing the initial elements, x1 and x2, of the two sets. If x1
equals x2, then that gives an element of the intersection, and the rest of the
intersection is the intersection of the cdr-s of the two sets. Suppose, however,
that x1 is less than x2. Since x2 is the smallest element in set2, we can
immediately conclude that x1 cannot appear anywhere in set2 and hence is not in
the intersection. Hence, the intersection is equal to the intersection of set2
with the cdr of set1. Similarly, if x2 is less than x1, then the intersection is
given by the intersection of set1 with the cdr of set2. Here is the procedure"
  (if (or (null? set1) (null? set2)) null
      (let [(x1 (car set1)) (x2 (car set2))]
        (cond [(= x1 x2)
               (cons x1 (intersection-ordered-set (cdr set1) (cdr set2)))]
              [(< x1 x2)
               (intersection-ordered-set (cdr set1) set2)]
              [(> x1 x2)
               (intersection-ordered-set set1 (cdr set2))]))))

Exercise: 2.61

Give an implementation of `adjoin-set' using the ordered representation. By
analogy with `element-of-set?' show how to take advantage of the ordering
to produce a procedure that requires on the average about half as many
steps as with the unordered representation.

Answer

(define (adjoin-ordered-set elt os)
  "Takes advantage of the ordering of the set to stop when elt > (car os)"
  (if (empty? os) (list elt)
      (let [(oelt (car os))]
        (cond [(< elt oelt) (cons elt os)]
              [(> elt oelt)
               (cons oelt (adjoin-ordered-set elt (cdr os)))]
              [(= elt oelt) os]))))

Exercise: 2.62

Give a [theta](n) implementation of `union-set' for sets represented as
ordered lists.

Answer

(define (union-ordered-set ss1 ss2)
  "Perform an O(n) union of 2 ordered sets"
  (if (or (empty? ss1) (empty? ss2)) (append ss1 ss2)
      (let [(x1 (car ss1))
            (x2 (car ss2))]
        (cond [(= x1 x2)
               (cons x1 (union-ordered-set (cdr ss1) (cdr ss2)))]
              [(< x1 x2)
               (cons x1 (union-ordered-set (cdr ss1) ss2) )]
              [(> x1 x2)
               (cons x2 (union-ordered-set ss1 (cdr ss2)) )]))))

Exercise: 2.63

Each of the following two procedures converts a binary tree to a list.

(define (tree->list-1 tree)
  (if (null? tree)
      '()
      (append (tree->list-1 (left-branch tree))
              (cons (entry tree)
                    (tree->list-1 (right-branch tree))))))

(define (tree->list-2 tree)
  (define (copy-to-list tree result-list)
    (if (null? tree)
        result-list
        (copy-to-list (left-branch tree)
                      (cons (entry tree)
                            (copy-to-list (right-branch tree)
                                          result-list)))))
  (copy-to-list tree '()))

a. Do the two procedures produce the same result for every tree?
If not, how do the results differ? What lists do the two
procedures produce for the trees in *Note Figure 2-16::?

b. Do the two procedures have the same order of growth in the
number of steps required to convert a balanced tree with n
elements to a list? If not, which one grows more slowly?

Answer

(define (sum-of-halves n)
  "Get the limit of a half a number, plus half of that, and so on"
  (if (= 0 n) 0
      (+ n (sum-of-halves (quotient n 2)))))

(define (get-depth tree)
  (if (null? tree) 0
      (+ 1 (max (get-depth (node-right tree))
           (get-depth (node-left tree))) )))

(struct node (val left right)
  #:transparent
  ;; #:methods gen:custom-write
  ;; [(define (write-proc self port mode)
  ;;    (fprintf port "(val: ~a left: ~a right: ~a)"
  ;;             (node-val self)
  ;;             (node-left self)
  ;;             (node-right self)))]
  )

(define (element-of-bset? elt ss)
  (cond [(null? ss) null]
        [(= elt (node-val ss)) true]
        [(< elt (node-val ss))
         (element-of-bset? elt (node-left ss))]
        [(> elt (node-val ss))
         (element-of-bset? elt (node-right ss))]))

(define (adjoin-bset elt ss)
  (cond [(null? ss) (node elt null null)]
        [(= elt (node-val ss)) ss]
        [(< elt (node-val ss))
         (node (node-val ss)
               (adjoin-bset elt (node-left ss))
               (node-right ss))]
        [(> elt (node-val ss))
         (node (node-val ss)
               (node-left ss)
               (adjoin-bset elt (node-right ss)))]))

(define (make-random-bset maxct [ct 0])
  "Helper function to create a binary treeset"
  (if (< maxct ct) (adjoin-bset (random maxct) null)
      (adjoin-bset (random maxct)
                   (make-random-bset maxct (inc ct)))))

(define (make-linear-bset maxct [ct 0])
  "Helper function to create a binary treeset"
  (if (< maxct ct) (adjoin-bset ct null)
      (adjoin-bset ct
                   (make-linear-bset maxct (inc ct)))))

Exercise: 2.63

Answer

1. I don't think they differ.
2. The former grows faster than the latter because of the `append' call. The orders of growth are identical.

Answer

(define (tree->list-1 tree)
  (if (null? tree)
      '()
      (append
       (tree->list-1
        (node-left tree))
       (cons (node-val tree)
             (tree->list-1
              (node-right tree))))))

(define (tree->list-2 tree)
  (define (copy-to-list tree result-list)
    (if (null? tree)
        result-list
        (copy-to-list
         (node-left tree)
         (cons (node-val tree)
               (copy-to-list
                (node-right tree)
                result-list)))))
  (copy-to-list tree '()))

Exercise: 2.64


Write a short paragraph explaining as clearly as you can how partial-tree works.

Draw the tree produced by list->tree for the list (1 3 5 7 9 11).
What is the order of growth in the number of steps required by list->tree to
convert a list of n elements?

Partial tree effectively performs binary search to split the tree.

Answer

(define (partial-tree elts n)
  (if (= n 0) (cons null elts)
      (let* ([left-size      (quotient (- n 1) 2)]
             [left-result    (partial-tree elts left-size)]
             [left-tree      (first left-result)]
             [right-elts     (rest left-result)]
             [right-size     (- n (+ left-size 1))]
             [this-entry     (first right-elts)]
             [right-result   (partial-tree (cdr right-elts)
                                           right-size)]
             [right-tree     (first right-result)]
             [remaining-elts (rest right-result)])

        (cons (node this-entry
                    left-tree
                    right-tree)
              remaining-elts))))

(define (list->tree elements)
  (car (partial-tree
        elements (length elements))))

(define tbsize 20)
(define tbset (make-random-bset tbsize))
(define tbbad (make-linear-bset tbsize))
(define tbsorted (list->tree (range tbsize)))
(define (nprint p)
  (pretty-print p (current-output-port) 1))


(define (pprint tree [depth 0] [str ""])
  (string-append
   (if (empty? (node-left tree)) ""
       (string-append str (pprint (node-left tree) (+ 1 depth))))

    (string-append (make-string (* 2 depth) #\ ) str (number->string (node-val tree)) "\n")

   (if (empty? (node-right tree)) ""
       (string-append str (pprint (node-right tree) (+ 1 depth))))))

Exercise 2.65

Use the results of Exercise 2.63 and Exercise 2.64 to give Θ ( n )
implementations of union-set and intersection-set for sets implemented as
(balanced) binary trees.107

Answer

(define (union-balanced-set bs1 bs2)
  (list->tree ((union-set (tree->list-1 bs1)
                          (tree->list-1 bs2)))))


(define (intersection-balanced-set bs1 bs2)
  (list->tree ((intersection (tree->list-1 bs1)
                             (tree->list-1 bs2)))))

Exercise 2.66

Implement the lookup procedure for the case where the set of records is
structured as a binary tree, ordered by the numerical values of the keys.

Answer

(define (lookup-bset elt bs)
  (if (null? bs) false
      (let [(val (node-val bs))]
        (cond [(= val elt) bs]
              [(> val elt) (lookup-bset elt (node-left bs))]
              [(< val elt) (lookup-bset elt (node-right bs))]))))

(struct leaf (sym weight)
  #:transparent)
(struct code-tree (left right syms weight)
  #:transparent)

(define (make-code-tree left right)
  (code-tree left
             right
             (append (syms left)
                     (syms right))
             (+ (weight left) (weight right))))

(define (left-branch tree) (code-tree-left tree))
(define (right-branch tree) (code-tree-right tree))

(define (syms tree)
  (if (leaf? tree)
      (list (leaf-sym tree))
      (code-tree-syms tree)))

(define (weight tree)
  (if (leaf? tree)
      (leaf-weight tree)
      (code-tree-weight tree)))

(define (decode bits tree)
  (define (decode-1 bits current-branch)
    (if (null? bits)
        null
        (let [(next-branch
               (choose-branch
                (car bits)
                current-branch))]
          (if (leaf? next-branch)
              (cons
               (leaf-sym next-branch)
               (decode-1 (cdr bits) tree))
              (decode-1 (cdr bits)
                        next-branch)))))
  (decode-1 bits tree))

(define (choose-branch bit branch)
  (cond [(= bit 0) (left-branch branch)]
        [(= bit 1) (right-branch branch)]
        [else (error "bad bit(ch?)")]))

(define (adjoin-htset x ss)
  (cond ((null? ss) (list x))
        ((< (weight x) (weight (car ss)))
         (cons x ss))
        (else
         (cons (car ss)
               (adjoin-htset x (cdr ss))))))

(define (make-leaf-set pairs)
  (if (null? pairs) null
      (let ((pair (car pairs)))
        (adjoin-htset
         (leaf (car pair)    ; symbol
               (cadr pair))  ; frequency
         (make-leaf-set (cdr pairs))))))

Exercise 2.67:

Define an encoding tree and a sample message:

(define sample-tree
  (make-code-tree (make-leaf 'A 4)
                  (make-code-tree
                   (make-leaf 'B 2)
                   (make-code-tree (make-leaf 'D 1)
                                   (make-leaf 'C 1)))))

(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))

Use the `decode' procedure to decode the message, and give the
result.

Answer

(define sample-tree
  (make-code-tree
   (leaf 'A 4)
   (make-code-tree
    (leaf 'B 2)
    (make-code-tree
     (leaf 'D 1)
     (leaf 'C 1)))))

;; A D A B B C A
(define sample-message
  '(0 1 1 0 0 1 0 1 0 1 1 1 0))

(define (decode-sample)
  (decode sample-message sample-tree)) ;; => '(A D A B B C A)

Exercise 2.68

The encode procedure takes as arguments a message and a tree and produces the
list of bits that gives the encoded message.

Encode-symbol is a procedure, which you must write, that returns the list of
bits that encodes a given symbol according to a given tree. You should design
encode-symbol so that it signals an error if the symbol is not in the tree at
all. Test your procedure by encoding the result you obtained in Exercise 2.67
with the sample tree and seeing whether it is the same as the original sample
message.

Answer

(define (encode message tree)
  (if (null? message)
      '()
      (append
       (encode-symbol (car message)
                      tree)
       (encode (cdr message) tree))))

(define (encode-symbol symbol tree)
  (cond
    [(null? tree) (error "Not found")]
    [(leaf? tree) null]
    [(memq symbol (syms (left-branch tree)))
     (cons 0 (encode-symbol symbol (left-branch tree)))]
    [(memq symbol (syms (right-branch tree)))
     (cons 1 (encode-symbol symbol (right-branch tree)))]))

Exercise 2.69

The following procedure takes as its argument a list of symbol-frequency pairs
(where no symbol appears in more than one pair) and generates a Huffman encoding
tree according to the Huffman algorithm.

Make-leaf-set is the procedure given above that transforms the list of pairs
into an ordered set of leaves. Successive-merge is the procedure you must write,
using make-code-tree to successively merge the smallest-weight elements of the
set until there is only one element left, which is the desired Huffman tree.
(This procedure is slightly tricky, but not really complicated. If you find
yourself designing a complex procedure, then you are almost certainly doing
something wrong. You can take significant advantage of the fact that we are
using an ordered set representation.)

Answer

(define (generate-huffman-tree pairs)
  (successive-merge
   (make-leaf-set pairs)))

(define (successive-merge xs)
  (if (= 1 (length xs)) (car xs)
      (successive-merge
       (cons (make-code-tree (cadr xs) (car xs))
             (cddr xs)))))

Exercise 2.70

The following eight-symbol alphabet with associated relative frequencies was
designed to efficiently encode the lyrics of 1950s rock songs. (Note that the
“symbols” of an “alphabet” need not be individual letters.)

    A 2 NA 16
    BOOM 1 SHA 3
    GET 2 YIP 9
    JOB 2 WAH 1

Use generate-huffman-tree (Exercise 2.69) to generate a corresponding Huffman
tree, and use encode (Exercise 2.68) to encode the following message:

    Get a job
    Sha na na na na na na na na

    Get a job
    Sha na na na na na na na na

    Wah yip yip yip yip
    yip yip yip yip yip
    Sha boom

Answer

(define (generate-rock-n-roll-htree)
  (define rockfreq (generate-huffman-tree
                    '((A 2)    (NA  16)
                      (BOOM 1) (SHA  3)
                      (GET  2) (YIP  9)
                      (JOB  2) (WAH  1))))
  (define msg-to-youth
    (map (λ (s) (string->symbol (string-upcase s)))
         (string-split "Get a job Sha na na na na na na na na
                        Get a job Sha na na na na na na na na Wah yip yip
                        yip yip yip yip yip yip yip Sha boom")))
  (define rock-bits (encode msg-to-youth rockfreq))
  (printf "bits: ~a\n" rock-bits)
  (printf "decoded: ~a\n" (decode rock-bits rockfreq)))

Exercise 2.72

Consider the encoding procedure that you designed in Exercise 2.68. What is the
order of growth in the number of steps needed to encode a symbol? Be sure to
include the number of steps needed to search the symbol list at each node
encountered. To answer this question in general is difficult. Consider the
special case where the relative frequencies of the n symbols are as described in
Exercise 2.71, and give the order of growth (as a function of n ) of the number
of steps needed to encode the most frequent and least frequent symbols in the
alphabet.

Answer

(Copied from Eli Bendersky)

In general, in the worst case we’d need to descend n levels (as Exercise 2.71 shows), and at each step we have to find the symbol in a set of symbols at that node. The implementation of encode used an unordered set to keep the symbols, so the search takes O(n)[3]. Therefore, the whole encoding procedure takes O(n2). Had we used a binary tree for the sets of symbols, we could bring this time down to O(n2). Of course, building the tree would then take longer.