SICP 2.2 exercises cont.


Part a)

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

Part b)

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

Part c)

(define (balanced? mobile)
  (define (weight s)
    (if (pair? s) (total-weight s) s))
  (let ((ls (branch-structure (left-branch mobile)))
        (rs (branch-structure (right-branch mobile)))
        (ll (branch-length (left-branch mobile)))
        (rl (branch-length (right-branch mobile))))
    (and (if (pair? ls) (balanced? ls) #t)
         (if (pair? rs) (balanced? rs) #t)
         (= (* ll (weight ls)) (* rl (weight rs))))))

Part d)

Simply change the selectors since the other procedures are built on top of them.

(define (left-branch mobile)
  (car mobile))

(define (right-branch mobile)
  (cdr mobile))

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

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

Fun implementation that took about a few hours. Defining helper functions made a world of difference in terms of difficulty.


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

Pretty much the same as in the example.


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

Logical next step given what we’ve read so far.


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

Had to stop and think for this one.


(define (map-2 p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) '() sequence))

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

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


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


(define (count-leaves-2 t)
  (accumulate (lambda (x y) (+ 1 y)) 0 (map identity (fringe t))))

I made it fit the template given in the exercise, but the map here is very pointless. Apparently other people answered by using + instead of the lambda like so

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

Which makes more sense and adheres to the template.


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

Nothing to say here, the answer pretty much screams at you.


(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 (rows) (matrix-*-vector cols rows)) m)))

This looks annoying at first glance but turns out to be fine.


guile> (fold-right / 1 (list 1 2 3))
guile> (fold-left / 1 (list 1 2 3))
guile> (fold-right list '() (list 1 2 3))
(1 (2 (3 ())))
guile> (fold-left list '() (list 1 2 3))
(((() 1) 2) 3)

Associativity is the obvious property that is needed for fold right and fold left to act the same as it is all about the order of which the operation is performed.


(define (reverse-r sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))
(define (reverse-l sequence)
  (fold-left (lambda (x y) (cons y x)) '() sequence))


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

(define (unique-pairs n)
  (flatmap (lambda (i)
             (map (lambda (j)
                    (list i j))
                  (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

Just isolating the code in the examples.


(define (unique-triples n)
  (flatmap (lambda (pair)
             (map (lambda (third)
                    (append pair (list third)))
                  (enumerate-interval 1 (- (car (cdr pair)) 1))))
           (unique-pairs n)))

Maybe there’s a better way, but this is the first one that comes to my mind. A unique-list procedure could probably be extracted out of the above.

I did most of these questions yesterday. Currently I’m working on the eight queens problem, but there are so many ways to do it that I get bogged down in the decision making.


Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s