;;; PROBLEM 2-a (define SQUARE-ROOT (lambda [n] (square-root-approximate n 1))) (define SQUARE-ROOT-APPROXIMATE (lambda [n guess] (if (good-enough guess n) guess (square-root-approximate n (improve guess n))))) (define IMPROVE (lambda [guess n] (average guess (/ n guess)))) ;;; The required AVERAGE function (define AVERAGE (lambda [m n] (/ (+ m n) 2))) ;;; Testing the AVERAGE function (average 4 8) ; normalizes to 6 (average 0 12) ; normalizes to 6 (average 5 5) ; normalizes to 5 (average 1 4) ; normalizes to 2 ;;; The closest 3-LISP could get to the real square root is within 1 since ;;; 3-LISP uses only integer arithmetic. But GOOD-ENOUGH requires not ;;; that the guess be within one of the real square-root, but that the ;;; square of guess is within one of n, a much more stringent requirement. ;;; In fact, in certain cases, this requirement just can't be met, and the ;;; procedure enters an infinite loop, due to the rounding error. ;;; The following procedure remedies this problem. (define GOOD-ENOUGH (lambda [guess answer] (let [[this-error (abs (- answer (* guess guess)))] [next-error (abs (- answer (* (1+ guess) (1+ guess))))] [prev-error (abs (- answer (* (1- guess) (1- guess))))]] (and (< this-error next-error) (< this-error prev-error))))) ;;; But the following is better modularized: (define GOOD-ENOUGH (lambda [guess answer] (let [[prev (1- guess)] [next (1+ guess)] [error (lambda [n] (abs (- answer (* n n))))]] (and (< (error guess) (error next)) (< (error guess) (error prev)))))) ;;; Testing the square-root approximation procedures: (square-root 4) ; normalizes to 2 (square-root 9) ; normalizes to 3 (square-root 8) ; normalizes to 3 (square-root 10) ; normalizes to 3 ;;; PROBLEM 2-d ;;; A more abstract version of the second version (GOOD-ENOUGH) given ;;; above: (define WITHIN-1 (lambda [guess function answer] (let [[prev (1- guess)] [next (1+ guess)] [error (lambda [n] (abs (- answer (function n))))]] (and (< (error guess) (error next)) (< (error guess) (error prev)))))) ;;; This is a perfectly reasonable solution to the problem. But a ;;; little more can be said about the problem of checking errors in ;;; functions. ;;; Whereas the definition of GOOD-ENOUGH was good enough for ;;; squaring, since the derivative of the square function is always ;;; greater than 1, this won't work in some cases (such as when ;;; function is (lambda [n] (/ n 10)) where the guess is eactly right, ;;; or when (function guess) and (function prev) are identical. It ;;; seems that a better version might be the following: (define WITHIN-1 (lambda [guess function answer] (let [[prev (1- guess)] [next (1+ guess)] [error (lambda [n] (abs (- answer (function n))))]] (and (<= (error guess) (error next)) (<= (error guess) (error prev)))))) ;;; But for a function of low slope, n and n+1 could both be far from ;;; the solution, but have the same error. But note that if the slope is ;;; low near the answer so that n and n+1 might have the same error, ;;; then one knows that for some integer n, the answer will be zero. ;;; Therefore, we should adopt instead the following: (define WITHIN-1 (lambda [guess function answer] (or (= (function guess) answer) (let [[prev (1- guess)] [next (1+ guess)] [error (lambda [n] (abs (- answer (function n))))]] (and (< (error guess) (error next)) (< (error guess) (error prev))))))) ;;; PROBLEM 2-e ;;; Now for the general iterative improver, INTEGER-APPROXIMATION (define INTEGER-APPROXIMATION (lambda [guess function n improver] (if (within-1 guess function n) ; we're close enough guess ; so return the current guess (integer-approximation ; otherwise, approximate (improver guess) ; using improved guess function n improver)))) ;;; Testing the procedures: (define SQUARE (lambda [n] (* n n))) (define SQUARE-ROOT (lambda [n] (integer-approximation 1 square n (lambda [guess] (average guess (/ n guess)))))) (square-root 4) ; normalizes to 2 (square-root 16) ; normalizes to 4 (square-root 10) ; normalizes to 3 (square-root 8) ; normalizes to 3 ;;; PROBLEM 2-f ;;; More sophisticated version of INTEGER-APPROXIMATION using the ;;; technique first seen in the FIB-3 procedure to eliminate gratuitous ;;; argument passing: (define INTEGER-APPROXIMATION (lambda [guess function n improver] (letrec [[helper (lambda [guess] (if (within-1 guess function n) guess (helper (improver guess))))]] (helper guess))))