;;;;CODE FROM CHAPTER 1 OF STRUCTURE AND INTERPRETATION OF COMPUTER PROGRAMS ;;; Examples from the book are commented out with ;: so that they ;;; are easy to find and so that they will be omitted if you evaluate a ;;; chunk of the file (programs with intervening examples) in Scheme. ;;; BEWARE: Although the whole file can be loaded into Scheme, ;;; don't expect the programs to work if you do so. For example, ;;; the redefinition of + in exercise 1.9 wreaks havoc with the ;;; last version of square defined here. ;;;SECTION 1.1.1 ;; interpreter examples ;: 486 ;: (+ 137 349) ;: (- 1000 334) ;: (* 5 99) ;: (/ 10 5) ;: (+ 2.7 10) ;: (+ 21 35 12 7) ;: (* 25 4 12) ;: (+ (* 3 5) (- 10 6)) ;: (+ (* 3 (+ (* 2 4) (+ 3 5))) (+ (- 10 7) 6)) ;: (+ (* 3 ;: (+ (* 2 4) ;: (+ 3 5))) ;: (+ (- 10 7) ;: 6)) ;;;SECTION 1.1.2 ;: (define size 2) ;: size ;: (* 5 size) ;: (define pi 3.14159) ;: (define radius 10) ;: (* pi (* radius radius)) ;: (define circumference (* 2 pi radius)) ;: circumference ;;;SECTION 1.1.3 ;: (* (+ 2 (* 4 6)) ;: (+ 3 5 7)) ;;;SECTION 1.1.4 (define (square x) (* x x)) ;: (square 21) ;: (square (+ 2 5)) ;: (square (square 3)) (define (sum-of-squares x y) (+ (square x) (square y))) ;: (sum-of-squares 3 4) (define (f a) (sum-of-squares (+ a 1) (* a 2))) ;: (f 5) ;;;SECTION 1.1.5 ;: (f 5) ;: (sum-of-squares (+ 5 1) (* 5 2)) ;: (+ (square 6) (square 10)) ;: (+ (* 6 6) (* 10 10)) ;: (+ 36 100) ;: (f 5) ;: (sum-of-squares (+ 5 1) (* 5 2)) ;: (+ (square (+ 5 1)) (square (* 5 2)) ) ;: (+ (* (+ 5 1) (+ 5 1)) (* (* 5 2) (* 5 2))) ;: (+ (* 6 6) (* 10 10)) ;: (+ 36 100) ;: 136 ;;;SECTION 1.1.6 (define (abs x) (cond ((> x 0) x) ((= x 0) 0) ((< x 0) (- x)))) (define (abs x) (cond ((< x 0) (- x)) (else x))) (define (abs x) (if (< x 0) (- x) x)) ;: (and (> x 5) (< x 10)) (define (>= x y) (or (> x y) (= x y))) (define (>= x y) (not (< x y))) ;;EXERCISE 1.1 ;: 10 ;: (+ 5 3 4) ;: (- 9 1) ;: (/ 6 2) ;: (+ (* 2 4) (- 4 6)) ;: (define a 3) ;: (define b (+ a 1)) ;: (+ a b (* a b)) ;: (= a b) ;: (if (and (> b a) (< b (* a b))) ;: b ;: a) ;: (cond ((= a 4) 6) ;: ((= b 4) (+ 6 7 a)) ;: (else 25)) ;: (+ 2 (if (> b a) b a)) ;: (* (cond ((> a b) a) ;: ((< a b) b) ;: (else -1)) ;: (+ a 1)) ;;EXERCISE 1.4 (define (a-plus-abs-b a b) ((if (> b 0) + -) a b)) ;;EXERCISE 1.5 (define (p) (p)) (define (test x y) (if (= x 0) 0 y)) ;: (test 0 (p)) ;;;SECTION 1.1.7 (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (define (improve guess x) (average guess (/ x guess))) (define (average x y) (/ (+ x y) 2)) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (sqrt x) (sqrt-iter 1.0 x)) ;: (sqrt 9) ;: (sqrt (+ 100 37)) ;: (sqrt (+ (sqrt 2) (sqrt 3))) ;: (square (sqrt 1000)) ;;EXERCISE 1.6 (define (new-if predicate then-clause else-clause) (cond (predicate then-clause) (else else-clause))) ;: (new-if (= 2 3) 0 5) ;: (new-if (= 1 1) 0 5) (define (sqrt-iter guess x) (new-if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) ;;;SECTION 1.1.8 (define (square x) (* x x)) (define (square x) (exp (double (log x)))) (define (double x) (+ x x)) ;; As in 1.1.7 (define (sqrt x) (sqrt-iter 1.0 x)) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (improve guess x) (average guess (/ x guess))) ;; Block-structured (define (sqrt x) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (improve guess x) (average guess (/ x guess))) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (sqrt-iter 1.0 x)) ;; Taking advantage of lexical scoping (define (sqrt x) (define (good-enough? guess) (< (abs (- (square guess) x)) 0.001)) (define (improve guess) (average guess (/ x guess))) (define (sqrt-iter guess) (if (good-enough? guess) guess (sqrt-iter (improve guess)))) (sqrt-iter 1.0)) ;;;SECTION 1.2.1 ;; Recursive (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) ;; Iterative (define (factorial n) (fact-iter 1 1 n)) (define (fact-iter product counter max-count) (if (> counter max-count) product (fact-iter (* counter product) (+ counter 1) max-count))) ;; Iterative, block-structured (from footnote) (define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* counter product) (+ counter 1)))) (iter 1 1)) ;;EXERCISE 1.9 (define (+ a b) (if (= a 0) b (inc (+ (dec a) b)))) (define (+ a b) (if (= a 0) b (+ (dec a) (inc b)))) ;;EXERCISE 1.10 (define (A x y) (cond ((= y 0) 0) ((= x 0) (* 2 y)) ((= y 1) 2) (else (A (- x 1) (A x (- y 1)))))) ;: (A 1 10) ;: (A 2 4) ;: (A 3 3) (define (f n) (A 0 n)) (define (g n) (A 1 n)) (define (h n) (A 2 n)) (define (k n) (* 5 n n)) ;;;SECTION 1.2.2 ;; Recursive (define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))))) ;; Iterative (define (fib n) (fib-iter 1 0 n)) (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) ;; Counting change (define (count-change amount) (cc amount 5)) (define (cc amount kinds-of-coins) (cond ((= amount 0) 1) ((or (< amount 0) (= kinds-of-coins 0)) 0) (else (+ (cc amount (- kinds-of-coins 1)) (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins))))) (define (first-denomination kinds-of-coins) (cond ((= kinds-of-coins 1) 1) ((= kinds-of-coins 2) 5) ((= kinds-of-coins 3) 10) ((= kinds-of-coins 4) 25) ((= kinds-of-coins 5) 50))) ;: (count-change 100) ;;;SECTION 1.2.3 ;;EXERCISE 1.15 (define (cube x) (* x x x)) (define (p x) (- (* 3 x) (* 4 (cube x)))) (define (sine angle) (if (not (> (abs angle) 0.1)) angle (p (sine (/ angle 3.0))))) ;;;SECTION 1.2.4 ;; Linear recursion (define (expt b n) (if (= n 0) 1 (* b (expt b (- n 1))))) ;; Linear iteration (define (expt b n) (expt-iter b n 1)) (define (expt-iter b counter product) (if (= counter 0) product (expt-iter b (- counter 1) (* b product)))) ;; Logarithmic iteration (define (fast-expt b n) (cond ((= n 0) 1) ((even? n) (square (fast-expt b (/ n 2)))) (else (* b (fast-expt b (- n 1)))))) (define (even? n) (= (remainder n 2) 0)) ;;EXERCISE 1.17 (define (* a b) (if (= b 0) 0 (+ a (* a (- b 1))))) ;;EXERCISE 1.19 (define (fib n) (fib-iter 1 0 0 1 n)) (define (fib-iter a b p q count) (cond ((= count 0) b) ((even? count) (fib-iter a b ??FILL-THIS-IN?? ; compute p' ??FILL-THIS-IN?? ; compute q' (/ count 2))) (else (fib-iter (+ (* b q) (* a q) (* a p)) (+ (* b p) (* a q)) p q (- count 1))))) ;;;SECTION 1.2.5 (define (gcd a b) (if (= b 0) a (gcd b (remainder a b)))) ;;;SECTION 1.2.6 ;; prime? (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1))))) (define (divides? a b) (= (remainder b a) 0)) (define (prime? n) (= n (smallest-divisor n))) ;; fast-prime? (define (expmod base exp m) (cond ((= exp 0) 1) ((even? exp) (remainder (square (expmod base (/ exp 2) m)) m)) (else (remainder (* base (expmod base (- exp 1) m)) m)))) (define (fermat-test n) (define (try-it a) (= (expmod a n n) a)) (try-it (+ 1 (random (- n 1))))) (define (fast-prime? n times) (cond ((= times 0) true) ((fermat-test n) (fast-prime? n (- times 1))) (else false))) ;;EXERCISE 1.22 (define (timed-prime-test n) (newline) (display n) (start-prime-test n (runtime))) (define (start-prime-test n start-time) (if (prime? n) (report-prime (- (runtime) start-time)))) (define (report-prime elapsed-time) (display " *** ") (display elapsed-time)) ;;EXERCISE 1.25 (define (expmod base exp m) (remainder (fast-expt base exp) m)) ;;EXERCISE 1.26 (define (expmod base exp m) (cond ((= exp 0) 1) ((even? exp) (remainder (* (expmod base (/ exp 2) m) (expmod base (/ exp 2) m)) m)) (else (remainder (* base (expmod base (- exp 1) m)) m)))) ;;;SECTION 1.3 (define (cube x) (* x x x)) ;;;SECTION 1.3.1 (define (sum-integers a b) (if (> a b) 0 (+ a (sum-integers (+ a 1) b)))) (define (sum-cubes a b) (if (> a b) 0 (+ (cube a) (sum-cubes (+ a 1) b)))) (define (pi-sum a b) (if (> a b) 0 (+ (/ 1.0 (* a (+ a 2))) (pi-sum (+ a 4) b)))) (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) ;; Using sum (define (inc n) (+ n 1)) (define (sum-cubes a b) (sum cube a inc b)) ;: (sum-cubes 1 10) (define (identity x) x) (define (sum-integers a b) (sum identity a inc b)) ;: (sum-integers 1 10) (define (pi-sum a b) (define (pi-term x) (/ 1.0 (* x (+ x 2)))) (define (pi-next x) (+ x 4)) (sum pi-term a pi-next b)) ;: (* 8 (pi-sum 1 1000)) (define (integral f a b dx) (define (add-dx x) (+ x dx)) (* (sum f (+ a (/ dx 2)) add-dx b) dx)) ;: (integral cube 0 1 0.01) ;: (integral cube 0 1 0.001) ;;EXERCISE 1.32 ;: (accumulate combiner null-value term a next b) ;;;SECTION 1.3.2 (define (pi-sum a b) (sum (lambda (x) (/ 1.0 (* x (+ x 2)))) a (lambda (x) (+ x 4)) b)) (define (integral f a b dx) (* (sum f (+ a (/ dx 2.0)) (lambda (x) (+ x dx)) b) dx)) (define (plus4 x) (+ x 4)) (define plus4 (lambda (x) (+ x 4))) ;: ((lambda (x y z) (+ x y (square z))) 1 2 3) ;; Using let (define (f x y) (define (f-helper a b) (+ (* x (square a)) (* y b) (* a b))) (f-helper (+ 1 (* x y)) (- 1 y))) (define (f x y) ((lambda (a b) (+ (* x (square a)) (* y b) (* a b))) (+ 1 (* x y)) (- 1 y))) (define (f x y) (let ((a (+ 1 (* x y))) (b (- 1 y))) (+ (* x (square a)) (* y b) (* a b)))) ;: (+ (let ((x 3)) ;: (+ x (* x 10))) ;: x) ;: (let ((x 3) ;: (y (+ x 2))) ;: (* x y)) (define (f x y) (define a (+ 1 (* x y))) (define b (- 1 y)) (+ (* x (square a)) (* y b) (* a b))) ;;EXERCISE 1.34 (define (f g) (g 2)) ;: (f square) ;: (f (lambda (z) (* z (+ z 1)))) ;;;SECTION 1.3.3 ;; Half-interval method (define (search f neg-point pos-point) (let ((midpoint (average neg-point pos-point))) (if (close-enough? neg-point pos-point) midpoint (let ((test-value (f midpoint))) (cond ((positive? test-value) (search f neg-point midpoint)) ((negative? test-value) (search f midpoint pos-point)) (else midpoint)))))) (define (close-enough? x y) (< (abs (- x y)) 0.001)) (define (half-interval-method f a b) (let ((a-value (f a)) (b-value (f b))) (cond ((and (negative? a-value) (positive? b-value)) (search f a b)) ((and (negative? b-value) (positive? a-value)) (search f b a)) (else (error "Values are not of opposite sign" a b))))) ;: (half-interval-method sin 2.0 4.0) ;: (half-interval-method (lambda (x) (- (* x x x) (* 2 x) 3)) ;: 1.0 ;: 2.0) ;; Fixed points (define tolerance 0.00001) (define (fixed-point f first-guess) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) (try first-guess)) ;: (fixed-point cos 1.0) ;: (fixed-point (lambda (y) (+ (sin y) (cos y))) ;: 1.0) (define (sqrt x) (fixed-point (lambda (y) (/ x y)) 1.0)) (define (sqrt x) (fixed-point (lambda (y) (average y (/ x y))) 1.0)) ;;EXERCISE 1.37 ;: (cont-frac (lambda (i) 1.0) ;: (lambda (i) 1.0) ;: k) ;;;SECTION 1.3.4 (define (average-damp f) (lambda (x) (average x (f x)))) ;: ((average-damp square) 10) (define (sqrt x) (fixed-point (average-damp (lambda (y) (/ x y))) 1.0)) (define (cube-root x) (fixed-point (average-damp (lambda (y) (/ x (square y)))) 1.0)) ;; Newton's method (define (deriv g) (lambda (x) (/ (- (g (+ x dx)) (g x)) dx))) (define dx 0.00001) (define (cube x) (* x x x)) ;: ((deriv cube) 5) (define (newton-transform g) (lambda (x) (- x (/ (g x) ((deriv g) x))))) (define (newtons-method g guess) (fixed-point (newton-transform g) guess)) (define (sqrt x) (newtons-method (lambda (y) (- (square y) x)) 1.0)) ;; Fixed point of transformed function (define (fixed-point-of-transform g transform guess) (fixed-point (transform g) guess)) (define (sqrt x) (fixed-point-of-transform (lambda (y) (/ x y)) average-damp 1.0)) (define (sqrt x) (fixed-point-of-transform (lambda (y) (- (square y) x)) newton-transform 1.0)) ;;EXERCISE 1.40 ;: (newtons-method (cubic a b c) 1) ;;EXERCISE 1.41 ;: (((double (double double)) inc) 5) ;;EXERCISE 1.42 ;: ((compose square inc) 6) ;;EXERCISE 1.43 ;: ((repeated square 2) 5)