SICP Exercise 2.53: Quoted Lists

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

So let's check with the interpreter...

> (list 'a 'b 'c)
(a b c)
> (list (list 'george))
((george))
> (cdr '((x1 x2) (y1 y2)))
((y1 y2))
> (cadr '((x1 x2) (y1 y2)))
(y1 y2)
> (pair? (car '(a short list)))
#f
> (memq 'red '((red shoes) (blue socks)))
#f
> (memq 'red '(red shoes blue socks))
(red shoes blue socks)

SICP Exercise 2.52: Abusing Painters

Make changes to the square limit of wave shown in figure 2.9 by working at each of the levels described above. In particular:

1. Add some segments to the primitive wave painter of exercise 2.49 (to add a smile, for example).
2. Change the pattern constructed by corner-split (for example, by using only one copy of the up-split and right-split images instead of two).
3. Modify the version of square-limit that uses square-of-four so as to assemble the corners in a different pattern. (For example, you might make the big Mr. Rogers look outward from each corner of the square.)

Before we get started, let's see what our current procedures give us. We're going to be modifying the wave painter, so we'll show what that looks like with square-limit. If we try ((square-limit wave 4) window) we get:

Now let's add a smile and a pair of eyes to the wave painter. I quickly sketched out what I wanted to add as follows:

From this we can work out the coordinates for the eyes and smile and then add in another three sets of connected segments using build-segments-list as we did in exercise 2.49. The extended wave painter looks like this, with the new connected segment sets added at the bottom:

(define wave
 (segments->painter
   (append (build-segments-list (make-vect 0.0  0.85)
                                (make-vect 0.15 0.6)
                                (make-vect 0.3  0.65)
                                (make-vect 0.4  0.65)
                                (make-vect 0.35 0.85)
                                (make-vect 0.4  1.0))
           (build-segments-list (make-vect 0.6  1.0)
                                (make-vect 0.65 0.85)
                                (make-vect 0.6  0.65)
                                (make-vect 0.75 0.65)
                                (make-vect 1.0  0.35))
           (build-segments-list (make-vect 1.0  0.15)
                                (make-vect 0.6  0.45)
                                (make-vect 0.75 0.0))
           (build-segments-list (make-vect 0.6  0.0)
                                (make-vect 0.5  0.3)
                                (make-vect 0.4  0.0))
           (build-segments-list (make-vect 0.25 0.0)
                                (make-vect 0.35 0.5)
                                (make-vect 0.3  0.6)
                                (make-vect 0.15 0.4)
                                (make-vect 0.0  0.65))
           (build-segments-list (make-vect 0.4 0.9)
                                (make-vect 0.45 0.9)
                                (make-vect 0.45 0.85)
                                (make-vect 0.4 0.85)
                                (make-vect 0.4 0.9))
           (build-segments-list (make-vect 0.55 0.9)
                                (make-vect 0.6 0.9)
                                (make-vect 0.6 0.85)
                                (make-vect 0.55 0.85)
                                (make-vect 0.55 0.9))
           (build-segments-list (make-vect 0.4 0.75)
                                (make-vect 0.45 0.7)
                                (make-vect 0.55 0.7)
                                (make-vect 0.6 0.75)))))

Trying this out with (wave window) gives:

...and ((square-limit wave 4) window) gives:

Next we can work on corner-split. The exercise suggests only using one copy of the up-split and right-split images, instead of two. This is a nice straightforward change. Here's the original corner-split:

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

As you can see it defines top-left as applying beside with up as both parameter values and bottom-right as applying below with right as both parameter values. We can see the effect of corner-split by applying it to the updated wave via ((corner-split wave 4) window):

All we need to do is to remove these definitions and replace usages of top-left and bottom-right with up and right respectively. If we do this (and collapse the let statements as the nesting is no longer needed) we get:

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

Testing this with ((corner-split wave 4) window) now gives:

...and ((square-limit wave 4) window) now gives:

Finally we can look at changing square-limit. The exercise suggests making "the big Mr. Rogers look outward from each corner of the square". If we look at the quadrants as they're shown in section 2.2.4 we can see that Mr. Rodgers currently looks inward at the center of the square. E.g. in the top-right quadrant Mr. Rodgers' face is in the bottom-left-hand corner and looks towards the left.

Now there are at least a couple of ways in which you could interpret this suggested change depending upon what orientation of the head you end up with in each quadrant. I decided to go with the simplest - I'll have Mr. Rodgers' face have the correct orientation in the bottom-right quadrant. I.e. in the bottom-right quadrant Mr. Rodgers' face will be in the bottom-left-hand corner and look towards the left. This then reduces the problem to simply swapping over the contents of opposite corners of the square. So we take the original square-limit of:

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

...and then swap the top-left corner with the bottom-right and the top-right corner with the bottom-left to give:

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

When we try this out with ((square-limit wave 4) window) we now get:

Whoops - Stalled!

No SICP posts for over a week! Well, everyone has to take a holiday at some point.

SICP Exercise 2.51: Below and Below Again

Define the below operation for painters. Below takes two painters as arguments. The resulting painter, given a frame, draws with the first painter in the bottom of the frame and with the second painter in the top. Define below in two different ways -- first by writing a procedure that is analogous to the beside procedure given above, and again in terms of beside and suitable rotation operations (from exercise 2.50).

Here's the procedure beside:

(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              split-point
                              (make-vect 0.0 1.0)))
          (paint-right
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.0)
                              (make-vect 0.5 1.0))))
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

This takes two painters and applies transformations to them such that the first painter is squashed into the left-hand side of a frame, while the second painter is squashed into the right-hand side of the frame... Assuming, of course, that the frame is orientated normally. I.e. with the origin at the bottom left-hand corner, edge1 defining the bottom side of the frame, going from left to right, and edge2 defining the left side of the frame, going from bottom to top. We can express this mapping graphically as follows:

We can use a similar pattern to this for our first version of below, except we want the mapping produced to divide the frame into two horizontal stripes, one above the other. Graphically this is:

To do this we need a different split-point, (0, 0.5) instead of (0.5, 0), and this split-point needs to split edge2 rather than edge1. And we need to rename a few variables. Other than that, it's pretty similar:

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

And putting this to the test with...

((below wave spiral) window)

...gives:

Now onto the second version... As we noted, beside puts its first painter on the left-hand side of the frame and its second on the right-hand side. We want below to put the first painter underneath the second painter. Graphically we can view this as the following rotation:

This rotation is a 90° anti-clockwise rotation. Fortunately, we've already been given a procedure for doing this, rotate90, which was introduced in the section "Transforming and combining painters". Unfortunately, as the image above shows, this translation also has the effect of rotating the contents of the painters by 90° anti-clockwise. We need to compensate for this by rotating each of the painters themselves by 90° clockwise, which is equivalent to rotating by 270° anti-clockwise and is encapsulated in the procedure rotate270 which we defined in exercise 2.50.

Here's what we get when we put these two sets of rotations together:

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

As you'd expect, this gives identical results to the first version above.

SICP Exercise 2.50: Flipping Painters

Define the transformation flip-horiz, which flips painters horizontally, and transformations that rotate painters counterclockwise by 180 degrees and 270 degrees.

Okay, so first of all here's our default frame: The origin is at (0, 0), edge1 is the horizontal edge, ending at (1,0) and edge2 is the vertical edge, ending at (0, 1). And for comparison with later images, here's what we get when we invoke (wave window): To flip a painter horizontally we need to retain the vertical orientation properly, but invert the horizontal orientation. I.e. we want our coordinates system to be: Here the origin is at (1, 0), edge1 is still the horizontal edge, but goes in the oposite direction and ends at (0,0) and edge2 is still the vertical edge, but is on the right of the frame, ending at (1, 1). This translates directly into the following transformation:

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

Calling ((flip-horiz wave) window) gives us: Rotate the frame by 180° moves the origin to the opposite corner and pulls the edges around with it: Here the origin is at (1, 1), edge1 is still the horizontal edge, but is at the top of the frame and goes in the oposite direction, ending at (0, 1), and edge2 is still the vertical edge, but is on the right of the frame and is inverted, ending at (1, 0). This gives us the following transformation:

(define (rotate180 painter)
  (transform-painter painter
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)))

Calling ((rotate180 wave) window) gives us: Finally, rotating the frame by 270° gives us the following coordinates system: Here the origin is at (0, 1), edge1 is now the (inverted) vertical edge on the left-hand side, ending at (0, 0), and edge2 is now the horizontal edge at the top, ending at (1, 1). So our final transformation is:

(define (rotate270 painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

Calling ((rotate270 wave) window) gives us:

SICP Exercise 2.49: Primitive Painters

Use segments->painter to define the following primitive painters:

1. The painter that draws the outline of the designated frame.
2. The painter that draws an "X" by connecting opposite corners of the frame.
3. The painter that draws a diamond shape by connecting the midpoints of the sides of the frame.
4. The wave painter.

Before we start defining a load of segments, let's first have a look at the outline, diamond and painters... To draw an outline of the frame we need four segments:

• One from the bottom-left corner to the bottom-right corner
• One from the bottom-right corner to the top-right corner
• One from the top-right corner to the top-left corner
• One from the top-left corner to the bottom-left corner

Similarly we need four segments to draw a diamond shape, except these connect the midpoints of the sides:

• One from the midpoint of the bottom side to the midpoint of the right side
• One from the midpoint of the right side to the midpoint of the top side
• One from the midpoint of the top side to the midpoint of the left side
• One from the midpoint of the left side to the midpoint of the bottom side

Notice how these painters need a connected series of segments. I.e. the end point of one segment becomes the start point of the next segment, and so on throughout the segments. Also note that, although the wave painter's segments don't form a closed polygon, it's made up of five sets of connected segments. If we were to manually create the segment lists for these painters we'd end up with a large number of make-segment chains along the lines of:

  (make-segment (make-vect x1 y1) (make-vect x2 y2))
  (make-segment (make-vect x2 y2) (make-vect x3 y3))
  (make-segment (make-vect x3 y3) (make-vect x4 y4))
  …

Rather than doing this we can produce a helper procedure that will take a list of vectors and produce a connected sequence of segments such that the first segment starts with the first vector and ends with the second vector, the second segments starts with the second vector and ends with the third vector and so on. The resulting list of segments will contain one less segment than there are vectors. To produce this we can have a procedure that takes an arbitrary number of vectors (via the syntax we learned in exercise 2.20), takes the first vector as the starting point and then iterates through the remaining list, producing a segment linking the the current start point with the current list item and moving the start point along to the current list item at each iteration. Here's the implementation I produced to do this:

(define (build-segments-list . vect-list)
  (define (build cur-vect remaining)
    (if (null? remaining)
        nil
        (cons (make-segment cur-vect (car remaining))
              (build (car remaining) (cdr remaining)))))
  (if (null? vect-list)
      nil
      (build (car vect-list) (cdr vect-list))))

Using this we can then define procedures for drawing the outline and diamond slightly more succinctly than would otherwise be possible as:

(define outline
  (segments->painter (build-segments-list (make-vect 0.0 0.0)
                                          (make-vect 0.0 1.0)
                                          (make-vect 1.0 1.0)
                                          (make-vect 1.0 0.0)
                                          (make-vect 0.0 0.0))))

(define diamond
  (segments->painter (build-segments-list (make-vect 0.0 0.5)
                                          (make-vect 0.5 1.0)
                                          (make-vect 1.0 0.5)
                                          (make-vect 0.5 0.0)
                                          (make-vect 0.0 0.5))))

To make the results of these easier to see I produced a procedure, quad that draws a 2 × 2 grid, with each cell containing the requested painter:

(define (quad painter)
  (let ((side-by-side (beside painter painter)))
    (below side-by-side side-by-side)))

Then I can use:

((quad outline) window)

...to produce:
...and...

((quad diamond) window)

...to produce:
We can't use build-segments-list for drawing an "X", however. There is no connected series of segments here. Instead we need to produce two segments that join the diagonally opposite corners:

(define draw-x
  (segments->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0))
                           (make-segment (make-vect 0.0 1.0) (make-vect 1.0 0.0)))))

Here:

((quad draw-x) window)

...gives:
Finally we can address wave. Now there doesn't appear to be a handy set of coordinates kicking around for this, so I resorted to my paper copy of the book and a ruler. But, as noted above, this has five sets of connected segments, so we can use build-segments-list again to simplify the procedure slightly. Note that, as each build-segments-list call produces a list of segments we have to append them together in order that we can then pass them through to segments->painter:

(define wave
 (segments->painter
   (append (build-segments-list (make-vect 0.0  0.85)
                                (make-vect 0.15 0.6)
                                (make-vect 0.3  0.65)
                                (make-vect 0.4  0.65)
                                (make-vect 0.35 0.85)
                                (make-vect 0.4  1.0))
           (build-segments-list (make-vect 0.6  1.0)
                                (make-vect 0.65 0.85)
                                (make-vect 0.6  0.65)
                                (make-vect 0.75 0.65)
                                (make-vect 1.0  0.35))
           (build-segments-list (make-vect 1.0  0.15)
                                (make-vect 0.6  0.45)
                                (make-vect 0.75 0.0))
           (build-segments-list (make-vect 0.6  0.0)
                                (make-vect 0.5  0.3)
                                (make-vect 0.4  0.0))
           (build-segments-list (make-vect 0.25 0.0)
                                (make-vect 0.35 0.5)
                                (make-vect 0.3  0.6)
                                (make-vect 0.15 0.4)
                                (make-vect 0.0  0.65)))))

Then we can test it out, using:

((quad wave) window)

...to produce:

SICP Exercise 2.48: Segments

A directed line segment in the plane can be represented as a pair of vectors -- the vector running from the origin to the start-point of the segment, and the vector running from the origin to the end-point of the segment. Use your vector representation from exercise 2.46 to define a representation for segments with a constructor make-segment and selectors start-segment and end-segment.

As with the representation we produced for vectors in exercise 2.46, segments lend themselves naturally to being represented as pairs. We can put the start of the segment in the first element of the pair, and the end of the segment in the second element of the pair. Then we can access the start and end using car and cdr respectively:

(define (make-segment start-v end-v)
  (cons start-v end-v))

(define (start-segment seg)
  (car seg))

(define (end-segment seg)
  (cdr seg))

This then allows us to represent segments and access their components:

> (define segment (make-segment (make-vect 10 5) (make-vect 30 40)))
> segment
'((10 . 5) 30 . 40)
> (start-segment segment)
'(10 . 5)
> (end-segment segment)
'(30 . 40)

SICP Exercise 2.47: Frames

Here are two possible constructors for frames:

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

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

For each constructor supply the appropriate selectors to produce an implementation for frames.

First, let's look at the structures the two constructors produce.

The first (list-based) version of make-frame constructs a list of origin, edge1 and edge2 in that order. As shown in section 2.2.1, a list is really represented as a chain of pairs with each pair consisting of the next element in the list and the next pair in the chain (with the last pair having nil as its second element. This means that the list constructed is a chain of three pairs where the first components of each pair are origin, edge1 and edge2 respectively. I.e. The second (pair-based) version of make-frame also constructs a chain of pairs, but in this case it is done directly and only consists of two pairs. The first pair has origin as its first component and the second pair as its second component. The second pair has edge1 as its first component and edge2 as its second component. I.e. As can be seen, the two structures differing only in the way edge2 is included in them. This means that selectors origin-frame and edge1-frame will be identical regardless of the constructor implementation used. The former simply returns the first element of the root pair via car, while the latter returns the first element of the second pair in the structure via cadr:

(define (origin-frame f) (car f))
(define (edge1-frame f) (cadr f))

The only difference is in the implementations of edge2-frame. In the list-based representation we need this selector to return the first element of the third pair. I.e. via caddr:

(define (edge2-frame f) (caddr f))

However, in the pair-based representation we need this selector to return the second element of the second pair. I.e. via cddr:

(define (edge2-frame f) (cddr f))

The choice as to which we we use is fairly arbitrary. It could be argued that the pair-based representation is more compact, eliminating the third pair. However the list-based representation feels more elegant.

Anyway, here they are in use. First the list-based representation:

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

> (define origin (make-vect 10 5))
> (define edge1 (make-vect 0 100))
> (define edge2 (make-vect 40 -4))

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

> (origin-frame frame)
'(10 . 5)
> (edge1-frame frame)
'(0 . 100)
> (edge2-frame frame)
'(40 . -4)

...and the pairs-based representation:

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

> (define origin (make-vect 10 5))
> (define edge1 (make-vect 0 100))
> (define edge2 (make-vect 40 -4))

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

> (origin-frame frame)
'(10 . 5)
> (edge1-frame frame)
'(0 . 100)
> (edge2-frame frame)
'(40 . -4)

As you'd expect, although the internal representations differ, the constructor and selectors hide this from the next layer of abstraction up and so they behave identically.

SICP Exercise 2.46: Vectors

A two-dimensional vector v running from the origin to a point can be represented as a pair consisting of an x-coordinate and a y-coordinate. Implement a data abstraction for vectors by giving a constructor make-vect and corresponding selectors xcor-vect and ycor-vect. In terms of your selectors and constructor, implement procedures add-vect, sub-vect, and scale-vect that perform the operations vector addition, vector subtraction, and multiplying a vector by a scalar:

(x1, y1) + (x2, y2) = (x1 + x2, y1 + y2)
(x1, y1) - (x2, y2) = (x1 - x2, y1 - y2)
        s · (x, y) = (sx, sy)

As a two-dimensional vector has only two pieces of data associated with it, the x- and y-coordinates, it lends itself naturally to being represented as a pair. Let's put x as the first elements, and y as the second. We can then access them via car and cdr respectively:

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

Given this representation (or at least this constructor and these selectors), we can implement the given operations straightforwardly. We simply need to extract the x- and y-coordinates from the vectors we're dealing with using the selectors, perform the appropriate mathematical operations on them and then create a new vector as our result using the constructor:

(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 s v)
  (make-vect (* s (xcor-vect v))
             (* s (ycor-vect v))))

Let's see them in action:

> (define v1 (make-vect 4 5))
> (define v2 (make-vect 7 3))

> v1
'(4 . 5)
> v2
'(7 . 3)

> (xcor-vect v1)
4
> (ycor-vect v1)
5
> (ycor-vect v2)
3
> (xcor-vect v2)
7

> (add-vect v1 v2)
'(11 . 8)
> (add-vect v2 v1)
'(11 . 8)

> (sub-vect v1 v2)
'(-3 . 2)
> (sub-vect v2 v1)
'(3 . -2)

> (scale-vect 3 v1)
'(12 . 15)
> (scale-vect 2 v2)
'(14 . 6)

SICP Exercise 2.45: Splitting the splitters

Right-split and up-split can be expressed as instances of a general splitting operation. Define a procedure split with the property that evaluating

(define right-split (split beside below))
(define up-split (split below beside))

produces procedures right-split and up-split with the same behaviors as the ones already defined.

What we want split to do here is to return a procedure that takes a painter and some integer value, n that applies the supplied splitting operations in the given order. As we noted in exercise 2.44, right-split and up-split are very similar. Here they are again, but with the differences highlighted:

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

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

This gives us the pattern for the procedure we want split to return. We just need to replace the calls to below and beside with the appropriate calls to the supplied splitting operations. We can define this as an inner procedure for split and then return a lambda expression that invokes the procedure with the appropriate values:

(define (split large-splitter small-splitter)
  (define (splitter painter n)
    (if (= n 0)
        painter
        (let ((smaller (splitter painter (- n 1))))
          (large-splitter painter (small-splitter smaller smaller)))))
  (lambda (painter n) (splitter painter n)))

We can then use this to produce new versions of right-split and up-split:

(define right-split (split beside below))
(define up-split (split below beside))

...and then try them out. Invoking:

(right-split spiral 4)

...produces: While...

(up-split spiral 4)

...produces:

SICP Exercise 2.44: Splitting Up

Define the procedure up-split used by corner-split. It is similar to right-split, except that it switches the roles of below and beside.

up-split is very similar... Here's right-split:

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

To produce up-split we simply rename the procedure and recursive call and switch below and beside around to give:

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

Using the spiral we produced earlier we can put this to the test:

((up-split spiral 3) window)

...produces the following:

SICP's Picture Language in DrRacket

Section 2.2.4 of SICP introduces us, bit by bit, to a language that can be used for representing and drawing pictures. Unfortunately, as graphics support tends to be implementation-dependent the author's don't (and can't, without tying themselves to a particular Scheme interpreter) provide a way of actually drawing the graphics. The closest they get is to posit the existence of a procedure, draw-line, which takes two vectors representing the start and end points of the line and draws a line between those points.

When I originally did the exercises in this section I didn't worry myself too much about this. After all, some of the exercises rely upon the existence of procedures that aren't addressed until later exercises, so I wouldn't necessarily be able to produce sensible pictures for each exercise until I'd completed them all.

Of course now I'm writing up the exercises after the fact, and have a full picture language at my disposal. So I decided I'd produce at least an implementation of draw-line that would allow me to produce some pictures to post in the exercises as I write them up.

I've noted before that one of the interpreters I'm using is DrRacket, which has its own graphical interface toolkit. After a bit of head-scratching and hitting the docs, here's what I came up with:

#lang racket
(require racket/gui/base)

(define picture-size 300)

(define bitmap
  (make-object bitmap% (+ picture-size 1) (+ picture-size 1)))

(define bitmap-dc
  (new bitmap-dc% [bitmap bitmap]))

(define frame
  (new frame% [label "SICP Picture Language"]))

(define canvas
  (new canvas%
     [parent frame]
     [min-width (+ picture-size 1)]
     [min-height (+ picture-size 1)]
     [paint-callback (lambda (canvas dc)
                       (send dc draw-bitmap bitmap 0 0))]))

(define (draw-line start end)
  (send bitmap-dc 
        draw-line
        (xcor-vect start)
        (ycor-vect start)
        (xcor-vect end)
        (ycor-vect end)))

(define window (make-frame (make-vect 0 picture-size)
                           (make-vect picture-size 0)
                           (make-vect 0 (- 0 picture-size))))

(send frame show #t)

You'll need the vector constructor and selectors from exercise 2.46 and the same for one of the frame representations from exercise 2.47 for these to work.

Note that window provides a frame that will map a picture with x and y coordinates in the ranges [0..1] into the [0..picture-size] that's provided. It needs to map standard Cartesian coordinates into an inverted coordinate system as, like many windowing systems, the coordinates (0, 0) correspond to the top-left corner of the window, as opposed to the bottom-left as is used by the picture language.

We can also give ourselves a shape to play with. I'm using a procedure I produced as part of exercise 2.49, build-segments-list, that basically takes a list of vectors and turns those into a list of segments. I've used this to produce a spiral:

(define spiral
  (segments->painter (build-segments-list (make-vect 0.0 0.0)
                                          (make-vect 1.0 0.0)
                                          (make-vect 1.0 1.0)
                                          (make-vect 0.0 1.0)
                                          (make-vect 0.0 0.1)
                                          (make-vect 0.9 0.1)
                                          (make-vect 0.9 0.9)
                                          (make-vect 0.1 0.9)
                                          (make-vect 0.1 0.2)
                                          (make-vect 0.8 0.2)
                                          (make-vect 0.8 0.8)
                                          (make-vect 0.2 0.8)
                                          (make-vect 0.2 0.3)
                                          (make-vect 0.7 0.3)
                                          (make-vect 0.7 0.7)
                                          (make-vect 0.3 0.7)
                                          (make-vect 0.3 0.4)
                                          (make-vect 0.6 0.4)
                                          (make-vect 0.6 0.6)
                                          (make-vect 0.4 0.6)
                                          (make-vect 0.4 0.5)
                                          (make-vect 0.5 0.5))))

We can then display our spiral... Invoking this:

(spiral window)

Produces this: Now with that done we can actually get on to the exercises themselves.

SICP Exercise 2.43: Louis' Queens

Louis Reasoner is having a terrible time doing exercise 2.42. His queens procedure seems to work, but it runs extremely slowly. (Louis never does manage to wait long enough for it to solve even the 6× 6 case.) When Louis asks Eva Lu Ator for help, she points out that he has interchanged the order of the nested mappings in the flatmap, writing it as

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

Explain why this interchange makes the program run slowly. Estimate how long it will take Louis's program to solve the eight-queens puzzle, assuming that the program in exercise 2.42 solves the puzzle in time T.

Here's Louis' full version of the queens procedure:

(define (queens board-size)
  (define (queen-cols k)  
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k 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))

So what effect has interchanging the order of the nested mappings in flatmap had? Well, it still correctly constructs all of the potential positions for a queen to go in the current column. However, whereas in the original version each call to (queen-cols k) would have made only a single call to (queen-cols (- k 1)), in Louis' version each call to (queen-cols k) will result in board-size calls to (queen-cols (- k 1)).

Why is this?

Well in the original version in order to evaluate flatmap the interpreter first evaluates (queen-cols (- k 1)). flatmap then processes the resulting list by applying the nested mapping to each set of positions in the list. This nested mapping takes a set of safe positions for the previous columns, enumerates all of the possible row indexes for the board-size and then generates a new list of sets of potential positions from the set passed by appending each of these potential positions for the current column onto the passed set in turn.

In Louis' version this logic is reversed. In order to evaluate flatmap the interpreter first enumerates all of the possible row indexes for the board-size. flatmap then processes this list of row indexes, applying the nested mapping to each set of positions in the list. In this case the nested mapping takes a row index, generates all of the possible safe board positions for the previous columns and then generates a new list of sets of potential positions from the row index passed by appending it onto each of the each of the known safe positions for the previous columns in turn.

What does this mean for the run time of Louis' version?

In the original version in order to calculate the safe positions for (queens board-size) the interpreter would need to make one call to (queen-cols board-size), one to (queen-cols (- board-size 1)), and so on down to a single call to (queen-cols 0). This means that, for any given board-size, there are board-size + 1 calls to queen-cols.

In Louis version in order to calculate the safe positions for (queens board-size) the interpreter has to make one call to (queen-cols board-size), which then makes board-size calls to (queen-cols (- board-size 1)). Each of these calls in turn makes board-size calls to (queen-cols (- board-size 2)), giving a total of board-size² calls to (queen-cols (- board-size 2)). This carries on down to (queen-cols 0), which is called a grand total of board-sizeboard-size times. This increase in the number of steps required at each subsequent level gives us a geometric progression and so we can calculate the sum of this progression as:

  n
  Σ board-sizei
  i=0
= 1 - board-sizeboard-size+1
       1 - board-size

Note that we can also express the number of calls to queen-cols in the original implementation using the same denominator (i.e. 1 - board-size):

  board-size + 1
= 1 - board-size × board-size + 1
  1 - board-size  
= (1 - board-size)(board-size + 1)
            1 - board-size
= board-size + 1 - board-size2 - board-size
              1 - board-size
= 1 - board-size2
  1 - board-size

Then we can determine the ratio of calls to queen-cols that are required between the two algorithms for different board sizes by dividing the steps required for Louis algorithm by the steps required for the original algorithm:

  1 - board-sizeboard-size+1  /  1 - board-size2
       1 - board-size          1 - board-size
= 1 - board-sizeboard-size+1  ×  1 - board-size 
       1 - board-size          1 - board-size2
= 1 - board-sizeboard-size+1
      1 - board-size2

If we then make the naïve (and wildly incorrect) assumption that a single queen-cols call takes constant time then this would allow us to state that, given time T for the original algorithm, we would expect Louis' algorithm to take:

(1 - board-sizeboard-size+1)T
     1 - board-size2

It's a wildly incorrect assumption as the number of steps required to evaluate (queen-cols k) depends upon both k and board-size. However, I'm going to leave the exercise here.

SICP Exercise 2.42: The Eight-Queens Puzzle

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 [below]. 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 k^th 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 k^th column. Now filter these, keeping only the positions for which the queen in the k^th 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 k^th 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 k^th 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.)

So what will our representation for board positions be? Well, as we only have one type of piece on the board, the queen, we don't need to concern ourselves with recording which type of piece we're putting in each position. We only need to record the row and position of each placed piece, so a pair will do nicely for this. As for representing a set of board positions, we can represent this as a list of such pairs. That means that empty-board will just be an empty list and adjoin-position will just cons a pair representing the position of the placed piece onto the list representing the set of board positions so far:

(define empty-board nil)

(define (adjoin-position row column board)
  (cons (cons row column) board))

Let's give ourselves a couple of selectors as well for extracting the row and column from a given position:

(define (get-row position)
  (car position))

(define (get-column position)
  (cdr position))

That's the easy bit done. We need to write safe? now. As stated in the exercise, a position is safe if there are no two queens are in the same row, column, or diagonal. Now safe? is called with the column number, k, and the set of positions to be validated. We know that the positions of the queens in the first k - 1 columns have already been validated as safe - we just need to validate that the newly added queen position is also safe. So before we can even check the positions we need to find the queen that's just been added and also produce the set of positions we need to validate (i.e. all but the newly added queen). Both of these involve filtering the list of positions... In the former case we want to filter to just those queens in the column we've added. There should one and only be one of these, so let's assume that and extract it from the filtered list using car. For the latter case, assuming we've already found the first queen in the column we've just added, we can just filter the list to remove any queens in that position. Here's a couple of procedures that will do this for us:

(define (get-first-in-column column positions)
  (car (filter (lambda (position)
                 (= (get-column position) column))
               positions)))

(define (filter-out-position filter-position positions)
  (let ((row (get-row filter-position))
        (column (get-column filter-position)))
    (filter (lambda (position)
              (not (and (= (get-row position) row)
                        (= (get-column position) column))))
            positions)))

Now onto the actual checking itself. To check whether or not a newly-added queen in a particular row and column is a safe position we need to compare it with all the other queen positions and, for each one, confirm that it's not in the same row or column and that it's not on a diagonal. The first two tests here are easy. The second one's a little bit tricky, but easy enough if you note that the diagonal positions that are n columns away from a particular position are also n rows away from that position. I.e. if we've got a piece in row 4, column 5, then the positions that are diagonal to this in column 2 are 3 columns away, and so are 3 rows away to: in rows 1 and 7 (i.e. 4 - 3 and 4 + 3 rows away). Also note that we don't need to worry if this takes us outside the board size - there shouldn't be any pieces there anyway! Anyway, here's a test to check whether a newly added queen in (row, column) is safe with respect to another queen in (other-row, other-column):

(define (is-safe-position? row column other-row other-column)
  (let ((other-column-diff (- column other-column)))
       (and (not (= row other-row))
            (not (= column other-column))
            (not (= (+ row other-column-diff) other-row))
            (not (= (- row other-column-diff) other-row)))))

Finally we can put this all together. We just need to extract the position of the queen we've just added, get the list of other queens' positions, and then iterate across those positions and check each one is safe with respect to the newly-added queen (via is-safe-position?). We can do this iterative step using accumulate. A newly added queen is safe if it's safe with respect to the first queen in the list of positions and with respect to the second and with respect to the third, and so on. So if we assume that the queen position is safe to begin with (i.e. initial is #t) then we can determine whether the position's safe by anding the accumulated result so far with the results of testing the next position in the list with is-safe-position?. Of course that's easier to express in code than words:

(define (safe? column positions)
  (let ((test-position (get-first-in-column column positions)))
    (let ((row (get-row test-position))
          (column (get-column test-position))
          (other-positions (filter-out-position test-position positions)))
      (accumulate (lambda (position preceding-positions-safe)
                    (and (is-safe-position? row
                                            column
                                            (get-row position)
                                            (get-column position))
                         preceding-positions-safe))
                    #t
                    other-positions))))

Now we can put this to the test:

> (queens 0)
'(())
> (queens 1)
'(((1 . 1)))
> (queens 2)
'()
> (queens 3)
'()
> (queens 4)
'(((3 . 4) (1 . 3) (4 . 2) (2 . 1)) ((2 . 4) (4 . 3) (1 . 2) (3 . 1)))
> (queens 5)
'(((4 . 5) (2 . 4) (5 . 3) (3 . 2) (1 . 1))
  ((3 . 5) (5 . 4) (2 . 3) (4 . 2) (1 . 1))
  ((5 . 5) (3 . 4) (1 . 3) (4 . 2) (2 . 1))
  ((4 . 5) (1 . 4) (3 . 3) (5 . 2) (2 . 1))
  ((5 . 5) (2 . 4) (4 . 3) (1 . 2) (3 . 1))
  ((1 . 5) (4 . 4) (2 . 3) (5 . 2) (3 . 1))
  ((2 . 5) (5 . 4) (3 . 3) (1 . 2) (4 . 1))
  ((1 . 5) (3 . 4) (5 . 3) (2 . 2) (4 . 1))
  ((3 . 5) (1 . 4) (4 . 3) (2 . 2) (5 . 1))
  ((2 . 5) (4 . 4) (1 . 3) (3 . 2) (5 . 1)))
> (queens 6)
'(((5 . 6) (3 . 5) (1 . 4) (6 . 3) (4 . 2) (2 . 1))
  ((4 . 6) (1 . 5) (5 . 4) (2 . 3) (6 . 2) (3 . 1))
  ((3 . 6) (6 . 5) (2 . 4) (5 . 3) (1 . 2) (4 . 1))
  ((2 . 6) (4 . 5) (6 . 4) (1 . 3) (3 . 2) (5 . 1)))

SICP Exercise 2.41: Triple Sum

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.

This bears some resemblance to the prime-sum-pairs procedure in the "Nested mappings" section and exercise 2.40. This time, however, we want to generate triples of integers, i, j, and k, such that 1 ≤ i < j < k ≤ n and i + j + k = s.

We already have a procedure, unique-pairs, that will generate all unique ordered pairs of distinct positive integers less than or equal to a given value. We can use this as the basis for building the triples. All we need to do is for each k, such that 3 ≤ k ≤ n, generate the unique pairs of distinct positive integers less than k (using unique-pairs), add k to each of these pairs to give all of the valid triples for that value of k and then append the results for all values of k together. And the authors have handily provided a procedure, flatmap, that encapsulates the "map and accumulate with append" process. Here's the snippet:

(flatmap (lambda (i)
                 (map (lambda (j) (cons i j))
                      (unique-pairs (- i 1))))
         (enumerate-interval 3 n))

Now all we need to do is to filter this to those triples whose sum is s and wrap it in a procedure:

(define (triples-equaling s n)
  (filter (lambda (x)
                  (= (+ (car x) (cadr x) (caddr x)) s))
          (flatmap (lambda (i)
                           (map (lambda (j) (cons i j))
                                (unique-pairs (- i 1))))
                   (enumerate-interval 3 n))))

Let's try it out:

> (triples-equaling 10 10)
'((5 3 2) (5 4 1) (6 3 1) (7 2 1))
> (triples-equaling 15 10)
'((6 5 4) (7 5 3) (7 6 2) (8 4 3) (8 5 2) (8 6 1) (9 4 2) (9 5 1) (10 3 2)
  (10 4 1))
> (triples-equaling 6 3)
'((3 2 1))
> (triples-equaling 10 5)
'((5 3 2) (5 4 1))

SICP Exercise 2.40: Unique Pairs

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.

In the section on "Nested mappings" the authors show us how to build this sequence of pairs using accumulate:

(accumulate append
            nil
            (map (lambda (i)
                   (map (lambda (j) (list i j))
                        (enumerate-interval 1 (- i 1))))
                 (enumerate-interval 1 n)))

They then introduce flatmap to simplify the process of mapping and accumulating with append and use this to produce their definition of prime-sum-pairs:

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

The highlighted section above shows the portion of the procedure that builds the sequence of pairs, and this is pretty much exactly what we want for our unique-pairs procedure:

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

Note that this procedure does some unnecessary work though. There are no pairs of integers such that 1 ≤ j < i ≤ n where i=1. The smallest i we can successfully generate any such pairs for is 2 - there's only one such pair: (1,2). So there's no point in starting the sequence passed to flatmap at 1 - we can start it at 2 instead without changing the outcome:

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

Let's give it a spin:

> (unique-pairs 3)
'((2 1) (3 1) (3 2))
'> (unique-pairs 4)
((2 1) (3 1) (3 2) (4 1) (4 2) (4 3))
'> (unique-pairs 5)
((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))

Finally we can replace the old code to generate unique pairs in prime-sum-pairs with an appropriate call to unique-pairs:

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

...and then test it works:

> (prime-sum-pairs 3)
'((2 1 3) (3 2 5))
> (prime-sum-pairs 4)
'((2 1 3) (3 2 5) (4 1 5) (4 3 7))
> (prime-sum-pairs 5)
'((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7))

Progress Report

Well, it's been a couple of weeks since the last one...

As of tomorrow's meeting we'll have covered all the exercises up to and including 2.72, completing section 2.3 of the book. That means we've covered a grand total of 118 exercises.

I've been doing pretty well at catching up though. I've just finished writing up exercise 2.39, which means that I've written up 85 exercises in total, and a whopping 22 in the last week. So I'm now 72% of the way to being caught up with the ever-moving target.

If I'm really lucky I'll get caught up just in time to fall behind as I go away on holiday...

SICP Exercise 2.39: Folding Reverse

Complete the following definitions of reverse (exercise 2.18) in terms of fold-right and fold-left from exercise 2.38:

(define (reverse sequence)
  (fold-right (lambda (x y) <??>) nil sequence))
(define (reverse sequence)
  (fold-left (lambda (x y) <??>) nil sequence))

In both cases we start with the empty list, but, as we discussed in exercise 2.38 we process the elements in different orders: fold-left processes the elements in the list from first to last, while fold-right processes the elements in the list from last to first.

We're starting with the fold-right case first, so we're going to process the elements from last to first. This means that at any particular step in the process we're going to want to combine the results of reversing the later elements in sequence with the current element we're processing. For example, when we finally process the first element of the sequence we want to combine it with the results of reversing the remainder of the sequence. So the current element (x in the lambda expression) needs to go onto the tail of the results of reversing the later elements in the sequence. We know that we can't use cons to append a single item onto the end of a list... But we can use append to combine two lists. If we take the current element of the sequence and turn it into a single-item list then we can append that onto the end of the results of reversing the later elements in the sequence as follows:

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

And just to check that works:

> (reverse (list 1 2 3 4 5))
'(5 4 3 2 1)

The fold-left case is a bit easier. We're processing the elements from first to last, so we can simply cons each element onto the accumulated result sequence in turn. We cons the first element of sequence onto an empty list, giving a single item list. Then we cons the second element of sequence onto that, giving us a list of the first two items from sequence, but in reverse order. And we repeat that throughout the list to give us the reverse list:

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

And again we check it works:

> (reverse (list 1 2 3 4 5))
'(5 4 3 2 1)

SICP Exercise 2.38: MapReduce

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.

What the authors omit to point out in this exercise is that fold-left is also known as reduce. Not particularly relevant, but reduce, in combination with map, inspired a pretty nifty distributed processing framework that you may have heard of.

Okay, let's spin up the interpreter:

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

So what property does op have to satisfy to guarantee that fold-right and fold-left will produce the same values for any sequence?

Well fold-left and fold-right process the elements in opposite directions. Both start with the initial value. I.e. fold-left starts by applying op to the initial value and the first element, takes the result of this and applies op to this value and the second element and so on. However, fold-right starts by applying op to the initial value and the last element, takes the result of this and applies op to this value and the second-last element and so on.

This means that op must return the same result regardless of which order the operators are applied to them. In other words, op must be commutative.

SICP Exercise 2.37: Matrix Manipulation

Suppose we represent vectors v = (vi) as sequences of numbers, and matrices m = (mij) as sequences of vectors (the rows of the matrix). For example, 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 Σiviwi
(matrix-*-vector m v)   returns the vector t, where ti = Σjmijvj
(matrix-*-matrix m n)   returns the matrix p, where pij = Σkmiknkj
(transpose m)           returns the matrix n, where nij = mji

We can define the dot product as

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

The formal definition of matrix-*-vector given above effectively indicates that the generated vector should contain the results of calculating the dot products of each of the rows in m and the vector v. Now as the matrix m is represented as a sequence of sequences, with each sub-sequence representing the corresponding row in the matrix, mapping across the matrix will perform an operation on each row of the sequence. So all we need to do is provide a procedure that calculates the dot product of the row and v and we have our implementation:

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

The procedure transpose needs to transform the matrix so that the rows become columns and vice versa. In other words, we need to take the first item from each row in turn and put them together, in order, into a sequence, then we take the second item from each row in turn and put them into a sequence, and so on, and put these resulting sequences together to form our transformed matrix.

Now we know that the procedure accumulate-n applies accumulate to the sequence containing the first items from each sequence in a sequence of sequences, and then cons the result onto the sequence produced by applying accumulate-n to the sequence of sequences produced by taking the tails of each of the original sequences. It just so happens that the sequence passed to accumulate in this process is the sequence we want, so all we need to do is to pass an appropriate operator and base case to accumulate-n so that it effectively turns the application of accumulate into an identity function. In this case the operator cons and the base case nil will achieve the desired effect:

(define (transpose mat)
  (accumulate-n cons nil mat))

Finally onto matrix-*-matrix. Matrix multiplication takes an a×b matrix, m, and a b×c matrix, n, and produces a new a×c matrix, p, where the value p_ij is calculated as the dot product of the i^th row of m and the j^th column of n. Handily the template we're given for matrix-*-matrix transforms the matrix n so that its rows become columns and vice versa. This means that each sub-sequence of cols will have the same length as each sub-sequence of m, and we can generate each row of the resulting matrix by taking the corresponding sub-sequence from m and applying matrix-*-vector to the matrix cols and that sub-sequence of m:

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x) (matrix-*-vector cols x))
         m)))

Okay, let's see these matrix operations in action:

> (define v (list 1 2 3))
> (define m1 (list (list 1 2 3) (list 4 5 6)))
> (define m2 (list (list 1 2) (list 3 4) (list 5 6)))
> (matrix-*-vector m1 v)
'(14 32)
> (transpose m1)
'((1 4) (2 5) (3 6))
> (matrix-*-matrix m1 m2)
'((22 28) (49 64))

SICP Exercise 2.36: n-way Accumulation

The procedure accumulate-n is similar to accumulate except that it takes as its third argument a sequence of sequences, which are all assumed to have the same number of elements. It applies the designated accumulation procedure to combine all the first elements of the sequences, all the second elements of the sequences, and so on, and returns a sequence of the results. For instance, if s is a sequence containing four sequences, ((1 2 3) (4 5 6) (7 8 9) (10 11 12)), then the value of (accumulate-n + 0 s) should be the sequence (22 26 30). Fill in the missing expressions in the following definition of accumulate-n:

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      nil
      (cons (accumulate op init <??>)
            (accumulate-n op init <??>))))

What we need to do here is to get the sequence containing all the first elements of the sequences in seqs and apply accumulate to those, and then cons that result onto the head of the list produced by applying accumulate-n to the sequence of sequences where each sub-sequence is the tail of the corresponding sequence in seqs. We're given most of this in the template procedure. It applies accumulate to some sequence and then cons it onto the sequence returned by applying accumulate-n onto a sequence of sequences. All we need to do is to:

• Get the sequence containing all the first elements of the sequences in seqs, so we can pass this to accumulate.
• Get the sequence of sequences where each sub-sequence is the tail of the corresponding sequence in seqs, so we can pass this to the recursive call to accumulate-n.

We can achieve both of these via map. We know that we can extract the first element of a sequence by using car, so mapping seqs with the operation car will give us the sequence containing the first element of each sequence in seqs. Similarly, we know that we can extract the tail of a sequence by using cdr, so mapping seqs with the operation cdr will give us the sequence of sequences containing the tails of each sequence in seqs.

So here's the completed procedure:

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

And here it is in action:

> (define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
> (accumulate-n + 0 s)
(22 26 30)
> (accumulate-n * 1 s)
(280 880 1944)

SICP Exercise 2.35: Counting Leaves Again

Redefine count-leaves from section 2.2.2 as an accumulation:

(define (count-leaves t)
  (accumulate <??> <??> (map <??> <??>)))

In the "Sequence operations" section the authors define the procedure enumerate-tree which flattens a tree into a list that contains only the leaf nodes of the tree. We can use this to simplify our job here - we're only interested in the leaf nodes and this saves us the complexity of writing our own tree-traversal. The length of this list is equal to the number of leaf nodes in the tree...

However, the procedure template we're given above doesn't allow us to do that - we have to map across a list and then accumulate in some way across the result of the mapped list. So what mapping should we use, and what accumulation?

Well, when we defined length in terms of accumulate in exercise 2.33, we started with an initial value of 0 and incremented this by 1 for each element in the tree. We could achieve the same effect by using + as our op for accumulate, 0 as the initial value, and pass it a sequence that's a list with the same number of elements as there are leaf nodes, but with each element having the value 1... And we can produce such a sequence by mapping each element from the list returned by enumerate-tree to 1.

Here's my implementation:

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

...and in practice:

> (define x (cons (list 1 2) (list 3 4)))
> (define y (list 1 (list 2 3) (cons (list 4 5) (list 6 7))))
> (count-leaves x)
4
> (count-leaves (cons x x))
8
> (count-leaves y)
7
> (count-leaves (list x y))
11

SICP Exercise 2.34: Horner's Rule

Evaluating a polynomial in x at a given value of x can be formulated as an accumulation. We evaluate the polynomial

a_nxⁿ + a_n-1x^n-1 + … + a₁x + a₀

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

( … (a_nx + a_n-1)x + … + a₁)x + a₀

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₀. 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₀ through a_n.

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) <??>)
              0
              coefficient-sequence))

For example, to compute 1 + 3x + 5x³ + x⁵ at x = 2 you would evaluate

(horner-eval 2 (list 1 3 0 5 0 1))

Remembering that accumulate is effectively equivalent to starting with some initial value, then going through the supplied list backwards from the last item to the first, applying op to each item and the accumulated result so far, we're actually going to start at the n^th coefficient and work backwards towards the 0^th one. This allows use to define the recursive relationship here as: multiply the accumulated result so far by x and then add the next coefficient.

Let's put this into code:

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

And give it a test:

> (horner-eval 2 (list 1 3 0 5 0 1))
79
> (horner-eval 4 (list 3 2 1))
27

SICP Exercise 2.33: Accumulations

Fill in the missing expressions to complete the following definitions of some basic list-manipulation operations as accumulations:

(define (map p sequence)
  (accumulate (lambda (x y) <??>) nil sequence))
(define (append seq1 seq2)
  (accumulate cons <??> <??>))
(define (length sequence)
  (accumulate <??> 0 sequence))

First, map... The procedure accumulate produces a single value by iterating over the list and, for each element in the list, applying a supplied two-parameter procedure to the element and the results of applying accumulate to the rest of the list. We want to produce a list as our result that contains the same number of elements as the original list, but that has applied the procedure p to each element. We're given a hint in our base case - it's the empty list. If we apply p to each element in the list and then use cons to put this result onto the head of the accumulated result for the remainder of the list then this will give us the desired result:

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

Next append... We want append to put all of the items from seq1 onto the front of seq2. We know we're going to be using cons to perform the accumulation step, and we know that accumulate works in a manner equivalent to starting with the last item of the list it is accumulating over and applying op to it and the accumulated result so far, starting with some initial value and repeating that backwards throughout the list. So if we start with an initial value of seq2 and cons each item from seq1 to it, starting at the last and working through to the first then we will produce an equivalent implementation to append. Therefore we can implement append as follows:

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

Finally, length... We know that an empty list has a length of 0, and that if we start at 0 and add 1 for each element in the list we'll get the length of the list, so this gives us our initial value and tells us what op should do - increment the accumulated value by 1. This gives us the following implementation:

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

Okay, let's take them for a spin:

> (define list1 (list 1 2 3 4))
> (define list2 (list 5 6 7 8 9))
> (map square list1)
(1 4 9 16)
> (map square list2)
(25 36 49 64 81)
> (append list1 list2)
(1 2 3 4 5 6 7 8 9)
> (append list2 list1)
(5 6 7 8 9 1 2 3 4)
> (length list1)
4
> (length list2)
5