100 lines
		
	
	
		
			2.6 KiB
		
	
	
	
		
			Racket
		
	
	
	
	
	
			
		
		
	
	
			100 lines
		
	
	
		
			2.6 KiB
		
	
	
	
		
			Racket
		
	
	
	
	
	
#lang racket
 | 
						|
 | 
						|
; definitions from some earlier chapters.
 | 
						|
(define (fixed-point f first-guess)
 | 
						|
  (define tolerance 0.01)
 | 
						|
  (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))
 | 
						|
 | 
						|
; some definitions: these are given by the book.
 | 
						|
(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))
 | 
						|
 | 
						|
; example 1-40
 | 
						|
(define (cubic a b c)
 | 
						|
  (λ (x) (+ (expt x 3)
 | 
						|
            (* a (expt x 2))
 | 
						|
            (* b (expt x 1))
 | 
						|
            c)))
 | 
						|
 | 
						|
; example 1-41
 | 
						|
; NOTE: inc isn't defined in racket, so I just defined that too
 | 
						|
(define (inc x) (+ 1 x))
 | 
						|
(define (double f)
 | 
						|
  (λ (x) (f (f x))))
 | 
						|
 | 
						|
(display (((double (double double)) inc) 5))
 | 
						|
(newline)
 | 
						|
; => 21
 | 
						|
 | 
						|
; example 1-42
 | 
						|
(define (square x) (* x x))
 | 
						|
(define (compose f g) (λ (x) (f (g x))))
 | 
						|
 | 
						|
(display ((compose square inc) 6))
 | 
						|
; => 49
 | 
						|
 | 
						|
; example 1-43
 | 
						|
(define (repeated f n)
 | 
						|
  "This procedure generates an iterative process."
 | 
						|
  (define (iter ret i)
 | 
						|
    (if (<= i 1)
 | 
						|
        ret
 | 
						|
        (iter (compose f ret) (- i 1))))
 | 
						|
  (iter f n))
 | 
						|
 | 
						|
; example 1-44
 | 
						|
; procedure average is defined here for convenience
 | 
						|
(define (average a b c)
 | 
						|
  (/ (+ a b c) 3))
 | 
						|
(define (smooth f dx)
 | 
						|
  (λ (x)
 | 
						|
    (average (f (- x dx))
 | 
						|
             (f x)
 | 
						|
             (f (+ x dx)))))
 | 
						|
; example asks us to "show" how n-fold smoothing would be done.
 | 
						|
; here it is, with the procedure `repeated`
 | 
						|
; note we need to pass an anonymous function to do it because the way
 | 
						|
; I defined it, `smooth` accepts two arguments, not one.
 | 
						|
; thankfully one of the arguments will be the same for all calls,
 | 
						|
; so we can just curry it up a little.
 | 
						|
(define (some-func x) x) ; assume there is some function we want to smooth.
 | 
						|
(define n 2)
 | 
						|
((repeated (λ (f) (smooth f 0.001)) n) some-func)
 | 
						|
 | 
						|
; example 1-45
 | 
						|
; this one looks long, I'm skipping for now
 | 
						|
 | 
						|
; example 1-46
 | 
						|
(define (iterative-improve good-enough? improve)
 | 
						|
  "I use a define here because the returned procedure will be recursive
 | 
						|
   (an iterative process, but recursive function)
 | 
						|
   I guess we could use `do` for this but whatever"
 | 
						|
  (define (ret x)
 | 
						|
    (if (good-enough? x)
 | 
						|
        x
 | 
						|
        (ret (improve x))))
 | 
						|
  ret)
 | 
						|
 | 
						|
(define (sqrt n)
 | 
						|
  "Careful: we're calling iterative-improve, which creates a procedure,
 | 
						|
   then we're calling the returned procedure with 1 as a parameter."
 | 
						|
  ((iterative-improve
 | 
						|
    (λ (x) (< (abs (- (* x x) n)) 0.0000001))
 | 
						|
    (λ (x) (/ (+ x (/ n x)) 2.0)))
 | 
						|
   2.0))
 |