adrianwong programmer · retired coal miner

SICP section 2.2 - hierarchical data and the closure property

Selected exercises

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:

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