├── sec-1.2.6.scm ├── sec-2.4.scm ├── README.md ├── ex-1.2.md ├── ex-2.57.scm ├── ex-4.72.md ├── ex-3.61-test.scm ├── ex-3.55-test.scm ├── ex-3.70-test.scm ├── ex-3.60-test.scm ├── ex-3.49.md ├── ex-2.87.scm ├── sec-3.3-sample-lists.scm ├── ex-4.68.scm ├── ex-3.55.scm ├── sec-3.1.2.scm ├── sec-3.1.1.scm ├── sec-2.3.2-v2.scm ├── ex-2.80.scm ├── ex-2.75.scm ├── ex-2.79.scm ├── ex-4.58.scm ├── ex-2.62.scm ├── ex-3.51.scm ├── ex-3.59-test.scm ├── ex-4.73.md ├── ex-4.55.scm ├── ex-3.79.scm ├── ex-3.60.scm ├── ex-4.67.scm ├── ex-4.28.scm ├── ex-3.64-test.scm ├── ex-2.83.scm ├── ex-3.64.scm ├── ex-3.53.scm ├── ex-3.28.scm ├── ex-4.78.scm ├── ex-4.77.scm ├── ex-4.25.md ├── ex-4.61.scm ├── ex-1.8.scm ├── ex-3.13.md ├── ex-4.10.scm ├── ex-4.71.md ├── ex-3.1.scm ├── ex-4.35.scm ├── ex-4.69.scm ├── ex-2.61.scm ├── ex-1.3.scm ├── ex-3.61.scm ├── ex-4.62.scm ├── ex-3.29.scm ├── ex-4.46.md ├── ex-2.59.scm ├── ex-4.64.md ├── ex-3.54.scm ├── ex-4.70.md ├── ex-4.47.md ├── ex-3.18.scm ├── ex-3.46.md ├── ex-3.50.scm ├── ex-2.58-b.scm ├── sec-2.3.3-sets-as-binary-trees.scm ├── ex-3.15.md ├── ex-3.76.scm ├── ex-4.37.md ├── ex-3.39.md ├── ex-4.56.scm ├── ex-3.66-test.scm ├── ex-1.1.md ├── prime.scm ├── ex-4.74.scm ├── ex-2.67.scm ├── ex-3.67.scm ├── ex-3.31.md ├── ex-3.33.scm ├── ex-3.8.scm ├── ex-3.34.md ├── ex-2.88.scm ├── ex-3.68.md ├── ex-1.16.scm ├── sec-2.3.2-v1.scm ├── ex-3.58.scm ├── ex-3.19.scm ├── ex-3.3.scm ├── ex-4.57.scm ├── ex-4.24.scm ├── ex-2.66.scm ├── ex-2.56.scm ├── ex-3.69.scm ├── ex-4.26.scm ├── ex-1.6.md ├── ex-4.14.md ├── ex-2.58-a.scm ├── ex-4.60.scm ├── ex-4.6.scm ├── ex-4.50.scm ├── ex-2.72.scm ├── ex-3.44.md ├── ex-4.13.scm ├── ex-3.77.scm ├── ex-4.33.scm ├── ex-4.15.md ├── ex-2.78.scm ├── ex-4.44.scm ├── ex-4.1.scm ├── ex-4.18.md ├── ex-4.9.scm ├── ex-3.17.scm ├── ex-3.71.scm ├── ex-3.6.scm ├── ex-3.62.scm ├── ex-1.9.md ├── ex-4.5.scm ├── ex-1.7.md ├── ex-3.63.md ├── ex-4.3.scm ├── ex-3.72.scm ├── ex-4.7.scm ├── ex-4.66.md ├── ex-2.68.scm ├── ex-3.2.scm ├── ex-4.65.md ├── ex-2.65.scm ├── ex-3.57.md ├── ex-4.27.scm ├── ex-3.35.scm ├── ex-3.42.md ├── ex-2.89.scm ├── ex-3.82.scm ├── ex-3.4.scm ├── sec-2.3.4.scm ├── ex-3.37.scm ├── ex-4.41.scm ├── ex-4.2.scm ├── ex-4.38.scm ├── ex-1.10.md ├── ex-4.48.scm ├── ex-4.63.scm ├── ex-3.73.scm ├── ex-4.8.scm ├── ex-3.78.scm ├── ex-3.75.scm ├── ex-3.81.scm ├── ex-3.47.scm ├── ex-4.53.scm ├── ex-2.77.md ├── ex-4.23.md ├── sec-4.3.2.scm ├── ex-3.56.scm ├── ex-3.24.scm ├── ex-3.22.scm ├── ex-4.59.scm ├── sec-4.4.1-sample-db.scm ├── ex-2.71.scm ├── ex-4.36.scm ├── ex-4.45.scm ├── ex-2.76.md ├── ex-3.52.scm ├── ex-4.29.scm ├── ex-4.32.scm ├── ex-4.39.md ├── ex-3.66.md ├── ex-3.12.md └── ex-4.40.scm /sec-1.2.6.scm: -------------------------------------------------------------------------------- 1 | (use srfi-27) 2 | 3 | (random-source-randomize! default-random-source) 4 | 5 | (define (random range) 6 | (* (random-real) range)) 7 | -------------------------------------------------------------------------------- /sec-2.4.scm: -------------------------------------------------------------------------------- 1 | (define the-table (make-hash-table 'equal?)) 2 | 3 | (define (put op type item) 4 | (hash-table-put! the-table (cons op type) item)) 5 | 6 | (define (get op type) 7 | (hash-table-get the-table (cons op type) #f)) 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This repository contains my progress of reading 2 | [Structure and Interpretation of Computer Programs](http://mitpress.mit.edu/sicp/). 3 | I use [Gauche](http://practical-scheme.net/gauche/) to check validness of my code. 4 | 5 | -- 6 | [kana](https://github.com/kana) 7 | -------------------------------------------------------------------------------- /ex-1.2.md: -------------------------------------------------------------------------------- 1 | > Exercise 1.2. Translate the following expression into prefix form 2 | > 3 | > ``` 4 | > 5 + 4 + (2 - (3 - (6 + (4 / 5)))) 5 | > --------------------------------- 6 | > 3 (6 - 2) (2 - 7) 7 | > ``` 8 | 9 | ```scheme 10 | (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) 11 | (* 3 (- 6 2) (- 2 7))) 12 | ``` 13 | -------------------------------------------------------------------------------- /ex-2.57.scm: -------------------------------------------------------------------------------- 1 | (load "./ex-2.56.scm") 2 | 3 | (define (augend s) 4 | (let ((rest (cddr s))) 5 | (if (null? (cdr rest)) 6 | (car rest) 7 | (cons '+ rest)))) 8 | 9 | (define (multiplicand p) 10 | (let ((rest (cddr p))) 11 | (if (null? (cdr rest)) 12 | (car rest) 13 | (cons '* rest)))) 14 | -------------------------------------------------------------------------------- /ex-4.72.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.72. Why do `disjoin` and `stream-flatmap` interleave the streams 2 | > rather than simply append them? Give examples that illustrate why 3 | > interleaving works better. (Hint: Why did we use `interleave` in section 4 | > 3.5.3?) 5 | 6 | Because streams might be infinite. 7 | 8 | TODO: Write examples. 9 | -------------------------------------------------------------------------------- /ex-3.61-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.59.scm") 3 | (load "./ex-3.60.scm") 4 | (load "./ex-3.61.scm") 5 | 6 | (define s (mul-series exp-series (invert-unit-series exp-series))) 7 | 8 | (do ((i 0 (+ i 1))) 9 | ((= i 30)) 10 | (display (stream-ref s i)) 11 | (display ", ")) 12 | (display "...\n") 13 | 14 | -------------------------------------------------------------------------------- /ex-3.55-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.55.scm") 3 | 4 | (define sums (partial-sums integers)) 5 | (print (stream-ref sums 0)) 6 | (print (stream-ref sums 1)) 7 | (print (stream-ref sums 2)) 8 | (print (stream-ref sums 3)) 9 | (print (stream-ref sums 4)) 10 | (print (stream-ref sums 5)) 11 | (print (stream-ref sums 6)) 12 | -------------------------------------------------------------------------------- /ex-3.70-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.70.scm") 3 | 4 | (define sa (weighted-pairs integers integers (lambda (ij) (apply + ij)))) 5 | (print "sa ==>") 6 | (do ((i 0 (+ i 1))) 7 | ((= i 10)) 8 | (print (stream-ref sa i))) 9 | 10 | (print "sb ==>") 11 | (do ((i 0 (+ i 1))) 12 | ((= i 30)) 13 | (print (stream-ref sb i))) 14 | -------------------------------------------------------------------------------- /ex-3.60-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.59.scm") 3 | (load "./ex-3.60.scm") 4 | 5 | (define s 6 | (add-streams 7 | (mul-series sine-series sine-series) 8 | (mul-series cosine-series cosine-series))) 9 | 10 | (do ((i 0 (+ i 1))) 11 | ((= i 30)) 12 | (display (stream-ref s i)) 13 | (display ", ")) 14 | (display "...\n") 15 | -------------------------------------------------------------------------------- /ex-3.49.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.49. Give a scenario where the deadlock-avoidance mechanism 2 | > described above does not work. (Hint: In the exchange problem, each process 3 | > knows in advance which accounts it will need to get access to. Consider 4 | > a situation where a process must get access to some shared resources before 5 | > it can know which additional shared resources it will require.) 6 | 7 | TODO 8 | -------------------------------------------------------------------------------- /ex-2.87.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.87. Install =zero? for polynomials in the generic arithmetic 2 | ;;; package. This will allow adjoin-term to work for polynomials with 3 | ;;; coefficients that are themselves polynomials. 4 | 5 | ; Since our representation of term list is a list of nonzero terms. 6 | ; So that the zero polynomial is represented as the empty list. 7 | (put '=zero? 'polynomial 8 | empty-termlist?) 9 | -------------------------------------------------------------------------------- /sec-3.3-sample-lists.scm: -------------------------------------------------------------------------------- 1 | (define (make-cycle x) 2 | (set-cdr! (last-pair x) x) 3 | x) 4 | 5 | (define z3 (list 'a 'b 'c)) 6 | (define z4 7 | (let ([x (list 'a)]) 8 | (list x x))) 9 | (define z7 10 | (let* ([x (list 'a)] 11 | [y (cons x x)]) 12 | (cons y y))) 13 | (define z* (make-cycle (list 'a 'b 'c))) 14 | 15 | (define (zap x) 16 | (with-output-to-string (lambda () (write/ss x)))) 17 | -------------------------------------------------------------------------------- /ex-4.68.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.68. Define rules to implement the reverse operation of exercise 2 | ;;; 2.18, which returns a list containing the same elements as a given list in 3 | ;;; reverse order. (Hint: Use append-to-form.) Can your rules answer both 4 | ;;; (reverse (1 2 3) ?x) and (reverse ?x (1 2 3)) ? 5 | 6 | (rule (reverse (?x) (?x))) 7 | (rule (reverse (?x . (?y)) (?y . (?x)))) 8 | (rule (reverse (?x . ?y) (?a . ?b)) 9 | ; TODO 10 | ) 11 | -------------------------------------------------------------------------------- /ex-3.55.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.55. Define a procedure partial-sums that takes as argument 2 | ;;; a stream S and returns the stream whose elements are S0, S0 + S1, S0 + S1 3 | ;;; + S2, .... For example, (partial-sums integers) should be the stream 1, 3, 4 | ;;; 6, 10, 15, .... 5 | 6 | (define (partial-sums s) 7 | (if (stream-null? s) 8 | 0 9 | (cons-stream (stream-car s) 10 | (stream-map (lambda (x) (+ x (stream-car s))) 11 | (partial-sums (stream-cdr s)))))) 12 | -------------------------------------------------------------------------------- /sec-3.1.2.scm: -------------------------------------------------------------------------------- 1 | (define (estimate-pi trials) 2 | (sqrt (/ 6 (monte-carlo trials cesaro-test)))) 3 | (define (cesaro-test) 4 | (= (gcd (rand) (rand)) 1)) 5 | (define (monte-carlo trials experiment) 6 | (define (iter trials-remaining trials-passed) 7 | (cond ((= trials-remaining 0) 8 | (/ trials-passed trials)) 9 | ((experiment) 10 | (iter (- trials-remaining 1) (+ trials-passed 1))) 11 | (else 12 | (iter (- trials-remaining 1) trials-passed)))) 13 | (iter trials 0)) 14 | -------------------------------------------------------------------------------- /sec-3.1.1.scm: -------------------------------------------------------------------------------- 1 | (define (make-account balance) 2 | (define (withdraw amount) 3 | (if (>= balance amount) 4 | (begin (set! balance (- balance amount)) 5 | balance) 6 | "Insufficient funds")) 7 | (define (deposit amount) 8 | (set! balance (+ balance amount)) 9 | balance) 10 | (define (dispatch m) 11 | (cond ((eq? m 'withdraw) withdraw) 12 | ((eq? m 'deposit) deposit) 13 | (else (error "Unknown request -- MAKE-ACCOUNT" 14 | m)))) 15 | dispatch) 16 | -------------------------------------------------------------------------------- /sec-2.3.2-v2.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-2.3.2-v1.scm") 2 | 3 | (define (=number? exp num) 4 | (and (number? exp) 5 | (= exp num))) 6 | 7 | (define (make-sum a1 a2) 8 | (cond ((=number? a1 0) a2) 9 | ((=number? a2 0) a1) 10 | ((and (number? a1) (number? a2)) (+ a1 a2)) 11 | (else (list '+ a1 a2)))) 12 | 13 | (define (make-product m1 m2) 14 | (cond ((or (=number? m1 0) (=number? m2 0)) 0) 15 | ((=number? m1 1) m2) 16 | ((=number? m2 1) m1) 17 | ((and (number? m1) (number? m2)) (* m1 m2)) 18 | (else (list '* m1 m2)))) 19 | -------------------------------------------------------------------------------- /ex-2.80.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.80. Define a generic predicate =zero? that tests if its 2 | ;;; argument is zero, and install it in the generic arithmetic package. This 3 | ;;; operation should work for ordinary numbers, rational numbers, and complex 4 | ;;; numbers. 5 | 6 | (define (=zero? x) 7 | (apply-generic '=zero? x)) 8 | 9 | (put '=zero? '(scheme-number) 10 | (lambda (x) (= x 0))) 11 | (put '=zero? '(rational) 12 | (lambda (q) (= (numerator q) 0))) 13 | (put '=zero? '(complex) 14 | (lambda (z) 15 | (and (= (real-part z) 0) 16 | (= (imag-part z) 0)))) 17 | -------------------------------------------------------------------------------- /ex-2.75.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.75. 2 | ;;; 3 | ;;; Implement the constructor make-from-mag-ang in message-passing style. This 4 | ;;; procedure should be analogous to the make-from-real-imag procedure given 5 | ;;; above. 6 | 7 | (define (make-from-mag-ang r a) 8 | (define (dispatch op) 9 | (cond [(eq? op 'real-part) (* (magnitude z) (cos (angle z)))] 10 | [(eq? op 'imag-part) (* (magnitude z) (sin (angle z)))] 11 | [(eq? op 'magnitude) r] 12 | [(eq? op 'angle) a] 13 | [else 14 | (error "Unknown op -- MAKE-FROM-MAG-ANG" op)])) 15 | dispatch) 16 | -------------------------------------------------------------------------------- /ex-2.79.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.79. Define a generic equality predicate equ? that tests the 2 | ;;; equality of two numbers, and install it in the generic arithmetic package. 3 | ;;; This operation should work for ordinary numbers, rational numbers, and 4 | ;;; complex numbers. 5 | 6 | (define (equ? x y) 7 | (apply-generic 'equ? x y)) 8 | 9 | (put 'equ? '(scheme-number scheme-number) 10 | =) 11 | (put 'equ? '(rational rational) 12 | equal?) 13 | (put 'equ? '(complex complex) 14 | (lambda (z1 z2) 15 | (and (= (real-part z1) (real-part z2)) 16 | (= (imag-part z1) (imag-part z2))))) 17 | -------------------------------------------------------------------------------- /ex-4.58.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.58. Define a rule that says that a person is a ``big shot'' in 2 | ;;; a division if the person works in the division but does not have 3 | ;;; a supervisor who works in the division. 4 | 5 | (load "./sec-4.4.4.scm") 6 | (load "./sec-4.4.1-sample-db.scm") 7 | 8 | (query-driver-loop-for-script '( 9 | 10 | (assert! (rule (big-shot ?person) 11 | (and (job ?person (?division . ?person-job)) 12 | (supervisor ?person ?supervisor) 13 | (not (job ?supervisor (?division . ?supervisor-job)))))) 14 | 15 | (big-shot ?who) 16 | 17 | )) 18 | -------------------------------------------------------------------------------- /ex-2.62.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.62. 2 | ;;; 3 | ;;; Give a O(n) implementation of union-set for sets represented as ordered 4 | ;;; lists. 5 | 6 | (define (union-set set1 set2) 7 | (cond [(null? set1) set2] 8 | [(null? set2) set1] 9 | [else 10 | (let ([x1 (car set1)] 11 | [x2 (car set2)]) 12 | (cond ([= x1 x2] 13 | (cons x1 (union-set (cdr set1) (cdr set2)))) 14 | ([< x1 x2] 15 | (cons x1 (union-set (cdr set1) set2))) 16 | ([< x2 x1] 17 | (cons x2 (union-set set1 (cdr set2))))))])) 18 | -------------------------------------------------------------------------------- /ex-3.51.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | ;;; Exercise 3.51. In order to take a closer look at delayed evaluation, we 4 | ;;; will use the following procedure, which simply returns its argument after 5 | ;;; printing it: 6 | 7 | (define (show x) 8 | (display-line x) 9 | x) 10 | 11 | ;;; What does the interpreter print in response to evaluating each expression 12 | ;;; in the following sequence? [59] 13 | 14 | (define x (stream-map show (stream-enumerate-interval 0 10))) 15 | ;==> 0 16 | 17 | (stream-ref x 5) 18 | ;==> 1 19 | ; 2 20 | ; 3 21 | ; 4 22 | ; 5 23 | 24 | (stream-ref x 7) 25 | ;==> 5 26 | ; 6 27 | ; 7 28 | -------------------------------------------------------------------------------- /ex-3.59-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.59.scm") 3 | 4 | (print "(a)") 5 | (let ([s (stream-enumerate-interval 10 15)]) 6 | (display-stream (integrate-series s))) 7 | (newline) 8 | 9 | (newline) 10 | (print "(b)") 11 | (let go ([names '(exp-series cosine-series sine-series)]) 12 | (if (not (null? names)) 13 | (let* ([name (car names)] 14 | [s (eval name (current-module))]) 15 | (write name) 16 | (display " ==> ") 17 | (do ((i 0 (+ i 1))) 18 | ((= i 15)) 19 | (display (stream-ref s i)) 20 | (display ", ")) 21 | (display "...\n") 22 | (go (cdr names))))) 23 | -------------------------------------------------------------------------------- /ex-4.73.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.73. Why does `flatten-stream` use `delay` explicitly? What would 2 | > be wrong with defining it as follows: 3 | > 4 | > ```scheme 5 | > (define (flatten-stream stream) 6 | > (if (stream-null? stream) 7 | > the-empty-stream 8 | > (interleave 9 | > (stream-car stream) 10 | > (flatten-stream (stream-cdr stream))))) 11 | > ``` 12 | 13 | `flatten-stream` is an ordinary procedure, so that its argument is evaluated 14 | before evaluating the body of `flatten-stream`. The same can be said for 15 | `interleave`. Without explicit `delay`, `flatten-stream` runs forever if 16 | `stream` is an infinite stream. 17 | -------------------------------------------------------------------------------- /ex-4.55.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.55. Give simple queries that retrieve the following information 2 | ;;; from the data base: 3 | ;;; 4 | ;;; a. all people supervised by Ben Bitdiddle; 5 | ;;; 6 | ;;; b. the names and jobs of all people in the accounting division; 7 | ;;; 8 | ;;; c. the names and addresses of all people who live in Slumerville. 9 | 10 | (load "./sec-4.4.4.scm") 11 | (load "./sec-4.4.1-sample-db.scm") 12 | 13 | (query-driver-loop-for-script '( 14 | 15 | ; a 16 | (supervisor ?person (Bitdiddle Ben)) 17 | 18 | ; b 19 | (job ?name (accounting . ?type)) 20 | 21 | ; c 22 | (address ?name (Slumerville . ?detail)) 23 | 24 | )) 25 | -------------------------------------------------------------------------------- /ex-3.79.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.79. Generalize the solve-2nd procedure of exercise 3.78 so that 2 | ;;; it can be used to solve general second-order differential equations d2 3 | ;;; y/dt2 = f(dy/dt, y). 4 | 5 | (load "./sec-3.5.scm") 6 | (load "./ex-3.77.scm") 7 | 8 | (define (solve-2nd f dt y0 dy0) 9 | (define y (integral (delay dy) y0 dt)) 10 | (define dy (integral (delay ddy) dy0 dt)) 11 | (define ddy (f dy y)) 12 | y) 13 | 14 | (define (ex-3.78 a b dt y0 dy0) 15 | (solve-2nd (lambda (dy y) 16 | (add-streams (scale-stream dy a) 17 | (scale-stream y b))) 18 | dt 19 | y0 20 | dy0)) 21 | -------------------------------------------------------------------------------- /ex-3.60.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.60. With power series represented as streams of coefficients 2 | ;;; as in exercise 3.59, adding series is implemented by add-streams. Complete 3 | ;;; the definition of the following procedure for multiplying series: 4 | ;;; 5 | ;;; (define (mul-series s1 s2) 6 | ;;; (cons-stream (add-streams ))) 7 | ;;; 8 | ;;; You can test your procedure by verifying that sin^2 x + cos^2 x = 1, using 9 | ;;; the series from exercise 3.59. 10 | 11 | (define (mul-series s1 s2) 12 | (cons-stream 13 | (* (stream-car s1) (stream-car s2)) 14 | (add-streams 15 | (scale-stream (stream-cdr s2) (stream-car s1)) 16 | (mul-series (stream-cdr s1) s2)))) 17 | -------------------------------------------------------------------------------- /ex-4.67.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.67. Devise a way to install a loop detector in the query system 2 | ;;; so as to avoid the kinds of simple loops illustrated in the text and in 3 | ;;; exercise 4.64. The general idea is that the system should maintain some 4 | ;;; sort of history of its current chain of deductions and should not begin 5 | ;;; processing a query that it is already working on. Describe what kind of 6 | ;;; information (patterns and frames) is included in this history, and how the 7 | ;;; check should be made. (After you study the details of the query-system 8 | ;;; implementation in section 4.4.4, you may want to modify the system to 9 | ;;; include your loop detector.) 10 | 11 | ; TODO 12 | -------------------------------------------------------------------------------- /ex-4.28.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.28. Eval uses actual-value rather than eval to evaluate the 2 | ;;; operator before passing it to apply, in order to force the value of the 3 | ;;; operator. Give an example that demonstrates the need for this forcing. 4 | 5 | ; Suppose that RANDOM returns a random number between [0, 1). 6 | (define (choose-random . args) 7 | (let go ((args args) 8 | (i 1) 9 | (chosen #f)) 10 | (if (null? args) 11 | chosen 12 | (go 13 | (cdr args) 14 | (+ i 1) 15 | (if (= (* i (random)) 0) 16 | (car args) 17 | chosen))))) 18 | 19 | ; Without forcing, eval uses a thunk as a operator. 20 | ((choose-random + - * /) 123 456) 21 | -------------------------------------------------------------------------------- /ex-3.64-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.64.scm") 3 | 4 | (define (average x y) 5 | (/ (+ x y) 2)) 6 | 7 | (define (sqrt-improve guess x) 8 | (average guess (/ x guess))) 9 | 10 | (define (sqrt-stream x) 11 | (cons-stream 1.0 12 | (stream-map (lambda (guess) 13 | (sqrt-improve guess x)) 14 | (sqrt-stream x)))) 15 | 16 | (define (sqrt x tolerance) 17 | (stream-limit (sqrt-stream x) tolerance)) 18 | 19 | (define s (sqrt-stream 10)) 20 | (print "0.1 ==> " (sqrt 10 0.1)) 21 | (print "0.01 ==> " (sqrt 10 0.01)) 22 | (print "0.001 ==> " (sqrt 10 0.001)) 23 | (print "0.000001 ==> " (sqrt 10 0.000001)) 24 | -------------------------------------------------------------------------------- /ex-2.83.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.83. Suppose you are designing a generic arithmetic system for 2 | ;;; dealing with the tower of types shown in figure 2.25: integer, rational, 3 | ;;; real, complex. For each type (except complex), design a procedure that 4 | ;;; raises objects of that type one level in the tower. Show how to install 5 | ;;; a generic raise operation that will work for each type (except complex). 6 | 7 | (define (raise number) 8 | (apply-generic 'raise number)) 9 | 10 | (put 'raise '(integer) 11 | (lambda (n) (make-rational n 1))) 12 | 13 | (put 'raise '(rational) 14 | (lambda (q) (attach-tag 'real (/ (numer q) (denom q))))) 15 | 16 | (put 'raise '(real) 17 | (lambda (r) (make-complex-from-real-imag r 0))) 18 | -------------------------------------------------------------------------------- /ex-3.64.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.64. Write a procedure stream-limit that takes as arguments 2 | ;;; a stream and a number (the tolerance). It should examine the stream until 3 | ;;; it finds two successive elements that differ in absolute value by less than 4 | ;;; the tolerance, and return the second of the two elements. Using this, we 5 | ;;; could compute square roots up to a given tolerance by 6 | ;;; 7 | ;;; (define (sqrt x tolerance) 8 | ;;; (stream-limit (sqrt-stream x) tolerance)) 9 | 10 | (define (stream-limit s tolerance) 11 | (let* ([v1 (stream-car s)] 12 | [v2 (stream-car (stream-cdr s))]) 13 | (if (< (abs (- v1 v2)) tolerance) 14 | v2 15 | (stream-limit (stream-cdr s) tolerance)))) 16 | -------------------------------------------------------------------------------- /ex-3.53.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | ;;; Exercise 3.53. Without running the program, describe the elements of the 4 | ;;; stream defined by 5 | 6 | (define s (cons-stream 1 (add-streams s s))) 7 | 8 | ; Let's denote the n-th element of s as s(n). 9 | ; 10 | ; s(1) = 1, and 11 | ; s(n) = s(n - 1) + s(n - 1) by the definition. 12 | ; 13 | ; So, 14 | ; 15 | ; s(2) = s(1) + s(1) = 2 16 | ; s(3) = s(2) + s(2) = 4 17 | ; s(4) = s(3) + s(3) = 8 18 | ; s(5) = s(4) + s(4) = 16 19 | ; ... 20 | ; s(n) = s(n - 1) + s(n - 1) = 2^(n - 1) 21 | 22 | (define (stream-take s n) 23 | (if (= n 0) 24 | the-empty-stream 25 | (cons-stream (stream-car s) 26 | (stream-take (stream-cdr s) (- n 1))))) 27 | 28 | (display-stream (stream-take s 10)) 29 | -------------------------------------------------------------------------------- /ex-3.28.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.28. Define an or-gate as a primitive function box. Your or-gate 2 | ;;; constructor should be similar to and-gate. 3 | 4 | (define (or-gate o1 o2 output) 5 | (define (or-action-procedure) 6 | (let ([new-value (logical-or (get-signal o1) (get-signal o2))]) 7 | (after-delay or-gate-delay 8 | (lambda () 9 | (set-signal! output new-value))))) 10 | (add-action! o1 or-action-procedure) 11 | (add-action! o2 or-action-procedure) 12 | 'ok) 13 | 14 | (define (logical-or s1 s2) 15 | (cond [(and (= s1 0) (= s2 0)) 0] 16 | [(and (= s1 1) (= s2 0)) 1] 17 | [(and (= s1 0) (= s2 1)) 1] 18 | [(and (= s1 1) (= s2 1)) 1] 19 | [else (error "Invalid signals" s1 s2)])) 20 | -------------------------------------------------------------------------------- /ex-4.78.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.78. Redesign the query language as a nondeterministic program 2 | ;;; to be implemented using the evaluator of section 4.3, rather than as 3 | ;;; a stream process. In this approach, each query will produce a single answer 4 | ;;; (rather than the stream of all answers) and the user can type try-again to 5 | ;;; see more answers. You should find that much of the mechanism we built in 6 | ;;; this section is subsumed by nondeterministic search and backtracking. You 7 | ;;; will probably also find, however, that your new query language has subtle 8 | ;;; differences in behavior from the one implemented here. Can you find 9 | ;;; examples that illustrate this difference? 10 | 11 | ; TODO: Implement. 12 | 13 | ; TODO: Write examples on the difference. 14 | -------------------------------------------------------------------------------- /ex-4.77.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.77. In section 4.4.3 we saw that not and lisp-value can cause 2 | ;;; the query language to give ``wrong'' answers if these filtering operations 3 | ;;; are applied to frames in which variables are unbound. Devise a way to fix 4 | ;;; this shortcoming. One idea is to perform the filtering in a ``delayed'' 5 | ;;; manner by appending to the frame a ``promise'' to filter that is fulfilled 6 | ;;; only when enough variables have been bound to make the operation possible. 7 | ;;; We could wait to perform filtering until all other operations have been 8 | ;;; performed. However, for efficiency's sake, we would like to perform 9 | ;;; filtering as soon as possible so as to cut down on the number of 10 | ;;; intermediate frames generated. 11 | 12 | ; TODO: ??? 13 | -------------------------------------------------------------------------------- /ex-4.25.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.25. Suppose that (in ordinary applicative-order Scheme) we define 2 | > `unless` as shown above and then define `factorial` in terms of `unless` as 3 | > 4 | > ```scheme 5 | > (define (factorial n) 6 | > (unless (= n 1) 7 | > (* n (factorial (- n 1))) 8 | > 1)) 9 | > ``` 10 | 11 | 12 | > What happens if we attempt to evaluate `(factorial 5)`? 13 | 14 | It causes an infinite loop. All arguments to `unless` must be evaluated before 15 | applying `unless`. So that another `factorial` is applied. The same can be 16 | said for the newly applied `factorial`. 17 | 18 | 19 | > Will our definitions work in a normal-order language? 20 | 21 | Yes. `usual-value` to `unless` is evaluated if `condition` is evaluated to 22 | false. So that the recursion will be eventually terminated. 23 | -------------------------------------------------------------------------------- /ex-4.61.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-4.4.4.scm") 2 | (load "./sec-4.4.1-sample-db.scm") 3 | 4 | (query-driver-loop-for-script '( 5 | 6 | ;;; Exercise 5.61. The following rules implement a next-to relation that finds 7 | ;;; adjacent elements of a list: 8 | 9 | (assert! (rule (?x next-to ?y in (?x ?y . ?u)))) 10 | 11 | (assert! (rule (?x next-to ?y in (?v . ?z)) 12 | (?x next-to ?y in ?z))) 13 | 14 | ;;; What will the response be to the following queries? 15 | ;;; 16 | ;;; (?x next-to ?y in (1 (2 3) 4)) 17 | ;;; 18 | ;;; (?x next-to 1 in (2 1 3 1)) 19 | 20 | (?x next-to ?y in (1 (2 3) 4)) 21 | ; ==> (1 next-to (2 3) in (1 (2 3) 4)) 22 | ; ((2 3) next-to 4 in (1 (2 3) 4)) 23 | 24 | (?x next-to 1 in (2 1 3 1)) 25 | ; ==> (2 next-to 1 in (2 1 3 1)) 26 | ; (3 next-to 1 in (2 1 3 1)) 27 | 28 | )) 29 | -------------------------------------------------------------------------------- /ex-1.8.scm: -------------------------------------------------------------------------------- 1 | ; Exercise 1.8. Newton's method for cube roots is based on the fact that if 2 | ; y is an approximation to the cube root of x, then a better approximation is 3 | ; given by the value 4 | ; 5 | ; x / y^2 + 2y 6 | ; ------------ 7 | ; 3 8 | ; 9 | ; Use this formula to implement a cube-root procedure analogous to the 10 | ; square-root procedure. 11 | 12 | 13 | (define (cbrt x) 14 | (cbrt-iter 1.0 x)) 15 | 16 | (define (cbrt-iter guess x) 17 | (if (good-enough? guess x) 18 | guess 19 | (cbrt-iter (improve guess x) x))) 20 | 21 | (define (good-enough? guess x) 22 | (= guess (improve guess x))) ; TODO 23 | 24 | (define (square x) 25 | (* x x)) 26 | 27 | (define (cube x) 28 | (* x x x)) 29 | 30 | (define (improve guess x) 31 | (/ (+ (/ x (square guess)) (* 2 guess)) 3)) 32 | -------------------------------------------------------------------------------- /ex-3.13.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.13. Consider the following `make-cycle` procedure, which uses the 2 | > `last-pair` procedure defined in exercise 3.12: 3 | > 4 | > ```scheme 5 | > (define (make-cycle x) 6 | > (set-cdr! (last-pair x) x) 7 | > x) 8 | > ``` 9 | > 10 | > Draw a box-and-pointer diagram that shows the structure `z` created by 11 | > 12 | > ```scheme 13 | > (define z (make-cycle (list 'a 'b 'c))) 14 | > ``` 15 | > 16 | > What happens if we try to compute `(last-pair z)`? 17 | 18 | ``` 19 | .----------------------------. 20 | | | 21 | z--*->[o][o]---->[o][o]---->[o][o] 22 | | | | 23 | v v v 24 | [a] [b] [c] 25 | ``` 26 | 27 | `z` is a circular list. There is no cdr which points the empty list. 28 | So that computing `(last-pair z)` never ends. 29 | -------------------------------------------------------------------------------- /ex-4.10.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.10. By using data abstraction, we were able to write an eval 2 | ;;; procedure that is independent of the particular syntax of the language to 3 | ;;; be evaluated. To illustrate this, design and implement a new syntax for 4 | ;;; Scheme by modifying the procedures in this section, without changing eval 5 | ;;; or apply. 6 | 7 | ;; Let's introduce another syntax for assignment. 8 | ;; The original syntax is (set! ), 9 | ;; while the new syntax is ( := ). 10 | 11 | (define (assignment? exp) 12 | (cond ((tagged-list? exp 'set!) 'set!) 13 | ((and (pair? exp) (tagged-list? (cdr exp) ':=)) ':=) 14 | (else #f))) 15 | 16 | (define (assignment-variable exp) 17 | (if (eq? (assignment? exp) 'set!) 18 | (cadr exp) 19 | (car exp))) 20 | 21 | (define (assignment-value exp) 22 | (caddr exp)) 23 | -------------------------------------------------------------------------------- /ex-4.71.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.71. Louis Reasoner wonders why the `simple-query` and `disjoin` 2 | > procedures (section 4.4.4.2) are implemented using explicit `delay` 3 | > operations, rather than being defined as follows: 4 | > 5 | > ```scheme 6 | > (define (simple-query query-pattern frame-stream) 7 | > (stream-flatmap 8 | > (lambda (frame) 9 | > (stream-append (find-assertions query-pattern frame) 10 | > (apply-rules query-pattern frame))) 11 | > frame-stream)) 12 | > (define (disjoin disjuncts frame-stream) 13 | > (if (empty-disjunction? disjuncts) 14 | > the-empty-stream 15 | > (interleave 16 | > (qeval (first-disjunct disjuncts) frame-stream) 17 | > (disjoin (rest-disjuncts disjuncts) frame-stream)))) 18 | > ``` 19 | > 20 | > Can you give examples of queries where these simpler definitions would lead 21 | > to undesirable behavior? 22 | 23 | TODO 24 | -------------------------------------------------------------------------------- /ex-3.1.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.1. An accumulator is a procedure that is called repeatedly with 2 | ;;; a single numeric argument and accumulates its arguments into a sum. Each 3 | ;;; time it is called, it returns the currently accumulated sum. Write 4 | ;;; a procedure make-accumulator that generates accumulators, each maintaining 5 | ;;; an independent sum. The input to make-accumulator should specify the 6 | ;;; initial value of the sum; for example 7 | ;;; 8 | ;;; (define A (make-accumulator 5)) 9 | ;;; (A 10) 10 | ;;; 15 11 | ;;; (A 10) 12 | ;;; 25 13 | 14 | (define (make-accumulator sum) 15 | (lambda (n) 16 | (set! sum (+ sum n)) 17 | sum)) 18 | 19 | (define A1 (make-accumulator 10)) 20 | (define A2 (make-accumulator 3)) 21 | 22 | (print (A1 8)) 23 | ;=> 18 24 | 25 | (print (A2 8)) 26 | ;=> 11 27 | 28 | (print (A1 4)) 29 | ;=> 22 30 | 31 | (print (A2 4)) 32 | ;=> 15 33 | -------------------------------------------------------------------------------- /ex-4.35.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.35. Write a procedure an-integer-between that returns an 2 | ;;; integer between two given bounds. This can be used to implement a procedure 3 | ;;; that finds Pythagorean triples, i.e., triples of integers (i,j,k) between 4 | ;;; the given bounds such that i < j and i^2 + j^2 = k^2, as follows: 5 | ;;; 6 | ;;; (define (a-pythagorean-triple-between low high) 7 | ;;; (let ((i (an-integer-between low high))) 8 | ;;; (let ((j (an-integer-between i high))) 9 | ;;; (let ((k (an-integer-between j high))) 10 | ;;; (require (= (+ (* i i) (* j j)) (* k k))) 11 | ;;; (list i j k))))) 12 | 13 | (load "./sec-4.3.3.scm") 14 | 15 | (ambtest 16 | '(begin 17 | 18 | (define (an-integer-between i j) 19 | (require (<= i j)) 20 | (amb i (an-integer-between (+ i 1) j))) 21 | 22 | (let ((k (an-integer-between 13 19))) 23 | (print "k = " k)) 24 | 25 | )) 26 | -------------------------------------------------------------------------------- /ex-4.69.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.69. Beginning with the data base and the rules you formulated 2 | ;;; in exercise 4.63, devise a rule for adding ``greats'' to a grandson 3 | ;;; relationship. This should enable the system to deduce that Irad is the 4 | ;;; great-grandson of Adam, or that Jabal and Jubal are the 5 | ;;; great-great-great-great-great-grandsons of Adam. (Hint: Represent the fact 6 | ;;; about Irad, for example, as ((great grandson) Adam Irad). Write rules that 7 | ;;; determine if a list ends in the word grandson. Use this to express a rule 8 | ;;; that allows one to derive the relationship ((great . ?rel) ?x ?y), where 9 | ;;; ?rel is a list ending in grandson.) Check your rules on queries such as 10 | ;;; ((great grandson) ?g ?ggs) and (?relationship Adam Irad). 11 | 12 | (rule ((great . ?rel) ?x ?y) 13 | ; TODO: ... 14 | ) 15 | 16 | ((great grandson) ?g ?ggs) 17 | (?relationship Adam Irad) ; !!?!?!? 18 | -------------------------------------------------------------------------------- /ex-2.61.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.61. 2 | ;;; 3 | ;;; Give an implementation of adjoin-set using the ordered representation. 4 | 5 | (define (adjoin-set x set) 6 | (if (null? set) 7 | (list x) 8 | (let ([x1 (car set)]) 9 | (cond [(= x x1) set] 10 | [(< x x1) (cons x set)] 11 | [(< x1 x) (cons x1 (adjoin-set x (cdr set)))])))) 12 | 13 | 14 | ;;; By analogy with element-of-set? show how to take advantage of the ordering 15 | ;;; to produce a procedure that requires on the average about half as many 16 | ;;; steps as with the unordered representation. 17 | 18 | ; If the item we want to add is the P-th item of the resulting set, the number 19 | ; of steps required is P. Because we can reuse the items after the P-th item, 20 | ; but we have to cons each item before the P-th item and the P-th item itself 21 | ; to prepend them to the reused items. 22 | ; 23 | ; So that the average number of steps required will be about n/2. 24 | -------------------------------------------------------------------------------- /ex-1.3.scm: -------------------------------------------------------------------------------- 1 | ; Exercise 1.3. Define a procedure that takes three numbers as arguments and 2 | ; returns the sum of the squares of the two larger numbers. 3 | 4 | (define (square x) 5 | (* x x)) 6 | 7 | (define (sum-of-squares x y) 8 | (+ (square x) (square y))) 9 | 10 | (define (f a b c) 11 | (cond ((and (<= a b) (<= a c)) (sum-of-squares b c)) 12 | ((and (<= b a) (<= b c)) (sum-of-squares a c)) 13 | ((and (<= c a) (<= c b)) (sum-of-squares a b)))) 14 | 15 | (define (expect args expected) 16 | (define actual (apply f args)) 17 | (for-each display 18 | (list 19 | "Expect " `(f ,@args) " to be evaluated to " expected ".\n" 20 | "Actual value is ... " actual ".\n" 21 | (if (= actual expected) "Okay" "Failed") ".\n" 22 | "\n"))) 23 | 24 | (expect '(1 2 3) 13) 25 | (expect '(2 1 4) 20) 26 | (expect '(6 4 1) 52) 27 | (expect '(8 1 1) 65) 28 | (expect '(2 8 2) 68) 29 | (expect '(3 3 8) 73) 30 | (expect '(5 5 5) 50) 31 | -------------------------------------------------------------------------------- /ex-3.61.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.61. Let S be a power series (exercise 3.59) whose constant term 2 | ;;; is 1. Suppose we want to find the power series 1/S, that is, the series 3 | ;;; X such that S · X = 1. Write S = 1 + S_R where S_R is the part of S after 4 | ;;; the constant term. Then we can solve for X as follows: 5 | ;;; 6 | ;;; S・X = 1 7 | ;;; (1+S_R)・X = 1 8 | ;;; X + S_R・X = 1 9 | ;;; X = 1 - S_R・X 10 | ;;; 11 | ;;; In other words, X is the power series whose constant term is 1 and whose 12 | ;;; higher-order terms are given by the negative of S_R times X. Use this idea 13 | ;;; to write a procedure invert-unit-series that computes 1/S for a power 14 | ;;; series S with constant term 1. You will need to use mul-series from 15 | ;;; exercise 3.60. 16 | 17 | (define (invert-unit-series S) 18 | (define X (cons-stream 1 19 | (mul-series (scale-stream (stream-cdr S) -1) 20 | X))) 21 | X) 22 | -------------------------------------------------------------------------------- /ex-4.62.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.62. Define rules to implement the last-pair operation of 2 | ;;; exercise 2.17, which returns a list containing the last element of 3 | ;;; a nonempty list. Check your rules on queries such as (last-pair (3) ?x), 4 | ;;; (last-pair (1 2 3) ?x), and (last-pair (2 ?x) (3)). Do your rules work 5 | ;;; correctly on queries such as (last-pair ?x (3)) ? 6 | 7 | (load "./sec-4.4.4.scm") 8 | (load "./sec-4.4.1-sample-db.scm") 9 | 10 | (query-driver-loop-for-script '( 11 | 12 | (assert! (rule (last-pair ?x ?x) 13 | (same ?x (?e . ())))) 14 | (assert! (rule (last-pair (?z . ?y) ?x) 15 | (last-pair ?y ?x))) 16 | 17 | (last-pair (3) ?x) 18 | ; ==> (last-pair (3) (3)) 19 | 20 | (last-pair (1 2 3) ?x) 21 | ; ==> (last-pair (1 2 3) (3)) 22 | 23 | (last-pair (2 ?x) (3)) 24 | ; ==> (last-pair (2 3) (3)) 25 | 26 | ; (last-pair ?x (3)) 27 | ; ==> ...? There are infinite instances. 28 | 29 | )) 30 | -------------------------------------------------------------------------------- /ex-3.29.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.29. Another way to construct an or-gate is as a compound 2 | ;;; digital logic device, built from and-gates and inverters. Define 3 | ;;; a procedure or-gate that accomplishes this. 4 | 5 | ; A or B = not(not(A or B)) 6 | ; = not(not(A) and not(B)) 7 | ; 8 | ; ---------------------- 9 | ; | no1 ___ | 10 | ; o1 ----|>o---| \ a | 11 | ; | | |---|>o----- output 12 | ; o2 ----|>o---|__/ | 13 | ; | no2 | 14 | ; ---------------------- 15 | 16 | (define (or-gate o1 o2 output) 17 | (let ([no1 (make-wire)] 18 | [no2 (make-wire)] 19 | [a (make-wire)]) 20 | (inverter o1 no1) 21 | (inverter o2 no2) 22 | (and-gate no1 no2 a) 23 | (inverter a output) 24 | 'ok)) 25 | 26 | ;;; What is the delay time of the or-gate in terms of and-gate-delay and 27 | ;;; inverter-delay? 28 | 29 | ; It is equal to (+ inverter-delay and-gate-delay inverter-delay). 30 | -------------------------------------------------------------------------------- /ex-4.46.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.46. The evaluators in sections 4.1 and 4.2 do not determine what 2 | > order operands are evaluated in. We will see that the amb evaluator evaluates 3 | > them from left to right. Explain why our parsing program wouldn't work if the 4 | > operands were evaluated in some other order. 5 | 6 | The parsing program uses the global variable `*unparsed*` to pass rest of 7 | input. And words in `*unparsed*` must be read from left to right. Recall the 8 | code of `parse-sentence`: 9 | 10 | ```scheme 11 | (define (parse-sentence) 12 | (list 'sentence 13 | (parse-noun-phrase) 14 | (parse-verb-phrase))) 15 | ``` 16 | 17 | If the amb evaluator evaluates operands from right to left, 18 | `(parse-verb-phrase)` will be evaluated before `(parse-noun-phrase)`. 19 | So that the parsing program parses sentences in wrong order. 20 | 21 | For example, "the cat eats" is not parsed as a right sentence, while "eats the 22 | cat" is parsed as a right sentence. 23 | -------------------------------------------------------------------------------- /ex-2.59.scm: -------------------------------------------------------------------------------- 1 | ;;;; Exercise 2.59. Implement the union-set operation for the unordered-list 2 | ;;;; representation of sets. 3 | 4 | ;;; Copied from the text: 5 | 6 | (define (element-of-set? x set) 7 | (cond [(null? set) #f] 8 | [(equal? x (car set)) #t] 9 | [else (element-of-set? x (cdr set))])) 10 | 11 | (define (adjoin-set x set) 12 | (if (element-of-set? x set) 13 | set 14 | (cons x set))) 15 | 16 | (define (intersection-set set1 set2) 17 | (cond [(or (null? set1) (null? set2)) '()] 18 | [(element-of-set? (car set1) set2) 19 | (cons (car set1) 20 | (intersection-set (cdr set1) set2))] 21 | [else (intersection-set (cdr set1) set2)])) 22 | 23 | ;;; Answer: 24 | 25 | (define (union-set set1 set2) 26 | (cond [(null? set1) set2] 27 | [(null? set2) set1] 28 | [(element-of-set? (car set1) set2) (union-set (cdr set1) set2)] 29 | [else (cons (car set1) (union-set (cdr set1) set2))])) 30 | -------------------------------------------------------------------------------- /ex-4.64.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.64. Louis Reasoner mistakenly deletes the `outranked-by` rule 2 | > (section 4.4.1) from the data base. When he realizes this, he quickly 3 | > reinstalls it. Unfortunately, he makes a slight change in the rule, and types 4 | > it in as 5 | > 6 | > ```scheme 7 | > (rule (outranked-by ?staff-person ?boss) 8 | > (or (supervisor ?staff-person ?boss) 9 | > (and (outranked-by ?middle-manager ?boss) 10 | > (supervisor ?staff-person ?middle-manager)))) 11 | > ``` 12 | > 13 | > Just after Louis types this information into the system, DeWitt Aull comes by 14 | > to find out who outranks Ben Bitdiddle. He issues the query 15 | > 16 | > ```scheme 17 | > (outranked-by (Bitdiddle Ben) ?who) 18 | > ``` 19 | > 20 | > After answering, the system goes into an infinite loop. Explain why. 21 | 22 | `(outranked-by ?middle-manager ?boss)` is queried with a frame in which 23 | `?middle-manager` is not bound. So that `outranked-by` falls into an infinite 24 | loop. 25 | -------------------------------------------------------------------------------- /ex-3.54.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | ;;; Exercise 3.54. Define a procedure mul-streams, analogous to add-streams, 4 | ;;; that produces the elementwise product of its two input streams. Use this 5 | ;;; together with the stream of integers to complete the following definition 6 | ;;; of the stream whose nth element (counting from 0) is n + 1 factorial: 7 | ;;; 8 | ;;; (define factorials (cons-stream 1 (mul-streams ))) 9 | 10 | (define (mul-streams s1 s2) 11 | (if (or (stream-null? s1) (stream-null? s2)) 12 | the-empty-stream 13 | (cons-stream (* (stream-car s1) (stream-car s2)) 14 | (mul-streams (stream-cdr s1) (stream-cdr s2))))) 15 | 16 | (define factorials (cons-stream 1 (mul-streams factorials (stream-cdr integers)))) 17 | 18 | (print (stream-ref factorials 0)) 19 | (print (stream-ref factorials 1)) 20 | (print (stream-ref factorials 2)) 21 | (print (stream-ref factorials 3)) 22 | (print (stream-ref factorials 4)) 23 | (print (stream-ref factorials 5)) 24 | -------------------------------------------------------------------------------- /ex-4.70.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.70. What is the purpose of the `let` bindings in the procedures 2 | > `add-assertion!` and `add-rule!`? What would be wrong with the following 3 | > implementation of `add-assertion!`? Hint: Recall the definition of the 4 | > infinite stream of ones in section 3.5.2: `(define ones (cons-stream 5 | > 1 ones))`. 6 | > 7 | > ```scheme 8 | > (define (add-assertion! assertion) 9 | > (store-assertion-in-index assertion) 10 | > (set! THE-ASSERTIONS 11 | > (cons-stream assertion THE-ASSERTIONS)) 12 | > 'ok) 13 | > ``` 14 | 15 | The purpose of the `let` bindings is to refer assertions and rules before 16 | additions. If the `let` bindings are omitted, there is no way to refer 17 | assertions and rules before additions. 18 | 19 | And the second argument given to `cons-stream` is lazily evaluated. After 20 | evaluating `(set! THE-ASSERTIONS (cons-stream assertion THE-ASSERTIONS))`, 21 | `THE-ASSERTIONS` is bound to a stream which consists of `assertion` and the 22 | stream itself. 23 | -------------------------------------------------------------------------------- /ex-4.47.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.47. Louis Reasoner suggests that, since a verb phrase is either 2 | > a verb or a verb phrase followed by a prepositional phrase, it would be much 3 | > more straightforward to define the procedure parse-verb-phrase as follows 4 | > (and similarly for noun phrases): 5 | > 6 | > ```scheme 7 | > (define (parse-verb-phrase) 8 | > (amb (parse-word verbs) 9 | > (list 'verb-phrase 10 | > (parse-verb-phrase) 11 | > (parse-prepositional-phrase)))) 12 | > ``` 13 | > 14 | > Does this work? Does the program's behavior change if we interchange the 15 | > order of expressions in the amb? 16 | 17 | It does not work. Using `parse-verb-phrase` in itself causes an infinite loop 18 | after enumerating some valid parsing results. 19 | 20 | Things get worse if the order of expressions in the amb is changed. The amb 21 | evaluator evaluates operands from left to right. So that `parse-verb-phrase` 22 | falls into an infinite loop before enumerating any valid parsing result. 23 | -------------------------------------------------------------------------------- /ex-3.18.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.18. Write a procedure that examines a list and determines 2 | ;;; whether it contains a cycle, that is, whether a program that tried to find 3 | ;;; the end of the list by taking successive cdrs would go into an infinite 4 | ;;; loop. Exercise 3.13 constructed such lists. 5 | 6 | ; With set!. 7 | (define (circular? x) 8 | (define visited '()) 9 | (define (go x) 10 | (if (pair? x) 11 | (if (memq x visited) 12 | #t 13 | (begin 14 | (set! visited (cons x visited)) 15 | (go (cdr x)))) 16 | #f)) 17 | (go x)) 18 | 19 | ; Without set!. 20 | (define (circular? x) 21 | (let go ([x x] 22 | [visited '()]) 23 | (if (pair? x) 24 | (if (memq x visited) 25 | #t 26 | (go (cdr x) (cons x visited))) 27 | #f))) 28 | 29 | 30 | 31 | 32 | (load "./sec-3.3-sample-lists.scm") 33 | 34 | (define (check x) 35 | (print (zap x) " ==> " (circular? x))) 36 | (check z3) 37 | (check z4) 38 | (check z7) 39 | (check z*) 40 | -------------------------------------------------------------------------------- /ex-3.46.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.46. Suppose that we implement `test-and-set!` using an ordinary 2 | > procedure as shown in the text, without attempting to make the operation 3 | > atomic. Draw a timing diagram like the one in figure 3.29 to demonstrate how 4 | > the mutex implementation can fail by allowing two processes to acquire the 5 | > mutex at the same time. 6 | 7 | ``` 8 | | Process 1 cell Process 2 9 | | (#f) 10 | | _____________||_____________ 11 | | | | 12 | | [acccess cell] | 13 | | | [acccess cell] 14 | | | | 15 | | | [modify cell] 16 | | [modify cell] _____________| 17 | | | | 18 | | | v [return false] 19 | | | (#t) 20 | | |_____________ 21 | | | 22 | | [return false] v 23 | | (#t) 24 | v 25 | time 26 | ``` 27 | -------------------------------------------------------------------------------- /ex-3.50.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.50. Complete the following definition, which generalizes 2 | ;;; stream-map to allow procedures that take multiple arguments, analogous to 3 | ;;; map in section 2.2.3, footnote 12. 4 | ;;; 5 | ;;; (define (stream-map proc . argstreams) 6 | ;;; (if ( (car argstreams)) 7 | ;;; the-empty-stream 8 | ;;; ( 9 | ;;; (apply proc (map argstreams)) 10 | ;;; (apply stream-map 11 | ;;; (cons proc (map argstreams)))))) 12 | 13 | (load "./sec-3.5.scm") 14 | 15 | (define (stream-map proc . argstreams) 16 | (if (any stream-null? argstreams) 17 | the-empty-stream 18 | (cons-stream 19 | (apply proc (map stream-car argstreams)) 20 | (apply stream-map 21 | (cons proc (map stream-cdr argstreams)))))) 22 | 23 | (define s 24 | (stream-map 25 | (lambda (x y) (+ (* x 2) (* y 3))) 26 | (stream-enumerate-interval 5 8) 27 | (stream-enumerate-interval 10 20) 28 | )) 29 | (print s) 30 | (display-stream s) 31 | -------------------------------------------------------------------------------- /ex-2.58-b.scm: -------------------------------------------------------------------------------- 1 | (load "./ex-2.58-a.scm") 2 | (use srfi-1) 3 | 4 | ; (define (left-exp app op) 5 | ; (define (go acc rest) 6 | ; (if (or (null? rest) (eq? op (car rest))) 7 | ; (reverse acc) 8 | ; (go (cons (car rest) acc) 9 | ; (cdr rest)))) 10 | ; (if (eq? op (cadr app)) 11 | ; (car app) 12 | ; (go '() app))) 13 | 14 | (define (left-exp app op) 15 | (if (eq? op (cadr app)) 16 | (car app) 17 | (take-while (lambda (x) (not (eq? op x))) app))) 18 | 19 | (define (right-exp app op) 20 | (let ((e (cdr (memq op app)))) 21 | (if (null? (cdr e)) 22 | (car e) 23 | e))) 24 | 25 | (define (sum? x) 26 | (and (pair? x) 27 | (memq '+ x))) 28 | 29 | (define (addend s) 30 | (left-exp s '+)) 31 | 32 | (define (augend s) 33 | (right-exp s '+)) 34 | 35 | ; Assumption: x is not a sum. 36 | (define (product? x) 37 | (and (pair? x) 38 | (memq '* x))) 39 | 40 | (define (multiplier p) 41 | (left-exp p '*)) 42 | 43 | (define (multiplicand p) 44 | (right-exp p '*)) 45 | -------------------------------------------------------------------------------- /sec-2.3.3-sets-as-binary-trees.scm: -------------------------------------------------------------------------------- 1 | (define (entry tree) 2 | (car tree)) 3 | (define (left-branch tree) 4 | (cadr tree)) 5 | (define (right-branch tree) 6 | (caddr tree)) 7 | (define (make-tree entry left right) 8 | (list entry left right)) 9 | 10 | (define (element-of-set? x set) 11 | (cond [(null? set) 12 | #f] 13 | [(= x (entry set)) 14 | #t] 15 | [(< x (entry set)) 16 | (element-of-set? x (left-branch set))] 17 | [(> x (entry set)) 18 | (element-of-set? x (right-branch set))])) 19 | 20 | (define (adjoin-set x set) 21 | (cond [(null? set) 22 | (make-tree x '() '())] 23 | [(= x (entry set)) 24 | set] 25 | [(< x (entry set)) 26 | (make-tree (entry set) 27 | (adjoin-set x (left-branch set)) 28 | (right-branch set))] 29 | [(> x (entry set)) 30 | (make-tree (entry set) 31 | (left-branch set) 32 | (adjoin-set x (right-branch set)))])) 33 | -------------------------------------------------------------------------------- /ex-3.15.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.15. Draw box-and-pointer diagrams to explain the effect of 2 | > `set-to-wow!` on the structures `z1` and `z2` above. 3 | 4 | > ```scheme 5 | > (define (set-to-wow! x) 6 | > (set-car! (car x) 'wow) 7 | > x) 8 | > 9 | > (define x (list 'a 'b)) 10 | > (define z1 (cons x x)) 11 | > 12 | > (define z2 (cons (list 'a 'b) (list 'a 'b))) 13 | > ``` 14 | 15 | The environment after evaluating `(set-to-wow! z1)` is as follows: 16 | 17 | ``` 18 | z1-->[o][o]-->[o][/] 19 | | | 20 | | ,-----' 21 | | | 22 | v v 23 | x-->[o][o]-->[o][/] 24 | | | 25 | v v 26 | [wow] [b] 27 | ``` 28 | 29 | The environment after evaluating `(set-to-wow! z2)` is as follows: 30 | 31 | ``` 32 | z2-->[o][o]-->[o][o]-->[o][/] 33 | | | | 34 | | v v 35 | | [a] [b] 36 | | ^ 37 | | | 38 | `------>[o][o]-->[o][/] 39 | | 40 | v 41 | [wow] 42 | ``` 43 | -------------------------------------------------------------------------------- /ex-3.76.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.76. Eva Lu Ator has a criticism of Louis's approach in exercise 2 | ;;; 3.75. The program he wrote is not modular, because it intermixes the 3 | ;;; operation of smoothing with the zero-crossing extraction. For example, the 4 | ;;; extractor should not have to be changed if Alyssa finds a better way to 5 | ;;; condition her input signal. Help Louis by writing a procedure smooth that 6 | ;;; takes a stream as input and produces a stream in which each element is the 7 | ;;; average of two successive input stream elements. Then use smooth as 8 | ;;; a component to implement the zero-crossing detector in a more modular 9 | ;;; style. 10 | 11 | (define (smooth input-stream) 12 | (stream-map 13 | (lambda (new old) 14 | (/ (+ new old) 2)) 15 | input-stream 16 | (cons-stream 0 input-stream))) 17 | 18 | (define (make-zero-crossings input-stream) 19 | (let ([smoothed-stream (smooth input-stream)]) 20 | (stream-map 21 | sign-change-detector 22 | smoothed-stream 23 | (cons 0 smoothed-stream)))) 24 | -------------------------------------------------------------------------------- /ex-4.37.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.37. Ben Bitdiddle claims that the following method for 2 | > generating Pythagorean triples is more efficient than the one in exercise 3 | > 4.35. Is he correct? (Hint: Consider the number of possibilities that must 4 | > be explored.) 5 | > 6 | > ```scheme 7 | > (define (a-pythagorean-triple-between low high) 8 | > (let ((i (an-integer-between low high)) 9 | > (hsq (* high high))) 10 | > (let ((j (an-integer-between i high))) 11 | > (let ((ksq (+ (* i i) (* j j)))) 12 | > (require (>= hsq ksq)) 13 | > (let ((k (sqrt ksq))) 14 | > (require (integer? k)) 15 | > (list i j k)))))) 16 | > ``` 17 | 18 | Ben is correct. The original version enumerates many integers also for k, even 19 | if there is no more triples that satisfies i^2 + j^2 = k^2 where values of 20 | i and j are already defined. 21 | 22 | While Ben's version does not enumerate values for k. So that the number of 23 | possibilities to be explored by Ben' version is smaller than the one by the 24 | original version. 25 | -------------------------------------------------------------------------------- /ex-3.39.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.39. Which of the five possibilities in the parallel execution 2 | > shown above remain if we instead serialize execution as follows: 3 | > 4 | > ```scheme 5 | > (define x 10) 6 | > 7 | > (define s (make-serializer)) 8 | > 9 | > (parallel-execute (lambda () (set! x ((s (lambda () (* x x)))))) 10 | > (s (lambda () (set! x (+ x 1))))) 11 | > ``` 12 | 13 | To simplify description, let's call interleavable pieces of code as follows: 14 | 15 | * A1: `(* x x)` 16 | * A2: `(set! x )` 17 | * B1: `(+ x 1)`) 18 | * B2: `(set! x )` 19 | 20 | Note that: 21 | 22 | * A1, B1 and B2 are not interleaved. 23 | * But A2 might be interleaved into B1 and B2. 24 | 25 | Possible orderings are: 26 | 27 | * A1 (10 * 10) -> A2 (x = 100) -> B1 (100 + 1) -> B2 (x = 101) 28 | * A1 (10 * 10) -> B1 (10 + 1) -> A2 (x = 100) -> B2 (x = 11) 29 | * A1 (10 * 10) -> B1 (10 + 1) -> B2 (x = 11) -> A2 (x = 100) 30 | * B1 (10 + 1) -> B2 (x = 11) -> A1 (11 * 11) -> A2 (x = 121) 31 | 32 | So that 11, 100, 101 and 121 remain. 33 | -------------------------------------------------------------------------------- /ex-4.56.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.56. Formulate compound queries that retrieve the following 2 | ;;; information: 3 | ;;; 4 | ;;; a. the names of all people who are supervised by Ben Bitdiddle, together 5 | ;;; with their addresses; 6 | ;;; 7 | ;;; b. all people whose salary is less than Ben Bitdiddle's, together with 8 | ;;; their salary and Ben Bitdiddle's salary; 9 | ;;; 10 | ;;; c. all people who are supervised by someone who is not in the computer 11 | ;;; division, together with the supervisor's name and job. 12 | 13 | (load "./sec-4.4.4.scm") 14 | (load "./sec-4.4.1-sample-db.scm") 15 | 16 | (query-driver-loop-for-script '( 17 | 18 | ; a 19 | (and (supervisor ?person (Bitdiddle Ben)) 20 | (address ?person ?address)) 21 | 22 | ; b 23 | (and (salary (Bitdiddle Ben) ?ben-salary) 24 | (salary ?who ?who-salary) 25 | (lisp-value < ?who-salary ?ben-salary)) 26 | 27 | ; c 28 | (and (supervisor ?employee ?supervisor) 29 | (not (job ?supervisor (computer . ?job-detail))) 30 | (job ?supervisor ?supervisor-job)) 31 | 32 | )) 33 | -------------------------------------------------------------------------------- /ex-3.66-test.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | (define (pairs s t) 4 | (cons-stream 5 | (list (stream-car s) (stream-car t)) 6 | (interleave 7 | (stream-map (lambda (x) (list (stream-car s) x)) 8 | (stream-cdr t)) 9 | (pairs (stream-cdr s) (stream-cdr t))))) 10 | 11 | (define (interleave s1 s2) 12 | (if (stream-null? s1) 13 | s2 14 | (cons-stream (stream-car s1) 15 | (interleave s2 (stream-cdr s1))))) 16 | 17 | (define (f i j) 18 | (cond ((= i j) 19 | (- (expt 2 i) 1)) 20 | ((= (+ i 1) j) 21 | (+ (f i i) (expt 2 (- i 1)))) 22 | ((<= (+ i 2) j) 23 | (+ (f i (+ i 1)) (* (- j (+ i 1)) (expt 2 i)))) 24 | (else 25 | (error "Invalid combination:" i j)))) 26 | 27 | (define (main args) 28 | (print (f 6 6)) 29 | (print (f 6 10)) 30 | (print (stream-ref (pairs integers integers) (- (f 6 6) 1))) 31 | (print (stream-ref (pairs integers integers) (- (f 6 10) 1))) 32 | (print (f 1 100)) 33 | (print (f 99 100)) 34 | (print (f 100 100)) 35 | ) 36 | -------------------------------------------------------------------------------- /ex-1.1.md: -------------------------------------------------------------------------------- 1 | > Exercise 1.1. Below is a sequence of expressions. What is the result printed 2 | > by the interpreter in response to each expression? Assume that the sequence 3 | > is to be evaluated in the order in which it is presented. 4 | 5 | > 10 6 | 7 | 10 8 | 9 | > (+ 5 3 4) 10 | 11 | 12 12 | 13 | > (- 9 1) 14 | 15 | 8 16 | 17 | > (/ 6 2) 18 | 19 | 3 20 | 21 | > (+ (* 2 4) (- 4 6)) 22 | 23 | 6 24 | 25 | > (define a 3) 26 | 27 | a 28 | 29 | (in Gauche) 30 | 31 | > (define b (+ a 1)) 32 | 33 | b 34 | 35 | (in Gauche) 36 | 37 | > (+ a b (* a b)) 38 | 39 | 19 40 | 41 | > (= a b) 42 | 43 | #f 44 | 45 | > (if (and (> b a) (< b (* a b))) 46 | > b 47 | > a) 48 | 49 | 4 50 | 51 | > (cond ((= a 4) 6) 52 | > ((= b 4) (+ 6 7 a)) 53 | > (else 25)) 54 | 55 | 16 56 | 57 | > (+ 2 (if (> b a) b a)) 58 | 59 | 6 60 | 61 | > (* (cond ((> a b) a) 62 | > ((< a b) b) 63 | > (else -1)) 64 | > (+ a 1)) 65 | 66 | 16 67 | -------------------------------------------------------------------------------- /prime.scm: -------------------------------------------------------------------------------- 1 | (define (square n) 2 | (* n n)) 3 | 4 | (define (gcd a b) 5 | (if (= b 0) 6 | a 7 | (gcd b (remainder a b)))) 8 | 9 | (define (smallest-divisor n) 10 | (find-divisor n 2)) 11 | (define (find-divisor n test-divisor) 12 | (cond ((> (square test-divisor) n) n) 13 | ((divides? test-divisor n) test-divisor) 14 | (else (find-divisor n (+ test-divisor 1))))) 15 | (define (divides? a b) 16 | (= (remainder b a) 0)) 17 | 18 | (define (prime? n) 19 | (= n (smallest-divisor n))) 20 | 21 | (define (expmod base exp m) 22 | (cond ((= exp 0) 1) 23 | ((even? exp) 24 | (remainder (square (expmod base (/ exp 2) m)) 25 | m)) 26 | (else 27 | (remainder (* base (expmod base (- exp 1) m)) 28 | m)))) 29 | 30 | (define (fermat-test n) 31 | (define (try-it a) 32 | (= (expmod a n n) a)) 33 | (try-it (+ 1 (random (- n 1))))) 34 | 35 | (define (fast-prime? n times) 36 | (cond ((= times 0) true) 37 | ((fermat-test n) (fast-prime? n (- times 1))) 38 | (else false))) 39 | -------------------------------------------------------------------------------- /ex-4.74.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.74. Alyssa P. Hacker proposes to use a simpler version of 2 | ;;; stream-flatmap in negate, lisp-value, and find-assertions. She observes 3 | ;;; that the procedure that is mapped over the frame stream in these cases 4 | ;;; always produces either the empty stream or a singleton stream, so no 5 | ;;; interleaving is needed when combining these streams. 6 | ;;; 7 | ;;; a. Fill in the missing expressions in Alyssa's program. 8 | ;;; 9 | ;;; (define (simple-stream-flatmap proc s) 10 | ;;; (simple-flatten (stream-map proc s))) 11 | ;;; 12 | ;;; (define (simple-flatten stream) 13 | ;;; (stream-map 14 | ;;; (stream-filter stream))) 15 | 16 | (define (simple-stream-flatmap proc s) 17 | (simple-flatten (stream-map proc s))) 18 | 19 | (define (simple-flatten stream) 20 | (stream-map stream-car 21 | (stream-filter (lambda (s) (not (stream-null? s))) stream))) 22 | 23 | 24 | ;;; b. Does the query system's behavior change if we change it in this way? 25 | 26 | ; I think there is no change. 27 | ; 28 | ; TODO: Write why. 29 | -------------------------------------------------------------------------------- /ex-2.67.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-2.3.4.scm") 2 | 3 | ;;; Exercise 2.67. 4 | ;;; 5 | ;;; Define an encoding tree and a sample message: 6 | 7 | (define sample-tree 8 | (make-code-tree (make-leaf 'A 4) 9 | (make-code-tree 10 | (make-leaf 'B 2) 11 | (make-code-tree (make-leaf 'D 1) 12 | (make-leaf 'C 1))))) 13 | 14 | (define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0)) 15 | 16 | ;;; Use the decode procedure to decode the message, and give the result. 17 | 18 | (print sample-tree) 19 | ; ==> ((leaf A 4) 20 | ; ((leaf B 2) 21 | ; ((leaf D 1) 22 | ; (leaf C 1) 23 | ; (D C) 24 | ; 2) 25 | ; (B D C) 26 | ; 4) 27 | ; (A B D C) 28 | ; 8) 29 | ; 30 | ; (A B D C)-8 31 | ; / \ 32 | ; A-4 (B D C)-4 33 | ; / \ 34 | ; B-2 (D C)-1 35 | ; / \ 36 | ; D-1 C-1 37 | 38 | (print sample-message) 39 | ; ==> (0 1 1 0 0 1 0 1 0 1 1 1 0) 40 | 41 | (print (decode sample-message sample-tree)) 42 | ; ==> (A D A B B C A) 43 | ; 0 110 0 10 10 111 0 44 | -------------------------------------------------------------------------------- /ex-3.67.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | (load "./ex-3.66-test.scm") 3 | 4 | ;; (S0,T0) | (S0,T1) (S0,T2) ... 5 | ;; ----------------------------- 6 | ;; (S1,T0) (S1,T1) (S1,T2) ... 7 | ;; ... ... ... 8 | (define (pairs s t) 9 | (cons-stream 10 | (list (stream-car s) (stream-car t)) 11 | (interleave 12 | (stream-map (lambda (tj) (list (stream-car s) tj)) 13 | (stream-cdr t)) 14 | (pairs (stream-cdr s) t)))) 15 | 16 | (define (main args) 17 | (define s (pairs integers integers)) 18 | (do ([i 0 (+ i 1)]) 19 | ((= i 20)) 20 | (print (stream-ref s i))) 21 | ) 22 | ; ==> (1 1) 23 | ; (1 2) 24 | ; (2 1) 25 | ; (1 3) 26 | ; (2 2) 27 | ; (1 4) 28 | ; (3 1) 29 | ; (1 5) 30 | ; (2 3) 31 | ; (1 6) 32 | ; (3 2) 33 | ; (1 7) 34 | ; (2 4) 35 | ; (1 8) 36 | ; (4 1) 37 | ; (1 9) 38 | ; (2 5) 39 | ; (1 10) 40 | ; (3 3) 41 | ; (1 11) 42 | ; ... 43 | ; 44 | ; (1 1) (1 2) (1 3) (1 4) (1 5) (1 6) (1 7) (1 8) (1 9) (1 10) (1 11) 45 | ; (2 1) (2 2) (2 3) (2 4) (2 5) 46 | ; (3 1) (3 2) (3 3) 47 | ; (4 1) 48 | -------------------------------------------------------------------------------- /ex-3.31.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.31. The internal procedure `accept-action-procedure!` defined in 2 | > `make-wire` specifies that when a new action procedure is added to a wire, 3 | > the procedure is immediately run. Explain why this initialization is 4 | > necessary. 5 | 6 | 1. The simulation is driven by `propagate`. 7 | 2. `propagate` operates on `the-agenda`. 8 | 3. New items are added to `the-agenda` only by `after-delay`. 9 | 4. `after-delay` is called only by procedures added with `add-action!`. 10 | 11 | Therefore, `the-agenda` is never updated if `accept-action-procedure!` does not 12 | do the initialization. This means nothing will be simulated by `propagate`. 13 | 14 | 15 | > In particular, trace through the half-adder example in the paragraphs above 16 | > and say how the system's response would differ if we had defined 17 | > `accept-action-procedure!` as 18 | > 19 | > ```scheme 20 | > (define (accept-action-procedure! proc) 21 | > (set! action-procedures (cons proc action-procedures))) 22 | > ``` 23 | 24 | Since new items are never added to `the-agenda` with this version, 25 | `(propagate)` simulates nothing and just returns `done`. 26 | -------------------------------------------------------------------------------- /ex-3.33.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.33. Using primitive multiplier, adder, and constant 2 | ;;; constraints, define a procedure averager that takes three connectors a, b, 3 | ;;; and c as inputs and establishes the constraint that the value of c is the 4 | ;;; average of the values of a and b. 5 | 6 | (load "./sec-3.3.5.scm") 7 | 8 | 9 | ;; a + b 10 | ;; c = ----- 11 | ;; 2 12 | ;; 13 | ;; 2c = a + b 14 | ;; 15 | ;; ------------ ------------ 16 | ;; c ---| m1 | q | a1 |--- a 17 | ;; | * p |-----| s + | 18 | ;; ,--| m2 | | a2 |--- b 19 | ;; | ------------ ------------ 20 | ;; r | 21 | ;; | ----- 22 | ;; `---| 2 | 23 | ;; ----- 24 | (define (averager a b c) 25 | (let ([q (make-connector)] 26 | [r (make-connector)]) 27 | (constant 2 r) 28 | (multiplier c r q) 29 | (adder a b q) 30 | 'ok)) 31 | 32 | (define a (make-connector)) 33 | (probe "A" a) 34 | (define b (make-connector)) 35 | (probe "B" b) 36 | (define c (make-connector)) 37 | (probe "C" c) 38 | (averager a b c) 39 | 40 | (set-value! b 10 'user) 41 | (set-value! c 30 'user) 42 | ; a will be set to 50. 43 | -------------------------------------------------------------------------------- /ex-3.8.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.8. When we defined the evaluation model in section 1.1.3, we 2 | ;;; said that the first step in evaluating an expression is to evaluate its 3 | ;;; subexpressions. But we never specified the order in which the 4 | ;;; subexpressions should be evaluated (e.g., left to right or right to left). 5 | ;;; When we introduce assignment, the order in which the arguments to 6 | ;;; a procedure are evaluated can make a difference to the result. Define 7 | ;;; a simple procedure f such that evaluating (+ (f 0) (f 1)) will return 0 if 8 | ;;; the arguments to + are evaluated from left to right but will return 1 if 9 | ;;; the arguments are evaluated from right to left. 10 | 11 | (define (make-f) 12 | (let ([evaluated #f]) 13 | (lambda (x) 14 | (if evaluated 15 | 0 16 | (begin 17 | (set! evaluated #t) 18 | x))))) 19 | 20 | ;; Emulate left-to-right evaluated (+ (f 0) (f 1)) 21 | (define f1 (make-f)) 22 | (let* ([l (f1 0)] 23 | [r (f1 1)]) 24 | (print (+ l r))) 25 | 26 | ;; Emulate right-to-left evaluated (+ (f 0) (f 1)) 27 | (define f2 (make-f)) 28 | (let* ([r (f2 1)] 29 | [l (f2 0)]) 30 | (print (+ l r))) 31 | -------------------------------------------------------------------------------- /ex-3.34.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.34. Louis Reasoner wants to build a squarer, a constraint device 2 | > with two terminals such that the value of connector `b` on the second 3 | > terminal will always be the square of the value `a` on the first terminal. He 4 | > proposes the following simple device made from a multiplier: 5 | > 6 | > ```scheme 7 | > (define (squarer a b) 8 | > (multiplier a a b)) 9 | > ``` 10 | > 11 | > There is a serious flaw in this idea. Explain. 12 | 13 | Like an adder and a multiplier, a squarer must: 14 | 15 | * Computes a square of `a` and set it to `b` if a new value is set to `a`, and 16 | * Computes a square root of `b` and set it to `a` if a new value is set to `b`. 17 | 18 | Louis' squarer meets the former, but it doesn't meet the latter. 19 | If a value is set to `b` of Louis' squarer, nothing will be computed. 20 | Because `multiplier` requires that two connectors have values to compute 21 | a value for the last connector. 22 | 23 | Try the following interaction: 24 | 25 | ```scheme 26 | (define a (make-connector)) 27 | (define b (make-connector)) 28 | (squarer a b) 29 | (probe "A" a) 30 | (probe "B" b) 31 | (set-value! b 9 'user) 32 | ``` 33 | 34 | `a` will not be computed. 35 | -------------------------------------------------------------------------------- /ex-2.88.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.88. Extend the polynomial system to include subtraction of 2 | ;;; polynomials. (Hint: You may find it helpful to define a generic negation 3 | ;;; operation.) 4 | 5 | (define (negate x) 6 | (apply-generic 'negate x)) 7 | 8 | (put 'negate '(integer) 9 | -) 10 | (put 'negate '(rational) 11 | (lambda (q) 12 | (make-rational (- (numer q)) (denom q)))) 13 | (put 'negate '(real) 14 | -) 15 | (put 'negate '(complex) 16 | (lambda (z) 17 | (make-complex-from-real-imag (negate (real-part z)) 18 | (negate (imag-part z))))) 19 | 20 | (define (negate-terms terms) 21 | (if (empty-termlist? terms) 22 | (the-empty-termlist) 23 | (adjoin-term 24 | (make-term (order (first-term terms)) 25 | (negate (coeff (first-term terms)))) 26 | (negate-terms (rest-terms terms))))) 27 | (put 'negate '(polynomial) 28 | (lambda (p) 29 | (make-poly (variable p) (negate-terms (term-list p))))) 30 | 31 | (define (sub-poly p1 p2) 32 | (if (same-variable? (variable p1) (variable p2)) 33 | (add-poly p1 (negate p2)) 34 | (error "Polys not in same var -- SUB-POLY" 35 | (list p1 p2)))) 36 | -------------------------------------------------------------------------------- /ex-3.68.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.68. Louis Reasoner thinks that building a stream of pairs from 2 | > three parts is unnecessarily complicated. Instead of separating the pair 3 | > (S0,T0) from the rest of the pairs in the first row, he proposes to work with 4 | > the whole first row, as follows: 5 | > 6 | > ```scheme 7 | > (define (pairs s t) 8 | > (interleave 9 | > (stream-map (lambda (x) (list (stream-car s) x)) 10 | > t) 11 | > (pairs (stream-cdr s) (stream-cdr t)))) 12 | > ``` 13 | > 14 | > Does this work? Consider what happens if we evaluate `(pairs integers 15 | > integers)` using Louis's definition of `pairs`. 16 | 17 | Louis's `pairs` does not work. It recursively calls itself forever. 18 | Because not all procedures are lazily evaluated. 19 | The steps to evaluate `(pairs integers integers)` will be as follows: 20 | 21 | 1. `pairs` calls `interleave`. 22 | 2. `interleave` is an ordinary procedure, so its arguments are evaluated before calling `interleave`. 23 | 3. One of subexpressions for `interleave` is `(pairs (stream-cdr s) (stream-cdr t))`. So the second `pairs` is called. 24 | 4. And the second `pairs` behaves the same as the first `pairs`. The third `pairs` is called, and so on. 25 | -------------------------------------------------------------------------------- /ex-1.16.scm: -------------------------------------------------------------------------------- 1 | ; (b^(n/2))^2 = (b^2)^(n/2) (n mod 2 = 0) 2 | ; b (b^n-1) 3 | ; 4 | ; b^1 = b 5 | ; b^2 = b^1 * b^1 6 | ; b^4 = b^2 * b^2 7 | ; b^5 = b * b^2 * b^2 8 | ; b^9 = b * b^8 9 | ; = b * b^4 * b^4 10 | ; = b * b^2 * b^2 * b^2 * b^2 11 | ; b7 = 1 6 = 1 (3 3) 12 | ; 13 | ; b^(n+1) = a * b^n 14 | ; b * b^n = a * b^n 15 | ; b * (b^(n/2))^2 = a * (b^2)^(n/2) 16 | ; b * (b^(n/2))^2 = a 17 | ; (b^2)^(n/2) 18 | ; 19 | ; b^(2n+1) = b * b^n * b^n 20 | ; b^(2n) = b^n * b^n 21 | 22 | (define (fast-expt b n) 23 | (define (iter b a n) 24 | (print "--- b " b " a " a " n " n) 25 | (cond 26 | ((= n 0) a) 27 | ((even? n) (iter (square b) a (/ n 2))) 28 | (else (iter b (* a b) (- n 1))))) 29 | (print) 30 | (print "=== b " b " n " n) 31 | (iter b 1 n)) 32 | 33 | (print (fast-expt 2 1) " vs " (expt 2 1)) 34 | (print (fast-expt 2 2) " vs " (expt 2 2)) 35 | (print (fast-expt 2 3) " vs " (expt 2 3)) 36 | (print (fast-expt 2 4) " vs " (expt 2 4)) 37 | (print (fast-expt 2 5) " vs " (expt 2 5)) 38 | (print (fast-expt 2 8) " vs " (expt 2 8)) 39 | (print (fast-expt 2 19) " vs " (expt 2 19)) 40 | ;(print (fast-expt 3 3) " vs " (expt 3 3)) 41 | ;(print (fast-expt 5 5) " vs " (expt 5 5)) 42 | ;(print (fast-expt 9 9) " vs " (expt 9 9)) 43 | -------------------------------------------------------------------------------- /sec-2.3.2-v1.scm: -------------------------------------------------------------------------------- 1 | (define (deriv exp var) 2 | (cond ((number? exp) 0) 3 | ((variable? exp) 4 | (if (same-variable? exp var) 1 0)) 5 | ((sum? exp) 6 | (make-sum (deriv (addend exp) var) 7 | (deriv (augend exp) var))) 8 | ((product? exp) 9 | (make-sum 10 | (make-product (multiplier exp) 11 | (deriv (multiplicand exp) var)) 12 | (make-product (deriv (multiplier exp) var) 13 | (multiplicand exp)))) 14 | (else 15 | (error "unknown expression type -- DERIV" exp)))) 16 | 17 | (define (variable? x) 18 | (symbol? x)) 19 | 20 | (define (same-variable? v1 v2) 21 | (and (variable? v1) 22 | (variable? v2) 23 | (eq? v1 v2))) 24 | 25 | (define (make-sum a1 a2) 26 | (list '+ a1 a2)) 27 | 28 | (define (sum? x) 29 | (and (pair? x) 30 | (eq? (car x) '+))) 31 | 32 | (define (addend s) 33 | (cadr s)) 34 | 35 | (define (augend s) 36 | (caddr s)) 37 | 38 | (define (make-product m1 m2) 39 | (list '* m1 m2)) 40 | 41 | (define (product? x) 42 | (and (pair? x) 43 | (eq? (car x) '*))) 44 | 45 | (define (multiplier p) 46 | (cadr p)) 47 | 48 | (define (multiplicand p) 49 | (caddr p)) 50 | -------------------------------------------------------------------------------- /ex-3.58.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | ;;; Exercise 3.58. Give an interpretation of the stream computed by the 4 | ;;; following procedure: 5 | 6 | (define (expand num den radix) 7 | (cons-stream 8 | (quotient (* num radix) den) 9 | (expand (remainder (* num radix) den) den radix))) 10 | 11 | ;;; (Quotient is a primitive that returns the integer quotient of two 12 | ;;; integers.) What are the successive elements produced by (expand 1 7 10)? 13 | ;;; What is produced by (expand 3 8 10)? 14 | 15 | ; Expand performs a long division and returns the resulting quotient as 16 | ; a stream of digits in a given radix. But num must be less than den. 17 | ; Therefore, 18 | ; 19 | ; * (expand 1 7 10) produces an infinite stream of 1, 4, 2, 8, 5 and 7. 20 | ; * (expand 3 8 10) produces 3, 7, 5 then infinite 0s. 21 | 22 | (let go ([parameters-list '((1 7 10) (3 8 10))]) 23 | (if (not (null? parameters-list)) 24 | (let* ([parameters (car parameters-list)] 25 | [s (apply expand parameters)]) 26 | (write (cons 'expand parameters)) 27 | (display " ==> ") 28 | (do ((i 0 (+ i 1))) 29 | ((= i 15)) 30 | (display (stream-ref s i)) 31 | (display ", ")) 32 | (display "...\n") 33 | (go (cdr parameters-list))))) 34 | -------------------------------------------------------------------------------- /ex-3.19.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.19. Redo exercise 3.18 using an algorithm that takes only 2 | ;;; a constant amount of space. (This requires a very clever idea.) 3 | 4 | ; Circular lists like z in Exercise 3.13 have loops. 5 | ; Taking successive CDRs of circular lists never ends. 6 | ; Likewise, taking successive CDDRs of circular lists never ends too. 7 | ; Once the former goes around a loop, the latter goes around the loop twice. 8 | ; These "visitors" eventually visit the same pair if a list is circular. 9 | ; Otherwise the latter visitor finishes taking CDDRs. 10 | ; 11 | ; So that we don't have to record already visited pairs to detect cycles. 12 | ; The two visitors are enought to detect cycles. 13 | 14 | (define (circular? x) 15 | (define (next x) 16 | (if (pair? x) 17 | (cdr x) 18 | #f)) 19 | (let go ([x1 x] 20 | [x2 (next x)]) 21 | (if (and x1 x2) 22 | (if (eq? x1 x2) 23 | #t 24 | (go (next x1) (next (next x2)))) 25 | #f))) 26 | 27 | 28 | 29 | 30 | (load "./sec-3.3-sample-lists.scm") 31 | 32 | (define (check x) 33 | (print (zap x) " ==> " (circular? x))) 34 | (check z3) 35 | (check z4) 36 | (check z7) 37 | (check z*) 38 | (check (make-cycle (list #f #f #f))) 39 | (check (cons #t #t)) 40 | (check (cons #f #f)) 41 | -------------------------------------------------------------------------------- /ex-3.3.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.3. Modify the make-account procedure so that it creates 2 | ;;; password-protected accounts. That is, make-account should take a symbol as 3 | ;;; an additional argument, as in 4 | ;;; 5 | ;;; (define acc (make-account 100 'secret-password)) 6 | ;;; 7 | ;;; The resulting account object should process a request only if it is 8 | ;;; accompanied by the password with which the account was created, and should 9 | ;;; otherwise return a complaint: 10 | ;;; 11 | ;;; ((acc 'secret-password 'withdraw) 40) 12 | ;;; 60 13 | ;;; 14 | ;;; ((acc 'some-other-password 'deposit) 50) 15 | ;;; "Incorrect password" 16 | 17 | (load "./sec-3.1.1.scm") 18 | 19 | (define make-account 20 | (let ([%make-account make-account]) 21 | (lambda (initial-balance the-password) 22 | (let ([acc (%make-account initial-balance)]) 23 | (define (dispatch password message) 24 | (if (eq? password the-password) 25 | (acc message) 26 | (lambda _ "Incorrect password"))) 27 | dispatch)))) 28 | 29 | ; (define acc (make-account 100 'secret-password)) 30 | ; 31 | ; (print ((acc 'secret-password 'withdraw) 40)) 32 | ; ;==> 60 33 | ; 34 | ; (print ((acc 'some-other-password 'deposit) 50)) 35 | ; ;==> "Incorrect password" 36 | -------------------------------------------------------------------------------- /ex-4.57.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.57. Define a rule that says that person 1 can replace person 2 | ;;; 2 if either person 1 does the same job as person 2 or someone who does 3 | ;;; person 1's job can also do person 2's job, and if person 1 and person 2 are 4 | ;;; not the same person. Using your rule, give queries that find the following: 5 | ;;; 6 | ;;; a. all people who can replace Cy D. Fect; 7 | ;;; 8 | ;;; b. all people who can replace someone who is being paid more than they 9 | ;;; are, together with the two salaries. 10 | 11 | (load "./sec-4.4.4.scm") 12 | (load "./sec-4.4.1-sample-db.scm") 13 | 14 | (query-driver-loop-for-script '( 15 | 16 | (assert! 17 | (rule (can-replace ?person1 ?person2) 18 | (and (or (and (job ?person1 ?job1) 19 | (job ?person2 ?job2) 20 | (same ?job1 ?job2)) 21 | (and (job ?personx ?jobx) 22 | (same ?jobx ?job1)) 23 | (same ?jobx ?job2)) 24 | (not (same ?person1 ?person2))))) 25 | 26 | ; a 27 | (can-replace ?who (Fect Cy D)) 28 | 29 | ; b 30 | (and (can-replace ?who ?someone) 31 | (salary ?who ?who-amount) 32 | (salary ?someone ?someone-amount) 33 | (lisp-value < ?who-amount ?someone-amount)) 34 | 35 | )) 36 | -------------------------------------------------------------------------------- /ex-4.24.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.24. Design and carry out some experiments to compare the speed 2 | ;;; of the original metacircular evaluator with the version in this section. 3 | ;;; Use your results to estimate the fraction of time that is spent in analysis 4 | ;;; versus execution for various procedures. 5 | 6 | (load "./sec-4.1.1.scm") 7 | (load "./sec-4.1.2.scm") 8 | (load "./sec-4.1.3.scm") 9 | (load "./sec-4.1.4.scm") 10 | 11 | (define eval-original eval) 12 | 13 | (load "./sec-4.1.7.scm") 14 | 15 | (define eval-analyzed eval) 16 | 17 | (define sample-codes 18 | '((begin (define (fib n) 19 | (cond ((= n 1) 1) 20 | ((= n 2) 1) 21 | (else (+ (fib (- n 1)) (fib (- n 2)))))) 22 | (print (fib 26))) 23 | (begin (define (loop n) 24 | (if (= n 0) 25 | 'done 26 | (begin (+ 1 1) 27 | (loop (- n 1))))) 28 | (loop 100000)) 29 | )) 30 | 31 | (for-each (lambda (code) 32 | (print "================================") 33 | (print "Code: " code) 34 | (print "Original:") 35 | (time (eval-original code the-global-environment)) 36 | (print "Analyzed:") 37 | (time (eval-analyzed code the-global-environment))) 38 | sample-codes) 39 | -------------------------------------------------------------------------------- /ex-2.66.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.66. Implement the lookup procedure for the case where the set 2 | ;;; of records is structured as a binary tree, ordered by the numerical values 3 | ;;; of the keys. 4 | 5 | (load "./sec-2.3.3-sets-as-binary-trees.scm") 6 | 7 | (define (make-record key value) 8 | (cons key value)) 9 | 10 | (define (key record) 11 | (car record)) 12 | 13 | (define (lookup given-key set-of-records) 14 | (if (null? set-of-records) 15 | #f 16 | (let* ([record (entry set-of-records)] 17 | [current-key (key record)]) 18 | (cond 19 | [(= given-key current-key) 20 | record] 21 | [(< given-key current-key) 22 | (lookup given-key (left-branch set-of-records))] 23 | [else 24 | (lookup given-key (right-branch set-of-records))])))) 25 | 26 | (define database 27 | (make-tree 28 | (make-record 5 'Fortran) 29 | (make-tree 30 | (make-record 3 'C++) 31 | (make-tree (make-record 1 'Ada) '() '()) 32 | (make-tree (make-record 4 'Dylan) '() '())) 33 | (make-tree 34 | (make-record 7 'Haskell) 35 | (make-tree (make-record 6 'Go) '() '()) 36 | (make-tree (make-record 9 'JavaScript) '() '())))) 37 | (print database) 38 | (map (lambda (i) 39 | (print "(lookup " i " database) ==> " (lookup i database))) 40 | '(0 1 2 3 4 5 6 7 8 9 10)) 41 | -------------------------------------------------------------------------------- /ex-2.56.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-2.3.2-v2.scm") 2 | 3 | (define (deriv exp var) 4 | (cond ((number? exp) 0) 5 | ((variable? exp) 6 | (if (same-variable? exp var) 1 0)) 7 | ((sum? exp) 8 | (make-sum (deriv (addend exp) var) 9 | (deriv (augend exp) var))) 10 | ((product? exp) 11 | (make-sum 12 | (make-product (multiplier exp) 13 | (deriv (multiplicand exp) var)) 14 | (make-product (deriv (multiplier exp) var) 15 | (multiplicand exp)))) 16 | ((exponentation? exp) 17 | (make-product 18 | (make-product 19 | (exponent exp) 20 | (make-exponentation (base exp) (- (exponent exp) 1))) 21 | (deriv (base exp) var))) 22 | (else 23 | (error "unknown expression type -- DERIV" exp)))) 24 | 25 | (define (make-exponentation base exponent) 26 | (cond 27 | ((=number? base 0) 0) 28 | ((=number? base 1) 1) 29 | ((=number? exponent 0) 1) 30 | ((=number? exponent 1) base) 31 | ((and (number? base) (number? exponent)) (expt base exponent)) 32 | (else (list '** base exponent)))) 33 | 34 | (define (exponentation? exp) 35 | (and (pair? exp) 36 | (eq? (car exp) '**))) 37 | 38 | (define (base e) 39 | (cadr e)) 40 | 41 | (define (exponent e) 42 | (caddr e)) 43 | -------------------------------------------------------------------------------- /ex-3.69.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.69. Write a procedure triples that takes three infinite 2 | ;;; streams, S, T, and U, and produces the stream of triples (Si,Tj,Uk) such 3 | ;;; that i < j < k. Use triples to generate the stream of all Pythagorean 4 | ;;; triples of positive integers, i.e., the triples (i,j,k) such that i < j and 5 | ;;; i^2 + j^2 = k^2. 6 | 7 | (load "./sec-3.5.scm") 8 | 9 | ; (1 1 1) + (1 1 z) + (1 y z) + (x y z) 10 | (define (triples s t u) 11 | (cons-stream 12 | (list (stream-car s) (stream-car t) (stream-car u)) 13 | (interleave 14 | (stream-map (lambda (uk) (list (stream-car s) (stream-car t) uk)) 15 | (stream-cdr u)) 16 | (interleave 17 | (stream-map (lambda (tjuk) (cons (stream-car s) tjuk)) 18 | (pairs (stream-cdr t) (stream-cdr u))) 19 | (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))) 20 | 21 | (define (pythagorean-triples) 22 | (define (square x) (* x x)) 23 | (stream-filter (lambda (ns) 24 | (= (+ (square (car ns)) (square (cadr ns))) 25 | (square (caddr ns)))) 26 | (triples integers integers integers))) 27 | 28 | ; (define s (triples integers integers integers)) 29 | (define s (pythagorean-triples)) 30 | (do ([i 0 (+ i 1)] 31 | [s (pythagorean-triples) (stream-cdr s)]) 32 | ((= i 3)) 33 | (print (stream-car s))) 34 | -------------------------------------------------------------------------------- /ex-4.26.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.26. Ben Bitdiddle and Alyssa P. Hacker disagree over the 2 | ;;; importance of lazy evaluation for implementing things such as unless. Ben 3 | ;;; points out that it's possible to implement unless in applicative order as 4 | ;;; a special form. Alyssa counters that, if one did that, unless would be 5 | ;;; merely syntax, not a procedure that could be used in conjunction with 6 | ;;; higher-order procedures. Fill in the details on both sides of the 7 | ;;; argument. 8 | 9 | 10 | ;;; Show how to implement unless as a derived expression (like cond or let), 11 | 12 | (define (unless? exp) 13 | (tagged-list? exp 'unless)) 14 | 15 | (define (unless-predicate exp) (cadr exp)) 16 | (define (unless-consequent exp) (caddr exp)) 17 | (define (unless-alternative exp) (cadddr exp)) 18 | 19 | (define (unless->if exp) 20 | (make-if (unless-predicate exp) 21 | (unless-consequent exp) 22 | (unless-alternative exp))) 23 | 24 | (define (eval exp env) 25 | (cond ((self-evaluating? exp) exp) 26 | ; ... 27 | ((unless? exp) (eval (unless->if exp) env)) 28 | ; ... 29 | (else 30 | (error "Unknown expression type -- EVAL" exp)))) 31 | 32 | 33 | ;;; and give an example of a situation where it might be useful to have unless 34 | ;;; available as a procedure, rather than as a special form. 35 | 36 | ; TODO 37 | -------------------------------------------------------------------------------- /ex-1.6.md: -------------------------------------------------------------------------------- 1 | > Exercise 1.6. Alyssa P. Hacker doesn't see why if needs to be provided as 2 | > a special form. "Why can't I just define it as an ordinary procedure in terms 3 | > of cond?" she asks. Alyssa's friend Eva Lu Ator claims this can indeed be 4 | > done, and she defines a new version of if: 5 | > 6 | > (define (new-if predicate then-clause else-clause) 7 | > (cond (predicate then-clause) 8 | > (else else-clause))) 9 | > 10 | > Eva demonstrates the program for Alyssa: 11 | > 12 | > (new-if (= 2 3) 0 5) 13 | > 5 14 | > 15 | > (new-if (= 1 1) 0 5) 16 | > 0 17 | > 18 | > Delighted, Alyssa uses new-if to rewrite the square-root program: 19 | > 20 | > (define (sqrt-iter guess x) 21 | > (new-if (good-enough? guess x) 22 | > guess 23 | > (sqrt-iter (improve guess x) 24 | > x))) 25 | > 26 | > What happens when Alyssa attempts to use this to compute square roots? 27 | > Explain. 28 | 29 | `if` and `cond` are special forms because of their own evaluation rules. 30 | Nto all operands given to `if` and `cond` are evaluated. 31 | 32 | While `new-if` is an ordinary procedure. 33 | All operands given to `new-if` are evaluated at first. 34 | And the body of `sqrt-iter` recursively calls itself. 35 | Therefore, the `sqrt-iter` defined with `new-if` will never end. 36 | -------------------------------------------------------------------------------- /ex-4.14.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.14. Eva Lu Ator and Louis Reasoner are each experimenting with 2 | > the metacircular evaluator. Eva types in the definition of `map`, and runs 3 | > some test programs that use it. They work fine. Louis, in contrast, has 4 | > installed the system version of `map` as a primitive for the metacircular 5 | > evaluator. When he tries it, things go terribly wrong. Explain why Louis's 6 | > `map` fails even though Eva's works. 7 | 8 | `map` takes a procedure and one or more lists. Lists of the underlying Lisp 9 | system and lists of the metacircular Lisp are represented in the same way, but 10 | procedures of both Lisp systems are (usually) represented in different ways. 11 | 12 | Eva's `map` expects a procedure defined in the metacircular Lisp, while Louis's 13 | `map` expects a procedure defined in the underlying Lisp. And both `map`s are 14 | applied with procedures defined in the metacircular Lisp. That's why Louis's 15 | `map` fails. 16 | 17 | In short: 18 | 19 | ------------------------------------------------------------ 20 | | | Eva's `map` | Louis's `map` | 21 | ------------------------------------------------------------ 22 | | Expected procedure | Metacircular one | Underlying one | 23 | | Given procedure | Metacircular one | Metacircular one | 24 | ------------------------------------------------------------ 25 | -------------------------------------------------------------------------------- /ex-2.58-a.scm: -------------------------------------------------------------------------------- 1 | (load "./ex-2.57.scm") 2 | 3 | (define (make-sum a1 a2) 4 | (cond ((=number? a1 0) a2) 5 | ((=number? a2 0) a1) 6 | ((and (number? a1) (number? a2)) (+ a1 a2)) 7 | (else (list a1 '+ a2)))) 8 | 9 | (define (sum? x) 10 | (and (pair? x) 11 | (pair? (cdr x)) 12 | (eq? (cadr x) '+))) 13 | 14 | (define (addend s) 15 | (car s)) 16 | 17 | (define (augend s) 18 | (caddr s)) 19 | 20 | (define (make-product m1 m2) 21 | (cond ((or (=number? m1 0) (=number? m2 0)) 0) 22 | ((=number? m1 1) m2) 23 | ((=number? m2 1) m1) 24 | ((and (number? m1) (number? m2)) (* m1 m2)) 25 | (else (list m1 '* m2)))) 26 | 27 | (define (product? x) 28 | (and (pair? x) 29 | (pair? (cdr x)) 30 | (eq? (cadr x) '*))) 31 | 32 | (define (multiplier p) 33 | (car p)) 34 | 35 | (define (multiplicand p) 36 | (caddr p)) 37 | 38 | (define (make-exponentation base exponent) 39 | (cond 40 | ((=number? base 0) 0) 41 | ((=number? base 1) 1) 42 | ((=number? exponent 0) 1) 43 | ((=number? exponent 1) base) 44 | ((and (number? base) (number? exponent)) (expt base exponent)) 45 | (else (list base '** exponent)))) 46 | 47 | (define (exponentation? x) 48 | (and (pair? x) 49 | (pair? (cdr x)) 50 | (eq? (cadr x) '**))) 51 | 52 | (define (base e) 53 | (car e)) 54 | 55 | (define (exponent e) 56 | (caddr e)) 57 | -------------------------------------------------------------------------------- /ex-4.60.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.60. By giving the query 2 | ;;; 3 | ;;; (lives-near ?person (Hacker Alyssa P)) 4 | ;;; 5 | ;;; Alyssa P. Hacker is able to find people who live near her, with whom she 6 | ;;; can ride to work. On the other hand, when she tries to find all pairs of 7 | ;;; people who live near each other by querying 8 | ;;; 9 | ;;; (lives-near ?person-1 ?person-2) 10 | ;;; 11 | ;;; she notices that each pair of people who live near each other is listed 12 | ;;; twice; for example, 13 | ;;; 14 | ;;; (lives-near (Hacker Alyssa P) (Fect Cy D)) 15 | ;;; (lives-near (Fect Cy D) (Hacker Alyssa P)) 16 | ;;; 17 | ;;; Why does this happen? Is there a way to find a list of people who live near 18 | ;;; each other, in which each pair appears only once? Explain. 19 | 20 | ; Because each pattern variable is matched valid person. 21 | 22 | (load "./sec-4.4.4.scm") 23 | (load "./sec-4.4.1-sample-db.scm") 24 | 25 | (define (namestring name1) 27 | (x->string name2))) 28 | 29 | (query-driver-loop-for-script '( 30 | 31 | (assert! (rule (lives-near ?person-1 ?person-2) 32 | (and (address ?person-1 (?town . ?rest-1)) 33 | (address ?person-2 (?town . ?rest-2)) 34 | (lisp-value name ) ... ( )) 4 | ;;; ) 5 | ;;; 6 | ;;; is equivalent to 7 | ;;; 8 | ;;; ((lambda ( ... ) 9 | ;;; ) 10 | ;;; 11 | ;;; : 12 | ;;; ) 13 | ;;; 14 | ;;; Implement a syntactic transformation let->combination that reduces 15 | ;;; evaluating let expressions to evaluating combinations of the type shown 16 | ;;; above, and add the appropriate clause to eval to handle let expressions. 17 | 18 | (define (let->combination let-exp) 19 | (define vars (map let-clause-var (let-clauses let-exp))) 20 | (define value-exps (map let-clause-value-exp (let-clauses let-exp))) 21 | (cons 22 | (make-lambda vars (let-body let-exp)) 23 | value-exps)) 24 | 25 | (define (let? exp) 26 | (tagged-list? exp 'let)) 27 | 28 | (define (let-clauses exp) 29 | (cadr exp)) 30 | 31 | (define (let-clause-var clause) 32 | (car clause)) 33 | 34 | (define (let-clause-value-exp clause) 35 | (cadr clause)) 36 | 37 | (define (let-body exp) 38 | (cddr exp)) 39 | 40 | (define (eval exp env) 41 | (cond ; ... 42 | ((let? exp) (eval (let->combination exp) env)) 43 | ((application? exp) 44 | (apply (eval (operator exp) env) 45 | (list-of-values (operands exp) env))) 46 | (else 47 | (error "Unknown expression type -- EVAL" exp)))) 48 | -------------------------------------------------------------------------------- /ex-4.50.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.50. Implement a new special form ramb that is like amb except 2 | ;;; that it searches alternatives in a random order, rather than from left to 3 | ;;; right. Show how this can help with Alyssa's problem in exercise 4.49. 4 | 5 | (load "./sec-4.3.2.scm") 6 | (load "./sec-4.3.3.scm") 7 | 8 | ; To generate random sentences which consist of randomly structured words, all 9 | ; use of amb in the parser must be replaced with ramb. To avoid a massive 10 | ; copy, I modify amb to act as ramb. 11 | 12 | (use gauche.sequence) 13 | 14 | (define (analyze-amb exp) 15 | (let ((cprocs (map analyze (amb-choices exp)))) 16 | (lambda (env succeed fail) 17 | (define (try-next choices) 18 | (if (null? choices) 19 | (fail) 20 | (let ((choices (shuffle choices))) ; *changed* 21 | ((car choices) env 22 | succeed 23 | (lambda () 24 | (try-next (cdr choices))))))) 25 | (try-next cprocs)))) 26 | 27 | (ambtest `(begin 28 | 29 | ,@parser-definitions 30 | 31 | (define (an-element-of items) 32 | (require (not (null? items))) 33 | (amb (car items) (an-element-of (cdr items)))) 34 | 35 | (define (parse-word word-list) 36 | (list (car word-list) (an-element-of (cdr word-list)))) 37 | 38 | (print (parse '())) 39 | 40 | )) 41 | -------------------------------------------------------------------------------- /ex-2.72.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.72. 2 | ;;; 3 | ;;; Consider the encoding procedure that you designed in exercise 2.68. What 4 | ;;; is the order of growth in the number of steps needed to encode a symbol? 5 | ;;; Be sure to include the number of steps needed to search the symbol list at 6 | ;;; each node encountered. 7 | ;;; 8 | ;;; To answer this question in general is difficult. Consider the special case 9 | ;;; where the relative frequencies of the n symbols are as described in 10 | ;;; exercise 2.71, and give the order of growth (as a function of n) of the 11 | ;;; number of steps needed to encode the most frequent and least frequent 12 | ;;; symbols in the alphabet. 13 | 14 | ; The order to encode the most frequent symbol is O(N), because: 15 | ; 16 | ; * The most frequent symbol is in the right branch of the root of the tree, 17 | ; and the branch is a leaf. 18 | ; * ENCODE-SYMBOL scans symbols of each branch to decide which branch to be 19 | ; looked up for the next ENCODE-SYMBOL. Since the symbol is in the right 20 | ; branch, the number of symbols to be scanned is N. 21 | ; 22 | ; The order to encode the least frequent symbol is also O(N), because: 23 | ; 24 | ; * The least frequent symbol is in the most left branch of the tree. 25 | ; So that ENCODE-SYMBOL drills down the tree N-1 times. 26 | ; * At i-th step, ENCODE-SYMBOL scans N-i symbols. 27 | ; But the first symbol in each step is always the least frequent symbol. 28 | ; So that memq ends in O(1). 29 | -------------------------------------------------------------------------------- /ex-3.44.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.44. Consider the problem of transferring an amount from one 2 | > account to another. Ben Bitdiddle claims that this can be accomplished with 3 | > the following procedure, even if there are multiple people concurrently 4 | > transferring money among multiple accounts, using any account mechanism that 5 | > serializes deposit and withdrawal transactions, for example, the version of 6 | > make-account in the text above. 7 | > 8 | > ```scheme 9 | > (define (transfer from-account to-account amount) 10 | > ((from-account 'withdraw) amount) 11 | > ((to-account 'deposit) amount)) 12 | > ``` 13 | > 14 | > Louis Reasoner claims that there is a problem here, and that we need to use 15 | > a more sophisticated method, such as the one required for dealing with the 16 | > exchange problem. Is Louis right? If not, what is the essential difference 17 | > between the transfer problem and the exchange problem? (You should assume 18 | > that the balance in `from-account` is at least amount.) 19 | 20 | Louis is wrong. The essential difference between the two problems is whether 21 | each account's balance is accessed more than once. The transfer problem 22 | accesses each account's balance only once, while the exchange problem accesses 23 | each account's balance two times --- the first time is to calculate the 24 | difference of the two balances, and the second time is to transfer the 25 | difference. So that the whole steps of an exchange must be serialized. 26 | -------------------------------------------------------------------------------- /ex-4.13.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.13. Scheme allows us to create new bindings for variables by 2 | ;;; means of `define`, but provides no way to get rid of bindings. Implement 3 | ;;; for the evaluator a special form `make-unbound!` that removes the binding 4 | ;;; of a given symbol from the environment in which the `make-unbound!` 5 | ;;; expression is evaluated. This problem is not completely specified. For 6 | ;;; example, should we remove only the binding in the first frame of the 7 | ;;; environment? Complete the specification and justify any choices you make. 8 | 9 | ;; The best behavior varies for each situation. So that I chose to implement 10 | ;; both versions. 11 | 12 | (require "./ex-4.12") 13 | 14 | (define (make-unbound-first! var env) 15 | (define undef (if #f #t)) 16 | (scan-environment 17 | var 18 | env 19 | (lambda (vars vals) 20 | ; TODO: The binding should be removed from the frame. 21 | (set-car! vars undef) 22 | (set-car! vals undef)) 23 | (lambda (frame) 24 | #f) 25 | (lambda () 26 | #f))) 27 | 28 | (define (make-unbound-all! var env) 29 | (define undef (if #f #t)) 30 | (scan-environment 31 | var 32 | env 33 | (lambda (vars vals) 34 | ; TODO: The binding should be removed from the frame. 35 | (set-car! vars undef) 36 | (set-car! vals undef)) 37 | (lambda (frame) 38 | (make-unbound-all! var (enclosing-environment env))) 39 | (lambda () 40 | #f))) 41 | -------------------------------------------------------------------------------- /ex-3.77.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.77. The integral procedure used above was analogous to the 2 | ;;; ``implicit'' definition of the infinite stream of integers in section 3 | ;;; 3.5.2. Alternatively, we can give a definition of integral that is more 4 | ;;; like integers-starting-from (also in section 3.5.2): 5 | ;;; 6 | ;;; (define (integral integrand initial-value dt) 7 | ;;; (cons-stream initial-value 8 | ;;; (if (stream-null? integrand) 9 | ;;; the-empty-stream 10 | ;;; (integral (stream-cdr integrand) 11 | ;;; (+ (* dt (stream-car integrand)) 12 | ;;; initial-value) 13 | ;;; dt)))) 14 | ;;; 15 | ;;; When used in systems with loops, this procedure has the same problem as 16 | ;;; does our original version of integral. Modify the procedure so that it 17 | ;;; expects the integrand as a delayed argument and hence can be used in the 18 | ;;; solve procedure shown above. 19 | 20 | (define (integral delayed-integrand initial-value dt) 21 | (cons-stream initial-value 22 | (let ([integrand (force delayed-integrand)]) 23 | (if (stream-null? integrand) 24 | the-empty-stream 25 | (integral (delay (stream-cdr integrand)) 26 | (+ (* dt (stream-car integrand)) 27 | initial-value) 28 | dt))))) 29 | -------------------------------------------------------------------------------- /ex-4.33.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.33. Ben Bitdiddle tests the lazy list implementation given 2 | ;;; above by evaluating the expression 3 | ;;; 4 | ;;; (car '(a b c)) 5 | ;;; 6 | ;;; To his surprise, this produces an error. After some thought, he realizes 7 | ;;; that the ``lists'' obtained by reading in quoted expressions are different 8 | ;;; from the lists manipulated by the new definitions of cons, car, and cdr. 9 | ;;; Modify the evaluator's treatment of quoted expressions so that quoted lists 10 | ;;; typed at the driver loop will produce true lazy lists. 11 | 12 | (load "./sec-4.1.1.scm") 13 | (load "./sec-4.1.2.scm") 14 | (load "./sec-4.1.3.scm") 15 | (load "./sec-4.1.4.scm") 16 | (load "./sec-4.2.2.scm") 17 | 18 | (define (text-of-quotation exp) 19 | (let go ((raw-value (cadr exp))) 20 | (cond ((null? raw-value) 21 | '()) 22 | ((pair? raw-value) 23 | (%eval `(cons ',(car raw-value) ',(go (cdr raw-value))) 24 | the-global-environment ; Dirty. 25 | )) 26 | (else 27 | raw-value)))) 28 | 29 | (define code 30 | '((define (cons x y) 31 | (lambda (m) (m x y))) 32 | (define (car z) 33 | (z (lambda (p q) p))) 34 | (define (cdr z) 35 | (z (lambda (p q) q))) 36 | (car '(a b c)) 37 | )) 38 | 39 | (define (main args) 40 | (for-each 41 | (lambda (expr) 42 | (print expr) 43 | (print "==> " (actual-value expr the-global-environment))) 44 | code)) 45 | -------------------------------------------------------------------------------- /ex-4.15.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.15. Given a one-argument procedure `p` and an object `a`, `p` is 2 | > said to “halt” on `a` if evaluating the expression `(p a)` returns a value 3 | > (as opposed to terminating with an error message or running forever). Show 4 | > that it is impossible to write a procedure `halts?` that correctly determines 5 | > whether `p` halts on `a` for any procedure `p` and object `a`. Use the 6 | > following reasoning: If you had such a procedure `halts?`, you could 7 | > implement the following program: 8 | > 9 | > (define (run-forever) (run-forever)) 10 | > 11 | > (define (try p) 12 | > (if (halts? p p) 13 | > (run-forever) 14 | > 'halted)) 15 | > 16 | > Now consider evaluating the expression `(try try)` and show that any possible 17 | > outcome (either halting or running forever) violates the intended behavior of 18 | > `halts?`. [23] 19 | 20 | The definition of `try` means: 21 | 22 | * `try` runs forever if `(p p)` halts, and 23 | * `try` halts if `(p p)` runs forever. 24 | 25 | So that whether `try` halts or not depends on whether `(p p)` halts or not. 26 | 27 | Suppose that `(try try)` halts. But `try` must run forever by definition. 28 | This result contradicts the assumption. 29 | 30 | Suppose that `(try try)` runs forever. But `try` must halt by definition. 31 | This result contradicts the assumption too. 32 | 33 | This contradictions are caused by assuming existence of `halts?`. So that it 34 | is not possible to write `halts?`. 35 | -------------------------------------------------------------------------------- /ex-2.78.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.78. The internal procedures in the scheme-number package are 2 | ;;; essentially nothing more than calls to the primitive procedures +, -, etc. 3 | ;;; It was not possible to use the primitives of the language directly because 4 | ;;; our type-tag system requires that each data object have a type attached to 5 | ;;; it. In fact, however, all Lisp implementations do have a type system, which 6 | ;;; they use internally. Primitive predicates such as symbol? and number? 7 | ;;; determine whether data objects have particular types. Modify the 8 | ;;; definitions of type-tag, contents, and attach-tag from section 2.4.2 so 9 | ;;; that our generic system takes advantage of Scheme's internal type system. 10 | ;;; That is to say, the system should work as before except that ordinary 11 | ;;; numbers should be represented simply as Scheme numbers rather than as pairs 12 | ;;; whose car is the symbol scheme-number. 13 | 14 | (define (attach-tag type-tag contents) 15 | (cond 16 | [(eq? type-tag 'scheme-number) 17 | contents] 18 | [else 19 | (cons type-tag contents)]) 20 | 21 | (define (type-tag datum) 22 | (cond 23 | [(number? datum) 24 | 'scheme-number] 25 | [(pair? datum) 26 | (car datum)] 27 | [else 28 | (error "Bad tagged datum -- TYPE-TAG" datum)])) 29 | 30 | (define (contents datum) 31 | (cond 32 | [(number? datum) 33 | datum] 34 | [(pair? datum) 35 | (cdr datum)] 36 | [else 37 | (error "Bad tagged datum -- CONTENTS" datum)])) 38 | -------------------------------------------------------------------------------- /ex-4.44.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.44. Exercise 2.42 described the ``eight-queens puzzle'' of 2 | ;;; placing queens on a chessboard so that no two attack each other. Write 3 | ;;; a nondeterministic program to solve this puzzle. 4 | 5 | (load "./sec-4.3.3.scm") 6 | 7 | (ambtest '(begin 8 | 9 | (define (valid? qs) 10 | (if (null? qs) 11 | true 12 | (and (valid-one? (car qs) (cdr qs) 1) 13 | (valid? (cdr qs))))) 14 | 15 | (define (valid-one? q qs offset) 16 | (if (null? qs) 17 | true 18 | (and (not (= q (car qs) )) 19 | (not (= q (+ (car qs) offset))) 20 | (not (= q (- (car qs) offset))) 21 | (valid-one? q (cdr qs) (+ offset 1))) 22 | )) 23 | 24 | (define (eight-queen) 25 | (let ((q1 (amb 1 2 3 4 5 6 7 8)) 26 | (q2 (amb 1 2 3 4 5 6 7 8)) 27 | (q3 (amb 1 2 3 4 5 6 7 8)) 28 | (q4 (amb 1 2 3 4 5 6 7 8)) 29 | (q5 (amb 1 2 3 4 5 6 7 8)) 30 | (q6 (amb 1 2 3 4 5 6 7 8)) 31 | (q7 (amb 1 2 3 4 5 6 7 8)) 32 | (q8 (amb 1 2 3 4 5 6 7 8))) 33 | (let ((qs (list q1 q2 q3 q4 q5 q6 q7 q8))) 34 | (require (valid? qs)) 35 | qs 36 | ))) 37 | 38 | (print (eight-queen)) 39 | 40 | )) 41 | -------------------------------------------------------------------------------- /ex-4.1.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.1. Notice that we cannot tell whether the metacircular 2 | ;;; evaluator evaluates operands from left to right or from right to left. Its 3 | ;;; evaluation order is inherited from the underlying Lisp: If the arguments to 4 | ;;; cons in list-of-values are evaluated from left to right, then 5 | ;;; list-of-values will evaluate operands from left to right; and if the 6 | ;;; arguments to cons are evaluated from right to left, then list-of-values 7 | ;;; will evaluate operands from right to left. 8 | ;;; 9 | ;;; Write a version of list-of-values that evaluates operands from left to 10 | ;;; right regardless of the order of evaluation in the underlying Lisp. Also 11 | ;;; write a version of list-of-values that evaluates operands from right to 12 | ;;; left. 13 | 14 | ;; The original version. 15 | (define (list-of-values exps env) 16 | (if (no-operands? exps) 17 | '() 18 | (cons (eval (first-operand exps) env) 19 | (list-of-values (rest-operands exps) env)))) 20 | 21 | ;; Left-to-right version. 22 | (define (list-of-values exps env) 23 | (if (no-operands? exps) 24 | '() 25 | (let ((first-value (eval (first-operand exps) env))) 26 | (cons first-value 27 | (list-of-values (rest-operands exps) env))))) 28 | 29 | ;; Right-to-left version. 30 | (define (list-of-values exps env) 31 | (if (no-operands? exps) 32 | '() 33 | (let ((rest-values (list-of-values (rest-operands exps) env))) 34 | (cons (eval (first-operand exps) env) 35 | rest-values)))) 36 | -------------------------------------------------------------------------------- /ex-4.18.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.18. Consider an alternative strategy for scanning out 2 | > definitions that translates the example in the text to 3 | > 4 | > ```scheme 5 | > (lambda 6 | > (let ((u '*unassigned*) 7 | > (v '*unassigned*)) 8 | > (let ((a ) 9 | > (b )) 10 | > (set! u a) 11 | > (set! v b)) 12 | > )) 13 | > ``` 14 | > 15 | > Here a and b are meant to represent new variable names, created by the 16 | > interpreter, that do not appear in the user's program. Consider the solve 17 | > procedure from section 3.5.4: 18 | > 19 | > ```scheme 20 | > (define (solve f y0 dt) 21 | > (define y (integral (delay dy) y0 dt)) 22 | > (define dy (stream-map f y)) 23 | > y) 24 | > ``` 25 | > 26 | > Will this procedure work if internal definitions are scanned out as shown 27 | > in this exercise? What if they are scanned out as shown in the text? 28 | > Explain. 29 | 30 | It depends on the order of evaluation on arguments to a procedure. 31 | `solve` works if arguments are evaluated from left to right. 32 | Otherwise it does not work. Because: 33 | 34 | * The scanned-out code in this exercise uses `let`. `let` is defined by 35 | a combination of a `lambda`. And the order of evaluation on subexpressions 36 | of a combination depends on how the interpreter is implemented. 37 | * But `y` must be defined when evaluating `dy`. 38 | 39 | `solve` works if the internal definitions are scanned out as shown in the text, 40 | because `` is always evaluated before `` in the scanned-out code. 41 | -------------------------------------------------------------------------------- /ex-4.9.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.9. Many languages support a variety of iteration constructs, 2 | ;;; such as do, for, while, and until. In Scheme, iterative processes can be 3 | ;;; expressed in terms of ordinary procedure calls, so special iteration 4 | ;;; constructs provide no essential gain in computational power. On the other 5 | ;;; hand, such constructs are often convenient. Design some iteration 6 | ;;; constructs, give examples of their use, and show how to implement them as 7 | ;;; derived expressions. 8 | 9 | ;; Let's implement C language-like `for` statement. It can be used as follows: 10 | ;; 11 | ;; (for (i 0) (< i 5) (+ i 1) 12 | ;; (display i) 13 | ;; (newline)) 14 | ;; 15 | ;; The above expression can be translated as follows: 16 | ;; 17 | ;; (let go ((i 0)) 18 | ;; (if (< i 5) 19 | ;; (begin 20 | ;; (display i) 21 | ;; (newline) 22 | ;; (go (+ i 1))))) 23 | 24 | (define (for? exp) 25 | (tagged-list? exp 'for)) 26 | 27 | (define (for-var exp) 28 | (car (cadr exp))) 29 | 30 | (define (for-initial exp) 31 | (cadr (cadr exp))) 32 | 33 | (define (for-condition exp) 34 | (caddr exp)) 35 | 36 | (define (for-update exp) 37 | (cadddr exp)) 38 | 39 | (define (for-body exp) 40 | (cddddr exp)) 41 | 42 | (define (for->named-let exp) 43 | (list 'let 'go (list (list (for-var exp) (for-initial exp))) 44 | (list 'if (for-condition exp) 45 | (cons 46 | (cons 'begin (for-body exp)) 47 | (list 'go (for-update exp)))))) 48 | -------------------------------------------------------------------------------- /ex-3.17.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.17. Devise a correct version of the `count-pairs` procedure of 2 | ;;; exercise 3.16 that returns the number of distinct pairs in any structure. 3 | ;;; (Hint: Traverse the structure, maintaining an auxiliary data structure that 4 | ;;; is used to keep track of which pairs have already been counted.) 5 | 6 | (define (wrong-count-pairs x) 7 | (if (not (pair? x)) 8 | 0 9 | (+ (wrong-count-pairs (car x)) 10 | (wrong-count-pairs (cdr x)) 11 | 1))) 12 | 13 | ; With set!. 14 | (define (count-pairs x) 15 | (define visited '()) 16 | (define (go x) 17 | (if (and (pair? x) (not (memq x visited))) 18 | (begin 19 | (set! visited (cons x visited)) 20 | (+ (go (car x)) 21 | (go (cdr x)) 22 | 1)) 23 | 0)) 24 | (go x)) 25 | 26 | ; Without set!. 27 | (define (count-pairs x) 28 | (car 29 | (let go ([x x] 30 | [visited '()]) 31 | (if (and (pair? x) (not (memq x visited))) 32 | (let* ([p-car (go (car x) (cons x visited))] 33 | [p-cdr (go (cdr x) (cdr p-car))]) 34 | (cons (+ (car p-car) (car p-cdr) 1) (cdr p-cdr))) 35 | (cons 0 visited))))) 36 | 37 | 38 | 39 | 40 | (load "./sec-3.3-sample-lists.scm") 41 | 42 | (print (zap z3) " ==> " (count-pairs z3) " vs " (wrong-count-pairs z3)) 43 | (print (zap z4) " ==> " (count-pairs z4) " vs " (wrong-count-pairs z4)) 44 | (print (zap z7) " ==> " (count-pairs z7) " vs " (wrong-count-pairs z7)) 45 | (print (zap z*) " ==> " (count-pairs z*) " vs " "...") 46 | -------------------------------------------------------------------------------- /ex-3.71.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.71. Numbers that can be expressed as the sum of two cubes in 2 | ;;; more than one way are sometimes called Ramanujan numbers, in honor of the 3 | ;;; mathematician Srinivasa Ramanujan.[70] Ordered streams of pairs provide an 4 | ;;; elegant solution to the problem of computing these numbers. To find 5 | ;;; a number that can be written as the sum of two cubes in two different ways, 6 | ;;; we need only generate the stream of pairs of integers (i,j) weighted 7 | ;;; according to the sum i^3 + j^3 (see exercise 3.70), then search the stream 8 | ;;; for two consecutive pairs with the same weight. Write a procedure to 9 | ;;; generate the Ramanujan numbers. The first such number is 1,729. What are 10 | ;;; the next five? 11 | 12 | (load "./sec-3.5.scm") 13 | (load "./ex-3.70.scm") 14 | 15 | (define (ramanujan-numbers) 16 | (define (cube x) 17 | (* x x x)) 18 | (define (weight ij) 19 | (+ (cube (car ij)) 20 | (cube (cadr ij)))) 21 | (define s (weighted-pairs 22 | integers 23 | integers 24 | weight)) 25 | (define (drop-unique s) 26 | (let go ([s s] 27 | [w0 0] 28 | [w1 (weight (stream-car s))]) 29 | (if (= w0 w1) 30 | (cons-stream w1 (go (stream-cdr s) w1 (weight (stream-car (stream-cdr s))))) 31 | (go (stream-cdr s) w1 (weight (stream-car (stream-cdr s)))) 32 | ))) 33 | (drop-unique s) 34 | ) 35 | 36 | (define s (ramanujan-numbers)) 37 | (do ((i 0 (+ i 1))) 38 | ((= i 30)) 39 | (print (stream-ref s i))) 40 | -------------------------------------------------------------------------------- /ex-3.6.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.6. It is useful to be able to reset a random-number generator 2 | ;;; to produce a sequence starting from a given value. Design a new rand 3 | ;;; procedure that is called with an argument that is either the symbol 4 | ;;; generate or the symbol reset and behaves as follows: (rand 'generate) 5 | ;;; produces a new random number; ((rand 'reset) ) resets the 6 | ;;; internal state variable to the designated . Thus, by resetting 7 | ;;; the state, one can generate repeatable sequences. These are very handy to 8 | ;;; have when testing and debugging programs that use random numbers. 9 | 10 | (define (rand-update x) 11 | (let ([m (expt 2 31)] 12 | [a 1103515245] 13 | [b 12345]) 14 | (mod (+ (* a x) b) m))) 15 | 16 | (define rand 17 | (let ([x 0]) 18 | (lambda (message) 19 | (cond [(eq? message 'generate) 20 | (set! x (rand-update x)) 21 | x] 22 | [(eq? message 'reset) 23 | (lambda (new-value) 24 | (set! x new-value))] 25 | [else 26 | (error "Unknown message for RAND: " message)])))) 27 | 28 | (define (main args) 29 | ((rand 'reset) 1024) 30 | (print (rand 'generate)) 31 | ;=> 423224377 32 | (print (rand 'generate)) 33 | ;=> 1581628030 34 | (print (rand 'generate)) 35 | ;=> 502725599 36 | 37 | ((rand 'reset) 1024) 38 | (print (rand 'generate)) 39 | ;=> 423224377 40 | (print (rand 'generate)) 41 | ;=> 1581628030 42 | (print (rand 'generate)) 43 | ;=> 502725599 44 | ) 45 | -------------------------------------------------------------------------------- /ex-3.62.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.62. Use the results of exercises 3.60 and 3.61 to define 2 | ;;; a procedure div-series that divides two power series. Div-series should 3 | ;;; work for any two series, provided that the denominator series begins with 4 | ;;; a nonzero constant term. (If the denominator has a zero constant term, then 5 | ;;; div-series should signal an error.) Show how to use div-series together 6 | ;;; with the result of exercise 3.59 to generate the power series for tangent. 7 | 8 | (load "./sec-3.5.scm") 9 | (load "./ex-3.59.scm") 10 | (load "./ex-3.60.scm") 11 | (load "./ex-3.61.scm") 12 | 13 | (define (invert-series S) 14 | (define X (scale-stream 15 | (cons-stream 1 16 | (mul-series (scale-stream (stream-cdr S) -1) 17 | X)) 18 | (/ 1 (stream-car S)))) 19 | X) 20 | 21 | (define (div-series psn psd) 22 | (if (= (stream-car psd) 0) 23 | (error "div-series: Denominator must begin with a nonzero constant term")) 24 | (mul-series psn (invert-series psd))) 25 | 26 | (define tangent-series (div-series sine-series cosine-series)) 27 | 28 | (define zeros (cons-stream 0 zeros)) 29 | (define one (cons-stream 1 zeros)) 30 | (define two-or-more (stream-cdr integers)) 31 | (define x (mul-series two-or-more (div-series one two-or-more))) 32 | 33 | (define ss (list tangent-series x)) 34 | 35 | (for-each 36 | (lambda (s) 37 | (do ((i 0 (+ i 1))) 38 | ((= i 30)) 39 | (display (stream-ref s i)) 40 | (display ", ")) 41 | (display "...\n")) 42 | ss) 43 | -------------------------------------------------------------------------------- /ex-1.9.md: -------------------------------------------------------------------------------- 1 | > Exercise 1.9. Each of the following two procedures defines a method for 2 | > adding two positive integers in terms of the procedures inc, which increments 3 | > its argument by 1, and dec, which decrements its argument by 1. 4 | > 5 | > (define (+ a b) 6 | > (if (= a 0) 7 | > b 8 | > (inc (+ (dec a) b)))) 9 | > 10 | > (define (+ a b) 11 | > (if (= a 0) 12 | > b 13 | > (+ (dec a) (inc b)))) 14 | > 15 | > Using the substitution model, illustrate the process generated by each 16 | > procedure in evaluating (+ 4 5). Are these processes iterative or recursive? 17 | 18 | The former is evaluated as follos: 19 | 20 | (+ 4 5) 21 | (if (= 4 0) 5 (inc (+ (dec 4) 5))) 22 | (inc (+ (dec 4) 5)) 23 | (inc (+ 3 5)) 24 | (inc (if (= 3 0) 5 (inc (+ (dec 3) 5)))) 25 | (inc (inc (+ (dec 3) 5))) 26 | (inc (inc (+ 2 5))) 27 | ... 28 | (inc (inc (inc (+ 1 5)))) 29 | ... 30 | (inc (inc (inc (inc (+ 0 5))))) 31 | (inc (inc (inc (inc (if (= 0 0) 5 (inc (+ (dec 0) 5))))))) 32 | (inc (inc (inc (inc 5)))) 33 | (inc (inc (inc 6))) 34 | (inc (inc 7)) 35 | (inc 8) 36 | 9 37 | 38 | Therefore the former is recursive. 39 | 40 | The latter is evaluatd as follows: 41 | 42 | (+ 4 5) 43 | (if (= 4 0) 5 (+ (dec 4) (inc 5))) 44 | (+ (dec 4) (inc 5)) 45 | (+ 3 6) 46 | (if (= 3 0) 6 (+ (dec 3) (inc 6))) 47 | (+ (dec 3) (inc 6)) 48 | (+ 2 7) 49 | ... 50 | (+ 1 8) 51 | ... 52 | (+ 0 9) 53 | (if (= 0 0) 9 (+ (dec 0) (inc 9))) 54 | 9 55 | 56 | Therefore the latter is iterative. 57 | -------------------------------------------------------------------------------- /ex-4.5.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.5. Scheme allows an additional syntax for cond clauses, ( 2 | ;;; => ). If evaluates to a true value, then is 3 | ;;; evaluated. Its value must be a procedure of one argument; this procedure is 4 | ;;; then invoked on the value of the , and the result is returned as the 5 | ;;; value of the cond expression. For example 6 | ;;; 7 | ;;; (cond ((assoc 'b '((a 1) (b 2))) => cadr) 8 | ;;; (else false)) 9 | ;;; 10 | ;;; returns 2. Modify the handling of cond so that it supports this extended 11 | ;;; syntax. 12 | 13 | (define (expand-clauses clauses) 14 | (if (null? clauses) 15 | 'false ; no else clause 16 | (let ((first (car clauses)) 17 | (rest (cdr clauses))) 18 | (cond [(cond-else-clause? first) 19 | (if (null? rest) 20 | (sequence->exp (cond-actions first)) 21 | (error "ELSE clause isn't last -- COND->IF" 22 | clauses))] 23 | [(cond-extended-clause? first) 24 | `(let ((result ,(cond-predicate first))) 25 | (if result 26 | (,(cond-recipient first) result) 27 | ,(expand-clauses rest)))] 28 | [else 29 | (make-if (cond-predicate first) 30 | (sequence->exp (cond-actions first)) 31 | (expand-clauses rest))])))) 32 | 33 | (define (cond-extended-clause? clause) 34 | (tagged-list? (cdr clause) '=>)) 35 | 36 | (define (cond-recipient clause) 37 | (caddr clause)) 38 | -------------------------------------------------------------------------------- /ex-1.7.md: -------------------------------------------------------------------------------- 1 | > Exercise 1.7. The `good-enough?` test used in computing square roots will 2 | > not be very effective for finding the square roots of very small numbers. 3 | > Also, in real computers, arithmetic operations are almost always performed 4 | > with limited precision. This makes our test inadequate for very large 5 | > numbers. Explain these statements, with examples showing how the test fails 6 | > for small and large numbers. 7 | 8 | 0.001 is not a good threshold for very small numbers. 9 | For example: 10 | 11 | (square 0.03) 12 | 0.0009 13 | 14 | (sqrt 0.0009) 15 | 0.04030062264654547 16 | 17 | Because 0.001 is relatively larger than a given number 0.0009. 18 | 19 | TODO: 0.001 is not a good threshold also for very large numbers. 20 | For example: 21 | 22 | (square ...) 23 | ... 24 | 25 | (sqrt ...) 26 | ... 27 | 28 | > An alternative strategy for implementing `good-enough?` is to watch how guess 29 | > changes from one iteration to the next and to stop when the change is a very 30 | > small fraction of the guess. Design a square-root procedure that uses this 31 | > kind of end test. Does this work better for small and large numbers? 32 | 33 | Precision of numbers are limited in real computers. 34 | In other words, there is a lower bound which real computers can operate. 35 | If we iterate `improve` many times, we will reach a number which can not be `improve`d anymore. 36 | 37 | (define (good-enough? guess x) 38 | (= guess (improve guess x))) 39 | 40 | (sqrt 0.0009) 41 | 0.03 42 | 43 | (sqrt ...) 44 | TODO... 45 | -------------------------------------------------------------------------------- /ex-3.63.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.63. Louis Reasoner asks why the `sqrt-stream` procedure was not 2 | > written in the following more straightforward way, without the local variable 3 | > guesses: 4 | > 5 | > ```scheme 6 | > (define (sqrt-stream x) 7 | > (cons-stream 1.0 8 | > (stream-map (lambda (guess) 9 | > (sqrt-improve guess x)) 10 | > (sqrt-stream x)))) 11 | > ``` 12 | > 13 | > Alyssa P. Hacker replies that this version of the procedure is considerably 14 | > less efficient because it performs redundant computation. Explain Alyssa's 15 | > answer. Would the two versions still differ in efficiency if our 16 | > implementation of `delay` used only `(lambda () )` without using the 17 | > optimization provided by `memo-proc` (section 3.5.1)? 18 | 19 | The original version is: 20 | 21 | ```scheme 22 | (define (sqrt-stream x) 23 | (define guesses 24 | (cons-stream 1.0 25 | (stream-map (lambda (guess) 26 | (sqrt-improve guess x)) 27 | guesses))) 28 | guesses) 29 | ``` 30 | 31 | Though Louis' version produces the same result as the original version, 32 | Louis' version doesn't reuse an existing stream to compute more terms. 33 | To compute the n-th term with Louis' version, streams are created 34 | 1 + 2 + ... + n-1 + n times. So that it's very inefficient. 35 | 36 | If results of `delay`ed expressions are not memoized, 37 | it means that terms of streams are not memoized. 38 | Therefore two versions does not differ. Both become inefficient. 39 | -------------------------------------------------------------------------------- /ex-4.3.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.3. Rewrite eval so that the dispatch is done in data-directed 2 | ;;; style. Compare this with the data-directed differentiation procedure of 3 | ;;; exercise 2.73. (You may use the car of a compound expression as the type of 4 | ;;; the expression, as is appropriate for the syntax implemented in this 5 | ;;; section.) . 6 | 7 | (define (eval exp env) 8 | ((or (get 'eval (exp-type exp)) 9 | eval-application) 10 | exp 11 | env)) 12 | 13 | (define (exp-type exp) 14 | (cond ((self-evaluating? exp) '(self-evaluating)) 15 | ((variable? exp) '(variable)) 16 | ((pair? exp) (car exp)) 17 | (else '(unknown)))) 18 | 19 | (put 'eval '(self-evaluating) (lambda (exp env) exp)) 20 | (put 'eval '(variable) lookup-variable-value) 21 | (put 'eval '(unknown) 22 | (lambda (exp env) 23 | (error "Unknown expression type -- EVAL" exp))) 24 | 25 | (put 'eval 'quote (lambda (exp env) (text-of-quotation exp))) 26 | (put 'eval 'set! eval-assignment) 27 | (put 'eval 'define eval-definition) 28 | (put 'eval 'if eval-if) 29 | (put 'eval 'lambda 30 | (lambda (exp env) 31 | (make-procedure (lambda-parameters exp) 32 | (lambda-body exp) 33 | env))) 34 | (put 'eval 'begin 35 | (lambda (exp env) 36 | (eval-sequence (begin-actions exp) env))) 37 | (put 'eval 'cond 38 | (lambda (exp env) 39 | ((cond? exp) (eval (cond->if exp) env)))) 40 | 41 | (define (eval-application exp env) 42 | (apply (eval (operator exp) env) 43 | (list-of-values (operands exp) env))) 44 | -------------------------------------------------------------------------------- /ex-3.72.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.72. In a similar way to exercise 3.71 generate a stream of all 2 | ;;; numbers that can be written as the sum of two squares in three different 3 | ;;; ways (showing how they can be so written). 4 | 5 | (load "./sec-3.5.scm") 6 | (load "./ex-3.70.scm") 7 | 8 | (define (group-by s key) 9 | (if (stream-null? s) 10 | the-empty-stream 11 | (let go ([s (stream-cdr s)] 12 | [w0 (key (stream-car s))] 13 | [es (list (stream-car s))]) 14 | (cond [(stream-null? s) 15 | (cons-stream (cons w0 es) the-empty-stream)] 16 | [(= w0 (key (stream-car s))) 17 | (go (stream-cdr s) 18 | w0 19 | (cons (stream-car s) es))] 20 | [else 21 | (cons-stream (cons w0 es) 22 | (go (stream-cdr s) 23 | (key (stream-car s)) 24 | (list (stream-car s))))])))) 25 | 26 | (define (s-numbers) 27 | (define (weight ij) 28 | (+ (square (car ij)) 29 | (square (cadr ij)))) 30 | (stream-filter (lambda (k-es) 31 | (= (length (cdr k-es)) 3)) 32 | (group-by (weighted-pairs integers integers weight) 33 | weight))) 34 | 35 | (use util.match) 36 | (do ([i 0 (+ i 1)] 37 | [s (s-numbers) (stream-cdr s)]) 38 | ((= i 10)) 39 | (match (stream-car s) 40 | [(sum (a1 b1) (a2 b2) (a3 b3)) 41 | (format #t "~4d = ~2d^2 + ~2d^2 = ~2d^2 + ~2d^2 = ~2d^2 + ~2d^2\n" 42 | sum a1 b1 a2 b2 a3 b3)])) 43 | -------------------------------------------------------------------------------- /ex-4.7.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.7. Let* is similar to let, except that the bindings of the let 2 | ;;; variables are performed sequentially from left to right, and each binding 3 | ;;; is made in an environment in which all of the preceding bindings are 4 | ;;; visible. For example 5 | ;;; 6 | ;;; (let* ((x 3) 7 | ;;; (y (+ x 2)) 8 | ;;; (z (+ x y 5))) 9 | ;;; (* x z)) 10 | ;;; 11 | ;;; returns 39. 12 | 13 | 14 | ;;; Explain how a let* expression can be rewritten as a set of nested let 15 | ;;; expressions, 16 | 17 | ; The example code can be rewritten as follows: 18 | 19 | (let ((x 3)) 20 | (let ((y (+ y 2))) 21 | (let ((z (+ x y 5))) 22 | (* x z)))) 23 | 24 | 25 | ;;; and write a procedure let*->nested-lets that performs this transformation. 26 | 27 | (require "./ex-4.6.scm") 28 | 29 | (define (let*->nested-lets exp) 30 | (define (go clauses) 31 | (if (null? clauses) 32 | (let-body expr) 33 | (list 'let (list (list (let-clause-var (car clauses)) 34 | (let-clause-value-exp (car clauses)))) 35 | (go (cdr clauses))))) 36 | (go (let-clauses exp))) 37 | 38 | 39 | ;;; If we have already implemented let (exercise 4.6) and we want to extend the 40 | ;;; evaluator to handle let*, is it sufficient to add a clause to eval whose 41 | ;;; action is 42 | ;;; 43 | ;;; (eval (let*->nested-lets exp) env) 44 | ;;; 45 | ;;; or must we explicitly expand let* in terms of non-derived expressions? 46 | 47 | ; Our eval can handle LET as if it is a non-derived expression. So that the 48 | ; above action is sufficient to support LET*. 49 | -------------------------------------------------------------------------------- /ex-4.66.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.66. Ben has been generalizing the query system to provide 2 | > statistics about the company. For example, to find the total salaries of all 3 | > the computer programmers one will be able to say 4 | > 5 | > ```scheme 6 | > (sum ?amount 7 | > (and (job ?x (computer programmer)) 8 | > (salary ?x ?amount))) 9 | > ``` 10 | > 11 | > In general, Ben's new system allows expressions of the form 12 | > 13 | > ```scheme 14 | > (accumulation-function 15 | > ) 16 | > ``` 17 | > 18 | > where `accumulation-function` can be things like `sum`, `average`, or 19 | > `maximum`. Ben reasons that it should be a cinch to implement this. He will 20 | > simply feed the query pattern to `qeval`. This will produce a stream of 21 | > frames. He will then pass this stream through a mapping function that 22 | > extracts the value of the designated variable from each frame in the stream 23 | > and feed the resulting stream of values to the accumulation function. Just as 24 | > Ben completes the implementation and is about to try it out, Cy walks by, 25 | > still puzzling over the `wheel` query result in exercise 4.65. When Cy shows 26 | > Ben the system's response, Ben groans, ``Oh, no, my simple accumulation 27 | > scheme won't work!'' 28 | 29 | 30 | 31 | 32 | > What has Ben just realized? 33 | 34 | Responses from the system might be duplicated because the system deduce answers 35 | from the data base for each employee. 36 | 37 | 38 | 39 | 40 | > Outline a method he can use to salvage the situation. 41 | 42 | Write which lists no duplicates like Exercise 4.60. 43 | -------------------------------------------------------------------------------- /ex-2.68.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-2.3.4.scm") 2 | 3 | ;;; Exercise 2.68. 4 | ;;; 5 | ;;; The encode procedure takes as arguments a message and a tree and produces 6 | ;;; the list of bits that gives the encoded message. 7 | 8 | (define (encode message tree) 9 | (if (null? message) 10 | '() 11 | (append (encode-symbol (car message) tree) 12 | (encode (cdr message) tree)))) 13 | 14 | ;;; Encode-symbol is a procedure, which you must write, that returns the list 15 | ;;; of bits that encodes a given symbol according to a given tree. You should 16 | ;;; design encode-symbol so that it signals an error if the symbol is not in 17 | ;;; the tree at all. Test your procedure by encoding the result you obtained 18 | ;;; in exercise 2.67 with the sample tree and seeing whether it is the same as 19 | ;;; the original sample message. 20 | 21 | (define (encode-symbol symbol tree) 22 | (cond [(leaf? tree) 23 | '()] 24 | [(memq symbol (symbols (left-branch tree))) 25 | (cons 0 26 | (encode-symbol symbol (left-branch tree)))] 27 | [(memq symbol (symbols (right-branch tree))) 28 | (cons 1 29 | (encode-symbol symbol (right-branch tree)))] 30 | [else 31 | (error "Unknown symbol -- ENCODE-SYMBOL" symbol)])) 32 | 33 | (load "./ex-2.67.scm") 34 | 35 | (print (encode (decode sample-message sample-tree) sample-tree)) 36 | (print (equal? sample-message 37 | (encode (decode sample-message sample-tree) sample-tree))) 38 | (print (encode '(A B C D) sample-tree)) 39 | ; (print (encode '(A B C D E) sample-tree)) 40 | ; ==> gosh: "error": Unknown symbol -- ENCODE-SYMBOL E 41 | -------------------------------------------------------------------------------- /ex-3.2.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.2. In software-testing applications, it is useful to be able to 2 | ;;; count the number of times a given procedure is called during the course of 3 | ;;; a computation. Write a procedure make-monitored that takes as input 4 | ;;; a procedure, f, that itself takes one input. The result returned by 5 | ;;; make-monitored is a third procedure, say mf, that keeps track of the number 6 | ;;; of times it has been called by maintaining an internal counter. If the 7 | ;;; input to mf is the special symbol how-many-calls?, then mf returns the 8 | ;;; value of the counter. If the input is the special symbol reset-count, then 9 | ;;; mf resets the counter to zero. For any other input, mf returns the result 10 | ;;; of calling f on that input and increments the counter. For instance, we 11 | ;;; could make a monitored version of the sqrt procedure: 12 | ;;; 13 | ;;; (define s (make-monitored sqrt)) 14 | ;;; 15 | ;;; (s 100) 16 | ;;; 10 17 | ;;; 18 | ;;; (s 'how-many-calls?) 19 | ;;; 1 20 | 21 | (define (make-monitored f) 22 | (let ([called-count 0]) 23 | (lambda (x) 24 | (cond 25 | [(eq? x 'how-many-calls?) 26 | called-count] 27 | [(eq? x 'reset-count) 28 | (set! called-count 0)] 29 | [else 30 | (set! called-count (+ called-count 1)) 31 | (f x)])))) 32 | 33 | 34 | (define s (make-monitored sqrt)) 35 | 36 | (print (s 'how-many-calls?)) 37 | ;=> 0 38 | 39 | (print (s 100)) 40 | ;=> 10 41 | 42 | (print (s 16)) 43 | ;=> 4 44 | 45 | (print (s 'how-many-calls?)) 46 | ;=> 2 47 | 48 | (s 'reset-count) 49 | (print (s 'how-many-calls?)) 50 | ;=> 0 51 | -------------------------------------------------------------------------------- /ex-4.65.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.65. Cy D. Fect, looking forward to the day when he will rise in 2 | > the organization, gives a query to find all the wheels (using the wheel rule 3 | > of section 4.4.1): 4 | > 5 | > ```scheme 6 | > (wheel ?who) 7 | > ``` 8 | > 9 | > To his surprise, the system responds 10 | > 11 | > ```scheme 12 | > ;;; Query results: 13 | > (wheel (Warbucks Oliver)) 14 | > (wheel (Bitdiddle Ben)) 15 | > (wheel (Warbucks Oliver)) 16 | > (wheel (Warbucks Oliver)) 17 | > (wheel (Warbucks Oliver)) 18 | > ``` 19 | > 20 | > Why is Oliver Warbucks listed four times? 21 | 22 | Because the system responds the wheel for each employees. 23 | 24 | Warbucks Oliver 25 | | 26 | _______________|______________ 27 | | | | 28 | Aull DeWitt Bitdiddle Ben Scrooge Eben 29 | | |_____________________ 30 | _______________|__________________ | 31 | | | | | 32 | Fect Cy D Hacker Alyssa P Tweakit Lem E Cratchet Robert 33 | | 34 | | 35 | | 36 | Reasoner Louis 37 | 38 | From the above employee tree, 39 | 40 | * Aull DeWitt doesn't have a wheel. 41 | * Bitdiddle Ben doesn't have a wheel. 42 | * Scrooge Eben doesn't have a wheel. 43 | * Fect Cy D has a wheel who is Warbucks Oliver. 44 | * Hacker Alyssa P has a wheel who is Warbucks Oliver. 45 | * Tweakit Lem E has a wheel who is Warbucks Oliver. 46 | * Cratchet Robert has a wheel who is Warbucks Oliver. 47 | * Reasoner Louis has a wheel who is Ben Bitdiddle. 48 | -------------------------------------------------------------------------------- /ex-2.65.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.65. Use the results of exercises 2.63 and 2.64 to give O(n) 2 | ;;; implementations of union-set and intersection-set for sets implemented as 3 | ;;; (balanced) binary trees. 4 | 5 | ; Copied from "Sets as ordered lists". 6 | (define (%intersection-set set1 set2) 7 | (if (or (null? set1) (null? set2)) 8 | '() 9 | (let ((x1 (car set1)) (x2 (car set2))) 10 | (cond [(= x1 x2) 11 | (cons x1 12 | (%intersection-set (cdr set1) 13 | (cdr set2)))] 14 | [(< x1 x2) 15 | (%intersection-set (cdr set1) set2)] 16 | [(< x2 x1) 17 | (%intersection-set set1 (cdr set2))])))) 18 | 19 | ; Copied from ex-2.62.scm 20 | (define (%union-set set1 set2) 21 | (cond [(null? set1) set2] 22 | [(null? set2) set1] 23 | [else 24 | (let ([x1 (car set1)] 25 | [x2 (car set2)]) 26 | (cond ([= x1 x2] 27 | (cons x1 (%union-set (cdr set1) (cdr set2)))) 28 | ([< x1 x2] 29 | (cons x1 (%union-set (cdr set1) set2))) 30 | ([< x2 x1] 31 | (cons x2 (%union-set set1 (cdr set2))))))])) 32 | 33 | (load "./ex-2.63.scm") 34 | (define tree->list tree->list-2) 35 | 36 | (load "./ex-2.64.scm") 37 | 38 | (define (union-set set1 set2) 39 | (let ([list1 (tree->list set1)] 40 | [list2 (tree->list set2)]) 41 | (list->tree (%union-set list1 list2)))) 42 | 43 | (define (intersection-set set1 set2) 44 | (let ([list1 (tree->list set1)] 45 | [list2 (tree->list set2)]) 46 | (list->tree (%intersection-set list1 list2)))) 47 | -------------------------------------------------------------------------------- /ex-3.57.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.57. How many additions are performed when we compute the *n*th 2 | > Fibonacci number using the definition of `fibs` based on the `add-streams` 3 | > procedure? Show that the number of additions would be exponentially greater 4 | > if we had implemented `(delay )` simply as `(lambda () )`, without 5 | > using the optimization provided by the `memo-proc` procedure described in 6 | > section 3.5.1. [64] 7 | 8 | ```scheme 9 | (define fibs 10 | (cons-stream 0 11 | (cons-stream 1 12 | (add-streams (stream-cdr fibs) 13 | fibs)))) 14 | ``` 15 | 16 | Let's denote a(n) for the number of additions to compute the n-th Fibonacci number. 17 | 18 | * The number of additions performed by `(add-streams s1 s2)` is equal to the 19 | minimum length of `s1` and `s2`. If the minimum length is n, the number of 20 | additions is also n. 21 | * `cons-stream` delays evaluation of its cdr. And the result of a delayed 22 | expression is memoized. 23 | 24 | So that 25 | 26 | * a(1) = a(2) = 0 27 | * a(n) = n - 2 28 | 29 | If `cons-stream` doesn't memoize its cdr part, 30 | 31 | * a(1) = a(2) = 0 32 | * a(n) = a(n - 1) + a(n - 2) + 1 33 | 34 | For example, 35 | 36 | * a(3) = a(2) + a(1) + 1 = 0 + 0 + 1 37 | * a(4) = a(3) + a(2) + 1 = 1 + 0 + 1 = 2 38 | * a(5) = a(4) + a(3) + 1 = 2 + 1 + 1 = 4 39 | * a(6) = a(5) + a(4) + 1 = 4 + 2 + 1 = 7 40 | * a(7) = a(6) + a(5) + 1 = 7 + 4 + 1 = 12 41 | * a(8) = a(7) + a(6) + 1 = 12 + 7 + 1 = 20 42 | * a(9) = a(8) + a(7) + 1 = 20 + 12 + 1 = 33 43 | * ... 44 | 45 | It is a series of sums of Fibonacci numbers, 46 | and it is exponentially greater than memoized one. 47 | -------------------------------------------------------------------------------- /ex-4.27.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.27. Suppose we type in the following definitions to the lazy 2 | ;;; evaluator: 3 | ;;; 4 | ;;; (define count 0) 5 | ;;; (define (id x) 6 | ;;; (set! count (+ count 1)) 7 | ;;; x) 8 | ;;; 9 | ;;; Give the missing values in the following sequence of interactions, and 10 | ;;; explain your answers. [38] 11 | ;;; 12 | ;;; (define w (id (id 10))) 13 | ;;; ;;; L-Eval input: 14 | ;;; count 15 | ;;; ;;; L-Eval value: 16 | ;;; 17 | ;;; ;;; L-Eval input: 18 | ;;; w 19 | ;;; ;;; L-Eval value: 20 | ;;; 21 | ;;; ;;; L-Eval input: 22 | ;;; count 23 | ;;; ;;; L-Eval value: 24 | ;;; 25 | 26 | ; The first is 1. The outer call of id is already evaluated at that 27 | ; moment, but the inner call of id is delayed and it is not forced yet. 28 | ; 29 | ; The second is 10. id returns the given argument as is. So that 30 | ; (id 10) returns 10, and (id (id 10)) returns 10 too. 31 | ; 32 | ; The third is 2. w is bound to the result of (id 10), and it is 33 | ; already forced to print the actual value of w. 34 | 35 | 36 | (load "./sec-4.1.1.scm") 37 | (load "./sec-4.1.2.scm") 38 | (load "./sec-4.1.3.scm") 39 | (load "./sec-4.1.4.scm") 40 | (load "./sec-4.2.2.scm") 41 | 42 | (for-each 43 | (lambda (expr) 44 | (print expr) 45 | (print "==> " (actual-value expr the-global-environment))) 46 | '((define count 0) 47 | (define (id x) 48 | (set! count (+ count 1)) 49 | x) 50 | (define w (id (id 10))) 51 | count 52 | w 53 | count 54 | ; (define (unless p t e) 55 | ; (if p e t)) 56 | ; (unless true (+ 'a 'b) (+ 1 2)) 57 | )) 58 | -------------------------------------------------------------------------------- /ex-3.35.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.35. Ben Bitdiddle tells Louis that one way to avoid the trouble 2 | ;;; in exercise 3.34 is to define a squarer as a new primitive constraint. Fill 3 | ;;; in the missing portions in Ben's outline for a procedure to implement such 4 | ;;; a constraint: 5 | ;;; 6 | ;;; (define (squarer a b) 7 | ;;; (define (process-new-value) 8 | ;;; (if (has-value? b) 9 | ;;; (if (< (get-value b) 0) 10 | ;;; (error "square less than 0 -- SQUARER" (get-value b)) 11 | ;;; ) 12 | ;;; )) 13 | ;;; (define (process-forget-value) ) 14 | ;;; (define (me request) ) 15 | ;;; 16 | ;;; me) 17 | 18 | (load "./sec-3.3.5.scm") 19 | 20 | 21 | (define (squarer a b) 22 | (define (process-new-value) 23 | (if (has-value? b) 24 | (if (< (get-value b) 0) 25 | (error "square less than 0 -- SQUARER" (get-value b)) 26 | (set-value! a (sqrt (get-value b)) me)) 27 | (if (has-value? a) 28 | (set-value! b (* (get-value a) (get-value a)) me)))) 29 | (define (process-forget-value) 30 | (forget-value! a me) 31 | (forget-value! b me) 32 | (process-new-value)) 33 | (define (me request) 34 | (cond ((eq? request 'I-have-a-value) 35 | (process-new-value)) 36 | ((eq? request 'I-lost-my-value) 37 | (process-forget-value)) 38 | (else 39 | (error "Unknown request -- SQUARER" request)))) 40 | (connect a me) 41 | (connect b me) 42 | me) 43 | 44 | 45 | (define a (make-connector)) 46 | (define b (make-connector)) 47 | (squarer a b) 48 | (probe "A" a) 49 | (probe "B" b) 50 | (set-value! b 9 'user) 51 | -------------------------------------------------------------------------------- /ex-3.42.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.42. Ben Bitdiddle suggests that it's a waste of time to create 2 | > a new serialized procedure in response to every `withdraw` and `deposit` 3 | > message. He says that `make-account` could be changed so that the calls to 4 | > protected are done outside the `dispatch` procedure. That is, an account 5 | > would return the same serialized procedure (which was created at the same 6 | > time as the account) each time it is asked for a withdrawal procedure. 7 | > 8 | > ```scheme 9 | > (define (make-account balance) 10 | > (define (withdraw amount) 11 | > (if (>= balance amount) 12 | > (begin (set! balance (- balance amount)) 13 | > balance) 14 | > "Insufficient funds")) 15 | > (define (deposit amount) 16 | > (set! balance (+ balance amount)) 17 | > balance) 18 | > (let ((protected (make-serializer))) 19 | > (let ((protected-withdraw (protected withdraw)) 20 | > (protected-deposit (protected deposit))) 21 | > (define (dispatch m) 22 | > (cond ((eq? m 'withdraw) protected-withdraw) 23 | > ((eq? m 'deposit) protected-deposit) 24 | > ((eq? m 'balance) balance) 25 | > (else (error "Unknown request -- MAKE-ACCOUNT" 26 | > m)))) 27 | > dispatch))) 28 | > ``` 29 | > 30 | > Is this a safe change to make? In particular, is there any difference in what 31 | > concurrency is allowed by these two versions of `make-account`? 32 | 33 | Yes, it's safe. By definition, two serialized procedures will never be 34 | interleaved if both are created by the same serializer. The same can be said 35 | even if two serialized procedures are the same. 36 | 37 | So that there is no difference between the two versions of `make-account`. 38 | -------------------------------------------------------------------------------- /ex-2.89.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.89. Define procedures that implement the term-list 2 | ;;; representation described above as appropriate for dense polynomials. 3 | 4 | ;; Procedures for terms are the same as ones for the sparse representation. 5 | (define (make-term order coeff) 6 | (list order coeff)) 7 | (define (order term) 8 | (car term)) 9 | (define (coeff term) 10 | (cadr term)) 11 | 12 | ;; Procedures on empty term lists are the same too. 13 | (define (the-empty-termlist) '()) 14 | (define (empty-termlist? term-list) (null? term-list)) 15 | 16 | ;; But we have to take care with first-term. Term lists in the dense 17 | ;; representation do not contain term orders explicitly. And first-term is the 18 | ;; only one procedure to return a term from a term list. There is a gap of 19 | ;; internal data formats between input and output of first-term. So that we 20 | ;; have to fill the gap as follows: 21 | (define (translate-into-term term-as-term-list) 22 | (make-term 23 | (- (length term-as-term-list) 1) 24 | (car term-as-term-list))) 25 | (define (first-term term-list) (translate-into-term term-list)) 26 | (define (rest-terms term-list) (cdr term-list)) 27 | 28 | ;; adjoin-term is not tricky except it has to fill zeros if necessary. 29 | (define (adjoin-term term term-list) 30 | (define (pad-zeros tl n) 31 | (if (= n 0) 32 | tl 33 | (pad-zeros (cons 0 tl) (- n 1)))) 34 | (if (=zero? (coeff term)) 35 | term-list 36 | (let* ([new-order (order term)] 37 | [first-order (order (first-term term-list))] 38 | [order-diff (- new-order first-order)]) 39 | (if (<= 1 order-diff) 40 | (cons (coeff term) (pad-zeros term-list (- order-diff 1))) 41 | (error "The order of TERM must be greater than all terms in TERM-LIST")])))) 42 | -------------------------------------------------------------------------------- /ex-3.82.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.82. Redo exercise 3.5 on Monte Carlo integration in terms of 2 | ;;; streams. The stream version of estimate-integral will not have an argument 3 | ;;; telling how many trials to perform. Instead, it will produce a stream of 4 | ;;; estimates based on successively more trials. 5 | 6 | (load "./ex-3.5.scm") 7 | (load "./sec-3.5.scm") 8 | 9 | (define (monte-carlo experiment) 10 | (let go ([passed 0] 11 | [total 0]) 12 | (let* ([r (experiment)] 13 | [passed (+ passed (if r 1 0))] 14 | [total (+ total 1)]) 15 | (cons-stream 16 | (/ passed total) 17 | (go passed total))))) 18 | 19 | (define (estimate-integral P x1 y1 x2 y2) 20 | (define (region-test) 21 | (let ([x (random-in-range x1 x2)] 22 | [y (random-in-range y1 y2)]) 23 | (P x y))) 24 | (stream-map 25 | (lambda (ratio) 26 | (* (- x2 x1) (- y2 y1) ratio)) 27 | (monte-carlo region-test))) 28 | 29 | 30 | 31 | 32 | (define (stream-sample-every s n) 33 | (cons-stream 34 | (stream-car s) 35 | (stream-sample-every (stream-drop s n) n))) 36 | 37 | (define (stream-take s n) 38 | (if (<= 1 n) 39 | (cons-stream 40 | (stream-car s) 41 | (stream-take (stream-cdr s) (- n 1))) 42 | the-empty-stream)) 43 | 44 | (define (stream-drop s n) 45 | (if (<= 1 n) 46 | (stream-drop (stream-cdr s) (- n 1)) 47 | s)) 48 | 49 | (define (main args) 50 | (define results 51 | (stream-map exact->inexact 52 | (stream-sample-every 53 | (estimate-integral 54 | (lambda (x y) (<= (+ (* x x) (* y y)) (* 1 1))) 55 | -1 -1 56 | 1 1) 57 | 10000))) 58 | (stream-for-each print (stream-take results 10))) 59 | -------------------------------------------------------------------------------- /ex-3.4.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.4. Modify the make-account procedure of exercise 3.3 by adding 2 | ;;; another local state variable so that, if an account is accessed more than 3 | ;;; seven consecutive times with an incorrect password, it invokes the 4 | ;;; procedure call-the-cops. 5 | 6 | (load "./ex-3.3.scm") 7 | 8 | (define make-account 9 | (let ([%make-account make-account]) 10 | (lambda initial-args 11 | (let ([acc (apply %make-account initial-args)] 12 | [failed-count 0]) 13 | (lambda dispatched-args 14 | (let* ([m (apply acc dispatched-args)] 15 | [r (m 0)]) 16 | (if (equal? r "Incorrect password") 17 | (begin 18 | (set! failed-count (+ failed-count 1)) 19 | (if (> failed-count 7) 20 | (call-the-cops) 21 | m)) 22 | (begin 23 | (set! failed-count 0) 24 | m)))))))) 25 | 26 | (define (call-the-cops) 27 | (error "wooooop wooooop")) 28 | 29 | (define acc (make-account 100 'secret-password)) 30 | 31 | (print ((acc 'secret-password 'withdraw) 10)) 32 | ;=> 90 33 | (print ((acc 'wrong-password 'withdraw) 10)) 34 | ;=> "Incorrect password" 35 | (print ((acc 'wrong-password 'withdraw) 10)) 36 | ;=> "Incorrect password" 37 | (print ((acc 'wrong-password 'withdraw) 10)) 38 | ;=> "Incorrect password" 39 | (print ((acc 'wrong-password 'withdraw) 10)) 40 | ;=> "Incorrect password" 41 | (print ((acc 'wrong-password 'withdraw) 10)) 42 | ;=> "Incorrect password" 43 | (print ((acc 'wrong-password 'withdraw) 10)) 44 | ;=> "Incorrect password" 45 | (print ((acc 'wrong-password 'withdraw) 10)) 46 | ;=> "Incorrect password" 47 | (print ((acc 'wrong-password 'withdraw) 10)) 48 | ;=> error: wooooop wooooop 49 | -------------------------------------------------------------------------------- /sec-2.3.4.scm: -------------------------------------------------------------------------------- 1 | (define (make-leaf symbol weight) 2 | (list 'leaf symbol weight)) 3 | (define (leaf? object) 4 | (eq? (car object) 'leaf)) 5 | (define (symbol-leaf x) 6 | (cadr x)) 7 | (define (weight-leaf x) 8 | (caddr x)) 9 | 10 | (define (make-code-tree left right) 11 | (list left 12 | right 13 | (append (symbols left) (symbols right)) 14 | (+ (weight left) (weight right)))) 15 | 16 | (define (left-branch tree) 17 | (car tree)) 18 | (define (right-branch tree) 19 | (cadr tree)) 20 | (define (symbols tree) 21 | (if (leaf? tree) 22 | (list (symbol-leaf tree)) 23 | (caddr tree))) 24 | (define (weight tree) 25 | (if (leaf? tree) 26 | (weight-leaf tree) 27 | (cadddr tree))) 28 | 29 | (define (decode bits tree) 30 | (define (decode-1 bits current-branch) 31 | (if (null? bits) 32 | '() 33 | (let ((next-branch 34 | (choose-branch (car bits) current-branch))) 35 | (if (leaf? next-branch) 36 | (cons (symbol-leaf next-branch) 37 | (decode-1 (cdr bits) tree)) 38 | (decode-1 (cdr bits) next-branch))))) 39 | (decode-1 bits tree)) 40 | (define (choose-branch bit branch) 41 | (cond ((= bit 0) (left-branch branch)) 42 | ((= bit 1) (right-branch branch)) 43 | (else (error "bad bit -- CHOOSE-BRANCH" bit)))) 44 | 45 | (define (adjoin-set x set) 46 | (cond ((null? set) (list x)) 47 | ((< (weight x) (weight (car set))) (cons x set)) 48 | (else (cons (car set) 49 | (adjoin-set x (cdr set)))))) 50 | 51 | (define (make-leaf-set pairs) 52 | (if (null? pairs) 53 | '() 54 | (let ((pair (car pairs))) 55 | (adjoin-set (make-leaf (car pair) ; symbol 56 | (cadr pair)) ; frequency 57 | (make-leaf-set (cdr pairs)))))) 58 | -------------------------------------------------------------------------------- /ex-3.37.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.37. The celsius-fahrenheit-converter procedure is cumbersome 2 | ;;; when compared with a more expression-oriented style of definition, such as 3 | ;;; 4 | ;;; (define (celsius-fahrenheit-converter x) 5 | ;;; (c+ (c* (c/ (cv 9) (cv 5)) 6 | ;;; x) 7 | ;;; (cv 32))) 8 | ;;; (define C (make-connector)) 9 | ;;; (define F (celsius-fahrenheit-converter C)) 10 | ;;; 11 | ;;; Here c+, c*, etc. are the ``constraint'' versions of the arithmetic 12 | ;;; operations. For example, c+ takes two connectors as arguments and returns 13 | ;;; a connector that is related to these by an adder constraint: 14 | ;;; 15 | ;;; (define (c+ x y) 16 | ;;; (let ((z (make-connector))) 17 | ;;; (adder x y z) 18 | ;;; z)) 19 | ;;; 20 | ;;; Define analogous procedures c-, c*, c/, and cv (constant value) that enable 21 | ;;; us to define compound constraints as in the converter example above. [33] 22 | 23 | (load "./sec-3.3.5.scm") 24 | 25 | (define (c+ x y) 26 | (let ((z (make-connector))) 27 | (adder x y z) 28 | z)) 29 | 30 | 31 | 32 | 33 | (define (c- x y) 34 | (let ((z (make-connector))) 35 | (adder z y x) 36 | z)) 37 | 38 | (define (c* x y) 39 | (let ((z (make-connector))) 40 | (multiplier x y z) 41 | z)) 42 | 43 | (define (c/ x y) 44 | (let ((z (make-connector))) 45 | (multiplier z y x) 46 | z)) 47 | 48 | (define (cv v) 49 | (let ((z (make-connector))) 50 | (set-value! z v 'constant) 51 | z)) 52 | 53 | 54 | 55 | 56 | (define (celsius-fahrenheit-converter x) 57 | (c+ (c* (c/ (cv 9) (cv 5)) 58 | x) 59 | (cv 32))) 60 | (define C (make-connector)) 61 | (define F (celsius-fahrenheit-converter C)) 62 | (probe "C" C) 63 | (probe "F" F) 64 | (set-value! C 25 'user) 65 | (forget-value! C 'user) 66 | (set-value! F 212 'user) 67 | -------------------------------------------------------------------------------- /ex-4.41.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.41. Write an ordinary Scheme program to solve the multiple 2 | ;;; dwelling puzzle. 3 | 4 | (define (multiple-dwelling) 5 | (define (distinct? items) 6 | (cond ((null? items) #t) 7 | ((null? (cdr items)) #t) 8 | ((member (car items) (cdr items)) #f) 9 | (else (distinct? (cdr items))))) 10 | (define (check baker cooper fletcher miller smith) 11 | (if (and (distinct? (list baker cooper fletcher miller smith)) 12 | (not (= baker 5)) 13 | (not (= cooper 1)) 14 | (not (= fletcher 5)) 15 | (not (= fletcher 1)) 16 | (> miller cooper) 17 | (not (= (abs (- smith fletcher)) 1)) 18 | (not (= (abs (- fletcher cooper)) 1))) 19 | (print "baker: " baker ", cooper: " cooper ", " 20 | "fletcher: " fletcher ", miller: " miller ", " 21 | "smith: " smith))) 22 | (let go-baker ((baker 1)) 23 | (if (<= baker 5) 24 | (begin 25 | (let go-cooper ((cooper 1)) 26 | (if (<= cooper 5) 27 | (begin 28 | (let go-fletcher ((fletcher 1)) 29 | (if (<= fletcher 5) 30 | (begin 31 | (let go-miller ((miller 1)) 32 | (if (<= miller 5) 33 | (begin 34 | (let go-smith ((smith 1)) 35 | (if (<= smith 5) 36 | (begin 37 | (check baker cooper fletcher miller smith) 38 | (go-smith (+ smith 1))))) 39 | (go-miller (+ miller 1))))) 40 | (go-fletcher (+ fletcher 1))))) 41 | (go-cooper (+ cooper 1))))) 42 | (go-baker (+ baker 1)))))) 43 | 44 | (multiple-dwelling) 45 | -------------------------------------------------------------------------------- /ex-4.2.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.2. Louis Reasoner plans to reorder the cond clauses in eval so 2 | ;;; that the clause for procedure applications appears before the clause for 3 | ;;; assignments. He argues that this will make the interpreter more efficient: 4 | ;;; Since programs usually contain more applications than assignments, 5 | ;;; definitions, and so on, his modified eval will usually check fewer clauses 6 | ;;; than the original eval before identifying the type of an expression. 7 | 8 | ;;; a. What is wrong with Louis's plan? (Hint: What will Louis's evaluator do 9 | ;;; with the expression (define x 3)?) 10 | 11 | ;; Expressions of procedure applications are written as lists. 12 | ;; Expressions of special forms such as definitions are also written as lists. 13 | ;; Louis's eval treats all special forms as if they are procedure applications. 14 | 15 | ;;; b. Louis is upset that his plan didn't work. He is willing to go to any 16 | ;;; lengths to make his evaluator recognize procedure applications before it 17 | ;;; checks for most other kinds of expressions. Help him by changing the syntax 18 | ;;; of the evaluated language so that procedure applications start with call. 19 | ;;; For example, instead of (factorial 3) we will now have to write (call 20 | ;;; factorial 3) and instead of (+ 1 2) we will have to write (call + 1 2). 21 | 22 | ;; All we have to do is to update APPLICATION?, OPERATOR and OPERANDS. 23 | ;; Because the new syntax changes only how procedure applications are written. 24 | 25 | ;; The procedures for the original syntax are: 26 | 27 | (define (application? exp) (pair? exp)) 28 | (define (operator exp) (car exp)) 29 | (define (operands exp) (cdr exp)) 30 | 31 | ;; While the ones for the new syntax are: 32 | 33 | (define (application? exp) (tagged-list? exp 'call)) 34 | (define (operator exp) (cadr exp)) 35 | (define (operands exp) (cddr exp)) 36 | -------------------------------------------------------------------------------- /ex-4.38.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.38. Modify the multiple-dwelling procedure to omit the 2 | ;;; requirement that Smith and Fletcher do not live on adjacent floors. How 3 | ;;; many solutions are there to this modified puzzle? 4 | 5 | (load "./sec-4.3.3.scm") 6 | 7 | (ambtest '(begin 8 | 9 | (define (distinct? items) 10 | (cond ((null? items) true) 11 | ((null? (cdr items)) true) 12 | ((member (car items) (cdr items)) false) 13 | (else (distinct? (cdr items))))) 14 | 15 | (define (multiple-dwelling) 16 | (let ((baker (amb 1 2 3 4 5)) 17 | (cooper (amb 1 2 3 4 5)) 18 | (fletcher (amb 1 2 3 4 5)) 19 | (miller (amb 1 2 3 4 5)) 20 | (smith (amb 1 2 3 4 5))) 21 | (require 22 | (distinct? (list baker cooper fletcher miller smith))) 23 | (require (not (= baker 5))) 24 | (require (not (= cooper 1))) 25 | (require (not (= fletcher 5))) 26 | (require (not (= fletcher 1))) 27 | (require (> miller cooper)) 28 | ; (require (not (= (abs (- smith fletcher)) 1))) 29 | (require (not (= (abs (- fletcher cooper)) 1))) 30 | (list (list 'baker baker) 31 | (list 'cooper cooper) 32 | (list 'fletcher fletcher) 33 | (list 'miller miller) 34 | (list 'smith smith)))) 35 | 36 | (let ((answer (multiple-dwelling))) 37 | (print answer)) 38 | 39 | )) 40 | 41 | ; baker | 1 | 1 | 1 | 3 | 3 | 42 | ; cooper | 2 | 2 | 4 | 2 | 4 | 43 | ; fletcher | 4 | 4 | 2 | 4 | 2 | 44 | ; miller | 3 | 5 | 5 | 5 | 5 | 45 | ; smith | 5 | 3 | 3 | 1 | 1 | 46 | -------------------------------------------------------------------------------- /ex-1.10.md: -------------------------------------------------------------------------------- 1 | > Exercise 1.10. The following procedure computes a mathematical function 2 | > called Ackermann's function. 3 | > 4 | > (define (A x y) 5 | > (cond ((= y 0) 0) 6 | > ((= x 0) (* 2 y)) 7 | > ((= y 1) 2) 8 | > (else (A (- x 1) 9 | > (A x (- y 1)))))) 10 | > 11 | > What are the values of the following expressions? 12 | > 13 | > (A 1 10) 14 | 15 | 1024 16 | 17 | > (A 2 4) 18 | 19 | 65536 20 | 21 | > (A 3 3) 22 | 23 | 65536 24 | 25 | 26 | 27 | 28 | > Consider the following procedures, where A is the procedure defined above: 29 | > 30 | > (define (f n) (A 0 n)) 31 | > 32 | > (define (g n) (A 1 n)) 33 | > 34 | > (define (h n) (A 2 n)) 35 | > 36 | > (define (k n) (* 5 n n)) 37 | > 38 | > Give concise mathematical definitions for the functions computed by the 39 | > procedures f, g, and h for positive integer values of n. For example, (k n) 40 | > computes 5n^2. 41 | 42 | (A 0 n) is equivalent to (* 2 n), so that (f n) computes 2n. 43 | 44 | (A 1 n) is equivalent to: 45 | 46 | (A (- 1 1) (A 1 (- n 1))) 47 | = (A 0 (A 1 (- n 1))) 48 | = (A 0 (g (n - 1))) 49 | = (f (g (n - 1))) 50 | ... 51 | = (f (f ... (f (g 1)))) 52 | ~~~~~~~~~~~~ 53 | n - 1 54 | = (f (f ... (f 2))) 55 | ~~~~~~~~~~~~ 56 | n - 1 57 | = 2 * 2 * ... * 2 58 | ~~~~~~~~~~~~~~~ 59 | n 60 | = 2^n 61 | 62 | Therefore (g n) computes 2^n. 63 | 64 | (A 2 n) is equivalent to: 65 | 66 | (A 2 n) 67 | = (A (- 2 1) (A 2 (- n 1))) 68 | = (A 1 (A 2 (- n 1))) 69 | = (g (A 2 (- n 1))) 70 | = (g (g (A 2 (- n 2)))) 71 | ... 72 | = (g (g ... (g (A 2 1)))) 73 | ~~~~~~~~~~~~ 74 | n - 1 75 | = (g (g ... (g 2))) 76 | ~~~~~~~~~~~~ 77 | n - 1 78 | = ((2^2)^2)^2...^2 79 | ~~~~~~~~~~ 80 | n - 1 81 | = 2^(2^n) 82 | 83 | Therefore (h n) computes 2^(2^n). 84 | -------------------------------------------------------------------------------- /ex-4.48.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.48. Extend the grammar given above to handle more complex 2 | ;;; sentences. For example, you could extend noun phrases and verb phrases to 3 | ;;; include adjectives and adverbs, or you could handle compound sentences. 4 | ;;; [53] 5 | 6 | (load "./sec-4.3.2.scm") 7 | (load "./sec-4.3.3.scm") 8 | 9 | (ambtest `(begin 10 | 11 | ,@parser-definitions 12 | 13 | (define adjectives '(adjective wise fool sane crazy hot black)) 14 | (define adverbs '(adverb reluctantly always often seldom never)) 15 | 16 | (define (parse-simple-noun-phrase) 17 | (amb (list 'simple-noun-phrase 18 | (parse-word articles) 19 | (parse-word nouns)) 20 | (list 'simple-noun-phrase 21 | (parse-word articles) 22 | (parse-word adjectives) 23 | (parse-word nouns)))) 24 | 25 | (define (parse-simple-verb-phrase) 26 | (amb (list 'simple-verb-phrase 27 | (parse-word verbs)) 28 | (list 'simple-verb-phrase 29 | (parse-word adverbs) 30 | (parse-word verbs)))) 31 | (define (parse-verb-phrase) 32 | (define (maybe-extend verb-phrase) 33 | (amb verb-phrase 34 | (maybe-extend (list 'verb-phrase 35 | verb-phrase 36 | (parse-prepositional-phrase))))) 37 | (maybe-extend (parse-simple-verb-phrase))) 38 | 39 | (define the-sentence 40 | '(the wise professor lectures 41 | to the crazy student in the hot class 42 | with the black cat)) 43 | 44 | (print (parse the-sentence)) 45 | 46 | )) 47 | -------------------------------------------------------------------------------- /ex-4.63.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.63. The following data base (see Genesis 4) traces the 2 | ;;; genealogy of the descendants of Ada back to Adam, by way of Cain: 3 | ;;; 4 | ;;; (son Adam Cain) 5 | ;;; (son Cain Enoch) 6 | ;;; (son Enoch Irad) 7 | ;;; (son Irad Mehujael) 8 | ;;; (son Mehujael Methushael) 9 | ;;; (son Methushael Lamech) 10 | ;;; (wife Lamech Ada) 11 | ;;; (son Ada Jabal) 12 | ;;; (son Ada Jubal) 13 | ;;; 14 | ;;; Formulate rules such as ``If S is the son of F, and F is the son of G, then 15 | ;;; S is the grandson of G'' and ``If W is the wife of M, and S is the son of 16 | ;;; W, then S is the son of M'' (which was supposedly more true in biblical 17 | ;;; times than today) that will enable the query system to find the grandson of 18 | ;;; Cain; the sons of Lamech; the grandsons of Methushael. (See exercise 4.69 19 | ;;; for some rules to deduce more complicated relationships.) 20 | 21 | (load "./sec-4.4.4.scm") 22 | (load "./sec-4.4.1-sample-db.scm") 23 | 24 | (query-driver-loop-for-script '( 25 | 26 | (assert! (son Adam Cain)) 27 | (assert! (son Cain Enoch)) 28 | (assert! (son Enoch Irad)) 29 | (assert! (son Irad Mehujael)) 30 | (assert! (son Mehujael Methushael)) 31 | (assert! (son Methushael Lamech)) 32 | (assert! (wife Lamech Ada)) 33 | (assert! (son Ada Jabal)) 34 | (assert! (son Ada Jubal)) 35 | 36 | (assert! (rule (grandson ?g ?s) 37 | (and (son$ ?g ?f) 38 | (son$ ?f ?s)))) 39 | (assert! (rule (son$ ?m ?s) 40 | (or (son ?m ?s) 41 | (and (wife ?m ?w) 42 | (son$ ?w ?s))))) 43 | 44 | (grandson Cain ?x) 45 | ; ==> (grandson Cain Irad) 46 | 47 | (son$ Lamech ?x) 48 | ; ==> (son$ Lamech Jabal) 49 | ; (son$ Lamech Jubal) 50 | 51 | (grandson Methushael ?x) 52 | ; ==> (grandson Methushael Jabal) 53 | ; (grandson Methushael Jubal) 54 | 55 | )) 56 | -------------------------------------------------------------------------------- /ex-3.73.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.73. 2 | ;;; 3 | ;;; [Figure 3.33: An RC circuit and the associated signal-flow diagram.] 4 | ;;; 5 | ;;; v = v_0 + (1/C)∫_0^t i dt + R i 6 | ;;; 7 | ;;; We can model electrical circuits using streams to represent the values of 8 | ;;; currents or voltages at a sequence of times. For instance, suppose we have 9 | ;;; an RC circuit consisting of a resistor of resistance R and a capacitor of 10 | ;;; capacitance C in series. The voltage response v of the circuit to an 11 | ;;; injected current i is determined by the formula in figure 3.33, whose 12 | ;;; structure is shown by the accompanying signal-flow diagram. 13 | ;;; 14 | ;;; Write a procedure RC that models this circuit. RC should take as inputs the 15 | ;;; values of R, C, and dt and should return a procedure that takes as inputs 16 | ;;; a stream representing the current i and an initial value for the capacitor 17 | ;;; voltage v0 and produces as output the stream of voltages v. For example, 18 | ;;; you should be able to use RC to model an RC circuit with R = 5 ohms, 19 | ;;; C = 1 farad, and a 0.5-second time step by evaluating (define RC1 (RC 20 | ;;; 5 1 0.5)). This defines RC1 as a procedure that takes a stream representing 21 | ;;; the time sequence of currents and an initial capacitor voltage and produces 22 | ;;; the output stream of voltages. 23 | 24 | (load "./sec-3.5.scm") 25 | 26 | (define (integral integrand initial-value dt) 27 | (define int 28 | (cons-stream initial-value 29 | (add-streams (scale-stream integrand dt) 30 | int))) 31 | int) 32 | 33 | (define (RC R C dt) 34 | (define (vs is v0) 35 | (cons-stream v0 36 | (add-streams (scale-stream is R) 37 | (integral (scale-stream is (/ 1 C)) v0 dt)))) 38 | vs) 39 | 40 | (define RC1 (RC 5 1 0.5)) 41 | (define s (RC1 ones 10)) 42 | (do ((i 0 (+ i 1))) 43 | ((= i 30)) 44 | (print (stream-ref s i))) 45 | -------------------------------------------------------------------------------- /ex-4.8.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.8. ``Named let'' is a variant of let that has the form 2 | ;;; 3 | ;;; (let ) 4 | ;;; 5 | ;;; The and are just as in ordinary let, except that is 6 | ;;; bound within to a procedure whose body is and whose 7 | ;;; parameters are the variables in the . Thus, one can repeatedly 8 | ;;; execute the by invoking the procedure named . For example, the 9 | ;;; iterative Fibonacci procedure (section 1.2.2) can be rewritten using named 10 | ;;; let as follows: 11 | ;;; 12 | ;;; (define (fib n) 13 | ;;; (let fib-iter ((a 1) 14 | ;;; (b 0) 15 | ;;; (count n)) 16 | ;;; (if (= count 0) 17 | ;;; b 18 | ;;; (fib-iter (+ a b) a (- count 1))))) 19 | ;;; 20 | ;;; Modify let->combination of exercise 4.6 to also support named let. 21 | 22 | (define (let? exp) 23 | (tagged-list? exp 'let)) 24 | 25 | (define (let-name exp) 26 | (if (symbol? (cadr exp)) 27 | (cadr exp) 28 | #f)) 29 | 30 | (define (let-plain? exp) 31 | (not (let-name exp))) 32 | 33 | (define (let-named? exp) 34 | (let-name exp)) 35 | 36 | (define (let-bindings exp) 37 | (if (let-plain? exp) 38 | (cadr exp) 39 | (caddr exp))) 40 | 41 | (define (let-clauses exp) 42 | (if (let-plain? exp) 43 | (cddr exp) 44 | (cdddr exp))) 45 | 46 | (define (let-clause-var clause) 47 | (car clause)) 48 | 49 | (define (let-clause-value-exp clause) 50 | (cadr clause)) 51 | 52 | (define (let->combination exp) 53 | (define name (let-name exp)) 54 | (define vars (map let-clause-var (let-clauses exp))) 55 | (define value-exps (map let-clause-value-exp (let-clauses exp))) 56 | (define body (let-body exp)) 57 | (if name 58 | (list 'let (list (list name (make-lambda vars body))) 59 | (cons name value-exps)) 60 | (cons 61 | (list (make-lambda vars body)) 62 | value-exps))) 63 | -------------------------------------------------------------------------------- /ex-3.78.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.78. 2 | ;;; 3 | ;;; dy0 y0 4 | ;;; | | 5 | ;;; v v 6 | ;;; ddy ------------ dy ------------ y 7 | ;;; ,----------->| integral |---*--| integral |--*--> 8 | ;;; | ------------ | ------------ | 9 | ;;; | | | 10 | ;;; | ---- ------------ | | 11 | ;;; | / |<--| scale: a |<--' | 12 | ;;; | / | ------------ | 13 | ;;; `--| add | | 14 | ;;; \ | ------------ | 15 | ;;; \ |<--| scale: b |<-------------------' 16 | ;;; ---- ------------ 17 | ;;; 18 | ;;; Figure 3.35: Signal-flow diagram for the solution to a second-order linear 19 | ;;; differential equation. 20 | ;;; 21 | ;;; Consider the problem of designing a signal-processing system to study the 22 | ;;; homogeneous second-order linear differential equation 23 | ;;; 24 | ;;; d^2 y dy 25 | ;;; ------- - a ---- - by = 0 26 | ;;; d t^2 dt 27 | ;;; 28 | ;;; 29 | ;;; The output stream, modeling y, is generated by a network that contains 30 | ;;; a loop. This is because the value of d^2y/dt^2 depends upon the values of 31 | ;;; y and dy/dt and both of these are determined by integrating d^2y/dt^2. The 32 | ;;; diagram we would like to encode is shown in figure 3.35. Write a procedure 33 | ;;; solve-2nd that takes as arguments the constants a, b, and dt and the 34 | ;;; initial values y0 and dy0 for y and dy/dt and generates the stream of 35 | ;;; successive values of y. 36 | 37 | (load "./sec-3.5.scm") 38 | (load "./ex-3.77.scm") 39 | 40 | (define (solve-2nd a b dt y0 dy0) 41 | (define y (integral (delay dy) y0 dt)) 42 | (define dy (integral (delay ddy) dy0 dt)) 43 | (define ddy (add-streams (scale-stream dy a) 44 | (scale-stream y b))) 45 | y) 46 | -------------------------------------------------------------------------------- /ex-3.75.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.75. Unfortunately, Alyssa's zero-crossing detector in exercise 2 | ;;; 3.74 proves to be insufficient, because the noisy signal from the sensor 3 | ;;; leads to spurious zero crossings. Lem E. Tweakit, a hardware specialist, 4 | ;;; suggests that Alyssa smooth the signal to filter out the noise before 5 | ;;; extracting the zero crossings. Alyssa takes his advice and decides to 6 | ;;; extract the zero crossings from the signal constructed by averaging each 7 | ;;; value of the sense data with the previous value. She explains the problem 8 | ;;; to her assistant, Louis Reasoner, who attempts to implement the idea, 9 | ;;; altering Alyssa's program as follows: 10 | ;;; 11 | ;;; (define (make-zero-crossings input-stream last-value) 12 | ;;; (let ((avpt (/ (+ (stream-car input-stream) last-value) 2))) 13 | ;;; (cons-stream (sign-change-detector avpt last-value) 14 | ;;; (make-zero-crossings (stream-cdr input-stream) 15 | ;;; avpt)))) 16 | ;;; 17 | ;;; This does not correctly implement Alyssa's plan. Find the bug that Louis 18 | ;;; has installed and fix it without changing the structure of the program. 19 | ;;; (Hint: You will need to increase the number of arguments to 20 | ;;; make-zero-crossings.) 21 | 22 | ; Let's denote 23 | ; 24 | ; * S = (S_i) as the sense data, and 25 | ; * A = (A_i) as the average values calculated from S, 26 | ; where A_i = (S_i + S_{i-1}) / 2. 27 | ; 28 | ; Alyssa's plan is to extract zero crossings from A. 29 | ; But Louis's implementation does not correctly calculate A. 30 | ; It calculates A_i by (S_i + A_{i-1}) / 2. 31 | 32 | (define (make-zero-crossings input-stream last-raw-value last-average-value) 33 | (let ((avpt (/ (+ (stream-car input-stream) last-raw-value) 2))) 34 | (cons-stream (sign-change-detector avpt last-average-value) 35 | (make-zero-crossings (stream-cdr input-stream) 36 | (stream-car input-stream) 37 | avpt)))) 38 | -------------------------------------------------------------------------------- /ex-3.81.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.81. Exercise 3.6 discussed generalizing the random-number 2 | ;;; generator to allow one to reset the random-number sequence so as to produce 3 | ;;; repeatable sequences of ``random'' numbers. Produce a stream formulation of 4 | ;;; this same generator that operates on an input stream of requests to 5 | ;;; generate a new random number or to reset the sequence to a specified value 6 | ;;; and that produces the desired stream of random numbers. Don't use 7 | ;;; assignment in your solution. 8 | 9 | (load "./ex-3.6.scm") 10 | (load "./sec-3.5.scm") 11 | 12 | (define (rand requests) 13 | (define (generate-random-numbers seed) 14 | (define random-numbers 15 | (cons-stream seed 16 | (stream-map rand-update random-numbers))) 17 | random-numbers) 18 | (define (dispatch requests numbers) 19 | (let ([r (stream-car requests)]) 20 | (cond [(eq? r 'generate) 21 | (process requests numbers)] 22 | [(number? r) 23 | (process requests (stream-cdr (generate-random-numbers r)))] 24 | [else (error "Unknown request: " r)]))) 25 | (define (process requests numbers) 26 | (cons-stream 27 | (stream-car numbers) 28 | (dispatch (stream-cdr requests) (stream-cdr numbers)))) 29 | (define random-seed 0) 30 | (dispatch requests (generate-random-numbers random-seed))) 31 | 32 | 33 | 34 | 35 | (define (stream-from-list xs) 36 | (define (go xs) 37 | (if (null? xs) 38 | the-empty-stream 39 | (cons-stream (car xs) 40 | (go (cdr xs))))) 41 | (go xs)) 42 | 43 | (define (main args) 44 | (define requests '(1024 generate generate 45 | 1024 generate generate)) 46 | (define ns (rand (stream-from-list requests))) 47 | (print (stream-ref ns 0) "\t" 423224377) 48 | (print (stream-ref ns 1) "\t" 1581628030) 49 | (print (stream-ref ns 2) "\t" 502725599) 50 | (print (stream-ref ns 3) "\t" 423224377) 51 | (print (stream-ref ns 4) "\t" 1581628030) 52 | (print (stream-ref ns 5) "\t" 502725599) 53 | ) 54 | -------------------------------------------------------------------------------- /ex-3.47.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.47. A semaphore (of size n) is a generalization of a mutex. 2 | ;;; Like a mutex, a semaphore supports acquire and release operations, but it 3 | ;;; is more general in that up to n processes can acquire it concurrently. 4 | ;;; Additional processes that attempt to acquire the semaphore must wait for 5 | ;;; release operations. Give implementations of semaphores 6 | 7 | ;;; a. in terms of mutexes 8 | 9 | (define (make-semaphore n) 10 | (let ([mutex (make-mutex)] 11 | [c 0]) 12 | (define (acquire) 13 | (mutex 'acquire) 14 | (cond [(< c n) 15 | (set! c (+ c 1)) 16 | (mutex 'release)] 17 | [else 18 | (mutex 'release) 19 | (acquire)])) 20 | (define (release) 21 | (mutex 'acquire) 22 | (if (<= 1 c) 23 | (set! c (- c 1)) 24 | (error "This semaphore is not acquired yet")) 25 | (mutex 'release)) 26 | (define (dispatch m) 27 | (cond [(eq? m 'acquire) (acquire)] 28 | [(eq? m 'release) (release)] 29 | [else (error "Unknown message sent to a semaphore" m)])) 30 | dispatch)) 31 | 32 | 33 | 34 | 35 | ;;; b. in terms of atomic test-and-set! operations. 36 | 37 | (define (make-semaphore n) 38 | (let ([cell (list #f)] 39 | [c 0]) 40 | (define (acquire) 41 | (if (test-and-set! cell) 42 | (acquire) 43 | (cond [(< c n) 44 | (set! c (+ c 1)) 45 | (clear! cell)] 46 | [else 47 | (clear! cell) 48 | (acquire)]))) 49 | (define (release) 50 | (cond [(test-and-set! cell) 51 | (release)] 52 | [else 53 | (if (<= 1 c) 54 | (set! c (- c 1)) 55 | (error "This semaphore is not acquired yet")) 56 | (clear! cell)]) 57 | (define (dispatch m) 58 | (cond [(eq? m 'acquire) (acquire)] 59 | [(eq? m 'release) (release)] 60 | [else (error "Unknown message sent to a semaphore" m)])) 61 | dispatch)) 62 | -------------------------------------------------------------------------------- /ex-4.53.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.53. With permanent-set! as described in exercise 4.51 and 2 | ;;; if-fail as in exercise 4.52, what will be the result of evaluating 3 | ;;; 4 | ;;; (let ((pairs '())) 5 | ;;; (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110)))) 6 | ;;; (permanent-set! pairs (cons p pairs)) 7 | ;;; (amb)) 8 | ;;; pairs)) 9 | 10 | (load "./ex-4.51.scm") 11 | (load "./ex-4.52.scm") 12 | 13 | (define (main args) 14 | (ambtest `(begin 15 | 16 | (define (square x) 17 | (* x x)) 18 | 19 | (define (smallest-divisor n) 20 | (find-divisor n 2)) 21 | (define (find-divisor n test-divisor) 22 | (cond ((> (square test-divisor) n) n) 23 | ((divides? test-divisor n) test-divisor) 24 | (else (find-divisor n (+ test-divisor 1))))) 25 | (define (divides? a b) 26 | (= (remainder b a) 0)) 27 | (define (prime? n) 28 | (= n (smallest-divisor n))) 29 | 30 | (define (an-element-of items) 31 | (require (not (null? items))) 32 | (amb (car items) (an-element-of (cdr items)))) 33 | 34 | (define (prime-sum-pair list1 list2) 35 | (let ((a (an-element-of list1)) 36 | (b (an-element-of list2))) 37 | (require (prime? (+ a b))) 38 | (list a b))) 39 | 40 | (define (test) 41 | (let ((pairs '())) 42 | (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110)))) 43 | (permanent-set! pairs (cons p pairs)) 44 | (amb)) 45 | pairs))) 46 | (print (test)) 47 | 48 | )) 49 | ) 50 | 51 | ; Output: 52 | ; ------------------------------------------------------------ 53 | ; ((8 35) (3 110) (3 20)) 54 | ; *** No more values *** 55 | ; ------------------------------------------------------------ 56 | -------------------------------------------------------------------------------- /ex-2.77.md: -------------------------------------------------------------------------------- 1 | > Exercise 2.77. Louis Reasoner tries to evaluate the expression (magnitude z) 2 | > where z is the object shown in figure 2.24. To his surprise, instead of the 3 | > answer 5 he gets an error message from apply-generic, saying there is no method 4 | > for the operation magnitude on the types (complex). He shows this interaction 5 | > to Alyssa P. Hacker, who says ``The problem is that the complex-number 6 | > selectors were never defined for complex numbers, just for polar and 7 | > rectangular numbers. All you have to do to make this work is add the following 8 | > to the complex package:'' 9 | > 10 | > (put 'real-part '(complex) real-part) 11 | > (put 'imag-part '(complex) imag-part) 12 | > (put 'magnitude '(complex) magnitude) 13 | > (put 'angle '(complex) angle) 14 | > 15 | > Describe in detail why this works. 16 | 17 | Each operation was defined only for `(rectangular)` and `(polar)`. 18 | So that applying these operations to `(complex)` objects failed. 19 | 20 | After adding the work suggested by Alyssa, applying these operations to 21 | `(complex)` objects will apply the same operations to contents extracted from 22 | given arguments. Such contents are typed as `(rectangular)` or `(polar)`. 23 | So that the latter applications will return valid results. 24 | 25 | > As an example, trace through all the procedures called in evaluating the 26 | > expression (magnitude z) where z is the object shown in figure 2.24. In 27 | > particular, how many times is apply-generic invoked? What procedure is 28 | > dispatched to in each case? 29 | 30 | 1. (magnitude '(complex rectangular 3 . 4)) 31 | 2. (apply-generic 'magnitude '(complex rectangular 3 . 4)) 32 | 3. (apply magnitude '((rectangular 3 . 4))) 33 | 4. (magnitude '(rectangular 3 . 4)) 34 | 5. (apply-generic 'magnitude '(rectangular 3 . 4)) 35 | 6. (apply %rectanguler-magnitude% '((3 . 4)))) 36 | 7. (%rectanguler-magnitude% '(3 . 4))) 37 | 8. 5 38 | 39 | `apply-generic` is invoked twice. 40 | The former dispatches its process to the generic `magnitude`. 41 | The latter dispatches its process to `magnitude` defined in the rectanguler package. 42 | -------------------------------------------------------------------------------- /ex-4.23.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.23. Alyssa P. Hacker doesn't understand why `analyze-sequence` 2 | > needs to be so complicated. All the other analysis procedures are 3 | > straightforward transformations of the corresponding evaluation procedures 4 | > (or eval clauses) in section 4.1.1. She expected `analyze-sequence` to look 5 | > like this: 6 | > 7 | > (define (analyze-sequence exps) 8 | > (define (execute-sequence procs env) 9 | > (cond ((null? (cdr procs)) ((car procs) env)) 10 | > (else ((car procs) env) 11 | > (execute-sequence (cdr procs) env)))) 12 | > (let ((procs (map analyze exps))) 13 | > (if (null? procs) 14 | > (error "Empty sequence -- ANALYZE")) 15 | > (lambda (env) (execute-sequence procs env)))) 16 | > 17 | > Eva Lu Ator explains to Alyssa that the version in the text does more of the 18 | > work of evaluating a sequence at analysis time. Alyssa's sequence-execution 19 | > procedure, rather than having the calls to the individual execution 20 | > procedures built in, loops through the procedures in order to call them: In 21 | > effect, although the individual expressions in the sequence have been 22 | > analyzed, the sequence itself has not been. 23 | > 24 | > Compare the two versions of `analyze-sequence`. For example, consider the 25 | > common case (typical of procedure bodies) where the sequence has just one 26 | > expression. 27 | 28 | 29 | > What work will the execution procedure produced by Alyssa's program do? 30 | 31 | It loops over a single-element list `procs` and execute the element. 32 | 33 | 34 | > What about the execution procedure produced by the program in the text above? 35 | 36 | The execution procedure returned by `analyze-sequence` is the same as the 37 | execution procedure returned by `(analyze (car exps))`. 38 | 39 | 40 | > How do the two versions compare for a sequence with two expressions? 41 | 42 | Alyssa's version still analyzes the sequence itself at each evaluation, while 43 | the original version analyzes the sequence itself only once. So that there is 44 | no `null?` check in the execution procedure produced by the original version. 45 | -------------------------------------------------------------------------------- /sec-4.3.2.scm: -------------------------------------------------------------------------------- 1 | (define parser-definitions 2 | '((define nouns '(noun student professor cat class)) 3 | (define verbs '(verb studies lectures eats sleeps)) 4 | (define articles '(article the a)) 5 | 6 | (define (parse-sentence) 7 | (list 'sentence 8 | (parse-noun-phrase) 9 | (parse-word verbs))) 10 | (define (parse-noun-phrase) 11 | (list 'noun-phrase 12 | (parse-word articles) 13 | (parse-word nouns))) 14 | (define (parse-word word-list) 15 | (require (not (null? *unparsed*))) 16 | (require (memq (car *unparsed*) (cdr word-list))) 17 | (let ((found-word (car *unparsed*))) 18 | (set! *unparsed* (cdr *unparsed*)) 19 | (list (car word-list) found-word))) 20 | 21 | (define *unparsed* '()) 22 | (define (parse input) 23 | (set! *unparsed* input) 24 | (let ((sent (parse-sentence))) 25 | (require (null? *unparsed*)) 26 | sent)) 27 | 28 | (define prepositions '(prep for to in by with)) 29 | 30 | (define (parse-prepositional-phrase) 31 | (list 'prep-phrase 32 | (parse-word prepositions) 33 | (parse-noun-phrase))) 34 | 35 | (define (parse-sentence) 36 | (list 'sentence 37 | (parse-noun-phrase) 38 | (parse-verb-phrase))) 39 | (define (parse-verb-phrase) 40 | (define (maybe-extend verb-phrase) 41 | (amb verb-phrase 42 | (maybe-extend (list 'verb-phrase 43 | verb-phrase 44 | (parse-prepositional-phrase))))) 45 | (maybe-extend (parse-word verbs))) 46 | 47 | (define (parse-simple-noun-phrase) 48 | (list 'simple-noun-phrase 49 | (parse-word articles) 50 | (parse-word nouns))) 51 | (define (parse-noun-phrase) 52 | (define (maybe-extend noun-phrase) 53 | (amb noun-phrase 54 | (maybe-extend (list 'noun-phrase 55 | noun-phrase 56 | (parse-prepositional-phrase))))) 57 | (maybe-extend (parse-simple-noun-phrase))) 58 | )) 59 | -------------------------------------------------------------------------------- /ex-3.56.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | ;;; Exercise 3.56. A famous problem, first raised by R. Hamming, is to 4 | ;;; enumerate, in ascending order with no repetitions, all positive integers 5 | ;;; with no prime factors other than 2, 3, or 5. One obvious way to do this is 6 | ;;; to simply test each integer in turn to see whether it has any factors other 7 | ;;; than 2, 3, and 5. But this is very inefficient, since, as the integers get 8 | ;;; larger, fewer and fewer of them fit the requirement. As an alternative, let 9 | ;;; us call the required stream of numbers S and notice the following facts 10 | ;;; about it. 11 | ;;; 12 | ;;; * S begins with 1. 13 | ;;; * The elements of (scale-stream S 2) are also elements of S. 14 | ;;; * The same is true for (scale-stream S 3) and (scale-stream 5 S). 15 | ;;; * These are all the elements of S. 16 | ;;; 17 | ;;; Now all we have to do is combine elements from these sources. For this we 18 | ;;; define a procedure merge that combines two ordered streams into one ordered 19 | ;;; result stream, eliminating repetitions: 20 | 21 | (define (merge s1 s2) 22 | (cond ((stream-null? s1) s2) 23 | ((stream-null? s2) s1) 24 | (else 25 | (let ((s1car (stream-car s1)) 26 | (s2car (stream-car s2))) 27 | (cond ((< s1car s2car) 28 | (cons-stream s1car (merge (stream-cdr s1) s2))) 29 | ((> s1car s2car) 30 | (cons-stream s2car (merge s1 (stream-cdr s2)))) 31 | (else 32 | (cons-stream s1car 33 | (merge (stream-cdr s1) 34 | (stream-cdr s2))))))))) 35 | 36 | ;;; Then the required stream may be constructed with merge, as follows: 37 | ;;; 38 | ;;; (define S (cons-stream 1 (merge ))) 39 | ;;; 40 | ;;; Fill in the missing expressions in the places marked above. 41 | 42 | (define S (cons-stream 1 (merge (merge (scale-stream integers 2) 43 | (scale-stream integers 3)) 44 | (scale-stream integers 5)))) 45 | 46 | (do ((i 0 (+ i 1))) 47 | ((= i 30)) 48 | (print (stream-ref S i))) 49 | -------------------------------------------------------------------------------- /ex-3.24.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.24. In the table implementations above, the keys are tested for 2 | ;;; equality using equal? (called by assoc). This is not always the appropriate 3 | ;;; test. For instance, we might have a table with numeric keys in which we 4 | ;;; don't need an exact match to the number we're looking up, but only a number 5 | ;;; within some tolerance of it. Design a table constructor make-table that 6 | ;;; takes as an argument a same-key? procedure that will be used to test 7 | ;;; ``equality'' of keys. Make-table should return a dispatch procedure that 8 | ;;; can be used to access appropriate lookup and insert! procedures for a local 9 | ;;; table. 10 | 11 | (define (make-table same-key?) 12 | (define local-table (list '*table*)) 13 | (define (associate key table) 14 | (cond [(null? table) #f] 15 | [(same-key? key (caar table)) (car table)] 16 | [else (associate key (cdr table))])) 17 | (define (lookup key-1 key-2) 18 | (let ((subtable (associate key-1 (cdr local-table)))) 19 | (if subtable 20 | (let ((record (associate key-2 (cdr subtable)))) 21 | (if record 22 | (cdr record) 23 | #f)) 24 | #f))) 25 | (define (insert! key-1 key-2 value) 26 | (let ([subtable (associate key-1 (cdr local-table))]) 27 | (if subtable 28 | (let ([record (associate key-2 (cdr subtable))]) 29 | (if record 30 | (set-cdr! record value) 31 | (set-cdr! subtable 32 | (cons (cons key-2 value) 33 | (cdr subtable))))) 34 | (set-cdr! local-table 35 | (cons (list key-1 36 | (cons key-2 value)) 37 | (cdr local-table))))) 38 | 'ok) 39 | (define (dispatch m) 40 | (cond [(eq? m 'lookup-proc) lookup] 41 | [(eq? m 'insert-proc!) insert!] 42 | [else (error "Unknown operation -- TABLE" m)])) 43 | dispatch) 44 | 45 | (use srfi-13) 46 | (define t (make-table string-ci=)) 47 | (print ((t 'lookup-proc) "foo" "bar")) 48 | ((t 'insert-proc!) "foo" "bar" "baz") 49 | (print ((t 'lookup-proc) "FoO" "bAr")) 50 | -------------------------------------------------------------------------------- /ex-3.22.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 3.22. Instead of representing a queue as a pair of pointers, we 2 | ;;; can build a queue as a procedure with local state. The local state will 3 | ;;; consist of pointers to the beginning and the end of an ordinary list. Thus, 4 | ;;; the make-queue procedure will have the form 5 | ;;; 6 | ;;; (define (make-queue) 7 | ;;; (let ((front-ptr ...) 8 | ;;; (rear-ptr ...)) 9 | ;;; 10 | ;;; (define (dispatch m) ...) 11 | ;;; dispatch)) 12 | ;;; 13 | ;;; Complete the definition of make-queue and provide implementations of the 14 | ;;; queue operations using this representation. 15 | 16 | (define (make-queue) 17 | (let ([front-ptr '()] 18 | [rear-ptr '()]) 19 | (define (empty-queue?) 20 | (null? front-ptr)) 21 | (define (front-queue) 22 | (cond [(empty-queue?) 23 | (error "FRONT-QUEUE called with an empty queue")] 24 | [else 25 | (car front-ptr)])) 26 | (define (insert-queue! item) 27 | (let ([new-pair (cons item '())]) 28 | (cond [(empty-queue?) 29 | (set! front-ptr new-pair) 30 | (set! rear-ptr new-pair)] 31 | [else 32 | (set-cdr! rear-ptr new-pair) 33 | (set! rear-ptr new-pair)]))) 34 | (define (delete-queue!) 35 | (cond [(empty-queue?) 36 | (error "DELETE-QUEUE! called with an empty queue")] 37 | [else 38 | (set! front-ptr (cdr front-ptr))])) 39 | (define (dispatch m) 40 | (cond [(eq? m 'empty-queue?) empty-queue?] 41 | [(eq? m 'front-queue) front-queue] 42 | [(eq? m 'insert-queue!) insert-queue!] 43 | [(eq? m 'delete-queue!) delete-queue!] 44 | [else (error "Unknown message -- " m)])) 45 | dispatch)) 46 | 47 | (define q (make-queue)) 48 | ((q 'insert-queue!) 'a) 49 | ((q 'insert-queue!) 'b) 50 | ((q 'insert-queue!) 'c) 51 | (print q) 52 | (print ((q 'front-queue))) 53 | ((q 'delete-queue!)) 54 | (print ((q 'front-queue))) 55 | ((q 'delete-queue!)) 56 | (print ((q 'front-queue))) 57 | (print ((q 'empty-queue?))) 58 | ((q 'delete-queue!)) 59 | (print q) 60 | (print ((q 'empty-queue?))) 61 | -------------------------------------------------------------------------------- /ex-4.59.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-4.4.4.scm") 2 | (load "./sec-4.4.1-sample-db.scm") 3 | 4 | (query-driver-loop-for-script '( 5 | 6 | ;;; Exercise 4.59. Ben Bitdiddle has missed one meeting too many. Fearing that 7 | ;;; his habit of forgetting meetings could cost him his job, Ben decides to do 8 | ;;; something about it. He adds all the weekly meetings of the firm to the 9 | ;;; Microshaft data base by asserting the following: 10 | 11 | (assert! (meeting accounting (Monday 9am))) 12 | (assert! (meeting administration (Monday 10am))) 13 | (assert! (meeting computer (Wednesday 3pm))) 14 | (assert! (meeting administration (Friday 1pm))) 15 | 16 | ;;; Each of the above assertions is for a meeting of an entire division. Ben 17 | ;;; also adds an entry for the company-wide meeting that spans all the 18 | ;;; divisions. All of the company's employees attend this meeting. 19 | 20 | (assert! (meeting whole-company (Wednesday 4pm))) 21 | 22 | 23 | 24 | 25 | ;;; a. On Friday morning, Ben wants to query the data base for all the meetings 26 | ;;; that occur that day. What query should he use? 27 | 28 | (meeting ?division (Friday . ?time)) 29 | 30 | 31 | 32 | 33 | ;;; b. Alyssa P. Hacker is unimpressed. She thinks it would be much more useful 34 | ;;; to be able to ask for her meetings by specifying her name. So she designs 35 | ;;; a rule that says that a person's meetings include all whole-company 36 | ;;; meetings plus all meetings of that person's division. Fill in the body of 37 | ;;; Alyssa's rule. 38 | ;;; 39 | ;;; (rule (meeting-time ?person ?day-and-time) 40 | ;;; ) 41 | 42 | (assert! (rule (meeting-time ?person ?day-and-time) 43 | (and (meeting ?d ?day-and-time) 44 | (or (same ?d ?division) 45 | (same ?d whole-company)) 46 | (job ?person (?division . ?job-rest))))) 47 | (meeting-time ?person (Friday . ?time)) 48 | (meeting-time (Bitdiddle Ben) ?day-and-time) 49 | 50 | 51 | 52 | 53 | ;;; c. Alyssa arrives at work on Wednesday morning and wonders what meetings 54 | ;;; she has to attend that day. Having defined the above rule, what query 55 | ;;; should she make to find this out? 56 | 57 | (meeting-time (Hacker Alyssa P) (Wednesday ?time)) 58 | 59 | )) 60 | -------------------------------------------------------------------------------- /sec-4.4.1-sample-db.scm: -------------------------------------------------------------------------------- 1 | (query-driver-loop-for-script 2 | '((assert! (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10))) 3 | (assert! (job (Bitdiddle Ben) (computer wizard))) 4 | (assert! (salary (Bitdiddle Ben) 60000)) 5 | 6 | (assert! (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))) 7 | (assert! (job (Hacker Alyssa P) (computer programmer))) 8 | (assert! (salary (Hacker Alyssa P) 40000)) 9 | (assert! (supervisor (Hacker Alyssa P) (Bitdiddle Ben))) 10 | (assert! (address (Fect Cy D) (Cambridge (Ames Street) 3))) 11 | (assert! (job (Fect Cy D) (computer programmer))) 12 | (assert! (salary (Fect Cy D) 35000)) 13 | (assert! (supervisor (Fect Cy D) (Bitdiddle Ben))) 14 | (assert! (address (Tweakit Lem E) (Boston (Bay State Road) 22))) 15 | (assert! (job (Tweakit Lem E) (computer technician))) 16 | (assert! (salary (Tweakit Lem E) 25000)) 17 | (assert! (supervisor (Tweakit Lem E) (Bitdiddle Ben))) 18 | 19 | (assert! (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80))) 20 | (assert! (job (Reasoner Louis) (computer programmer trainee))) 21 | (assert! (salary (Reasoner Louis) 30000)) 22 | (assert! (supervisor (Reasoner Louis) (Hacker Alyssa P))) 23 | 24 | (assert! (supervisor (Bitdiddle Ben) (Warbucks Oliver))) 25 | (assert! (address (Warbucks Oliver) (Swellesley (Top Heap Road)))) 26 | (assert! (job (Warbucks Oliver) (administration big wheel))) 27 | (assert! (salary (Warbucks Oliver) 150000)) 28 | 29 | (assert! (address (Scrooge Eben) (Weston (Shady Lane) 10))) 30 | (assert! (job (Scrooge Eben) (accounting chief accountant))) 31 | (assert! (salary (Scrooge Eben) 75000)) 32 | (assert! (supervisor (Scrooge Eben) (Warbucks Oliver))) 33 | (assert! (address (Cratchet Robert) (Allston (N Harvard Street) 16))) 34 | (assert! (job (Cratchet Robert) (accounting scrivener))) 35 | (assert! (salary (Cratchet Robert) 18000)) 36 | (assert! (supervisor (Cratchet Robert) (Scrooge Eben))) 37 | 38 | (assert! (address (Aull DeWitt) (Slumerville (Onion Square) 5))) 39 | (assert! (job (Aull DeWitt) (administration secretary))) 40 | (assert! (salary (Aull DeWitt) 25000)) 41 | (assert! (supervisor (Aull DeWitt) (Warbucks Oliver))))) 42 | -------------------------------------------------------------------------------- /ex-2.71.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 2.71. 2 | ;;; 3 | ;;; Suppose we have a Huffman tree for an alphabet of n symbols, and that the 4 | ;;; relative frequencies of the symbols are 1, 2, 4, ..., 2^(n-1). Sketch the 5 | ;;; tree for n=5; for n=10. 6 | 7 | (load "./ex-2.68.scm") 8 | (load "./ex-2.69.scm") 9 | 10 | (print "") 11 | (print "Exercise 2.71:") 12 | 13 | (define (nth-alphabet n) 14 | (string->symbol (string (integer->char (+ (char->integer #\A) n))))) 15 | 16 | (for-each 17 | (^n 18 | (let* ([alphabet-frequencies (map (^i (list (nth-alphabet i) (expt 2 i))) 19 | (iota n))] 20 | [tree (generate-huffman-tree alphabet-frequencies)] 21 | ) 22 | (print "") 23 | (print "n = " n) 24 | (print "alphabets = " alphabet-frequencies) 25 | (print "tree = " tree) 26 | )) 27 | '(5 10)) 28 | 29 | ; The tree for n = 5 is as follows: 30 | ; 31 | ; (A B C D E)-31 32 | ; / \ 33 | ; (A B C D)-15 E-16 34 | ; / \ 35 | ; (A B C)-7 D-8 36 | ; / \ 37 | ; (A B)-3 C-4 38 | ; / \ 39 | ; A-1 B-2 40 | ; 41 | ; The tree for n = 10 is as follows: 42 | ; 43 | ; (A B C D E F G H I J)-1023 44 | ; / \ 45 | ; (A B C D E F G H I)-511 J-512 46 | ; / \ 47 | ; (A B C D E F G H)-255 I-256 48 | ; / \ 49 | ; (A B C D E F G)-127 H-128 50 | ; / \ 51 | ; (A B C D E F)-63 G-64 52 | ; / \ 53 | ; (A B C D E)-31 F-32 54 | ; / \ 55 | ; (A B C D)-15 E-16 56 | ; / \ 57 | ; (A B C)-7 D-8 58 | ; / \ 59 | ; (A B)-3 C-4 60 | ; / \ 61 | ; A-1 B-2 62 | 63 | 64 | ;;; In such a tree (for general n) how many bits are required to encode the 65 | ;;; most frequent symbol? the least frequent symbol? 66 | 67 | ; Only 1 bit is required to encode the most frequent symbol, while 68 | ; n-1 bits are required to encode the least frequent symbol. 69 | -------------------------------------------------------------------------------- /ex-4.36.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.36. Exercise 3.69 discussed how to generate the stream of all 2 | ;;; Pythagorean triples, with no upper bound on the size of the integers to be 3 | ;;; searched. 4 | 5 | ;;; Explain why simply replacing an-integer-between by an-integer-starting-from 6 | ;;; in the procedure in exercise 4.35 is not an adequate way to generate 7 | ;;; arbitrary Pythagorean triples. 8 | 9 | ; The modified procedure would be: 10 | ; 11 | ; (define (a-pythagorean-triples low) 12 | ; (let ((i (an-integer-starting-from low))) 13 | ; (let ((j (an-integer-starting-from i))) 14 | ; (let ((k (an-integer-starting-from j))) 15 | ; (require (= (+ (* i i) (* j j)) (* k k))) 16 | ; (list i j k))))) 17 | ; 18 | ; And this version can be translated into C-like language as follows: 19 | ; 20 | ; for (int i = low; ; i++) 21 | ; { 22 | ; for (int j = i; ; j++) 23 | ; { 24 | ; for (int k = j; ; k++) 25 | ; { 26 | ; if (i * i + j * j != k * k) 27 | ; continue; 28 | ; emit(i, j, i); 29 | ; } 30 | ; } 31 | ; } 32 | ; 33 | ; Thus, the most inner loop tries to enumerate infinite number of integers. So 34 | ; that non-first candidates of i and j will never be enumerated. 35 | 36 | ;;; Write a procedure that actually will accomplish this. (That is, write 37 | ;;; a procedure for which repeatedly typing try-again would in principle 38 | ;;; eventually generate all Pythagorean triples.) 39 | 40 | (load "./sec-4.3.3.scm") 41 | 42 | (ambtest 43 | '(begin 44 | 45 | (define (a-pythagorean-triples low) 46 | (let ((k (an-integer-starting-from low))) 47 | (let ((j (an-integer-between low k))) 48 | (let ((i (an-integer-between low j))) 49 | (require (= (+ (* i i) (* j j)) (* k k))) 50 | (list i j k))))) 51 | 52 | (define (an-integer-between i j) 53 | (require (<= i j)) 54 | (amb i (an-integer-between (+ i 1) j))) 55 | (define (an-integer-starting-from i) 56 | (amb i (an-integer-starting-from (+ i 1)))) 57 | 58 | (let ((triple (a-pythagorean-triples 1))) 59 | (print triple) 60 | (if (>= (car (cdr (cdr triple))) 100) 61 | (error "... and more")) 62 | ) 63 | 64 | )) 65 | -------------------------------------------------------------------------------- /ex-4.45.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.45. With the grammar given above, the following sentence can be 2 | ;;; parsed in five different ways: ``The professor lectures to the student in 3 | ;;; the class with the cat.'' Give the five parses and explain the differences 4 | ;;; in shades of meaning among them. 5 | 6 | (load "./sec-4.3.2.scm") 7 | (load "./sec-4.3.3.scm") 8 | 9 | (ambtest `(begin 10 | 11 | ,@parser-definitions 12 | 13 | (define the-sentence 14 | '(the professor lectures to the student in the class with the cat)) 15 | 16 | (print (parse the-sentence)) 17 | 18 | )) 19 | 20 | ; Results are: 21 | ; (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) 22 | ; (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))) 23 | ; (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) 24 | ; (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))) 25 | ; (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))))) 26 | -------------------------------------------------------------------------------- /ex-2.76.md: -------------------------------------------------------------------------------- 1 | # Exercise 2.76. 2 | 3 | > As a large system with generic operations evolves, new types of data 4 | > objects or new operations may be needed. For each of the three strategies 5 | > -- generic operations with explicit dispatch, data-directed style, and 6 | > message-passing-style -- describe the changes that must be made to a system 7 | > in order to add new types or new operations. 8 | 9 | * Generic operations with explicit dispatch 10 | 11 | * Whenever new types of data objects are introduced, 12 | all generic operations have to be updated to support the new types 13 | by adding more explicit dispatches. To do this, we have to change the 14 | existing definitions of all operations. So that it's not additive. 15 | 16 | * Whenever new operations are introduced, 17 | the new operations have to include explicit dispatch for all types. 18 | It's additive, but combersome. 19 | 20 | * Data-directed style 21 | 22 | * Whenever new types of data objects are introduced, 23 | we have to write packages to support the new types to be applicable to 24 | existing operations. It's additive and easy to maintain because 25 | operations for a specific type is put into a single package. 26 | 27 | * Whenever new operations are introduced, 28 | we have to update existing packages. 29 | It's not additive, but maintainable. 30 | 31 | * Message-passing style 32 | 33 | * Whenever new types of data objects are introduced, 34 | we have to write data constructors for these types. 35 | It's additive. 36 | 37 | * Whenever new operations are introduced, we have to change the existing 38 | data constructors to support the operations. It's not additive. 39 | 40 | 41 | > Which organization would be most appropriate for a system in which new 42 | > types must often be added? 43 | 44 | Message-passing style is the most appropriate one. Because we don't have to 45 | change data constructors of existing types whenever new types are added. 46 | 47 | 48 | > Which would be most appropriate for a system in which new operations must 49 | > often be added? 50 | 51 | Explicit dispatch is not additive for both new operations and new types. But 52 | both data-directed style and message-passing style are not additive for new 53 | operations. So that it depends on applications. 54 | -------------------------------------------------------------------------------- /ex-3.52.scm: -------------------------------------------------------------------------------- 1 | (load "./sec-3.5.scm") 2 | 3 | ;;; Exercise 3.52. Consider the sequence of expressions 4 | 5 | (define sum 0) 6 | (define (accum x) ; E0 7 | (set! sum (+ x sum)) 8 | sum) 9 | (print "E0: " sum ";") 10 | (define seq (stream-map accum (stream-enumerate-interval 1 20))) ; E1 11 | (print "E1: " sum ";") 12 | (define y (stream-filter even? seq)) ; E2 13 | (print "E2: " sum ";") 14 | (define z (stream-filter (lambda (x) (= (remainder x 5) 0)) ; E3 15 | seq)) 16 | (print "E3: " sum ";") 17 | (stream-ref y 7) ; E4 18 | (print "E4: " sum ";") 19 | (display-stream z) ; E5 20 | (print "E5: " sum ";") 21 | 22 | ;;; What is the value of sum after each of the above expressions is evaluated? 23 | 24 | ; base 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 25 | ; E1 E2 E2 E3 26 | ; seq 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 27 | ; E1 E2 E2 E3 28 | ; y 6 10 28 36 66 78 120 136 190 210 29 | ; E2 E3 E4 E4 E4 E4 E4 E4 30 | ; z 10 15 45 55 120 190 210 31 | ; E3 E5 E5 E5 E5 E5 E5 32 | 33 | ; * After E0: 0, because seq is not processed yet. 34 | ; * After E1: 1, because stream-map delays evaluation only for non-first items. 35 | ; So only the first item -- in this case, 1 -- is processed by accum. 36 | ; * After E2: 6, because stream-filter eagrly processes a given stream until 37 | ; a proper item is found, and the first item of y is the third item of seq. 38 | ; * After E3: 10. Like E2. 39 | ; * After E4: 136. Like E2. 40 | ; * After E5: 210. In this case, the base stream is completely enumerated. 41 | 42 | ;;; What is the printed response to evaluating the stream-ref and 43 | ;;; display-stream expressions? 44 | 45 | ; For stream-ref: 136 46 | ; For display-stream: 10, 15, 45, 55, 120, 190 and 210 47 | 48 | ;;; Would these responses differ if we had implemented (delay ) simply as 49 | ;;; (lambda () ) without using the optimization provided by memo-proc? 50 | ;;; Explain. 51 | 52 | ; Yes they differ, because seq is enumerated twice by y and z. 53 | -------------------------------------------------------------------------------- /ex-4.29.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.29. Exhibit a program that you would expect to run much more 2 | ;;; slowly without memoization than with memoization. 3 | 4 | (define (average numbers) 5 | (/ (sum numbers) (length numbers))) 6 | 7 | (define (sum numbers) 8 | (let go ((acc 0) 9 | (numbers numbers)) 10 | (if (null? numbers) 11 | acc 12 | (go (+ acc (car numbers)) 13 | (cdr numbers))))) 14 | 15 | (define (sleep seconds) 16 | ; ... 17 | ) 18 | 19 | (define (list-numbers-slowly) 20 | (sleep 5) 21 | '(869 12 72 1127 197 37931 91 73 91301 1 51 11 1999)) 22 | 23 | ; Delayed (list-numbers-slowly) is passed to AVERAGE, and AVERAGE uses the 24 | ; given numbers twice. So that LIST-NUMBERS-SLOWLY is called twice. 25 | ; 26 | ; Likewise, if a procedure uses a given argument multiple times, thunks are 27 | ; evaluated that many times. 28 | (average (list-numbers-slowly)) 29 | 30 | 31 | 32 | 33 | ;;; Also, consider the following interaction, where the id procedure is defined 34 | ;;; as in exercise 4.27 and count starts at 0: 35 | ;;; 36 | ;;; (define (square x) 37 | ;;; (* x x)) 38 | ;;; ;;; L-Eval input: 39 | ;;; (square (id 10)) 40 | ;;; ;;; L-Eval value: 41 | ;;; 42 | ;;; ;;; L-Eval input: 43 | ;;; count 44 | ;;; ;;; L-Eval value: 45 | ;;; 46 | ;;; 47 | ;;; Give the responses both when the evaluator memoizes and when it does not. 48 | 49 | ; | With memoization | Without memoization 50 | ; ------------------+------------------+---------------------- 51 | ; First | 100 | 100 52 | ; Second | 1 | 2 53 | ; 54 | ; In SQUARE, X = delayed (id 10) is passed to *. * is a primitive procedure, 55 | ; so that X is immediately forced. So that the first is 100 for 56 | ; both evaluators. 57 | ; 58 | ; But the second is different. Because X is referred twice in 59 | ; SQUARE. So that (id 10) is evaluated twice. 60 | 61 | (load "./sec-4.1.1.scm") 62 | (load "./sec-4.1.2.scm") 63 | (load "./sec-4.1.3.scm") 64 | (load "./sec-4.1.4.scm") 65 | (load "./sec-4.2.2.scm") 66 | 67 | (for-each 68 | (lambda (expr) 69 | (print expr) 70 | (print "==> " (actual-value expr the-global-environment))) 71 | '((define count 0) 72 | (define (id x) 73 | (set! count (+ count 1)) 74 | x) 75 | (define (square x) 76 | (* x x)) 77 | (square (id 10)) 78 | count 79 | )) 80 | -------------------------------------------------------------------------------- /ex-4.32.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.32. Give some examples that illustrate the difference between 2 | ;;; the streams of chapter 3 and the ``lazier'' lazy lists described in this 3 | ;;; section. How can you take advantage of this extra laziness? 4 | 5 | ; We can construct linear lists of infinite length with the streams, 6 | ; but we can construct trees of infinite depth with the lazier lazy lists. 7 | ; For example... 8 | 9 | (load "./sec-4.1.1.scm") 10 | (load "./sec-4.1.2.scm") 11 | (load "./sec-4.1.3.scm") 12 | (load "./sec-4.1.4.scm") 13 | (load "./sec-4.2.2.scm") 14 | 15 | (define code 16 | '((define (cons x y) 17 | (lambda (m) (m x y))) 18 | (define (car z) 19 | (z (lambda (p q) p))) 20 | (define (cdr z) 21 | (z (lambda (p q) q))) 22 | 23 | (define (make-tree value left right) 24 | (cons value (cons left right))) 25 | 26 | (define nil-tree (make-tree "X" "X" "X")) 27 | 28 | (define (nil-tree? tree) 29 | (eq? tree nil-tree)) 30 | 31 | (define (tree-value tree) 32 | (car tree)) 33 | 34 | (define (tree-left tree) 35 | (car (cdr tree))) 36 | 37 | (define (tree-right tree) 38 | (cdr (cdr tree))) 39 | 40 | (define (make-random-tree value) 41 | (make-tree value 42 | (if (= (modulo value 5) 0) 43 | nil-tree 44 | (make-random-tree (+ value 3))) 45 | (if (= (modulo value 8) 0) 46 | nil-tree 47 | (make-random-tree (* value 2))))) 48 | 49 | (define (display-tree tree depth-limit) 50 | (define (go tree d) 51 | (cond ((nil-tree? tree) 52 | (print (indent d "-"))) 53 | (else 54 | (print (indent d (tree-value tree))) 55 | (cond ((>= (+ d 1) depth-limit) 56 | (print (indent d "..."))) 57 | (else 58 | (print (indent d "Left:")) 59 | (go (tree-left tree) (+ d 1)) 60 | (print (indent d "Right:")) 61 | (go (tree-right tree) (+ d 1))))))) 62 | (go tree 0)) 63 | 64 | (display-tree (make-random-tree 3) 3) 65 | (display-tree (make-random-tree 3) 8) 66 | )) 67 | 68 | (define (main args) 69 | (for-each 70 | (lambda (expr) 71 | (print expr) 72 | (print "==> " (actual-value expr the-global-environment))) 73 | code)) 74 | -------------------------------------------------------------------------------- /ex-4.39.md: -------------------------------------------------------------------------------- 1 | > Exercise 4.39. Does the order of the restrictions in the `multiple-dwelling` 2 | > procedure affect the answer? Does it affect the time to find an answer? If 3 | > you think it matters, demonstrate a faster program obtained from the given 4 | > one by reordering the restrictions. If you think it does not matter, argue 5 | > your case. 6 | 7 | It depends on how `amb` and `require` are ordered. 8 | 9 | The order of the restrictions in the `multiple-dwelling` procedure does not 10 | matter for performance. Combinations of `amb` and `require` can be treated as 11 | a loop construct in C-like language like this: 12 | 13 | ```c 14 | for (int baker = 1; baker <= 5; baker++) 15 | { 16 | for (int cooper = 1; cooper <= 5; cooper++) 17 | { 18 | .... 19 | for (int smith = 1; smith <= 5; smith++) 20 | { 21 | if (baker == 5) 22 | continue; 23 | if (cooper == 1) 24 | continue; 25 | ... 26 | return makeResult(baker, cooper, ..., smith); 27 | } 28 | .... 29 | } 30 | } 31 | ``` 32 | 33 | In this case all possible values are generated then are tested. So that the 34 | order of the restrictions does not matter. 35 | 36 | If the `multiple-dwelling` procedure is rewritten like this: 37 | 38 | ```scheme 39 | (define (multiple-dwelling) 40 | (let ((baker (amb 1 2 3 4 5))) 41 | (require (not (= baker 5))) 42 | (let ((cooper (amb 1 2 3 4 5))) 43 | (require (not (= cooper 1))) 44 | ... 45 | (let ((smith (amb 1 2 3 4 5))) 46 | (require 47 | (distinct? (list baker cooper fletcher miller smith))) 48 | (require (not (= (abs (- smith fletcher)) 1))) 49 | ...)))) 50 | ``` 51 | 52 | C-like language equivalent for the above procedure would be like this: 53 | 54 | ```c 55 | for (int baker = 1; baker <= 5; baker++) 56 | { 57 | if (baker == 5) 58 | continue; 59 | for (int cooper = 1; cooper <= 5; cooper++) 60 | { 61 | if (cooper == 1) 62 | continue; 63 | for (int smith = 1; smith <= 5; smith++) 64 | { 65 | ... 66 | } 67 | .... 68 | } 69 | } 70 | ``` 71 | 72 | This version does not generate all possible values. Many possible values are 73 | cut in early steps (like `baker == 5`, `cooper == 1`, etc). So that this 74 | version is faster than the original. 75 | -------------------------------------------------------------------------------- /ex-3.66.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.66. Examine the stream `(pairs integers integers)`. Can you make 2 | > any general comments about the order in which the pairs are placed into the 3 | > stream? 4 | 5 | A | B 6 | (1, 1) | (1, 2) (1, 3) (1, 4) ... 7 | --------------------------------- 8 | | C 9 | | (2, 2) (2, 3) (2, 4) ... 10 | | (3, 3) (3, 4) ... 11 | | (4, 4) ... 12 | 13 | `(pairs integers integers)` enumerates the pair A, then enumerates pairs from 14 | `interleave`d stream of B and C. C is also enumerated like `pairs`. 15 | 16 | A | B 17 | (1, 1) | (1, 2) (1, 3) (1, 4) ... 18 | --------------------------------- 19 | | C 20 | | Ca | Cb 21 | | (2, 2) | (2, 3) (2, 4) ... 22 | | -------------------------- 23 | | | Cc 24 | | | (3, 3) (3, 4) ... 25 | | | (4, 4) ... 26 | 27 | Likewise B and C, Cb and Cc are `interleave`d. So that enumeration of B is 28 | roughly twice as fast as enumeration of C. 29 | 30 | The first 15 pairs of `(pairs integers integers)` are: 31 | 32 | 1. (1, 1) 33 | 2. (1, 2) 34 | 3. (2, 2) 35 | 4. (1, 3) 36 | 5. (2, 3) 37 | 6. (1, 4) 38 | 7. (3, 3) 39 | 8. (1, 5) 40 | 9. (2, 4) 41 | 10. (1, 6) 42 | 11. (3, 4) 43 | 12. (1, 7) 44 | 13. (2, 5) 45 | 14. (1, 8) 46 | 15. (4, 4) 47 | 48 | 1(1, 1) 2(1, 2) 4(1, 3) 6(1, 4) 8(1, 5) 10(1, 6) 12(1, 7) 14(1, 8) 49 | 3(2, 2) 5(2, 3) 9(2, 4) 13(2, 5) 50 | 7(3, 3) 11(3, 4) 51 | 15(4, 4) 52 | 53 | Let f(i, j) = n for the n-th pair (i, j). From the above result, 54 | 55 | * f(i, i) seems to be 2^i - 1 56 | * f(i, i+1) seems to be f(i, i) + 2^(i-1) 57 | * For n >= 2, f(i, i+n) seems to be f(i, i+1) + (2^i) * (n - (i+1)) 58 | 59 | So that f(6, 6) should be 31, and f(6, 10) should be 287. 60 | 61 | > For example, about how many pairs precede the pair (1,100)? the pair 62 | > (99,100)? the pair (100,100)? (If you can make precise mathematical 63 | > statements here, all the better. But feel free to give more qualitative 64 | > answers if you find yourself getting bogged down.) 65 | 66 | * For (1, 100), there are 197 preceding pairs. 67 | * For (99, 100), there are 950,737,950,171,172,051,122,527,404,031 pairs. 68 | * For (1, 100), there are 1,267,650,600,228,229,401,496,703,205,375 pairs. 69 | -------------------------------------------------------------------------------- /ex-3.12.md: -------------------------------------------------------------------------------- 1 | > Exercise 3.12. The following procedure for appending lists was introduced in 2 | > section 2.2.1: 3 | > 4 | > ```scheme 5 | > (define (append x y) 6 | > (if (null? x) 7 | > y 8 | > (cons (car x) (append (cdr x) y)))) 9 | > ``` 10 | > 11 | > `Append` forms a new list by successively consing the elements of `x` onto 12 | > `y`. The procedure `append!` is similar to `append`, but it is a mutator 13 | > rather than a constructor. It appends the lists by splicing them together, 14 | > modifying the final pair of `x so` that its `cdr` is now `y`. (It is an error 15 | > to call `append!` with an empty `x`.) 16 | > 17 | > ```scheme 18 | > (define (append! x y) 19 | > (set-cdr! (last-pair x) y) 20 | > x) 21 | > ``` 22 | > 23 | > Here `last-pair` is a procedure that returns the last pair in its argument: 24 | > 25 | > ```scheme 26 | > (define (last-pair x) 27 | > (if (null? (cdr x)) 28 | > x 29 | > (last-pair (cdr x)))) 30 | > ``` 31 | > 32 | > Consider the interaction 33 | > 34 | > ```scheme 35 | > (define x (list 'a 'b)) 36 | > (define y (list 'c 'd)) 37 | > (define z (append x y)) 38 | > z 39 | > (a b c d) 40 | > (cdr x) 41 | > 42 | > (define w (append! x y)) 43 | > w 44 | > (a b c d) 45 | > (cdr x) 46 | > 47 | > ``` 48 | > 49 | > What are the missing **s? Draw box-and-pointer diagrams to explain 50 | > your answer. 51 | 52 | The first is `(b)`, because the environment is as follows: 53 | 54 | ``` 55 | x---->[o][o]-->[o][/] 56 | | | 57 | v v 58 | [a] [b] 59 | 60 | z---->[o][o]-->[o][o]--. 61 | | | | 62 | v v | 63 | [a] [b] | 64 | | 65 | y--*->[o][o]-->[o][/] 66 | | | 67 | v v 68 | [c] [d] 69 | ``` 70 | 71 | The second is `(b c d)`, because the environment is as follows: 72 | 73 | ``` 74 | w--. 75 | | 76 | x--*->[o][o]-->[o][o]--. 77 | | | | 78 | v v | 79 | [a] [b] | 80 | | 81 | z---->[o][o]-->[o][o]--* 82 | | | | 83 | v v | 84 | [a] [b] | 85 | | 86 | y--*->[o][o]-->[o][/] 87 | | | 88 | v v 89 | [c] [d] 90 | ``` 91 | -------------------------------------------------------------------------------- /ex-4.40.scm: -------------------------------------------------------------------------------- 1 | ;;; Exercise 4.40. In the multiple dwelling problem, how many sets of 2 | ;;; assignments are there of people to floors, both before and after the 3 | ;;; requirement that floor assignments be distinct? 4 | 5 | ; Before: 5 * 5 * 5 * 5 * 5 = 3125 sets 6 | ; After: 5 * 4 * 3 * 2 * 1 = 120 sets 7 | 8 | ;;; It is very inefficient to generate all possible assignments of people to 9 | ;;; floors and then leave it to backtracking to eliminate them. For example, 10 | ;;; most of the restrictions depend on only one or two of the person-floor 11 | ;;; variables, and can thus be imposed before floors have been selected for all 12 | ;;; the people. Write and demonstrate a much more efficient nondeterministic 13 | ;;; procedure that solves this problem based upon generating only those 14 | ;;; possibilities that are not already ruled out by previous restrictions. 15 | ;;; (Hint: This will require a nest of let expressions.) 16 | 17 | (load "./sec-4.3.3.scm") 18 | 19 | (ambtest '(begin 20 | 21 | (define (distinct? items) 22 | (cond ((null? items) true) 23 | ((null? (cdr items)) true) 24 | ((member (car items) (cdr items)) false) 25 | (else (distinct? (cdr items))))) 26 | 27 | (define (multiple-dwelling) 28 | (let ((baker (amb 1 2 3 4 5))) 29 | (require (not (= baker 5))) 30 | (let ((cooper (amb 1 2 3 4 5))) 31 | (require (not (= cooper 1))) 32 | (let ((fletcher (amb 1 2 3 4 5))) 33 | (require (not (= fletcher 5))) 34 | (require (not (= fletcher 1))) 35 | (require (not (= (abs (- fletcher cooper)) 1))) 36 | (let ((miller (amb 1 2 3 4 5))) 37 | (require (> miller cooper)) 38 | (let ((smith (amb 1 2 3 4 5))) 39 | (require (not (= (abs (- smith fletcher)) 1))) 40 | (require 41 | (distinct? (list baker cooper fletcher miller smith))) 42 | (list (list 'baker baker) 43 | (list 'cooper cooper) 44 | (list 'fletcher fletcher) 45 | (list 'miller miller) 46 | (list 'smith smith)))))))) 47 | 48 | (let ((answer (multiple-dwelling))) 49 | (print answer)) 50 | 51 | )) 52 | --------------------------------------------------------------------------------