Home > Notes > Books > Notes and Solutions from Structure and Interpretation of Computer Programs

2.2 Hierarchical Data and the Closure Property

The Closure property of cons is the ability to create pairs who elements are pairs. I'm not yet sure how this is related to what is referred to a closure in e.g. javascript. Actually I think this is answered in footnote 72. Seems to be an unfortunate naming coincidence and unrelated. In this context, closure is what allows us to create hierarchical data structures.

Exercise 2.17

(define (last-pair l)
(if (null? (cdr l))
l
(last-pair (cdr l))))

Exercise 2.18

(define (reverse l)
(define (rec-rev l1 l2)
(if (null? l1)
    l2
    (rec-rev (cdr l1) 
              (cons (car l1) l2))))
(rec-rev l nil))

Exercise 2.19

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

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

(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 (first-denomination coins) (car coins))
(define (except-first-denomination coins) (cdr coins))
(define (no-more? coins) (null? coins))

The order of the coins doesn't make a difference. If it did then the recursion wouldn't be valid.

Exercise 2.20

I'm not very happy with this and am sure there's a better way, but I'm moving on.

(define (same-parity . l)
(define (same-parity-rec l keep correct-sign)
(cond ((null? l) (reverse keep))
      ((correct-sign (car l)) 
        (same-parity-rec (cdr l) 
                          (cons (car l) keep) 
                          correct-sign))
      (else 
        (same-parity-rec 
          (cdr l) 
          keep 
          correct-sign))))
(if (even? (car l)) 
    (same-parity-rec l () even?)
    (same-parity-rec l () odd?)))

Exercise 2.21

(define (square x) (* x x))

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

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

Exercise 2.22

The new square-list produces an answer backwards for the same reason my exercise 2.20 does. We're taking things off the front of the first list, and then adding them to the front of the answer list. So everything flips around.

The updated code gives a datastructure with the squares in the right order, but we can't cdr and car over it the way we do with lists. If I was more motivated this morning I'd draw the box and pointer diagram here.

Exercise 2.23

Again, I'm sure there's a more elegant solution but this one gets the job done.

(define (for-each op items)
  (if (null? items)
      #t
      (and (op (car items)) (for-each op (cdr items)))))

Exercise 2.24

Had a bit of trouble with this and had to re-review box and pointer diagrams a bit. Eventually I got the tree but had to look at the sicp wiki solution to get my box and pointer diagram correct. It's annoying to try to format those as text so I'll just defer completely to that solution here. One to come back to.

Exercise 2.25

  1. (car (cdr (car (cdr (cdr (list 1 3 (list 5 7) 9))))))
  2. (car (car (list (list 7))))
  3. (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7))))))))))))))))))

Exercise 2.26

  1. (1 2 3 4 5 6)
  2. ((1 2 3) 4 5 6)
  3. ((1 2 3) (4 5 6))

Exercise 2.27

(define (deep-reverse l)
(define (rec-rev l1 l2)
(if (null? l1)
    l2
    (rec-rev (cdr l1) 
              (cons (deep-reverse (car l1)) l2))))
(if (list? l) (rec-rev l nil) l)

Exercise 2.28

(define (fringe tree)
(cond ((null? tree) tree)
    ((not (pair? tree)) (list tree))
    (else (append (fringe (car tree))
                  (fringe (cdr tree)))))

Exercise 2.29

(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)
  (car (cdr mobile)))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (car (cdr branch)))

(define (is-mobile? branch)
  (number? branch))

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

(define (torque branch)
  (let ((structure (branch-structure branch)))
    (* (branch-length branch) 
       (if (is-mobile? structure) 
           structure 
           (total-weight structure)))))

(define (balanced? mobile)
  (and (= (torque (left-branch mobile)) 
          (torque (right-branch mobile)))
       (if (is-mobile? (right-branch mobile)) (balanced (right-branch mobile)) #t)
       (if (is-mobile? (left-branch mobile)) (balanced (left-branch mobile)) #t)))

With the updated constructors, all I have to change is the right-branch and branch-structure selectors to just use cdr.

Exercise 2.30

(define (square-tree tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (square tree))
        (else 
          (cons (square-tree (car tree))
                (square-tree (cdr tree))))))

(define (square-tree tree)
  (map (lambda (sub-tree)
          (if (pair? sub-tree)
              (square-tree sub-tree)
              (square sub-tree)))
        tree))

Exercise 2.31

(define (tree-map proc tree)
  (map (lambda (sub-tree)
          (if (pair? sub-tree)
              (tree-map proc sub-tree)
              (proc sub-tree)))
        tree))

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

Exercise 2.32

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

Exercise 2.33

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) nil sequence))

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

(define (length sequence)
  (accumulate (lambda (x y) (+ y 1)) 0 sequence))

Exercise 2.34

One to revisit.

Exercise 2.35

Call this one half implemented. I wasn't about to do it without using enumerate-tree, which was defined earlier in the chapter. It's not clear weather that's allowed and it makes the need for map redundant.

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

Exercise 2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      nil
      (cons (accumulate op init (map (lambda (x) (car x)) seqs))
            (accumulate-n op init (map (lambda (x) (cdr x)) seqs)))))

Exercise 2.37

It's confusing that the dot-product uses the built-in version of map, but the others use the one from this chapter.

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

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

(define (transpose mat)
  (accumulate-n (lambda (x y) (cons x y)) () mat))

Can't quite get matrix multiplication.

Exercise 2.38

(fold-right / 1 (list 1 2 3)) => 1.5
(fold-left  / 1 (list 1 2 3)) => 0.16666666666666666
(fold-right list nil (list 1 2 3)) => (1 (2 (3 ())))
(fold-left list nil (list 1 2 3)) => => (((() 1) 2) 3)

I think if the the op is commutative, then fold-left and fold-right will return the same result.

Though in trying to verify that I've found conflicting answers, but I don't really feel like digging into it more right now.

Exercise 2.39

(define (reverse sequence)
  (fold-left
    (lambda (x y) (cons y x)) nil sequence))

(define (reverse sequence)
  (fold-right
    (lambda (x y) (append y (list x))) 
    nil 
    sequence))

Exercise 2.40

(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 (triplet-sum n s)
  (define (triplet-sum? triplet)
    (= s (+ (car triplet) 
            (cadr triplet) 
            (caddr triplet))))
  (define (unique-triplets)
    (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)))
  (filter triplet-sum? (unique-triplets)))

Exercise 2.42

I can't quite get this one, but I'm close. I'm not sure how to check that the new queen isn't on the same diagonal as any other queen. I think I need like a map with a counter or something, wich I guess I could implement.

I'll come back to this one.

Exercise 2.43

This one is dependent on the above.

Exercise 2.44

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

Exercise 2.45

The tricky thing here is creating a recursive lambda function, I had to look that up. The other tricky thing is not being able to actually test these functions.

(define (split op1 op1)
  ((lambda (x) (x x))
    (lambda (split-rec)
      (lambda (painter n)
        (if (= n 0)
            painter
            (let ((smaller (split-rec painter
                                      (- n 1))))
              (op1 painter
                   (op2 smaller smaller))))))))

I just compared my solution to the sicp wiki and realized there's no reason to use a lambda function inside instead of a define, which simplifies things a lot. Oh well, I'll leave this as is.

Exercise 2.46

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

(define (add-vect v1 v2)
  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
                (ycor-vect v1) (ycor-vect v2)))
    
(define (sub-vect v1 v2)
  (make-vect (- (xcor-vect v1) (xcor-vect v2))
                (ycor-vect v1) (ycor-vect v2)))

(define (scale-vect v s)
  (make-vect (* s (xcor-vect v)) 
             (* s (ycor-vect v))))

Exercise 2.47

(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

(define (origin-frame frame)
  (car frame))

(define (edge1-frame frame)
  (car (cdr frame)))

(define (edge2-frame frame)
  (car (cdr (cdr frame))))

(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

(define (origin-frame frame)
  (car frame))

(define (edge1-frame frame)
  (car (cdr frame)))

(define (edge2-frame frame)
  (cdr (cdr frame)))

Exercise 2.48

(define (make-segment v1 v2) (cons v1 v2))

(define (start-segment v) (car v))

(define (end-segment v) (cdr v))

Exercise 2.49

(define (outline-painter frame)
  (segments-painter (list (make-segment (make-vect 0 0) (make-vect 0 1))
                          (make-segment (make-vect 0 1) (make-vect 1 1))
                          (make-segment (make-vect 1 1) (make-vect 1 0))
                          (make-segment (make-vect 1 0) (make-vect 0 0)))))
(define (x-painter frame)
  (segments-painter (list (make-segment (make-vect 0 0) (make-vect 1 1))
                          (make-segment (make-vect 0 1) (make-vect 1 0)))))
(define (diamond-painter frame)
  (segments-painter (list (make-segment (make-vect 0 0.5) (make-vect 0.5 1))
                          (make-segment (make-vect 0.5 1) (make-vect 1 0.5))
                          (make-segment (make-vect 1 0.5) (make-vect 0.5 0))
                          (make-segment (make-vect 0.5 0) (make-vect 0 0.5)))))

Surely I'm not really expected to create the wave painter out of line segments.

Exercise 2.50

Exercise 2.51

Exercise 2.52

I feel like I've got the takeaway from the picture language example, and I'm tired of not being able to actually run my examples so I'm going to skip the last 3 exercises in the chapter for now.

Previous Next