### Initial commit from current SICP lecture exercises

master
commit
c01bb03e46
16 changed files with 557 additions and 0 deletions
1. 79
2.40.scm
2. 64
2.41.scm
3. 66
2.42.scm
4. 9
2.44.scm
5. 14
2.45.scm
6. 94
displaylib.scm
7. 18
ex2.32.scm
8. 26
ex2.33.scm
9. 24
ex2.34.scm
10. 21
ex2.35.scm
11. 23
ex2.36.scm
12. 43
ex2.37.scm
13. 26
ex2.38.scm
14. 10
ex2.39.scm
15. 2
run
16. 38
section2.scm

#### 79 2.40.scm View File

 `@ -0,0 +1,79 @@` `(newline)` `(display "Exercise 2.40")(newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` `; -- Start --` `(define (flatmap proc seq)` ` (accumulate append nil (map proc seq)))` `; --------` ``` ``` `(define (permutations s)` ` (if (null? s) ; empty set?` ` (list nil) ; sequence containing empty set` ` (flatmap (lambda (x)` ` (map (lambda (p) (cons x p))` ` (permutations (remove x s))))` ` s)))` `(define (remove item sequence) ` ` (filter (lambda (x) (not (= item x))) ` ` sequence))` ``` ``` `; (display "Permutations")(newline)` `; (display (permutations (list 1 2 3)))(newline)` ``` ``` `; Star exercise 2.40` `; 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` `(define (seq start stop)` ` (if (> start stop)` ` (list)` ` (cons start (seq (+ start 1) stop))))` ``` ``` `; (display "(seq 1 3)")(newline)` `; (display (seq 1 3))(newline)` ``` ``` `; unique-pairs n -> [ (i,j) | 1<=i

#### 64 2.41.scm View File

 `@ -0,0 +1,64 @@` `(newline)` `(display " ---------------")(newline)` `(display " Exercise 2.41")(newline)` `(display "-----------------------------------------------------------")(newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` `; -- Start --` `(define (flatmap proc seq)` ` (accumulate append nil (map proc seq)))` `; --------` ``` ``` `; Star exercise 2.41` `(display " Write a pro cedure to find all ordered triples")(newline)` `(display " of distinct positive integers i, j and k")(newline)` `(display " less than or equal to a given interger n")(newline)` `(display " that sum to a given integer s")(newline)` `(display "-----------------------------------------------------------")(newline)` `(newline)` `(define (seq start stop)` ` (if (> start stop)` ` (list)` ` (cons start (seq (+ start 1) stop))))` ``` ``` `; unique-pairs n -> [ (i,j) | 1<=i

#### 66 2.42.scm View File

 `@ -0,0 +1,66 @@` `(load "displaylib.scm")` `(title "Exercise 2.42")` `(doc "The eight-queens puzzle asks how to place eight queenson 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 kth 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 placinga queen in each row of the kth column. Now filter these, keeping only the positions for which the queen in the kth column is safe with respect to the other queens. This producesthe 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.\n\n 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 procedurequeen-cols that returns the sequence of all ways to place queens in the first k columns of the board.\n\n In this procedure rest-of-queens is a way to place k - 1 queens in thefirst k - 1 columns, and new-row is a proposed row in whichto place the queen for the kth column. Complete the programby implementing the representation for sets of board positions, including the procedure adjoin-position, which adjoinsa new row-column position to a set of positions, and empty-board, which represents an empty set of positions. You mustalso write the procedure safe?, which determines for a set of positions, whether the queen in the kth 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 (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))` ``` ``` `; Data structure definition` `; a partial board is a list of int` `; (3 5) represent two columns of the board (in the direction you want)` `; where a queen is on the row 3 and on the row 5.` `; etc...` `; a complete board is simple a partial board of good size.` ``` ``` `(define (empty-board) nil)` `(define (enumerate-interval start stop) (seq start stop))` `(define (adjoin-position new-row k rest-of-queens)` ` (cons new-row rest-of-queens))` ``` ``` `(define (one-equals position positions)` ` (accumulate ` ` (lambda (b c) (or b c)) ` ` #f` ` (map (lambda (x) (= x position)) positions)))` ``` ``` ``` ``` `(define (safe? k positions)` ` (let ((current-index (car positions)))` ` (not` ` (or ` ` ; no queen on same line` ` (one-equals current-index (cdr positions)) ` ` ; no queen on same positive diagonal` ` (one-equals current-index (positive-diags (cdr positions) 1)) ` ` ; no queen on same negative diagonal` ` (one-equals current-index (negative-diags (cdr positions) 1)))))) ` `; ` `(define (positive-diags l n)` ` (if (null? l)` ` nil` ` (cons (+ (car l) n) (positive-diags (cdr l) (+ n 1)))))` ``` ``` `(define (negative-diags l n)` ` (if (null? l)` ` nil` ` (cons (- (car l) n) (negative-diags (cdr l) (+ n 1)))))` ``` ``` `(display "(safe? 0 (list 1 4 7))")(newline)` `(display (safe? 0 (list 1 4 7)))(newline)` `(display "(safe? 0 (list 1 4 1))")(newline)` `(display (safe? 0 (list 1 4 1)))(newline)` `(display "(queens 4)")(newline)` `(display (queens 4))(newline)` `(display "(queens 8)")(newline)` `(display (queens 8))(newline)`

#### 9 2.44.scm View File

 `@ -0,0 +1,9 @@` `(load "displaylib.scm")` `(title "Exercise 2.44")` `(doc "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.")` ``` ``` `(define (up-split painter n)` ` (if (= n 0)` ` painter` ` (let ((smaller (up-split painter (- n 1))))` ` (below painter (beside smaller smaller)))))`

#### 14 2.45.scm View File

 `@ -0,0 +1,14 @@` `(load "displaylib.scm")` `(title "Exercise 2.45")` `(doc "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.")` ``` ``` `(define (up-split painter n)` ` (if (= n 0)` ` painter` ` (let ((smaller (up-split painter (- n 1))))` ` (below painter (beside smaller smaller)))))`

#### 94 displaylib.scm View File

 `@ -0,0 +1,94 @@` `; -- Defs --` `(define nil ())` ``` ``` `; -- accumulate (equivalent to foldr)` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` ``` ``` `; -- define flatmap` `(define (flatmap proc seq)` ` (accumulate append nil (map proc seq)))` ``` ``` `; === Display nicely long strings ===` ``` ``` `; search index to cut the line.` `(define (rec-last-newline s n)` ` (if (= n 0)` ` 0` ` (let ((current-car (substring s n (+ n 1))))` ` (if (string=? "\n" current-car)` ` n` ` (rec-last-newline s (- n 1))))))` ``` ``` `(define (last-newline s n)` ` (let ((index (rec-last-newline s n)))` ` (if (= index 0)` ` n` ` index)))` ` ` ``` ``` `(define (rec-last-special s n)` ` (if (= n 0)` ` 0` ` (let ((current-car (substring s n (+ n 1))))` ` (if (not ` ` (or ` ` (and ` ` (string>? current-car "A")` ` (string? current-car "a")` ` (string? current-car "0")` ` (string start stop)` ` (list)` ` (cons start (seq (+ start 1) stop))))` ``` ```

#### 18 ex2.32.scm View File

 `@ -0,0 +1,18 @@` `; Exercise 2.32` `(define nil ())` `(newline)` `(display "Exercise 2.32 (subsets)")` ``` ``` `(define (subsets s)` ` (if (null? s)` ` (list nil)` ` (let ((rest (subsets (cdr s)))` ` (x (car s)))` ` (append rest (map (lambda (r) (cons x r)) rest)))))` ``` ``` `(define l (list 1 2 3))` `(newline)` `(display "Subsets of ")` `(display l)` `(newline)` `(display (subsets l))`

#### 26 ex2.33.scm View File

 `@ -0,0 +1,26 @@` `; Exercise 2.33` ``` ``` `(newline) (display "Exercise 2.33") (newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` ``` ``` ``` ``` `(define (amap p sequence)` ` (accumulate (lambda (x y) (cons (p x) y)) nil sequence))` ``` ``` `(display (amap square (list 1 2 3 4))) (newline)` ``` ``` `(define (aappend seq1 seq2)` ` (accumulate cons seq2 seq1))` ``` ``` `(display (aappend (list 1 2 3) (list 4 5 6))) (newline)` ``` ``` `(define (alength sequence)` ` (accumulate (lambda (x y) (+ y 1)) 0 sequence))` ``` ``` `(display (alength (list 1 2 3) )) (newline)`

#### 24 ex2.34.scm View File

 `@ -0,0 +1,24 @@` `; Exercise 2.33` ``` ``` `(newline) (display "Exercise 2.34") (newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` `; -- Start --` `(define (horner-eval x coefficient-sequence)` ` (accumulate (lambda (this-coeff higher-terms) (+ (* higher-terms x) this-coeff))` ` 0` ` coefficient-sequence))` ``` ``` `(display (horner-eval 2 (list 1)))` `(newline)` `(display (horner-eval 2 (list 0 1)))` `(newline)` `(display (horner-eval 2 (list 1 1)))` `(newline)` `(display (horner-eval 2 (list 1 3 0 5 0 1)))` `(newline)`

#### 21 ex2.35.scm View File

 `@ -0,0 +1,21 @@` `; Exercise 2.33` ``` ``` `(newline) (display "Exercise 2.35") (newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` `; -- Start --` `(define (count-leaves t)` ` (accumulate + 0 (map ` ` (lambda (x) ` ` (if (not (pair? x)) ` ` 1 ` ` (count-leaves x))) t)))` ``` ``` `(define tree (list 1 (list 2 3) (list 4 (list 5))))` `(display tree)(newline)` `(display (count-leaves tree)) (newline)`

#### 23 ex2.36.scm View File

 `@ -0,0 +1,23 @@` `; Exercise 2.33` ``` ``` `(newline) (display "Exercise 2.36") (newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` `; -- Start --` `(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)))))` ``` ``` `(define s (list ` ` (list 1 2 3) ` ` (list 4 5 6) ` ` (list 7 8 9) ` ` (list 10 11 12)))` `(display (accumulate-n + 0 s))`

#### 43 ex2.37.scm View File

 `@ -0,0 +1,43 @@` `; Exercise 2.33` ``` ``` `(newline) (display "Exercise 2.37") (newline)` `; -- Defs --` `(define nil ())` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` ``` ``` `(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)))))` ``` ``` `; -- Start --` ``` ``` `(define V (list 3 2 1 0))` `(define W (list 1 1 1 1))` `(define M (list ` ` (list 0 1 2 3) ` ` (list 1 2 3 4) ` ` (list 2 3 4 5)))` ``` ``` `(define (dot-product v w)` ` (accumulate + 0 (map * v w)))` ``` ``` `(define (matrix-*-vector m v)` ` (map (lambda (x) (dot-product x v)) m))` ``` ``` `(define (transpose mat)` ` (accumulate-n (lambda (x acc) (cons x acc)) nil mat))` ``` ``` `(define (matrix-*-matrix m n)` ` (let ((cols (transpose n)))` ` (map (lambda (v) (matrix-*-vector cols v)) m)))` ``` ``` `(display (dot-product V W)) (newline)` `(display (matrix-*-vector M V)) (newline)` `(display (transpose M)) (newline)` `(display (matrix-*-matrix M (transpose M))) (newline)`

#### 26 ex2.38.scm View File

 `@ -0,0 +1,26 @@` `(newline) (display "Exercise 2.38") (newline)` `; -- Defs --` `(define nil ())` ``` ``` `(define (accumulate op initial sequence)` ` (if (null? sequence)` ` initial` ` (op (car sequence)` ` (accumulate op initial (cdr sequence)))))` ``` ``` `(define (fold-left op initial sequence)` ` (define (iter result rest)` ` (if (null? rest)` ` result` ` (iter (op result (car rest))` ` (cdr rest))))` ` (iter initial sequence))` `; -- Start --` `; For all initial & l =>` `; fold-right op initial l == fold-left op initial l` `; <=> (op commutative and associative)` `;` `; if initial is neutral element of op` `; (op x initial) == (op initial x) == x` `; Then, it is enough for op to be associative ` `; for fold-right & fold-left to return the same value.`

#### 10 ex2.39.scm View File

 `@ -0,0 +1,10 @@` `(newline) (display "Exercise 2.39") (newline)` `; -- Defs --` `(define nil ())` `; -- Start --` `(define (reverser sequence)` ` (fold-right (lambda (x y) (append y (list x))) nil sequence))` `(define (reversel sequence)` ` (fold-left (lambda (x y) (cons y x)) nil sequence))` `(newline) (display (reverser (list 2 3 9))) (newline)` `(newline) (display (reversel (list 2 3 9))) (newline)`

#### 2 run View File

 `@ -0,0 +1,2 @@` `#!/usr/bin/env zsh` `scheme --load \$1

#### 38 section2.scm View File

 `@ -0,0 +1,38 @@` `(define nil ())` `(define (square x) (* x x))` ``` ``` `; Exercise 2.31` ``` ``` `(define (tree-map f t)` ` (cond ((null? t) nil)` ` ((not (pair? t)) (f t))` ` (else (cons (tree-map f (car t))` ` (tree-map f (cdr t))))))` ``` ``` `(define x (list 1` ` (list 2 (list 3 4) 5)` ` (list 6 7)))` ``` ``` `(define (tree-square t)` ` (tree-map square t))` ``` ``` `; -- Print Results --` `(newline)` `(display "Exercise 2.31 (tree-map)")` `(newline)` `(display x)` `(newline)` `(display (tree-square x))` ``` ``` `; Exercise 2.32` `(newline)` `(display "Exercise 2.32 (subsets)")` ``` ``` `(define (subsets s)` ` (if (null? s)` ` (list nil)` ` (let ((rest (subsets (cdr s))))` ` (append rest (map (lambda (x) (list x (cons (car s) x)) rest))))))` ``` ``` `(subsets (list 1 2 3))` ``` ```