# SICP Chapter 2 Exercises & Solutions

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 2^{a} 3^{b}. 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

a_{n} r^{n} | a_{(n-1)} r^{(n-1)} + … + a_{1} r + a_{0}

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

computation as

(… (a_{n} r + a_{(n-1)}) r + … + a_{1}) r + a_{0}

In other words, we start with a_{n}, multiply by x, add a_{(n-1)}, multiply by

x, and so on, until we reach a_{0}.(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 a_{0} through a_{n}.

(define (horner-eval x coefficient-sequence) (accumulate (lambda

(this-coeff higher-terms) <??>) 0 coefficient-sequence))

For quote, to compute 1 + 3x + 5x^{3} + 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 = (v_{i}) 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} v_{i} w_{i}

(matrix-*-vector m v) returns the vector t, __ where t_{i} = >_{j} m_{(ij)} v_{j}

(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

n_{1} n_{2} — = — if and only if n_{1} d_{2} = n_{2} d_{1} d_{1} d_{2}

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(n

^{2}). Had we used a binary tree for the sets of symbols, we could bring this time down to O(n^{2}). Of course, building the tree would then take longer.

## Comments

You can add a comment to this page by writing one on it's Github Issue Page