Finish chapter 1 (rerun)

main
Felix Martin 2020-10-15 21:14:22 -04:00
parent 604cf09ccd
commit 32b723deee
5 changed files with 583 additions and 0 deletions

1
.gitignore vendored
View File

@ -1,3 +1,4 @@
old_ch2
# ---> Scheme
*.ss~
*.ss#*

184
ex-1_29-34.scm Normal file
View File

@ -0,0 +1,184 @@
; utils
(define (inc n) (+ n 1))
(define (cube n) (* n n n))
(define (square n) (* n n))
(define (identity n) n)
(define (even? n) (= (remainder n 2) 0))
(define (odd? n) (= (remainder n 2) 1))
(define (divides? a b) (= (remainder b a) 0))
(define (gcd a b) (if (= b 0) a (gcd b (remainder a b))))
; copied prime? from 1.21
(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 (smallest-divisor n)
(find-divisor n 2))
(define (prime? n) (if (= n 1) #f (= n (smallest-divisor n))))
(display "ex-1.29") (newline)
(define (sum term a next b)
(if (> a b)
0
(+ (term a)
(sum term (next a) next b))))
(define (sum-cubes a b)
(sum cube a inc b))
(display "(sum-cubes 1 10) = ")
(display (sum-cubes 1 10))
(newline)
(define (pi-sum a b)
(define (pi-term n) (/ 1.0 (* n (+ n 2))))
(define (pi-next n) (+ n 4))
(sum pi-term a pi-next b))
(display "(* 8 (pi-sum 1 100)) = ")
(display (* 8 (pi-sum 1 100)))
(newline)
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx))
(display "(integral cube 0 1 0.01) = ")
(display (integral cube 0 1 0.01))
(newline)
(define (integral-simpson f a b n)
(define h (/ (- b a) n))
(define (y k) (f (+ a (* k h))))
(define (simpson-term k)
(cond ((= k 0) (y 0))
((= k n) (y k))
((even? k) (* 2 (y k)))
(else (* 4 (y k)))))
(* (/ h 3) (sum simpson-term 0 inc n)))
(display "(integral-simpson cube 0 1 100) = ")
(display (integral-simpson cube 0 1 100))
(newline)
(newline) (display "ex-1.30") (newline)
; maximum recursion dept exceed
(display (* 8 (pi-sum 1 1000000)))
(define (sum term a next b)
(define (sum-iter a acc)
(if (> a b)
acc
(sum-iter (next a) (+ acc (term a)))))
(sum-iter a 0))
(newline)
(display "(* 8 (pi-sum 1 1000000)) = ")
(display (* 8 (pi-sum 1 1000000)))
(newline)(newline) (display "ex-1.31") (newline)
(define (product term a next b)
(if (> a b)
1
(* (term a) (product term (next a) next b))))
(define (factorial n)
(product identity 1 inc n))
(display "(factorial 10) = ")
(display (factorial 10))
(newline)
(define (pi-product n)
(define (pi-term n) (/ (* n (+ n 2.)) (square (+ n 1.))))
(define (pi-next n) (+ n 2))
(product pi-term 2 pi-next n))
(display "(* 4 (pi-product 1000000)) = ")
(display (* 4 (pi-product 1000000)))
(define (product term a next b)
(define (product-iter term a next b acc)
(if (> a b)
acc
(product-iter term (next a) next b (* acc (term a)))))
(product-iter term a next b 1))
(newline)
(display "(* 4 (pi-product 1000000)) = ")
(display (* 4 (pi-product 1000000)))
(newline)(newline) (display "ex-1.32") (newline)
(define (mul-op a b) (* a b))
(define (sum-op a b) (+ a b))
; Recursive
(define (accumulate combiner null-value term a next b)
(if (> a b) null-value
(combiner (term a) (accumulate combiner null-value term (next a) next b))))
(define (sum term a next b)
(accumulate sum-op 0 term a next b))
(define (product term a next b)
(accumulate mul-op 1 term a next b))
(display (sum identity 1 inc 10)) (newline)
(display (product identity 1 inc 10)) (newline)
(display "(* 4 (pi-product 1000000)) = ")
(display (* 4 (pi-product 1000000)))
; Iterative
(define (accumulate combiner null-value term a next b)
(define (acc-iter a acc)
(if (> a b)
acc
(acc-iter (next a) (combiner acc (term a)))))
(acc-iter a null-value))
(newline)
(display "(* 4 (pi-product 1000000)) = ")
(display (* 4 (pi-product 1000000)))
(newline)(newline) (display "ex-1.33") (newline)
(define (filtered-accumulate combiner null-value filter term a next b)
(define (combiner-filtered acc a)
(if (filter a)
(combiner acc (term a))
acc))
(define (iter a acc)
(if (> a b)
acc
(iter (next a) (combiner-filtered acc a))))
(iter a null-value))
(define (primes-squared-sum a b)
(filtered-accumulate sum-op 0 prime? square a inc b))
(display (primes-squared-sum 1 5)) (newline) ; expected 38
(define (product-integers-coprime n)
(define (filter a) (= (gcd n a) 1))
(filtered-accumulate mul-op 1 filter identity 1 inc (- n 1)))
(display (product-integers-coprime 10)) (newline) ; expected 189
(newline) (display "ex-1.34 - see comment") (newline)
; Exercise 1.34. Suppose we define the procedure (define (f g) (g 2)). What
; happens if we (perversely) ask the interpreter to evaluate the combination
; (f ; f)? Explain.
; The result would be (2 2) and 2 is not applicable.

202
ex-1_35-39.scm Normal file
View File

@ -0,0 +1,202 @@
(define (average a b) (/ (+ a b) 2.0))
(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)))))
(display (half-interval-method sin 2.0 4.0)) (newline)
(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))
(display (fixed-point cos 1.0)) (newline)
(define (sqrt x)
(fixed-point (lambda (y) (/ x y))
1.0))
; (display (sqrt 2) (newline)) ; doesn't converge
(define (sqrt x)
(fixed-point (lambda (y) (average y (/ x y)))
1.0))
(display (sqrt 2))
(newline)(newline) (display "ex-1.35") (newline)
; phi^2 = phi + 1
; phi = 1 + 1 / phi
(display (fixed-point (lambda (phi) (+ 1 (/ 1.0 phi))) 1.0)) (newline)
(newline)(newline) (display "ex-1.36") (newline)
(define (x_without_avg_damping x) (/ (log 1000) (log x)))
(define (x_with_avg_damping x)
(average x (/ (log 1000) (log x))))
(define (fixed-point f first-guess)
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(define (try guess)
(display guess) (newline)
(let ((next (f guess)))
(if (close-enough? guess next)
next
(try next))))
(try first-guess))
(newline)
(display (fixed-point x_without_avg_damping 2.0))(newline)
(display "Finished without average damping.")
(newline)
(newline)
(display (fixed-point x_with_avg_damping 2.0))(newline)
(display "Finished with average damping.")
(newline)(newline) (display "ex-1.37 a)") (newline)
; Recursive
(define (cont-frac n d k)
(define (frac-rec i)
(if (> i k)
0
(/ (n i) (+ (d i) (frac-rec (+ i 1))))))
(frac-rec 1))
(define (phi k)
(/ 1 (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) k)))
(display (phi 100))
(define (approx-phi tolerance)
(define (iteration current-phi i)
(let ((next-phi (phi i)))
(if (< (abs (- next-phi current-phi)) tolerance)
i
(iteration next-phi (+ i 1)))))
(iteration 1.1 1))
; Use approx-phi to calculate value of k to get four digit precisious.
(newline)
(display (approx-phi 0.00009)) ; 12
; Phi is 1.618033 so let's see if we can get many digits right with k = 12
(newline)
(display (phi 11))
(newline)
(display (phi 12))
(newline)
(display (phi 13))
; looks like we have found exactly the right value (:
; Recursive wrong
(define (cont-frac n d k)
(if (= k 1) 0
(/ (n k) (+ (d k) (cont-frac n d (- k 1))))))
(newline)(newline) (display "ex-1.37 b) - implemented iterative version") (newline)
; (phi 100000) ; show that previous version is recursive.
; Iterative
(define (cont-frac n d k)
(define (frac-iter i acc)
(if (= i 0)
acc
(frac-iter (- i 1) (/ (n i) (+ (d i) acc)))))
(frac-iter k 0))
(phi 100000) ; show that this version is iterative
(newline) (display "ex-1.38") (newline)
; 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 ; Indicies
; 1, 2, 1, 1, 4, 1, 1, 6, 1, 1, 8 ; Eulers expansion
(define (eulers-expansion k)
(define (n i) 1)
(define (d i)
(if (= (remainder (+ i 1) 3) 0)
(* 2 (/ (+ i 1) 3))
1))
(cont-frac n d k))
(display (+ 2 (/ (eulers-expansion 1000) 1.)))
(newline)(newline) (display "ex-1.39") (newline)
(define (tan-cf x k)
(define (n i)
(if (= i 1)
x
(* x x -1)))
(define (d i) (- (* i 2) 1))
(cont-frac n d k))
(display (tan 1.1)) (newline)
(display (tan-cf 1.1 15)) (newline)
(newline) (display "tests") (newline)
(define (average-damp f)
(lambda (x) (average x (f x))))
(define (sqrt x)
(fixed-point (average-damp (lambda (y) y (/ x y)))
1.0))
(display (sqrt 9)) (newline)
(define dx 0.0000001)
(define (deriv g)
(lambda (x)
(/ (- (g (+ x dx)) (g x))
dx)))
(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) (- (* y y) x)) 1.0))
(newline)
(display "example - Newton's Method")
(display (sqrt 3)) (newline)

195
ex-1_40-46.scm Normal file
View File

@ -0,0 +1,195 @@
(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))
(define dx 0.0000001)
(define (deriv g)
(lambda (x)
(/ (- (g (+ x dx)) (g x))
dx)))
(define (newton-transform g)
(lambda (x)
(- x (/ (g x) ((deriv g) x)))))
(define (newtons-method g guess)
(fixed-point (newton-transform g) guess))
(display "ex-1.40") (newline)
(define (cubic a b c)
(lambda (x) (+ (* x x x) (* a x x ) (* b x) c)))
(display (newtons-method (cubic 4 5 3) 1)) ; -2.465571231876768
; https://www.wolframalpha.com/input/?i=x^3+%2B+4x^2+%2B+5x+%2B+3+%3D+0
(newline)(newline) (display "ex-1.41") (newline)
(define (inc n) (+ n 1))
(define (double f)
(lambda (n) (f (f n))))
; expansion of double double
; (display (((double double) inc) 0)) (newline)
; (display (((lambda (x) (double (double x))) inc) 0)) (newline)
; (display ((double (double inc)) 0)) (newline)
; (display ((double (lambda (x) (inc (inc x)))) 0)) (newline)
; (display ((lambda (x) (inc (inc (inc (inc x))))) 0)) (newline)
; expansion of triple double
(display (((double (double double)) inc) 5)) (newline)
(display (((double (lambda (x) (double (double x)))) inc) 5)) (newline)
(display (((lambda (x) (double (double (double (double x))))) inc) 5)) (newline)
(display ((double (double (double (double inc)))) 5)) (newline)
(display ((double (double (double (lambda (x) (inc (inc x)))))) 5)) (newline)
(display ((double (double (lambda (x) (inc (inc (inc (inc x))))))) 5)) (newline)
(display ((double (lambda (x) (inc (inc (inc (inc (inc (inc (inc (inc x)))))))))) 5)) (newline)
(display (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc 5))))))))))))))))) (newline)
(newline) (display "ex-1.42") (newline)
(define (compose f g)
(lambda (x) (f (g x))))
(display ((compose square inc) 6))
(newline)(newline) (display "ex-1.43") (newline)
(define (identity x) x)
(define (repeated f n)
(if (< n 1) identity
(compose f (repeated f (- n 1)))))
(display ((repeated square 2) 5)) (newline)
; accumulator from ex_1_3_a.scm
(define (accumulate combiner null-value term a next b)
(define (acc-iter a acc)
(if (> a b)
acc
(acc-iter (next a) (combiner acc (term a)))))
(acc-iter a null-value))
; Same thing based on accumulator.
(define (repeated f n)
(accumulate compose identity (lambda (i) f) 1 inc n))
(display ((repeated square 2) 5))
(newline)(newline) (display "ex-1.44") (newline)
(define dx 0.1)
(define (smooth f)
(lambda (x) (/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3)))
; I had this very frustrating bug at first where I forgot one
; pair of brackets which resulted in f being return independently
; of the value of n.
;(define (n-fold-smooth f n)
; (repeated smooth n) f)
(define (n-fold-smooth f n)
((repeated smooth n) f))
(define pi_4 0.785398163397)
(display "sin (pi/4) = ")
(display (sin pi_4)) (newline)
(display "sin (pi/4) = ")
(display ((n-fold-smooth sin 0) pi_4)) (display " ; n-smooth 0") (newline)
(display "sin (pi/4) = ")
(display ((smooth sin) pi_4)) (display " ; smoothed") (newline)
(display "sin (pi/4) = ")
(display ((n-fold-smooth sin 1) pi_4)) (display " ; n-smooth 1") (newline)
(display "sin (pi/4) = ")
(display ((smooth (smooth sin)) pi_4)) (display " ; smoothed twice") (newline)
(display "sin (pi/4) = ")
(display ((n-fold-smooth sin 2) pi_4)) (display " ; n-smooth 2") (newline)
; I was curious how smooth smooth unfolds.
;(display "sin (pi/4) = ")
;(display ((smooth (lambda (x) (/ (+ (sin (- x dx)) (sin x) (sin (+ x dx))) 3))) pi_4))
;(display " ; smoothed twice") (newline)
;
;(display "sin (pi/4) = ")
;(display ((lambda (x) (/ (+
; ((lambda (x) (/ (+ (sin (- x dx)) (sin x) (sin (+ x dx))) 3)) (- x dx))
; ((lambda (x) (/ (+ (sin (- x dx)) (sin x) (sin (+ x dx))) 3)) x)
; ((lambda (x) (/ (+ (sin (- x dx)) (sin x) (sin (+ x dx))) 3)) (+ x dx))
; ) 3)) pi_4))
;(display " ; smoothed twice") (newline)
(newline) (display "ex-1.45") (newline)
(define (average a b) (/ (+ a b) 2.0))
(define (average-damp f) (lambda (x) (average x (f x))))
; I honestly don't now what the best way to calculate how often we have to average damp is.
(define (nth-root x n)
(define (f y) (/ x (expt y (- n 1))))
(define n_repeat (floor->exact (/ (log n) (log 2))))
(fixed-point ((repeated average-damp n_repeat) f) 1.0))
; n average-damp-count
; 2 1
; 3 1
; 4 2
; ...
; 7 2
; 8 3
; ...
; 15 3
; 16 4
; ...
; 31 4
; 32 5
; ...
; 63 5
; n (/ (log n) (log 2))
(display (nth-root 9 2)) (newline)
(display (nth-root 27 3)) (newline)
(display (nth-root 81 4)) (newline)
(display (nth-root 243 5)) (newline)
(display (nth-root 729 6)) (newline)
(display (nth-root 2187 7)) (newline)
(display (nth-root 6561 8)) (newline)
(display (nth-root 19683 9)) (newline)
(display (nth-root 59049 10)) (newline)
(display (nth-root 347012 63)) (newline)
(newline) (display "ex-1.46") (newline)
(define (iterative-improve good-enough? improve)
(define (iter guess)
(if (good-enough? guess)
guess
(iter (improve guess))))
(lambda (guess) (iter guess)))
(define (sqrt x)
((iterative-improve
(lambda (guess) (< (abs (- (square guess) x)) 0.001))
(lambda (guess) (average guess (/ x guess)))) 1.0))
(display "sqrt-test: ") (display (sqrt 9)) (newline)
(define (fixed-point f first-guess)
((iterative-improve
(lambda (x) (< (abs (- x (f x))) tolerance))
f) first-guess))
(display "fixed-point-test: ") (display (newtons-method (cubic 4 5 3) 1)) ; -2.465571231876768

1
run
View File

@ -3,6 +3,7 @@
for a in "$@"
do
echo "run: $a"
echo
mit-scheme --quiet < $a
done