[Back]

1.3 用高阶函数做抽象

1.29

(define (next k)
    (+ k 1))
(define (even? n)
    (= (remainder n 2) 0))
(define (sum term a next b)
    (if (> a b)
        0
        (+ (term a)
            (sum term (next a) next b))))
(define (intergral f a b n)
    (define h (/ (- b a) n))
    (define (y k)
        (f (+ a (* k h))))
    (define (factor k)
        (cond ((or (= k 0) (= k n)) 1)
            ((even? k) 2)
            (else 4)))
    (define (term k)
        (* (y k)
            (factor k)))
    (if (not (even? n))
        (display "error")
        (* (/ h 3)
    (sum term 0 next n))))

可以看到,辛普森积分在n=100的时候已经逼近精确解了

1.30

(define (sum term a next b)
    (define (iter a result)
        (if (> a b)
            result
            (iter (next a) (+ (term a)
                            result))))
    (iter a 0))

1.31

; A)
(define (square x) (* x x))
(define (inc a) (+ a 1))
(define (product term a next b)
    (if (> a b)
        1
        (* (term a)
            (product term (next a) next b))))
(define (id x) x)
(define (fac x)
    (product id 1 inc x))
(define (even-pi n)
    (cond ((= n 2) n)
          (else (square n))))
(define (plustwo n) (+ n 2))
(define pi
    (* 4
        (/ (* 2 (product square 4 plustwo 20))
            (* 20 (product square 3 plustwo 19)))))
; B)
(define (product term a next b)
    (define iter a result)
        (if (> a b)
            result
            (iter (next a) (* (term a) result)))
    (iter a 1))

1.32

(define (accumulate combiner null-value term a next b)
    (if (> a b)
        null-value
        (combiner (term a)
            (accumulate combiner null-value term (next a) next b))))

(define (accumulate combiner null-value term a next b)
    (define (iter a result)
        (if (> a b)
            result
            (iter (next a) (combiner (term a) result))))
    (iter a null-value))

1.33

(define (filtered-accumulate combiner null-value term a next b filter)
    (define (iter a result)
        (cond (> a b) result
              ((filter (term a)) (iter (next a) (combiner (term a) result)))
              (else (iter (next a) result))))
    (iter a null-value))
(filtered-accumulate + 0 id a inc b prime?)
(filtered-accumulate * 1 1 inc (- n 1) gcd?)
(define (gcd? a)
    (cond ((= (gcd a n) 1) #t)
          (else #f)))

1.34

按照Lisp的应用序求值,我们会发现它在求参数的值的时候发现这个过程缺少参数。这边我们会发现Lisp在传入过程参数时使用的是匿名函数。

1.35

1.36

(define (fixed-point f first-guess)
    (define (close-enough? v1 v2)
        (< (abs (- v1 v2))
        tolerance))
    (define (try guess)
        (display guess)
        (newline)
        (let ((next (f guess)))
            (if (close-enough? guess next)
                next
                (try next))))
    (try first-guess))
(define (averge-dump f) (lambda (x) (averge x (f x))))
(define (averge a b)
    (/ (+ a b) 2))
(fixed-point (averge-dump (lambda (x) (/ (log 1000) (log x)))) 2.0)

平均阻尼法比单纯寻找不动点快了许多

1.37

(define (cont-frac n d k)
    (define (rec i)
        (if (= k i)
            (/ (n i) (d i))
            (/ (n i)
                (+ (d i) (rec (+ i 1))))))
    (rec 1))

(define (cont-frac n d k)
    (define (iter i result)
        (if (= 0 i)
            result
            (iter (- i 1) (/ (n i) (+ (d i) result)))))
    (iter (- k 1) (/ (n k) (d k))))

1.38

(cont-frac 
    (lambda (i) 1.0) 
        (lambda (i) (cond ((= (remainder i 3) 2) (* 2 (/ (+ i 1) 3)))
                          (else 1))) 1000)

1.39

(define (tan-cf x k)
    (define (d i)
        (- (* 2 i) 1))
    (define (rec i)
        (define (n x)
            (cond ((= i 1) x)
                  (else (* x x))))
        (if (= k i)
            (/ (n x) (d i))
            (/ (n x) (- (d i) (rec (+ i 1))))))
    (rec 1))
(tan-cf (/ 3.1415926 4) 100)

1.40

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

1.41

(define (double f)
	(lambda (x) (f (f x))))
(define (inc a) (+ a 1))
(((double (double double)) inc) 5)
; 21

1.42

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

1.43

(define (repeat f k)
	(cond ((= k 1) f)
		  (else (compose f (repeat f (- k 1))))))

1.44

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

1.45

(define (n-rank-root x n)
    (define (average-dump f)
        (lambda (x) (/ (+ x (f x)) 2)))
    (define (expt a b)
        (if (= b 1)
            a
            (* a (rk a (- b 1)))))
    (let ((k (lg n)))
        (fixed-point (repeat (average-dump (lambda (x) (/ x (expt y (- n 1))))) k) 1.0)))

1.46

(define (iterative-improve good-enough? improve)
    (lambda (guess)
        (define (try x)
            (let ((next (improve x)))
                (if (good-enough? next x)
                    next
                    (try next))))
        (try guess)))