A cute program to compute nth-roots, extracted from SICP exercises

nth-root.lisp

(defun average-damp (fn)
  (lambda (x)
    (/ (+ x (funcall fn x)) 2)))

(defun compose (f g)
  (lambda (x)
    (funcall f (funcall g x))))

(defun repeated (fn n)
  (labels ((iter (i &optional result)
             (if (= i n)
                 result
                 (iter (1+ i) (compose fn result)))))
    (iter 1 fn)))

(defun fixed-point (fn initial-guess &key (log nil) (tolerance 0.0001))
  (labels ((close-enough-p (x y)
             (< (abs (- x y)) tolerance))
           (try (guess)
             (let ((next (funcall fn guess)))
               (when log
                 (format t "Guess: ~A~%" guess))
               (if (close-enough-p guess next)
                   next
                   (try next)))))
    (try initial-guess)))

(defun fixed-point-transform (fn transform guess)
  (fixed-point (funcall transform fn) guess))

(defun nth-root (n x)
  (flet ((find-root (y) (/ x (expt y (1- n)))))
    (let ((nth-damp (repeated #'average-damp (log n 2))))
      (fixed-point-transform #'find-root nth-damp 1.0))))