1 665c255d 2023-08-04 jrmu (defvar *tolerance* 0.0001)
 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 (defvar *dx* 0.00001)
13 665c255d 2023-08-04 jrmu (defun deriv (g)
14 665c255d 2023-08-04 jrmu   (lambda (x)
15 665c255d 2023-08-04 jrmu     (/ (- (funcall g (+ x *dx*))
16 665c255d 2023-08-04 jrmu 	  (funcall g x))
17 665c255d 2023-08-04 jrmu        *dx*)))
18 665c255d 2023-08-04 jrmu (defun newton-transform (g)
19 665c255d 2023-08-04 jrmu   (lambda (x)
20 665c255d 2023-08-04 jrmu     (- x (/ (funcall g x)
21 665c255d 2023-08-04 jrmu 	    (funcall (deriv g) x)))))
22 665c255d 2023-08-04 jrmu (defun newtons-method (g guess)
23 665c255d 2023-08-04 jrmu   (fixed-point (newton-transform g) guess))
24 665c255d 2023-08-04 jrmu 
25 665c255d 2023-08-04 jrmu (defun cubic (a b c)
26 665c255d 2023-08-04 jrmu   (lambda (x)
27 665c255d 2023-08-04 jrmu     (+ (cube x)
28 665c255d 2023-08-04 jrmu        (* a (square x))
29 665c255d 2023-08-04 jrmu        (* b x)
30 665c255d 2023-08-04 jrmu        c)))