196 lines
5.6 KiB
Scheme
196 lines
5.6 KiB
Scheme
(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
|