August « 2009 « Dan's Thoughts

27Aug/090

Exercise 2.42 of SICP

Exercise 2.42:

A solution to 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 in figure 2.8. 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.)

(define (filter pred? seq)
  (cond ((null? seq) '())
        ((pred? (car seq)) (cons (car seq) (filter pred? (cdr seq))))
        (else
          (filter pred? (cdr seq)))))
(define (flatmap pred seq)
  (accumulate append '() (map pred seq)))
(define (accumulate op init seq)
  (if (null? seq)
    init
    (op (car seq)
        (accumulate op init (cdr seq)))))
(define (enumerate-interval low high)
  (if (> low high)
    '()
    (cons low (enumerate-interval (+ 1 low) high))))
 
(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))
 
(define empty-board '())
(define (adjoin-position new-row k rest-of-queens)
  (append rest-of-queens (list new-row) ))
 
(define (safe? k positions)
  (let ((new-q-row (list-ref positions (- k 1))))
    (safe-queen? new-q-row k positions 1)))
 
(define (safe-queen? new-q-row new-q-col positions col)
  (cond ((null? positions) #t)
        ((and (= new-q-col col)
              (= new-q-row (car positions))) #t) ;check for last col
        ((= new-q-row (car positions)) #f) ;rook moves
        ((= 
           (abs (- new-q-row (car positions))) ;bishop moves
           (abs (- new-q-col col))) #f)
        (else
          (safe-queen? new-q-row new-q-col (cdr positions) (+ col 1)))))

> (length (queens 8))
92
> (length (queens 11))
2680
> (length (queens 10))
724
> (queens 4)
((2 4 1 3) (3 1 4 2))

Filed under: SICP, lisp No Comments

26Aug/090

Exercise 2.41 of SICP

Exercise 2.41: 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.

(define (filter pred seq)
  (cond ((null? seq) '())
        ((pred (car seq)) 
         (cons (car seq) (filter pred (cdr seq))))
        (else
          (filter pred (cdr seq)))))
 
(define (range start end)
  (define (iter end seq)
    (if (> start end)
      seq
      (iter (- end 1) (cons end seq))))
  (iter end '()))
 
(define (accumulate fn init-value sequence)
  (if (null? sequence)
    init-value
    (fn (car sequence)
        (accumulate fn init-value (cdr sequence)))))
 
(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))
 
(define (unique-triples n)
  (flatmap 
    (lambda (i)
      (flatmap 
        (lambda (j)
          (map (lambda (k)
                 (list i j k))
               (range 1 (- j 1))))
        (range 1 (- i 1))))
    (range 1 n)))
 
(define (sum-triples n s)
  (define (sum-desired? triple)
    (= s (accumulate + 0 triple)))
  (define (make-sum-of-triple triple)
    (append triple (list (accumulate + 0 triple))))
  (map make-sum-of-triple
       (filter sum-desired?
               (unique-triples n))))

> (sum-triples 5 9)
((4 3 2 9) (5 3 1 9))
> (sum-triples 5 10)
((5 3 2 10) (5 4 1 10))
> (sum-triples 5 11)
((5 4 2 11))
> (sum-triples 5 12)
((5 4 3 12))
> (sum-triples 5 13)
()
> (sum-triples 6 13)
((6 4 3 13) (6 5 2 13))
> (sum-triples 6 10)
((5 3 2 10) (5 4 1 10) (6 3 1 10))
> (sum-triples 6 11)
((5 4 2 11) (6 3 2 11) (6 4 1 11))
> (sum-triples 6 12)
((5 4 3 12) (6 4 2 12) (6 5 1 12))
> (sum-triples 6 13)
((6 4 3 13) (6 5 2 13))

Filed under: SICP No Comments

25Aug/090

Exercise 2.40 of SICP

Exercise 2.40: Define a procedure unique-pairs that, given an integer n, generates the sequence of pairs $(i,j)$ with $1\le j< i\le n$ . Use unique-pairs to simplify the definition of prime-sum-pairs given above.

Using Miller-Rabin primality test as well as taking advantage of some lexical scoping here is the solution:

(define (prime? n times)
  (define (miller-rabin-test n)
    (define (random n) (random-integer n))
    (define (expmod base exp m)
      (define (square-mod x) (remainder (* x x) m))
      (define (square-signal-root x)
        (if (and 
              (not (or (= 1 x) (= x (- m 1))))
              (= 1 (square-mod x)))
          0
          (square-mod x)))
      (cond ((= exp 0) 1)
            ((even? exp)
             (square-signal-root (expmod base (/ exp 2) m)))
            (else
              (remainder (* base (expmod base (- exp 1) m))
                         m))))  
    (define (try-it a)
      (= (expmod a (- n 1) n) 1))
    (try-it (+ 1 (random (- n 1)))))
  (cond ((= times 0) #t)
        ((miller-rabin-test n) (fast-prime? n (- times 1)))
        (else #f)))
 
(define (filter pred seq)
  (cond ((null? seq) '())
        ((pred (car seq)) 
         (cons (car seq) (filter pred (cdr seq))))
        (else
          (filter pred (cdr seq)))))
 
(define (range start end)
  (define (iter end seq)
    (if (> start end)
      seq
      (iter (- end 1) (cons end seq))))
  (iter end '()))
 
(define (flatmap proc seq)
  (define (accumulate fn init-value sequence)
    (if (null? sequence)
      init-value
      (fn (car sequence)
          (accumulate fn init-value (cdr sequence)))))
  (accumulate append '() (map proc seq)))
 
(define (unique-pairs n)
  (flatmap 
    (lambda (i)
      (map (lambda (j) (list i j))
           (range 1 (- i 1))))
    (range 1 n)))
 
(define (prime-sum-pairs n)
  (define (make-pair-sum pair)
    (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
  (define (prime-sum? pair)
    (prime? (+ (car pair) (cadr pair)) 10))
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs n))))

> (prime-sum-pairs 1)
()
> (prime-sum-pairs 2)
((2 1 3))
> (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))

Filed under: SICP, lisp No Comments

24Aug/090

Exercise 2.39 of SICP

Exercise 2.39: 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))

(define (fold-right fn init-value items)
  (if (null? items)
    init-value
    (fn (car items)
        (fold-right fn init-value (cdr items)))))
 
(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))
 
(define (reverse-right sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))
 
(define (reverse-left sequence)
  (fold-left (lambda (x y) (cons y x)) '() sequence))

> (reverse-right (list 1 2 3))
(3 2 1)
> (reverse-left (list 1 2 3))
(3 2 1)

Filed under: SICP, lisp No Comments

23Aug/090

Exercise 2.38 of SICP

Exercise 2.38: 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))

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)
Give a property that op should satisfy to guarantee that fold-right and fold-left will produce the same values for any sequence.
(fold-right op i (list a₁ a₂ a₃))
$(a_1 \cdot (a_2 \cdot ( a_3 \cdot i)))$
(fold-left op i (list a₁ a₂ a₃))
$(((i \cdot a_1) \cdot a_2) \cdot a_3)$

Any binary associative operation will be invariant under fold-right and fold-left.

Since 2.37 involved matrix multiplication which is associative, I will use that as an example.
> (define i (list (list 1 0 0) (list 0 1 0) (list 0 0 1)))
> (define a1 (list (list 8 3 2) (list 1 0 9) (list 3 4 5)))
> (define a2 (list (list 5 6 7) (list 1 2 8) (list 6 7 7)))
> (define a3 (list (list 6 7 9) (list 4 3 1) (list 3 4 5)))
> (fold-left matrix-*-matrix i (list a1 a2 a3))
((884 965 1033) (840 900 950) (802 878 942))
> (fold-right matrix-*-matrix i (list a1 a2 a3))
((884 965 1033) (840 900 950) (802 878 942))

Notice that i is the identity matrix because if it wasn't, I would also be testing commutativity of matrix product. Matrix product doesn't commute. If i is changed to another matrix fold-left and fold-right will return differing results.

Filed under: SICP, lisp, math No Comments

22Aug/090

Exercise 2.37 of SICP

Exercise 2.37: Suppose we represent vectors $v=(v_i)$ as sequences of numbers, and matrices $m = (m_{ij})$ as sequences of vectors (the rows of the matrix). For example, the matrix

$M = \begin{bmatrix} 1&2&3&4\\ 4&5&6&6\\ 6&7&8&9 \end{bmatrix}$

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 $\sum_{i} v_iw_i$
(matrix-*-vector m v)	returns the vector t, where $t_i = \sum_{j} m_{ij}v_j$
(matrix-*-matrix m n)	returns the matrix p where, $p_{ij} = \sum_{k} m_{ik}n_{kj}$
(transpose m)	returns the matrix n where, $n_{ij} = m_{ji}$

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

Solutions:

(define (accumulate fn init-value items)
  (if (null? items)
    init-value
    (fn (car items)
        (accumulate fn init-value (cdr items)))))
 
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
    '()
      (cons (accumulate op init (map (lambda (e) (car e)) seqs))
            (accumulate-n op init (map (lambda (e) (cdr e)) seqs)))))

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

> (define n (list (list 1 2) (list 3 4)))
> (matrix-*-vector n (list 10 20))
(50 110)
> (transpose n)
((1 3) (2 4))
> (define m (list (list 1 2 3) (list 4 5 6) (list 7 8 9)))
> (matrix-*-matrix m m)
((30 36 42) (66 81 96) (102 126 150))
> (define q (list (list 9 1) (list 3 4) (list 6 7) (list 1 8)))
> (matrix-*-matrix (list (list 1 2 3 4) (list 5 6 7 8)) q)
((37 62) (113 142))

Filed under: SICP, lisp, math No Comments

21Aug/090

Exercise 2.36 of SICP

Exercise 2.36: 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 fn init-value items)
  (if (null? items)
    init-value
    (fn (car items)
        (accumulate fn init-value (cdr items)))))
 
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
    '()
      (cons (accumulate op init (map (lambda (e) (car e)) seqs))
            (accumulate-n op init (map (lambda (e) (cdr e)) seqs)))))

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

Filed under: SICP, lisp No Comments

20Aug/090

Exercise 2.35 of SICP

Exercise 2.35: Redefine count-leaves from section 2.2.2 as an accumulation:

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

(define (count-leaves x)
  (cond ((null? x) 0)  
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

The goal here is for map to create something that accumulate can consume to count the number of leaves. The initial value must be 0 just like in count-leaves. The hard part is to come up with fn that will add up the leaves. If the tree is flatted a simple length function will compute the number of trees.

(define (accumulate fn init-value items)
  (if (null? items)
    init-value
    (fn (car items)
        (accumulate fn init-value (cdr items)))))
 
(define (enumerate-tree x)
  (cond ((null? x) '())
        ((not (pair? x))
         (list x))
        (else
          (append (enumerate-tree (car x)) (enumerate-tree (cdr x))))))
 
(define (count-leaves t)
  (accumulate (lambda (x y) (+ 1 y)) 
              0
              (map (lambda (x) x) (enumerate-tree t))))

I am not sure why map is needed in this example. It just serves to confuse. The lambda argument is really a throw away.
I am aware that it is possible to solve this problem using map in a way that recursively calls count-leaves. I feel like instead of making the computational process clearer as in square-tree and even-fibs it becomes more convoluted and mysterious. Nevertheless I include it bellow for completeness.

(define (count-leaves t)
  (accumulate
    +
    0 
    (map (lambda (elem)
           (if (not (pair? elem))
             1
             (count-leaves elem))) t)))

The example I like is:

(define (deep-reverse seq)
  (map (lambda (e) 
         (if (not (pair? e))
           e
           (deep-reverse e)))
       (reverse seq)))

Filed under: SICP, lisp No Comments

19Aug/090

Exercise 2.34 of SICP

Exercise 2.34: Evaluating a polynomial in x at a given value of x can be formulated as an accumulation. We evaluate the polynomial
$p(x) = a_n x^n + a_{n-1}x^{n-1} + \cdots + a_1 x+ a_0$
using a well-known algorithm called Horner's rule, which structures the computation as
$(\cdots (a_n x + a_{n-1})x + \cdots + a_1)x + a_0$
In other words, we start with an, 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^3 + x^5$ at $x = 2$ you would evaluate

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

I included a non-abstracted version of Horner's method for clarity.

(define (accumulate fn init-value items)
  (if (null? items)
    init-value
    (fn (car items)
        (accumulate fn init-value (cdr items)))))
 
(define (he x coeff-seq)
  (if (null? coeff-seq)
    0
    (+ (car coeff-seq)
       (* x (he x (cdr coeff-seq))))))
 
(define (horner-eval x coeff-seq)
  (accumulate (lambda (this-coeff higher-terms)
                (+ this-coeff (* x higher-terms)))
              0
              coeff-seq))

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

Filed under: SICP, lisp, math No Comments

18Aug/090

Exercise 2.33 of SICP

Exercise 2.33: 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))

(define (accumulate fn init-value items)
  (if (null? items)
    init-value
    (fn (car items)
        (accumulate fn init-value (cdr items)))))
 
(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) '() sequence))
 
(define (append seq1 seq2)
  (accumulate cons seq2 seq1))
 
(define (length seq)
  (accumulate (lambda (x y) (+ 1 y)) 0 seq))

I find it interesting how length is created by discarding the x in lambda thus discarding (car items).

Filed under: SICP, lisp No Comments

Older Entries »

Dan's Thoughts Thinking somewhat carefully

Exercise 2.42 of SICP

Exercise 2.41 of SICP

Exercise 2.40 of SICP

Exercise 2.39 of SICP

Exercise 2.38 of SICP

Exercise 2.37 of SICP

Exercise 2.36 of SICP

Exercise 2.35 of SICP

Exercise 2.34 of SICP

Exercise 2.33 of SICP

Pages

Categories

Blogroll

Archive

Meta