By Valleylord

更新日期:

文章目录

我使用的scheme解释器主要是petite chez scheme。解题过程中参考了：http://sicp.readthedocs.org/en/latest/index.html

1.1和1.2基本没问题，除非你没看书......

1.3

1
2
3
4
5
6
(define (<= x y)
    (or (< x y) (= x y)))
(define (add_large_two a b c)
    (cond ((and (<= a b) (<= a c))   (+ b c))
             ((and (<= b a) (<= b c))   (+ a c))
             (else                                 (+ a b))))

1.4 这题的意思应该是说，+-*/这些符号也可以作为表达式的返回值

1.5

1
2
3
4
5
6
(define (p) (p))
(define (test x y)
    (if (= x 0) 0 y))
(test 0 (p))

如果是正则序(normal-order evaluation)的话，那么会看到返回0，因为procedure test开始被call的时候就被展开，并求值，发现x=0就return了，y并没有被展开；如果是应用序(application-order evaluation)的话，那么会陷入无限递归，无法返回，因为procedure test试图展开y(也就是输入的p)，结果发现p被定义为自身，反复的展开p并得到p，最终陷入无限递归，无法被求值。我有一个疑问，如何在函数式编程中发现无穷递归？当一个程序运行了很久也没有返回的时候，究竟是这个程序本身运行的慢，还是已经陷入无穷递归，如何判定？在我的测试环境上，petite chez scheme和tiny scheme都是应用序的。(注：这题原先写反了)

1.6 这题和1.5是一个思路，子句什么时候展开的问题，scheme本身的if是应用序的，但是自定义的new-if是正则序的，会完全展开，然后else子句会自身调用并进一步展开，结果任然是死循环。

1.7 一个好一点的good-enough可以比较abs(old-new)/old < 0.000001，基于这个思路，代码如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(define (sqrt x)
  (sqrt-iter 1.0 x))
(define (sqrt-iter guess x)
  (if (good-enough? guess (improve guess x))
      guess
      (sqrt-iter (improve guess x)
                 x)))
(define (improve guess x)
  (average guess (/ x guess)))
(define (average x y)
  (/ (+ x y) 2))
(define (good-enough? x y)
  (< (/ (abs (- x y)) x) 0.0000001))
(define (abs x)
  (if (< x 0) (- x)
      x))
(define (square x)
  (* x x))

当然，这里没有检查输入不合法的情况，比如负数，而且输入0也会陷入无限循环，如果要考虑的话，可以修改sqrt

1
2
3
4
(define (sqrt x)
  (cond ((> x 0) (sqrt-iter 1.0 x))
        ((= x 0) 0)
        (else    -1)))

1.8 求立方的procedure cbrt，如下，主要修改了improve和good-enough

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(define (cbrt x)
  (cond ((= x 0) 0)
        (else    (cbrt-iter 1.0 x))))
(define (cbrt-iter guess x)
  (if (good-enough? guess (improve guess x))
      guess
      (cbrt-iter (improve guess x)
                 x)))
(define (improve guess x)
  (/ (+ (* 2.0 guess) (/ x (square guess))) 3))
(define (good-enough? x y)
  (< (/ (abs (- x y)) (abs x)) 0.0000001))
(define (abs x)
  (if (< x 0) (- x)
      x))
(define (square x)
  (* x x))

1.9 递归计算过程和迭代计算过程的区别，程序如下，为了和scheme本身的+-号区别开，用add和add2来命名

1
2
3
4
5
6
7
8
9
10
11
12
13
(define (add a b)
  (if (= a 0) b
      (inc (add (dec a) b))))
(define (add2 a b)
  (if (= a 0) b
      (add (dec a) (inc b))))
(define (dec a)
  (- a 1))
(define (inc a)
  (+ a 1))

add是递归计算过程，add2是迭代计算过程，假设我们的过程调用是(add 3 5)和(add2 3 5)，他们的展开分别是

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(add 3 5)
(inc (add 2 5))
(inc (inc (add 1 5)))
(inc (inc (inc (add 0 5))))
(inc (inc (inc 5)))
(inc (inc 6))
(inc 7)
8
(add2 3 5)
(add2 2 6)
(add2 1 7)
(add2 0 8)
8

其实，判定一个过程是递归计算过程还是迭代计算过程，也很简单，如果递归调用的时候，过程名出现在了参数列表中，那么就是递归计算过程；如果过程名不在参数列表中，那么就是迭代计算过程。这是我总结的经验，还没检验过......

1.10 Ackermann函数，

1
2
3
4
5
6
> (A 1 10)
1024
> (A 2 4)
65536
> (A 3 3)
65536

(f n)明显是2*n，(g n)是2^n，(h n)不是很容易猜，google了下，是2的连续2次幂，2^2^2......^2。

1
(A 2 n) = (A 1 (A 1 (A 1 ( ... (A 1 (A 2 1)) ... )

顺便说一下，scheme的递归实在是太容易被击溃了，在算Ackermann的时候，又挂了一次，不过这次是数据太大，不能计算。如何能有效的防止这种递归机制在错误的时候，自我终结呢？还是要靠programmer的介入？

1.11 递归计算过程是f，迭代计算过程是f1

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(define (f n)
  (if (< n 3) n
      (+ (f (- n 1))
         (* (f (- n 2)) 2)
         (* (f (- n 3)) 3) )))
(define (f1 n)
  (f-iter 2 1 0 n))
(define (f-iter a b c n)
  (cond ((= n 0) c)
        ((= n 1) b)
        ((= n 2) a)
        (else    (f-iter (+ a (* 2 b) (* 3 c)) a b (- n 1)))))

在我的机器上，f(30)和f1(30)就有很明显的性能差异。

1.12 pascal三角，并且注解中标明，这个在中国叫“杨辉三角”。设计函数(pascal-triangle row col)用来计算第row行，第col列的杨辉三角的值，我设计是，行数和列数都是从1开始标号，如下图

1
2
3
4
5
6
7
row
1    1
2    1 1
3    1 2 1
4    1 3 3 1
5    1 4 6 4 1
col  1 2 3 4 5

程序代码如下

1
2
3
4
5
(define (pascal-triangle row col)
  (cond ((= col row) 1)
        ((= col 1)   1)
        (else        (+ (pascal-triangle (- row 1) col) 
                        (pascal-triangle (- row 1) (- col 1))) )))

1.13 可以用特征方程的方法来推到，很easy，百度百科上就有。http://baike.baidu.com/view/816.htm

1.14 这题要求画图，我实在是不太会画，于是我在程序上加了一些display，这样就能比较容易的画出来了。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(define (count-change amount)
  (cc amount 5))
(define (cc amount kinds-of-coins)
  (display (list amount kinds-of-coins))
  (newline)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (= kinds-of-coins 0)) 0)
        (else (+ (cc amount
                     (- kinds-of-coins 1))
                 (cc (- amount
                        (first-denomination kinds-of-coins))
                     kinds-of-coins)))))
(define (first-denomination kinds-of-coins)
  (cond ((= kinds-of-coins 1) 1)
        ((= kinds-of-coins 2) 5)
        ((= kinds-of-coins 3) 10)
        ((= kinds-of-coins 4) 25)
        ((= kinds-of-coins 5) 50)))

程序输出的结果就不贴了，加上最终输出的结果4，总共有56行。从运行结果来看，解释器是先运行(cc amount (- kinds-of-coins 1))这段的。生成的树如下图

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
--(11 5)--(11 4)--(11 3)--(11 2)--(11 1)--(11 0)
        |       |       |       |       |-(10 1)--(10 0)
        |       |       |       |               |-(9 1) --(9 0)
        |       |       |       |                       |-(8 1) --(8 0)
        |       |       |       |                               |-(7 1) --(7 0)
        |       |       |       |                                       |-(6 1) --(6 0)
        |       |       |       |                                               |-(5 1) --(5 0)
        |       |       |       |                                                       |-(4 1) --(4 0)
        |       |       |       |                                                               |-(3 1) --(3 0)
        |       |       |       |                                                                       |-(2 1) --(2 0)
        |       |       |       |                                                                               |-(1 1) --(1 0)
        |       |       |       |                                                                                       |-(0 1)
        |       |       |       |-(6 2) --(6 1) --(6 0)
        |       |       |               |       |-(5 1) --(5 0)
        |       |       |               |               |-(4 1) --(4 0)
        |       |       |               |                       |-(3 1) --(3 0)
        |       |       |               |                               |-(2 1) --(2 0)
        |       |       |               |                                       |-(1 1) --(1 0)
        |       |       |               |                                               |-(0 1)
        |       |       |               |-(1 2) --(1 1) --(1 0)
        |       |       |                       |       |-(0 1)
        |       |       |                       |-(-4 2)
        |       |       |-(1 3) --(1 2) --(1 1) --(1 0)
        |       |               |       |       |-(0 1)
        |       |               |       |-(-4 2)
        |       |               |-(-9 3)
        |       |-(-14 4)
        |-(-39 5)
4

很明显，该二叉树是非平衡的，最大深度是其根的左子树的深度，$(n/i+m)$，即输入金额/最小硬币面额+硬币种类数，也就是说，其最差情况的空间和步数增长的阶是O(2^(n/i+m))，其根的右子树的深度是$((n-k)/i+m)$，即(输入金额-最大硬币面额)/最小硬币面额+硬币种类数。接下去分析不下去了，我感觉这个问题的阶是与硬币的种类密切相关的，如果要猜测的话，我猜阶不会超过O(m(n+m))

1.15 这个问题还是采取和上一题类似的办法，display每个p的调用

1
2
3
4
5
6
7
8
9
10
11
12
13
(define (cube x) (* x x x))
(define (p x)
  (display (list "p " x))
  (newline)
  (- (* 3 x) (* 4 (cube x))))
(define (sine angle)
  (display (list "sine " angle))
  (newline)
   (if (not (> (abs angle) 0.1))
       angle
       (p (sine (/ angle 3.0)))))

输出是

1
2
3
4
5
6
7
8
9
10
11
12
(sine  12.15)
(sine  4.05)
(sine  1.3499999999999999)
(sine  0.44999999999999996)
(sine  0.15)
(sine  0.049999999999999996)
(p  0.049999999999999996)
(p  0.1495)
(p  0.4351345505)
(p  0.9758465331678772)
(p  -0.7895631144708228)
-0.39980345741334

可以很明显的看到，p被调用了5次，sine被调用了6次，每次的参数也列出来了。每次调用sine的时候，参数a呈3倍递减，所以其阶是O(log3 a)。

1.16 这题还算厚道，直接贴代码了

1
2
3
4
5
6
7
(define (fast-expt1 x n)
  (fast-expt1-iter 1 x n))
(define (fast-expt1-iter a x n)
  (cond ((= n 0)   a)
        ((even? n) (fast-expt1-iter a (* x x) (/ n 2)))
        (else      (fast-expt1-iter (* a x) (* x x) (/ (- n 1) 2)))))

1.17 代码如下

1
2
3
4
5
6
7
8
9
10
11
12
13
(define (fast-mult x n)
  (fast-mult-iter 0 x n))
(define (fast-mult-iter a x n)
  (cond ((= n 0)   a)
        ((even? n) (fast-mult-iter a (double x) (halve n)))
        (else      (fast-mult-iter (+ a x) (double x) (halve (- n 1)))) ))
(define (double x)
  (+ x x))
(define (halve x)
  (/ x 2))

1.18 我感觉这题是和1.17是一样的，看了一下其他人的解答，原来前一题的意思是用一个递归计算过程的方式来做的，看来我前一题错了，算了，不改了。

1.19 这题还是很有意思的，但是我没做出来，其实静下心来慢慢凑应该也是有希望的，我直接去找答案了......

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(define (fast-fib n)
  (fib-iter 1 0 0 1 n))
(define (fib-iter a b p q count)
  (cond ((= count 0) b)
        ((even? count)
         (fib-iter a
                   b
                   (+ (* p p) (* q q)) ; compute p'
                   (+ (* 2 p q) (* q q)) ; compute q'
                   (/ count 2)))
        (else (fib-iter (+ (* b q) (* a q) (* a p))
                        (+ (* b p) (* a q))
                        p
                        q
                        (- count 1)))))

1.20 gcd过程中，remainder的调用，在应用序的情况下是4次，分别是

1
2
3
4
(remainder 206 40)
(remainder 40 6)
(remainder 6 4)
(remainder 4 2)

最后一次gcd(2 0)的时候直接返回，没有调用remainder，所以gcd的调用是5次。正题则序的话就多很多了，应为是先展开再求值，以gcd(6 4)举例，第1次展开得到(gcd 4 (remainder 6 4))，然后接着展开，在程序中有a和b的地方分别用4和(remainder 6 4)替换，if条件不满足，这样又多出了1次remainder调用，都是b的。最后一次gcd调用是(gcd (remainder 6 4) (remainder 4 (remainder 6 4)))，做同样的替换之后发现if条件满足，不需要继续递归了了，这样又多出3次remainder调用，2次是计算b=(remainder 4 (remainder 6 4))，1次是计算a=(remainder 6 4)。这样看起来的确多了很多次，有人总结了证明

正则代换后,则第n层的a b两个参数对应的remainder的次数分别为$a(n)$, $b(n)$,则: $$a(n) = b(n-1);b(n)=a(n-1)+b(n-1)+1;a(0)=0,b(0)=0$$ 总共5层,由于每层的if判断进行了计算,再加上最后一层的a是计算了的,所以最后的结果是: $$b(0)+b(1)+b(2)+b(3)+b(4)+a(4)=18$$ 这样看起来，我的解释器的确是应用序的。(注：应用序和正则序在FP里面还有另一种表述，分别是：Call-by-Value和Call-by-Name)

1.21 抄程序吧

1.22 坑爹啊，我找了N久才找到了petite里面记录系统运行时间的过程是real-time，首先修改了timed-prime-test来更方便的计时

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(define (timed-prime-test n)
  ;(newline)
  ;(display n)
  (start-prime-test n (real-time)))
(define (start-prime-test n start-time)
  (if (prime? n)
      (report-prime n (- (real-time) start-time))))
(define (report-prime n elapsed-time)
  (display n)
  (display " *** ")
  (display elapsed-time)
  (display "\n"))
(define (next-odd n)
  (if (even? n) (+ n 1)
      (+ n 2)))
(define (search-prime start-number first-i)
  (if (= first-i 0) (display "Done\n")
     (if (prime? start-number) ((timed-prime-test start-number)
                                (search-prime (next-odd start-number) (- first-i 1)))
         (search-prime (next-odd start-number) first-i)) ))

修改过后，只对已经判定为素数的情况做display，否则不做。另外，添加了2个函数为了方便测试，运行结果如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
> (search-prime 1000000 3)
1000003 *** 0
1000033 *** 1
1000037 *** 1
Done
> (search-prime 100000000 3)
100000007 *** 5
100000037 *** 5
100000039 *** 2
Done
> (search-prime 10000000000 3)
10000000019 *** 17
10000000033 *** 17
10000000061 *** 17
Done
> (search-prime 1000000000000 3)
1000000000039 *** 160
1000000000061 *** 157
1000000000063 *** 156
Done
> (search-prime 10000000000000 3)
10000000000037 *** 505
10000000000051 *** 514
10000000000099 *** 497
Done

在输入变的越来越大的时候，的确是呈现sqrt(n)的态势在增长。实际运行的时候，在运行结束还会报错，不清楚原因，以后再查

1
2
Exception: attempt to apply non-procedure #<void>
Type (debug) to enter the debugger.

1.23 修改后的prime?过程如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(define (smallest-divisor n)
  (find-divisor n 2))
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next-divisor test-divisor)))))
(define (divides? a b)
  (= (remainder b a) 0))
(define (prime? n)
  (= n (smallest-divisor n)))
(define (next-divisor n)
  (if (= n 2) 3
      (+ n 2)))

重新运行1.22中的search-prime，运行结果如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
> (search-prime 10000000000 3)
10000000019 *** 12
10000000033 *** 12
10000000061 *** 11
Done
> (search-prime 1000000000000 3)
1000000000039 *** 116
1000000000061 *** 117
1000000000063 *** 115
Done
> (search-prime 10000000000000 3)
10000000000037 *** 358
10000000000051 *** 354
10000000000099 *** 357
Done

实际上的运行时间并没有达到预期的减半效果，大约是0.7倍的样子，是不是多了一层调用，以至于栈的开销上升了？

1.24 先把书上的代码敲进来，再做点修改

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(define (expmod base exp m)
  (cond ((= exp 0) 1)
        ((even? exp)
         (remainder (square (expmod base (/ exp 2) m))
                    m))
        (else
         (remainder (* base (expmod base (- exp 1) m))
                    m))))        
(define (fermat-test n)
  (define (try-it a)
    (= (expmod a n n) a))
  (try-it (+ 1 (random (- n 1)))))
(define (fast-prime? n times)
  (cond ((= times 0) #t)
        ((fermat-test n) (fast-prime? n (- times 1)))
        (else #f)))
(define (square x)
  (* x x))
(define (prime? n)
  (fast-prime? n 10))

把检测一个数是否是素数，变为fermat-test 10次，这样修改的话，对于每个数的验证，时间上就几乎没有差别了才对，事实也是的确如此，程序输出

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
> (search-prime 10000000000 3)
10000000019 *** 1
10000000033 *** 1
10000000061 *** 0
Done
> (search-prime 1000000000000 3)
1000000000039 *** 0
1000000000061 *** 1
1000000000063 *** 1
Done
> (search-prime 10000000000000 3)
10000000000037 *** 0
10000000000051 *** 0
10000000000099 *** 1
Done

当然，如果仔细分析的话，复杂度任然是按照O(log n)在增长，只是我的机器上无法精确的反应这个O(log n)的差别。

1.25 如果对于任意大的数，求remainder的时间都是一样的，换言之，remainder的复杂度是O(1)，这样的话，他认为的将expmod替换成fast-expt+remainder的做法就是对的，但是随着数据量增大，对大数据的运算越来越慢，最终甚至可能造成溢出。顺便说一下，这题的测试又一次造成了scheme解释器无尽的计算.....

1.26 直接用*的方法比用square的方法多计算了一次(expmod base (/ exp 2) m)。

1.27 carmichael数检验，把之前的fermat检验的代码修改一下就好

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(define (expmod base exp m)
  (cond ((= exp 0) 1)
        ((even? exp)
         (remainder (square (expmod base (/ exp 2) m))
                    m))
        (else
         (remainder (* base (expmod base (- exp 1) m))
                    m))))
(define (try-it n a)
   (= (expmod a n n) a))
(define (carmichael-test n a)
  (cond ((= a n) #t)
        ((try-it n a) (carmichael-test n (+ a 1)))
        (else         #f) ))
(define (square x)
  (* x x))
(define (carmichael? n)
  (and (not (prime? n)) (carmichael-test n 1)))

运行结果

1
2
3
4
5
6
7
8
9
10
11
12
> (carmichael?  561)
#t
> (carmichael?  1105)
#t
> (carmichael?  1729)
#t
> (carmichael?  2465)
#t
> (carmichael?  2821)
#t
> (carmichael?  6601)
#t

1.28 引入非平凡平方根(nontrivial square root)的方法，程序改为

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
(define (nontrivial-square-root? a n)
    (and (not (= a 1))
         (not (= a (- n 1)))
         (= 1 (remainder (square a) n))))
(define (expmod base exp m)
  (cond ((= exp 0) 1)
        ((nontrivial-square-root? base m) 0)
        ((even? exp)
         (remainder (square (expmod base (/ exp 2) m))
                    m))
        (else
         (remainder (* base (expmod base (- exp 1) m))
                    m))))        
(define (mr-test n)
  (define (try-it a)
    (= (expmod a (- n 1) n) 1))
  (try-it (+ 1 (random (- n 1)))))
(define (fast-prime? n times)
  (cond ((= times 0) #t)
        ((mr-test n) (fast-prime? n (- times 1)))
        (else #f)))
(define (square x)
  (* x x))
(define (prime? n)
  (fast-prime? n 1))

只需要修改expmod这个过程就好了。

1.29 辛普森积分方法，修改程序

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(define (sum term a next b)
  (if (> a b)
      0
      (+ (term a)
         (sum term (next a) next b))))
(define (step-size n a b)
  (/ (- b a) n))
(define (inc n) (+ n 1))
(define (cube x) (* x x x))
(define (simpson-integral fx a b n)
  (define dx (step-size n a b))
  (define (coef i) 
    (cond ((or (= i 0) (= i n)) 1)
          ((even? i)   2)
          (else        4)))
  (define (f i) (* (fx (+ a (* i dx))) (coef i)))
  (* (sum f 0 inc n) (/ dx 3)) )

输出比较

1
2
3
4
5
6
7
8
9
> (simpson-integral cube 0.0 1.0 100)
0.24999999999999992
> (simpson-integral cube 0.0 1.0 1000)
0.2500000000000003
> (integral cube 0.0 1.0 0.01)
0.24998750000000042
> (integral cube 0.0 1.0 0.001)
0.249999875000001

和原先的integral相比，simpson-integral的收敛比较快

1.30 程序如下

1
2
3
4
5
6
7
8
; use time to compare runtime in petite like
; (time (sum identity 1 inc 10000000))
(define (sum term a next b)
  (define (iter a result)
    (if (> a b) result
         (iter (next a) (+ result (term a)))))
  (iter a 0))

修改之后，运行速度变快，petite chez scheme的运行结果如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
; 原来的sum
> (time (sum identity 1 inc 10000000))
(time (sum identity ...))
    143 collections
    4923 ms elapsed cpu time, including 3817 ms collecting
    6099 ms elapsed real time, including 4968 ms collecting
    1209306752 bytes allocated, including 1068476896 bytes reclaimed
50000005000000
> (time (sum identity 1 inc 1000000))
(time (sum identity ...))
    13 collections
    311 ms elapsed cpu time, including 198 ms collecting
    313 ms elapsed real time, including 199 ms collecting
    114705968 bytes allocated, including 82276352 bytes reclaimed
500000500000
; 修改之后的sum
> (time (sum identity 1 inc 10000000))
(time (sum identity ...))
    no collections
    999 ms elapsed cpu time
    1001 ms elapsed real time
    272 bytes allocated
50000005000000
> (time (sum identity 1 inc 1000000))
(time (sum identity ...))
    no collections
    112 ms elapsed cpu time
    112 ms elapsed real time
    272 bytes allocated
500000500000

cpu时间明显降低，改为了迭代过程，不需要栈的开销，所以空间要求也降低了。

1.31 递归过程的product代码如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(define (product term a next b)
  (if (> a b)
      1
      (* (term a)
         (product term (next a) next b))))
(define (inc n) (+ n 1))
(define (identity x) x)
(define (square x) (* x x))
(define (pi-term x)
  (/ (* (- x 1) (+ x 1)) (square x)) )
(define (pi-next x)
  (+ x 2))
(define (factorial n)
  (product identity 1 inc n))
(define (pi-product n)
  (* 4 (product pi-term 3.0 pi-next n)))

输出结果如下

1
2
3
4
5
6
> (factorial 10)
3628800
> (pi-product 100)
3.1573396892175642
> (pi-product 1000)
3.143163842419204

如果把product改为迭代过程的话，代码改为

1
2
3
4
5
(define (product-iter term a next b)
  (define (iter a result)
    (if (> a b) result
         (iter (next a) (* result (term a)))))
  (iter a 1))

1.32 完全仿造原先的写法

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(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-iter combiner null-value term a next b)
  (define (iter a result)
    (if (> a b) result
         (iter (next a) (combiner result (term a)))))
  (iter a null-value))
(define (sum term a next b)
  (accumulate + 0 term a next b))
(define (product term a next b)
  (accumulate * 1 term a next b))
(define (sum term a next b)
  (accumulate-iter + 0 term a next b))
(define (product term a next b)
  (accumulate-iter * 1 term a next b))

1.33 filtered-accumulate有种map-reduce的感觉

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(define (filtered-accumulate combiner null-value term a next b filt?)
  (cond ((> a b)   null-value)
        ((filt? a) 
           (combiner (term a) 
              (filtered-accumulate combiner null-value term (next a) next b filt?)))
        (else      
           (filtered-accumulate combiner null-value term (next a) next b filt?)) ))
(define (filtered-accumulate-iter combiner null-value term a next b filt?)
  (define (iter a result)
    (cond ((> a b)   result)
          ((filt? a) (iter (next a) (combiner result (term a))))
          (else      (iter (next a) result)) ))
  (iter a null-value))
(define (smallest-divisor n)
  (find-divisor n 2))
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next-divisor test-divisor)))))
(define (divides? a b)
  (= (remainder b a) 0))
(define (prime? n)
  (= n (smallest-divisor n)))
(define (next-divisor n)
  (if (= n 2) 3
      (+ n 2)))
(define (square x)
  (* x x))
(define (sum-square-prime a b)
  (filtered-accumulate-iter + 0 square a inc b prime?))
(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b)) ))
(define (prod-rela-prime n)
  (define (rela-prime? i)
    (= (gcd i n) 1))
  (filtered-accumulate-iter * 1 identity 2 inc n rela-prime?))

sum-square-prime和prod-rela-prime分别是a)和b)的解答

1.34 最终会报错，petite上的报错是

1
2
3
> (f f)
Exception: attempt to apply non-procedure 2
Type (debug) to enter the debugger.

因为(f f)->(f 2)->(2 2)，2不是一个过程，就悲剧了

1.35 证明黄金分割率就跳过了，二元一次方程而已，计算程序基本上就是抄fixed-point那段，输出是

1
2
> (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0)
1.6180327868852458

1.36 老的程序就是不用平均阻尼来计算的，输出是

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
> (fixed-point (lambda (x) (/ (log 1000) (log x))) 1.1)
(try  1.1 72.47657378429035)
(try  72.47657378429035 1.6127318474109593)
(try  1.6127318474109593 14.45350138636525)
(try  14.45350138636525 2.5862669415385087)
(try  2.5862669415385087 7.269672273367045)
(try  7.269672273367045 3.4822383620848467)
(try  3.4822383620848467 5.536500810236703)
(try  5.536500810236703 4.036406406288111)
(try  4.036406406288111 4.95053682041456)
(try  4.95053682041456 4.318707390180805)
(try  4.318707390180805 4.721778787145103)
(try  4.721778787145103 4.450341068884912)
(try  4.450341068884912 4.626821434106115)
(try  4.626821434106115 4.509360945293209)
(try  4.509360945293209 4.586349500915509)
(try  4.586349500915509 4.535372639594589)
(try  4.535372639594589 4.568901484845316)
(try  4.568901484845316 4.546751100777536)
(try  4.546751100777536 4.561341971741742)
(try  4.561341971741742 4.551712230641226)
(try  4.551712230641226 4.558059671677587)
(try  4.558059671677587 4.55387226495538)
(try  4.55387226495538 4.556633177654167)
(try  4.556633177654167 4.554812144696459)
(try  4.554812144696459 4.556012967736543)
(try  4.556012967736543 4.555220997683307)
(try  4.555220997683307 4.555743265552239)
(try  4.555743265552239 4.555398830243649)
(try  4.555398830243649 4.555625974816275)
(try  4.555625974816275 4.555476175432173)
(try  4.555476175432173 4.555574964557791)
(try  4.555574964557791 4.555509814636753)
(try  4.555509814636753 4.555552779647764)
(try  4.555552779647764 4.555524444961165)
(try  4.555524444961165 4.555543131130589)
(try  4.555543131130589 4.555530807938518)
(try  4.555530807938518 4.555538934848503)
4.555538934848503

使用平均阻尼的代码如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
fine tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (display (list "try " guess (f guess)))
    (newline)
    (let ((next (average guess (f guess))))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))
(define (average a b)
  (/ (+ a b) 2))

输出是

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
> (fixed-point (lambda (x) (/ (log 1000) (log x))) 1.1)
(try  1.1 72.47657378429035)
(try  36.78828689214517 1.9160641716198537)
(try  19.352175531882512 2.331491827268849)
(try  10.84183367957568 2.8982630247078642)
(try  6.870048352141772 3.5844015717925406)
(try  5.227224961967156 4.176695428351422)
(try  4.701960195159289 4.46243335124296)
(try  4.582196773201124 4.538071686206237)
(try  4.560134229703681 4.55250660915824)
(try  4.5563204194309606 4.555018304137115)
(try  4.555669361784037 4.55544756416724)
(try  4.555558462975639 4.555520696950483)
(try  4.55553957996306 4.555533149860501)
4.555536364911781

可以发现， 使用平均阻尼的话，迭代次数明显变少。

1.37 递归过程和迭代过程代码如下

1
2
3
4
5
6
7
8
9
10
11
12
(define (cont-frac ni di k)
  (define (cont-frac-recur i)
    (if (= i k) (/ (ni i) (di i))
        (/ (ni i) (+ (di i) (cont-frac-recur (+ i 1)))) ))
  (cont-frac-recur 1))
(define (cont-frac-iter ni di k)
  (define (iter i result)
    (let ((fi (/ (ni i) (+ (di i) result))))
      (if (= i 1) fi
          (iter (- i 1) fi))))
  (iter k 0))

黄金分割的4位小数近似为0.6180，实验数值表明，在k=10的时候，得到4位小数近似值

1
2
3
4
5
6
7
8
9
10
11
> (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) 9)
0.6181818181818182
> (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) 10)
0.6179775280898876 
1.38 利用1.37中的程序即可
 
> (cont-frac (lambda (i) 1.0) 
             (lambda (i) (if (= (remainder i 3) 2) (* (+ (div i 3) 1) 2) 
                             1)) 
             10)
0.7182817182817183

1.39 利用1.37中的程序，再加上下面这段即可

1
2
3
4
5
6
7
8
(define (square x)
  (* x x))
(define (tan-cf x k)
  (cont-frac (lambda (i) (if (= i 1) x
                             (- 0 (square x)))) 
             (lambda (i) (- (* 2 i) 1)) 
             k))

输出验证

1
2
3
4
5
6
> (tan-cf 1.0 10)
1.557407724654902
> (tan-cf 1.0 5)
1.5574074074074076
> (tan 1.0)
1.5574077246549023

1.40 其他的程序和书上一样，cubic定义如下

1
2
3
4
5
(define (cubic a b c)
  (lambda (x) (+ (cube x) 
                 (* a (square x))
                 (* b x)
                 c)))

1.41 程序如下

1
2
(define (double proc)
  (lambda (x) (proc (proc x))))

输出验证如下

1
2
> (((double (double double)) inc) 5)
21

解释是这样的，第1个double的参数是(double double)，返回是(double double)(double double)，也就是要做4次double，所以跟在后面的inc总共做了2^4=16次。

1.42 这题应该是好几题以来最简单的

1
2
(define (compose fx gx)
  (lambda (x) (fx (gx x))))

1.43 利用1.42的结果

1
2
3
4
5
6
(define (compose fx gx)
  (lambda (x) (fx (gx x))))
(define (repeated fx n)
  (if (= n 1) fx
      (compose fx (repeated fx (- n 1))) ))

1.44 调用1.43的repeated，代码如下

1
2
3
4
5
6
7
8
9
(define dx 0.00001)
(define (smooth fx)
  (lambda (x) (/ (+ (fx (+ x dx))
                    (fx x)
                    (fx (- x dx))) 3)))
(define (smooth_n fx n)
  ((repeated smooth n) fx))

1.45 借用1.17的fast-expt求幂，借用1.43的repeated求平均阻尼

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
(define (fast-expt1 x n)
  (fast-expt1-iter 1 x n))
(define (fast-expt1-iter a x n)
  (cond ((= n 0)   a)
        ((even? n) (fast-expt1-iter a (* x x) (/ n 2)))
        (else      (fast-expt1-iter (* a x) (* x x) (/ (- n 1) 2)))))
(define (average-damp f)
  (lambda (x) (average x (f x))))
(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next ((average-damp f) guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))
(define (fixed-point-of-transform g transform guess)
  (fixed-point (transform g) guess))
(define (log2 x)
  (round (/ (log x) (log 2))))
(define (nth-root x n)
  (define (average-damp f)
    (lambda (x) (average x (f x))))
  (define (rep-avg-damp f)
    ((repeated average-damp (log2 n)) f))
  (fixed-point-of-transform (lambda (y) (/ x (fast-expt1 y (- n 1))))
                            rep-avg-damp
                            1.0) )

平均阻尼的次数是$[\log_2 n]$，log2 n并向下取整，所以，定义了log2过程，用来计算[log2 n]。输出验证

1
2
3
4
> (nth-root 81 4)
3.00000501889963
> (nth-root 16 4)
2.000005048018041

1.46 参考原先fixed-point的写法，予以提取并改进

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
(define (iterative-improve close-enough? improve)
  (define (try guess)
    (let ((next (improve guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (lambda (x) (try x)))
(define tolerance 0.00001)
(define (average-damp f)
  (lambda (x) (average x (f x))))
(define (fixed-point f guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (improve guess)
    ((average-damp f) guess))
  ((iterative-improve close-enough? improve) guess) )
(define (fixed-point-of-transform g transform guess)
  (fixed-point (transform g) guess))
(define (sqrt x)
  (fixed-point-of-transform (lambda (y) (/ x y))
                            average-damp
                            1.0))

测试一下

1
2
3
4
> (fixed-point cos 1.0)
0.7390856958607677
> (sqrt 2.0)
1.4142047060743028

似乎没什么问题。

文章目录

欢迎来到Valleylord的博客！

本博的文章尽量原创。