# SICP section 2.2 - hierarchical data and the closure property

## Selected exercises

- 2.20
- 2.21
- 2.22
- 2.23
- 2.27
- 2.28
- 2.29
- 2.30
- 2.31
- 2.32
- 2.34
- 2.35
- 2.36
- 2.37
- 2.38
- 2.39
- 2.40
- 2.41
- 2.42
- 2.43
- 2.44
- 2.45
- 2.46
- 2.47
- 2.48
- 2.49
- 2.50
- 2.51
- 2.52

## Exercise 2.20

```
(define (same-parity x . y)
(let ((parity (if (odd? x) odd? even?)))
(define (parity-iter y)
(cond ((null? y) '())
((parity (car y)) (append (list (car y)) (parity-iter (cdr y))))
(else (parity-iter (cdr y)))))
(append (list x) (parity-iter y))))
```

## Exercise 2.21

First definition:

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

Second definition:

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

## Exercise 2.22

Applying the substitution model using `'(1 2 3)`

as the argument to Louis’ `square-list`

, we can observe that the squared value is incorrectly prepended to `answer`

on each iteration:

```
(square-list '(1 2 3))
(iter '(1 2 3) '())
(iter '(2 3) (cons 1 '()))
(iter '(3) (cons 4 (cons 1 '())))
(iter '() (cons 9 (cons 4 (cons 1 '()))))
(cons 9 (cons 4 (cons 1 '())))
'(9 4 1)
```

With Louis’ attempted fix, the result is a list that is improper:

```
(square-list '(1 2 3))
(iter '(1 2 3) '())
(iter '(2 3) (cons '() 1))
(iter '(3) (cons (cons '() 1) 4))
(iter '() (cons (cons (cons '() 1) 4) 9))
(cons (cons (cons '() 1) 4) 9)
'(((() . 1) . 4) . 9)
```

## Exercise 2.23

```
(define (for-each f l)
(cond ((not (null? l))
(f (car l))
(for-each f (cdr l)))))
```

## Exercise 2.27

```
(define (deep-reverse lst)
(if (pair? lst)
(append (deep-reverse (cdr lst))
(list (deep-reverse (car lst))))
lst))
```

Using the substitution model to illustrate how `deep-reverse`

works:

```
(deep-reverse '((1 2) (3 4) 5))
(append (deep-reverse '((3 4) 5)) (list (deep-reverse '(1 2))))
(append (append (deep-reverse '(5)) (list (deep-reverse '(3 4)))) (list (deep-reverse '(1 2))))
(append (append '(5) (list (deep-reverse '(3 4)))) (list (deep-reverse '(1 2))))
...
(append (append '(5) (list (append '(4) '(3)))) (list (append '(2) '(1))))
(append (append '(5) '((4 3))) '((2 1)))
(append '(5 (4 3)) '((2 1)))
'(5 (4 3) (2 1))
```

## Exercise 2.28

```
(define (fringe lst)
(cond ((null? lst) '())
((not (pair? lst)) (list lst))
(else (append (fringe (car lst))
(fringe (cdr lst))))))
```

By now it should be apparent that I rather like using the substitution model to help my little brain learn:

```
(fringe '((1 2) (3 4)))
(append (fringe '(1 2)) (fringe '((3 4))))
(append (append (fringe 1) (fringe '(2))) (fringe '((3 4))))
(append (append (fringe 1) (append (fringe 2) (fringe '()))) (fringe '((3 4))))
(append (append '(1) (append '(2) '())) (fringe '((3 4))))
(append (append '(1) '(2)) (fringe '((3 4))))
(append '(1 2) (fringe '((3 4))))
...
(append '(1 2) '(3 4))
'(1 2 3 4)
```

## Exercise 2.29

Part (a): providing selectors for the constructors `make-mobile`

and `make-branch`

:

```
(define (make-mobile left right)
(list left right))
(define (make-branch length structure)
(list length structure))
(define (left-branch mobile)
(car mobile))
(define (right-branch mobile)
(cadr mobile))
(define (branch-length branch)
(car branch))
(define (branch-structure branch)
(cadr branch))
```

Part (b): this solution uses two mutually recursive procedures. How they work are as follows:

- We define
`total-weight`

as a procedure that computes the sum of the`branch-weight`

s of the left and right branches of a mobile. - We define
`branch-weight`

as a procedure that takes a`branch`

, and checks its`structure`

to determine if it is another mobile, or a weight. - If the
`structure`

is a (child) mobile, we call the`total-weight`

procedure with`structure`

as its argument, which computes the sum of the`branch-weight`

s of the child mobile. - If it is a weight, return it. This is the terminating condition.

```
(define (is-mobile? structure)
(pair? structure))
(define (branch-weight branch)
(let ((structure (branch-structure branch)))
(if (is-mobile? structure)
(total-weight structure)
structure)))
(define (total-weight mobile)
(+ (branch-weight (left-branch mobile))
(branch-weight (right-branch mobile))))
```

Part (c): a mobile is balanced if the torque applied by its top-left branch is equal to that applied by its top-right branch and if each of its submobiles is also balanced.

This solution also makes use of mutually recursive procedures; the approach is very similar to part (b).

Note: we define `torque`

as a procedure that computes the product of a branch’s length and weight. To compute its weight, we make use of the `branch-weight`

procedure from part (b).

```
(define (torque branch)
(* (branch-length branch)
(branch-weight branch)))
(define (branch-balanced branch)
(let ((structure (branch-structure branch)))
(if (is-mobile? structure)
(is-balanced? structure)
#t)))
(define (is-balanced? mobile)
(and (= (torque (left-branch mobile))
(torque (right-branch mobile)))
(branch-balanced (left-branch mobile))
(branch-balanced (right-branch mobile))))
```

Part (d): only the `right-branch`

and `branch-structure`

selectors need to be redefined.

```
(define (make-mobile left right)
(cons left right))
(define (make-branch length structure)
(cons length structure))
(define (right-branch mobile)
(cdr mobile))
(define (branch-structure branch)
(cdr branch))
```

## Exercise 2.30

Without using higher-order procedures:

```
(define (square-tree tree)
(cond ((null? tree) '())
((not (pair? tree)) (* tree tree))
(else (cons (square-tree (car tree))
(square-tree (cdr tree))))))
```

Using `map`

. If element is a sub-tree, recursively call `square-tree`

on the sub-tree, as we also want to map over all its elements:

```
(define (square-tree tree)
(map (lambda (e)
(if (pair? e)
(square-tree e)
(* e e)))
tree))
```

## Exercise 2.31

```
(define (tree-map f tree)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(tree-map f sub-tree)
(f sub-tree)))
tree))
```

## Exercise 2.32

```
(define (subsets s)
(if (null? s)
(list '())
(let ((rest (subsets (cdr s))))
(append rest (map (lambda (x) (cons (car s) x)) rest)))))
```

Illustrating “why it works”:

```
(subsets '(1 2 3))
rest <- (subsets '(2 3))
rest <- (subsets '(3))
rest <- (subsets '())
'(())
(append '(()) (map (lambda (x) (cons 3 x)) '(())))
(append '(()) '((3))) ; ***
'(() (3)) ; <--- Set of all subsets of '(3)
(append '(() (3)) (map (lambda (x) (cons 2 x)) '(() (3))))
(append '(() (3)) '((2) (2 3))) ; ***
'(() (3) (2) (2 3)) ; <--- Set of all subsets of '(2 3)
(append '(() (3) (2) (2 3)) (map (lambda (x) (cons 1 x)) '(() (3) (2) (2 3))))
(append '(() (3) (2) (2 3)) '((1) (1 3) (1 2) (1 2 3))) ; ***
'(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)) ; <--- Set of all subsets of '(1 2 3)
```

*** If \(P\) is the set of all subsets of a set \(Q\) minus its first element, the set of all subsets of the full set \(Q\) is the union of \(P\) and \(P\) plus the first element of \(Q\) prepended to each of its subsets.

## Exercise 2.34

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

Computing \(1 + 4x + 9x^2\) (\(x\) deliberately unassigned) as an example, using the substitution model:

```
(horner-eval x '(1 4 9))
(+ (* (accumulate ... '(4 9)) x) 1)
(+ (* (+ (* (accumulate ... '(9)) x) 4) x) 1)
(+ (* (+ (* (+ (* (accumulate ... '()) x) 9) x) 4) x) 1)
(+ (* (+ (* (+ (* 0 x) 9) x) 4) x) 1)
(+ (* (+ (* (+ 0 9) x) 4) x) 1)
...
(+ 9x^2 4x 1) ; Obviously pseudocode
```

## Exercise 2.35

Solution uses `enumerate-tree`

, which is defined in the text. Alternatively, `fringe`

from exercise 2.28 can also be used, as they’re exactly the same.

```
(define (count-leaves t)
(accumulate + 0 (map (lambda (x) 1) (enumerate-tree t))))
```

## Exercise 2.36

```
(define (accumulate-n op init seqs)
(if (null? (car seqs))
'()
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
```

## Exercise 2.37

```
(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 ((cols (transpose n)))
(map (lambda (row) (matrix-*-vector cols row)) m)))
```

## Exercise 2.38

`(fold-right / 1 '(1 2 3))`

\(= 1 \frac{1}{2}\)

```
(fold-right / 1 '(1 2 3))
(/ 1 (fold-right ... '(2 3)))
(/ 1 (/ 2 (fold-right ... '(3))))
(/ 1 (/ 2 (/ 3 (fold-right ... '()))))
(/ 1 (/ 2 (/ 3 1)))
```

`(fold-left / 1 '(1 2 3))`

\(= \frac{1}{6}\)

```
(fold-left / 1 '(1 2 3))
(iter 1 '(1 2 3))
(iter (/ 1 1) '(2 3))
(iter (/ (/ 1 1) 2) '(3))
(iter (/ (/ (/ 1 1) 2) 3) '())
(/ (/ (/ 1 1) 2) 3)
```

`(fold-right list '() '(1 2 3))`

```
(fold-right list '() '(1 2 3))
(list 1 (fold-right ... '(2 3)))
(list 1 (list 2 (fold-right ... '(3))))
(list 1 (list 2 (list 3 (fold-right ... '()))))
(list 1 (list 2 (list 3 '())))
'(1 (2 (3 ())))
```

`(fold-left list '() '(1 2 3))`

```
(fold-left list '() '(1 2 3))
(iter '() '(1 2 3))
(iter (list '() 1) '(2 3))
(iter (list (list '() 1) 2) '(3))
(iter (list (list (list '() 1) 2) 3) '())
(list (list (list '() 1) 2) 3)
'(((() 1) 2) 3)
```

For `fold-right`

and `fold-left`

to produce the same values for any sequence, `op`

needs to be commutative, i.e. changing the order of the operands does not change the result.

## Exercise 2.39

Using `fold-right`

:

```
(define (reverse-r sequence)
(fold-right (lambda (x y) (append y (list x)))
'()
sequence))
(reverse-r '(1 2 3))
(append (fold-right ... '(2 3)) (list '()))
(append (append (fold-right ... '(3)) (list 2)) (list 1))
(append (append (append (fold-right ... '()) (list 3)) (list 2)) (list 1))
(append (append (append '() (list 3)) (list 2)) (list 1))
...
'(3 2 1)
```

Using `fold-left`

:

```
(define (reverse-l sequence)
(fold-left (lambda (x y) (cons y x)) '() sequence))
(reverse-l '(1 2 3))
(iter (cons 1 '()) '(2 3))
(iter (cons 2 (cons 1 '())) '(3))
(iter (cons 3 (cons 2 (cons 1 '()))) '())
(cons 3 (cons 2 (cons 1 '())))
'(3 2 1)
```

## Exercise 2.40

The definition of `unique-pairs`

is just the `flatmap`

procedure call in `prime-sum-pairs`

extracted into its own procedure.

```
(define (unique-pairs n)
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum? (unique-pairs n))))
```

## Exercise 2.41

```
(define (unique-triples n)
(flatmap (lambda (i)
(flatmap (lambda (j)
(map (lambda (k) (list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (sum-triples s)
(define (sum-equal? t)
(= (accumulate + 0 t) s))
(filter sum-equal? (unique-triples s)))
```

## Exercise 2.42

Defining the constructor, selectors and `empty-board`

is straightforward:

```
(define (make-position row col)
(list row col))
(define (position-row pos)
(car pos))
(define (position-col pos)
(cadr pos))
(define empty-board nil)
```

For `adjoin-position`

, the approach I’ve taken is to prepend the new position to the set of positions. This makes it much easier to separate the first element from all the other elements, which we will have to do when defining `safe?`

.

```
(define (adjoin-position new-row k rest-of-queens)
(append (list (make-position new-row k)) rest-of-queens))
```

In the definition of `safe?`

, we bind three local variables: `kth-queen-row`

, `kth-queen-column`

, and `other-queens`

. Notice how easy this is - if `adjoin-position`

appended instead of prepended the new position, this would have been slightly trickier.

In the subprocedure `attacks?`

, the equality statements check to see if another queen is positioned in the same row, or diagonally, to the `kth-queen`

. No column checks are necessary, as the `kth-queen`

is always placed in a new column.

Finally, we filter `other-queens`

using `attacks?`

as a predicate. If this value is greater than zero, the `kth-queen`

is under attack and is not safe.

Note: my definition of `safe?`

does not make use of the argument `k`

.

```
(define (safe? positions)
(let ((kth-queen-row (car (car positions)))
(kth-queen-col (cadr (car positions)))
(other-queens (cdr positions)))
(define (attacks? o)
(or (= kth-queen-row (position-row o))
(= (abs (- kth-queen-row (position-row o)))
(abs (- kth-queen-col (position-col o))))))
(not (> (length (filter attacks? other-queens)) 0))))
```

## Exercise 2.43

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

By swapping the order of nested mappings in `flatmap`

, `(queen-cols (- k 1))`

is evaluated `board-size`

times, i.e. once for each number generated by `(enumerate-interval 1 board-size)`

, turning a linear recursive process into a tree recursive process. This results in a time complexity of \(O(n^n)\).

## Exercise 2.44

Section 2.2.4 has us develop a simple language for drawing pictures. The exercises weren’t particularly challenging, but on the whole they were a lot of fun! To test my solutions, I imported the `sicp-pict`

collection from within the DrRacket IDE:

```
#lang sicp
(#%require sicp-pict)
(paint einstein)
```

Defining `up-split`

, which, as the exercise states, is similar to `right-split`

:

```
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
```

## Exercise 2.45

Generalising `right-split`

and `up-split`

:

```
(define (split f g)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller ((split f g) painter (- n 1))))
(f painter (g smaller smaller))))))
```

## Exercise 2.46

Defining the constructor and selectors:

```
(define (make-vect x y)
(cons x y))
(define (xcor-vect v)
(car v))
(define (ycor-vect v)
(cdr v))
```

Defining the vector operations:

```
(define (add-vect v1 v2)
(cons (+ (xcor-vect v1)
(xcor-vect v2))
(+ (ycor-vect v1)
(ycor-vect v2))))
(define (sub-vect v1 v2)
(cons (- (xcor-vect v1)
(xcor-vect v2))
(- (ycor-vect v1)
(ycor-vect v2))))
(define (scale-vect v s)
(cons (* s (xcor-vect v))
(* s (ycor-vect v))))
```

## Exercise 2.47

Selectors for the first constructor:

```
(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(caddr frame))
```

Selectors for the second (alternative) constructor:

```
(define (make-frame origin edge1 edge2)
(cons origin (cons edge1 edge2)))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(cddr frame))
```

## Exercise 2.48

```
(define (make-segment start end)
(cons start end))
(define (start-segment segment)
(car segment))
(define (end-segment segment)
(cdr segment))
```

## Exercise 2.49

For this exercise, I only attempted parts (a), (b) and (c). Making the `wave`

painter seemed like a painful connect-the-dots exercise, which I was happy to skip.

```
(define segments-outline
(list (make-segment (make-vect 0.0 0.0)
(make-vect 0.0 0.5))
(make-segment (make-vect 0.0 0.5)
(make-vect 0.5 0.5))
(make-segment (make-vect 0.5 0.5)
(make-vect 0.5 0.0))
(make-segment (make-vect 0.5 0.0)
(make-vect 0.0 0.0))))
(define segments-x
(list (make-segment (make-vect 0.0 0.0)
(make-vect 0.5 0.5))
(make-segment (make-vect 0.5 0.0)
(make-vect 0.0 0.5))))
(define segments-diamond
(list (make-segment (make-vect 0.0 0.25)
(make-vect 0.25 0.5))
(make-segment (make-vect 0.25 0.5)
(make-vect 0.5 0.25))
(make-segment (make-vect 0.5 0.25)
(make-vect 0.25 0.0))
(make-segment (make-vect 0.25 0.0)
(make-vect 0.0 0.25))))
```

## Exercise 2.50

```
(define (flip-horiz painter)
((transform-painter (make-vect 1.0 0.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0))
painter))
(define (rotate180 painter)
((transform-painter (make-vect 1.0 1.0)
(make-vect 0.0 1.0)
(make-vect 1.0 0.0))
painter))
(define (rotate270 painter)
((transform-painter (make-vect 0.0 1.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0))
painter))
```

## Exercise 2.51

Defining `below`

so it’s analogous to `beside`

:

```
(define (below painter1 painter2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-bottom
((transform-painter (make-vect 0.0 0.0)
(make-vect 1.0 0.0)
split-point)
painter1))
(paint-top
((transform-painter split-point
(make-vect 1.0 0.5)
(make-vect 0.0 1.0))
painter2)))
(lambda (frame)
(paint-bottom frame)
(paint-top frame)))))
```

Defining `below`

in terms of `beside`

and suitable rotation operations:

```
(define (below painter1 painter2)
(rotate90 (beside (rotate270 painter1)
(rotate270 painter2))))
```

## Exercise 2.52

Part (a): didn’t bother putting a smile on that face.

Part (b): modifying `corner-split`

to use only one copy of the `up-split`

and `right-split`

images:

```
(define (corner-split painter n)
(if (= n 0)
painter
(let ((up (up-split painter (- n 1)))
(right (right-split painter (- n 1)))
(corner (corner-split painter (- n 1))))
(beside (below painter up)
(below right corner)))))
```

Part (c): making the big (Einstein) look (inward) from each corner of the square:

```
(define (square-limit painter n)
(let ((combine4 (square-of-four flip-vert rotate180
identity flip-horiz)))
(combine4 (corner-split painter n))))
```