aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJacques Comeaux <jacquesrcomeaux@protonmail.com>2023-06-16 11:44:21 -0500
committerJacques Comeaux <jacquesrcomeaux@protonmail.com>2023-06-16 11:44:21 -0500
commitba1a692c56a2d2f9d5225625e072cec09bd77c32 (patch)
tree526556d964db576e9e0e5825013fdbebb48cc0d2
parent63206f44ff747ca24e4131460e1268a5e4447225 (diff)
Finish chapter 1
-rw-r--r--chap1.rkt724
1 files changed, 719 insertions, 5 deletions
diff --git a/chap1.rkt b/chap1.rkt
index ecbeff6..f84ae9b 100644
--- a/chap1.rkt
+++ b/chap1.rkt
@@ -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))