Blame


1 665c255d 2023-08-04 jrmu (defvar tolerance 0.00001)
2 665c255d 2023-08-04 jrmu (defun fixed-point (f first-guess)
3 665c255d 2023-08-04 jrmu (labels (
4 665c255d 2023-08-04 jrmu (close-enough? (v1 v2)
5 665c255d 2023-08-04 jrmu (< (abs (- v1 v2)) tolerance))
6 665c255d 2023-08-04 jrmu (try (guess)
7 665c255d 2023-08-04 jrmu (let ((next (funcall f guess)))
8 665c255d 2023-08-04 jrmu (if (close-enough? guess next)
9 665c255d 2023-08-04 jrmu next
10 665c255d 2023-08-04 jrmu (try next)))))
11 665c255d 2023-08-04 jrmu (try first-guess)))
12 665c255d 2023-08-04 jrmu (defun average (a b)
13 665c255d 2023-08-04 jrmu (/ (+ a b) 2))
14 665c255d 2023-08-04 jrmu (defun dampen-sqrt (x)
15 665c255d 2023-08-04 jrmu (fixed-point
16 665c255d 2023-08-04 jrmu (lambda (y)
17 665c255d 2023-08-04 jrmu (average y (/ x y)))
18 665c255d 2023-08-04 jrmu 1.0))
19 665c255d 2023-08-04 jrmu
20 665c255d 2023-08-04 jrmu (fixed-point (lambda (x) (1+ (/1 x))) 1.0)
21 665c255d 2023-08-04 jrmu
22 665c255d 2023-08-04 jrmu (defvar tolerance 0.00001)
23 665c255d 2023-08-04 jrmu (defun fixed-point (f first-guess)
24 665c255d 2023-08-04 jrmu (labels (
25 665c255d 2023-08-04 jrmu (close-enough? (v1 v2)
26 665c255d 2023-08-04 jrmu (< (abs (- v1 v2)) tolerance))
27 665c255d 2023-08-04 jrmu (try (guess)
28 665c255d 2023-08-04 jrmu (format t "Trying ~F~%" guess)
29 665c255d 2023-08-04 jrmu (let ((next (funcall f guess)))
30 665c255d 2023-08-04 jrmu (if (close-enough? guess next)
31 665c255d 2023-08-04 jrmu next
32 665c255d 2023-08-04 jrmu (try next)))))
33 665c255d 2023-08-04 jrmu (try first-guess)))
34 665c255d 2023-08-04 jrmu (defun average (a b)
35 665c255d 2023-08-04 jrmu (/ (+ a b) 2))
36 665c255d 2023-08-04 jrmu (defun xx (x)
37 665c255d 2023-08-04 jrmu (/ (log 1000) (log x)))
38 665c255d 2023-08-04 jrmu (defun dampen-xx (x)
39 665c255d 2023-08-04 jrmu (average x (xx x)))
40 665c255d 2023-08-04 jrmu (print (fixed-point #'xx 2.0))
41 665c255d 2023-08-04 jrmu (print (fixed-point #'dampen-xx 2.0))
42 665c255d 2023-08-04 jrmu