sicp-1-3-4-procedures-as-returned-values

#lang racket

;;;;;;;;;;
;; 1.40 ;;
;;;;;;;;;;

(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.00001)

(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))

(define (cubic a b c)
  (lambda (x)
    (+ (* x x x)
       (* a x x)
       (* b x)
       c)))

(newtons-method (cubic 0 0 -8) 1.0)
;; 2.000000000036784

(newtons-method (cubic 1 1 1) 1.0)
;; -0.9999999999997796

;;;;;;;;;;
;; 1.41 ;;
;;;;;;;;;;

(define (double f)
  (lambda (x) (f (f x))))

(((double (double double)) add1) 5)
;; 21

;;;;;;;;;;
;; 1.42 ;;
;;;;;;;;;;

(define (my-compose f g)
  (lambda (x) (f (g x))))

((my-compose sqr add1) 6)
;; 49

;;;;;;;;;;
;; 1.43 ;;
;;;;;;;;;;

(define (repeated f n)
  (if (= n 1)
    f
    (my-compose f (repeated f (sub1 n)))))

((repeated sqr 2) 5)
;; 625

;;;;;;;;;;
;; 1.44 ;;
;;;;;;;;;;

(define (smooth f)
  (lambda (x)
    (/ (+ (f (- x dx))
          (f x)
          (f (+ x dx)))
       3)))

(define (n-fold-smooth f n)
  ((repeated smooth n) f))

(for ([i (in-range 1 6)])
  (displayln (log i)))
;; 0
;; 0.6931471805599453
;; 1.0986122886681098
;; 1.3862943611198906
;; 1.6094379124341003

(for ([i (in-range 1 6)])
  (displayln (((repeated smooth 10) log) i)))
;; -3.333332199762096e-010
;; 0.693147180476612
;; 1.0986122886310727
;; 1.386294361099058
;; 1.6094379124207672

;;;;;;;;;;
;; 1.45 ;;
;;;;;;;;;;

(define (average a b)
  (/ (+ a b)
     2))

(define (average-damp f)
  (lambda (x) (average x (f x))))

(define (get-damped-root power times)
  (lambda (x)
    ; find the power-th root of x using fixed-point
    ; and damping the indicated number of times
    (fixed-point
      ((repeated average-damp times) (lambda (y) (/ x (expt y (sub1 power)))))
      1.0)))

(define (investigate power min-times)
  (for ([times (in-range min-times (add1 power))])
    (printf "power is ~a, times is ~a, answer is ~a ~n"
            power
            times
            ((get-damped-root power times) (expt 2 power)))))

;; I used the investigate function to find all powers and times,
;; for powers = 2, 3, ..., 17, and times = 1, 2, ..., power,
;; that did not converge.

;; did not converge
;; power   times-damped
;; 4       1
;; 5       1
;; 8       2
;; 9       2
;; 10      2
;; 11      2
;; 13      1
;; 13      2
;; 14      2
;; 16      3
;; 17      2
;; 17      3

;; I don't see any obvious pattern here.  The sample is too small.  But damping
;; four times should work for most small powers.

(define (my-root n)
  (get-damped-root n 4))

(for ([n (in-range 2 20)])
  (displayln ((my-root n) (expt 2 n))))
;; 1.9999378937004895
;; 1.9999583385968283
;; 1.9999751575244828
;; 2.0000200551235574
;; 2.000011071925238
;; 2.0000106805408264
;; 2.000008820504543
;; 2.0000074709755573
;; 2.0000044972691784
;; 2.0000038760178884
;; 2.000001241323132
;; 2.000001923509733
;; 2.0000006317785997
;; 2.0000001141598975
;; 2.000000000076957
;; 2.0000000561635765
;; 2.0000005848426476
;; 2.0000003649180282

;;;;;;;;;;
;; 1.46 ;;
;;;;;;;;;;

(define (iterative-improve good-enough? improve-guess)
  (define (iterate guess)
    (if (good-enough? guess)
      guess
      (iterate (improve-guess guess))))
  iterate)

(define (new-sqrt x)
  (define (good-enough? guess)
    (< (abs (- (sqr guess) x)) 0.001))
  (define (improve-guess guess)
    (average guess (/ x guess)))
  ((iterative-improve good-enough? improve-guess) 1.0))

(for ([i (in-range 2 10)])
  (displayln (new-sqrt i)))
;; 1.4142156862745097
;; 1.7321428571428572
;; 2.0000000929222947
;; 2.2360688956433634
;; 2.4494943716069653
;; 2.64576704419029
;; 2.8284685718801468
;; 3.00009155413138

(define (new-fixed-point f first-guess)
  (define (good-enough? guess)
    (< (abs (- guess (f guess))) 0.00001))
  ((iterative-improve good-enough? f) first-guess))

;; solve x ^ x = 1000 by finding the fixed point of f(x) = log(1000) / log(x)
(define soln (new-fixed-point (lambda (x) (/ (log 1000) (log x)))
                              2.0))
soln
;; 4.555540912917957
(expt soln soln)
;; 1000.0131045064136