diff options
author | Jacques Comeaux <jacquesrcomeaux@protonmail.com> | 2023-06-16 11:44:21 -0500 |
---|---|---|
committer | Jacques Comeaux <jacquesrcomeaux@protonmail.com> | 2023-06-16 11:44:21 -0500 |
commit | ba1a692c56a2d2f9d5225625e072cec09bd77c32 (patch) | |
tree | 526556d964db576e9e0e5825013fdbebb48cc0d2 | |
parent | 63206f44ff747ca24e4131460e1268a5e4447225 (diff) |
Finish chapter 1
-rw-r--r-- | chap1.rkt | 724 |
1 files changed, 719 insertions, 5 deletions
@@ -590,11 +590,11 @@ ((even-? n) (fast-expt-iter- a (square b) (/ n 2))) (else (fast-expt-iter- (* a b) b (- n 1))))) -(#%provide times) -(define (times a b) +(#%provide mult) +(define (mult a b) (if (= b 0) 0 - (+ a (times a (- b 1))))) + (+ a (mult a (- b 1))))) #| 1.17 |# @@ -677,7 +677,7 @@ a (gcd- b (remainder a b)))) -;; Process generated by normal order evaluation +;; Process generated by normal order evaluation #| (gcd- 206 40) |# #| (if (= 40 0) 206 (gcd- 40 (rem 206 40))) |# @@ -711,7 +711,7 @@ ;; 18 calls to remainder are performed -;; Process generated by applicative order evaluation +;; Process generated by applicative order evaluation #| (gcd- 206 40) |# #| (if (= 40 0) 206 (gcd- 40 (remainder 206 40))) ; one call |# @@ -730,3 +730,717 @@ #| 2 |# ;; 4 calls to remainder are performed + +(#%provide smallest-divisor) +(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 (next test-divisor))))) + +(define (divides? a b) + (= (remainder b a) 0)) + +(#%provide prime?) +(define (prime? n) + (= n (smallest-divisor n))) + +(define (expmod base expo m) + (cond + ((= expo 0) 1) + ((even-? expo) + (remainder (square (expmod base (/ expo 2) m)) m)) + (else + (remainder + (* base (expmod base (- expo 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))) + +#| 1.21 |# + +#| (smallest-divisor 199) |# +#| (smallest-divisor 1999) |# +#| (smallest-divisor 19999) |# + +(#%provide timed-prime-test) +(define (timed-prime-test n) + (newline) + (display n) + (start-prime-test n (runtime))) + +(define (start-prime-test n start-time) + (if (fast-prime? n 100) + (report-prime (- (runtime) start-time)))) + +(define (report-prime elapsed-time) +(display " *** ") + (display elapsed-time)) + +#| 1.22 |# + +(#%provide search-for-primes) +(define (search-for-primes a b) + (cond + ((> a b) (newline)) + (else + (timed-prime-test a) + (search-for-primes (+ a 1) b)))) + +;; Smallest primes over 1000: +;; 1009 3us +;; 1013 3 +;; 1019 3 + +;; Smallest primes over 10000: +;; 10007 9us +;; 10019 8 +;; 10037 9 + +;; Smallest primes over 100000: +;; 100003 22us +;; 100019 21 +;; 100043 20 + +;; Smallest primes over 1000000: +;; 1000003 65us +;; 1000033 65 +;; 1000037 65 + +;; 9 / 3 = 3 +;; 21 / 9 = 2.33 +;; 65 / 21 = 3.095 + +;; sqrt(10) = 3.16 + +#| 1.23 |# + +(define (next n) + (if (= n 2) 3 (+ n 2))) + +;; Smallest primes over 1000: +;; 1009 2us +;; 1013 2 +;; 1019 2 + +;; Smallest primes over 10000: +;; 10007 5us +;; 10019 4 +;; 10037 4 + +;; Smallest primes over 100000: +;; 100003 11us +;; 100019 12 +;; 100043 11 + +;; Smallest primes over 1000000: +;; 1000003 34us +;; 1000033 34 +;; 1000037 34 + +;; 3 / 2 = 1.4 +;; 9 / 4 = 2.25 +;; 21 / 11 = 1.9 +;; 65 / 34 = 1.9 + +#| 1.24 |# + +;; Using fast-prime? + +;; Smallest primes over 1000: +;; 1009 .28ms +;; 1013 .29 +;; 1019 .31 + +;; Smallest primes over 10000: +;; 10007 .37ms +;; 10019 .36 +;; 10037 .40 + +;; Smallest primes over 100000: +;; 100003 .42ms +;; 100019 .44 +;; 100043 .46 + +;; Smallest primes over 1000000: +;; 1000003 .50ms +;; 1000033 .49 +;; 1000037 .51 + +;; Scaling up by a factor of ten adds a constant amount of time + +#| 1.25 |# + +;; This version of expmod requires too much space to +;; represent the intermediate result when using very +;; large exponents + +(define (expmod-bad base expo m) + (remainder (fast-expt-iter base expo) m)) + +#| 1.26 |# + +;; This version of expmod makes two recursive calls of +;; size n / 2, making it Theta(n) in time rather than +;; Theta(log(n)) + +(define (expmod-slow base expo m) + (cond + ((= expo 0) 1) + ((even-? expo) + (remainder + (* + (remainder (expmod-slow base (/ expo 2) m) + (remainder (expmod-slow base (/ expo 2) m)))) + m)) + (else + (remainder + (* + base + (expmod-slow base (- expo 1) m)) + m)))) + +#| 1.27 |# + +(#%provide fermat-test-exhaustive) +(define (fermat-test-exhaustive n) + (define (iter i res) + (define (try-it a) (= (expmod a n n) a)) + (if (= i n) + res + (iter (+ i 1) (and res (try-it i))))) + (iter 1 true)) + +#| (fermat-test-exhaustive 561) |# +#| (fermat-test-exhaustive 1105) |# +#| (fermat-test-exhaustive 1729) |# +#| (fermat-test-exhaustive 2465) |# +#| (fermat-test-exhaustive 2821) |# +#| (fermat-test-exhaustive 6601) |# + +#| 1.28 |# + +(define (expmod-sig base expo m) + (define (square-sig x) + (define squared (remainder (square x) m)) + (if + (and + (= squared 1) + (not (= x 1)) + (not (= x expo))) + 0 + squared)) + (cond + ((= expo 0) 1) + ((even-? expo) + (square-sig (expmod base (/ expo 2) m))) + (else + (remainder + (* base (expmod base (- expo 1) m)) + m)))) + +(define (miller-rabin-test n) + (define (try-it a) + (= (expmod a (- n 1) n) 1)) + (try-it (+ 1 (random (- n 1))))) + +(#%provide mr-fast-prime?) +(define (mr-fast-prime? n times) + (cond + ((= times 0) true) + ((miller-rabin-test n) (mr-fast-prime? n (- times 1))) + (else false))) + +(#%provide sum-integers-) +(define (sum-integers- a b) + (if (> a b) + 0 + (+ a (sum-integers- (+ a 1) b)))) + +(#%provide sum-cubes-) +(define (sum-cubes- a b) + (if (> a b) + 0 + (+ (cube a) (sum-cubes- (+ a 1) b)))) + +(#%provide pi-sum-) +(define (pi-sum- a b) + (if (> a b) + 0 + (+ (/ 1.0 (* a (+ a 2))) (pi-sum- (+ a 4) b)))) + +(#%provide sum) +(define (sum term a next b) + (if (> a b) + 0 + (+ + (term a) + (sum term (next a) next b)))) + +(define (inc n) (+ n 1)) + +(#%provide sum-cubes) +(define (sum-cubes a b) (sum cube a inc b)) + +(define (id x) x) + +(#%provide sum-integers) +(define (sum-integers a b) (sum id a inc b)) + +(#%provide pi-sum) +(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)) + +(#%provide integral) +(define (integral f a b dx) + (define (add-dx x) (+ x dx)) + (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) + +#| 1.29 |# + +(#%provide simpson) +(define (simpson f a b n) + (define h (/ (- b a) n)) + (define (single-term k) + (f (+ a (* k h)))) + (define (simpson-term k) + (+ + (single-term (- k 1)) + (* 4.0 (single-term k)) + (single-term (+ k 1)))) + (define (simpson-next k) (+ k 2)) + (* (/ h 3.0) (sum simpson-term 1 simpson-next n))) + +#| 1.30 |# + +(#%provide sum-iter) +(define (sum-iter term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) (+ (term a) result)))) + (iter a 0)) + +#| 1.31 |# + +(#%provide product) +(define (product term a next b) + (if (> a b) + 1 + (* + (term a) + (product term (next a) next b)))) + +(#%provide factorial) +(define (factorial n) + (product id 1 inc n)) + +(#%provide pi-prod) +(define (pi-prod n) + (define (pi-term x) (/ (* (- x 1) (+ x 1)) (square x))) + (define (pi-next x) (+ x 2)) + (* 4.0 (product pi-term 3 pi-next n))) + +(#%provide product-iter) +(define (product-iter term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) (* (term a) result)))) + (iter a 1)) + +#| 1.32 |# + +(#%provide accumulate) +(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)))) + +(#%provide prod-acc) +(define (prod-acc term a next b) + (accumulate * 1 term a next b)) + +(#%provide sum-acc) +(define (sum-acc term a next b) + (accumulate + 0 term a next b)) + +(#%provide acc-iter) +(define (acc-iter combiner null-value term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) (combiner (term a) result)))) + (iter a null-value)) + +#| 1.33 |# + +(#%provide filtered-accumulate) +(define (filtered-accumulate combiner null-value pred term a next b) + (if (> a b) + null-value + (if (pred a) + (combiner + (term a) + (filtered-accumulate combiner null-value pred term (next a) next b)) + (filtered-accumulate combiner null-value pred term (next a) next b)))) + +(#%provide sum-prime-square) +(define (sum-prime-square a b) + (filtered-accumulate + 0 prime? square a inc b)) + +(#%provide prod-coprime) +(define (prod-coprime n) + (define (pred i) (= (gcd- i n) 1)) + (filtered-accumulate * 1 pred id 1 inc n)) + +(#%provide pi-sum-lam) +(define (pi-sum-lam a b) + (sum + (lambda (x) (/ 1.0 (* x (+ x 2)))) + a + (lambda (x) (+ x 4)) + b)) + +(#%provide integral-lam) +(define (integral-lam f a b dx) + (* + (sum + f + (+ a (/ dx 2.0)) + (lambda (x) (+ x dx)) + b) + dx)) + +(#%provide f-help) +(define (f-help x y) + (define (f-helper a b) + (+ + (* x (square a)) + (* y b) + (* a b))) + (f-helper + (+ 1 (* x y)) + (- 1 y))) + +(#%provide f-lam) +(define (f-lam x y) + ((lambda (a b) + (+ + (* x (square a)) + (* y b) + (* a b))) + (+ 1 (* x y)) + (- 1 y))) + +(#%provide f-let) +(define (f-let x y) + (let + ((a (+ 1 (* x y))) + (b (- 1 y))) + (+ + (* x (square a)) + (* y b) + (* a b)))) + +(#%provide f-def) +(define (f-def x y) + (define a (+ 1 (* x y))) + (define b (- 1 y)) + (+ + (* x (square a)) + (* y b) + (* a b))) + +#| 1.34 |# + +;; (define (f g) (g 2)) + +;; (f square) 4 + +;; (f (lambda (z) (* z (+ z 1)))) 6 + +;; (f f) (f 2) (2 2) error + +(#%provide search) +(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)) + +(#%provide half-interval-method) +(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))))) + +(define tolerance 0.0001) + +(#%provide fixed-point) +(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)) + +(#%provide sqrt-fix) +(define (sqrt-fix x) + (fixed-point + (lambda (y) (average y (/ x y))) + 1.0)) + +#| 1.35 |# + +(#%provide golden) +(define (golden) + (fixed-point + (lambda (x) (+ 1.0 (/ 1.0 x))) + 1.0)) + +#| 1.36 |# + +(#%provide x-to-the-x) +(define (x-to-the-x) + (fixed-point + (lambda (x) (/ (log 1000.0) (log x))) + 2.0)) + +#| 1.37 |# + +(#%provide cont-frac) +(define (cont-frac n d k) + (define (iter res i) + (if (= i 0) + res + (iter (/ (n i) (+ (d i) res)) (- i 1)))) + (iter 0 k)) + +;; (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) 11) +;; 0.6180555555555556 + +;; Accurate to 4 places after 11 iterations + +(#%provide cont-frac-rec) +(define (cont-frac-rec n d k) + (define (rec i) + (if (> i k) + 0 + (/ (n i) (+ (d i) (rec (+ i 1)))))) + (rec 1)) + +#| 1.38 |# + +(#%provide e-approx) +(define (e-approx k) + (define (n i) 1.0) + (define (d i) + (if (divides? 3 (+ i 1)) + (* 2 (/ (+ i 1) 3)) + 1.0)) + (+ (cont-frac n d k) 2)) + +#| 1.39 |# + +(#%provide tan-cf) +(define (tan-cf x k) + (define (rec prod sum) + (let ((stop (+ 1 (* 2 (- k 1))))) + (if (> sum stop) + 0 + (/ prod (- sum (rec (* prod x) (+ sum 2))))))) + (rec x 1.0)) + +(define (average-damp f) + (lambda (x) (average x (f x)))) + +((average-damp square) 10) + +(#%provide sqrt-avg-damp) +(define (sqrt-avg-damp x) + (fixed-point + (average-damp (lambda (y) (/ x y))) + 1.0)) + +(#%provide cbrt-avg-damp) +(define (cbrt-avg-damp x) + (fixed-point + (average-damp (lambda (y) (/ x (square y)))) + 1.0)) + +(define (deriv g) + (lambda (x) + (/ + (- (g (+ x dx)) (g x)) + dx))) + +(define dx 0.00001) + +((deriv cube) 5) + +(define (newton-transform g) + (lambda (x) + (- x (/ (g x) ((deriv g) x))))) + +(#%provide newtons-method) +(define (newtons-method g guess) + (fixed-point (newton-transform g) guess)) + +(#%provide sqrt-newt) +(define (sqrt-newt x) + (newtons-method + (lambda (y) (- (square y) x)) + 1.0)) + +(define (fixed-point-of-transform g transform guess) + (fixed-point (transform g) guess)) + +(#%provide sqrt-ad-trans) +(define (sqrt-ad-trans x) + (fixed-point-of-transform + (lambda (y) (/ x y)) + average-damp + 1.0)) + +(#%provide sqrt-newt-trans) +(define (sqrt-newt-trans x) + (fixed-point-of-transform + (lambda (y) (- (square y) x)) + newton-transform + 1.0)) + +#| 1.40 |# + +(#%provide cubic) +(define (cubic a b c) + (lambda (x) + (+ + (cube x) + (* a (square x)) + (* b x) + c))) + +;; (newtons-method (cubic 0 0 -8.0) 4.0) + +#| 1.41 |# + +(#%provide twice) +(define (twice f) + (lambda (x) (f (f x)))) + +;; (twice inc 1) +;; 3 + +;; (((twice (twice twice)) inc) 5) +;; 21 + +#| 1.42 |# + +(#%provide compose-) +(define (compose- f g) + (lambda (x) (f (g x)))) + +;; ((compose- square inc) 6) +;; 49 + +#| 1.43 |# + +(#%provide repeated) +(define (repeated f n) + (if (= n 0) + (lambda (x) x) + (compose- (repeated f (- n 1)) f))) + +;; ((repeated square 2) 5) +;; 625 + +#| 1.44 |# + +(#%provide smooth) +(define (smooth f) + (lambda (x) + (/ + (+ + (f (- x dx)) + (f x) + (f (+ x dx))) + 3.0))) + +(#%provide n-smooth) +(define (n-smooth f n) + (repeated smooth n)) + +#| 1.45 |# + +(#%provide flog2) +(define (flog2 n) (floor (/ (log n) (log 2)))) + +(#%provide nth-root) +(define (nth-root n x) + (fixed-point + ((repeated average-damp (flog2 n)) + (lambda (y) (/ x (fast-expt-iter y (- n 1))))) + 1.0)) + +#| 1.46 |# + +(#%provide iterative-improve) +(define (iterative-improve good-enough? improve) + (lambda (guess) + (define (iter x) + (if (good-enough? x) + x + (iter (improve x)))) + (iter guess))) + +(#%provide sqrt-it-imp) +(define (sqrt-it-imp x) + ((iterative-improve + (lambda (guess) (< (abs (- (square guess) x)) 0.001)) + (lambda (guess) (average guess (/ x guess)))) + 1.0)) + +(#%provide fixed-point-it-imp) +(define (fixed-point-it-imp f first-guess) + ((iterative-improve + (lambda (guess) (< (abs (- guess (f guess))) tolerance)) + f) + first-guess)) |