SICP 解题集

来源:互联网 发布:java xp版下载 编辑:程序博客网 时间:2024/05/17 22:40

第一章

练习1.15
a:p被使用啦5次
b:angle每乘以3,p多调用一次。空间和步数都为线性增长。
练习1.16

  (cond    [(= n 0) a]    [(even? n) (first-e (square b) (/ n 2) a )]    [(odd? n)  (first-e b (- n 1) (* a b ))]))(define (square x)  (* x x)

练习1.17

(define (double x)  (+ x x))(define (halve-iter x b)  (if (= (+ b b) x)      b      (halve-iter x (+ b 1))))(define (halve x )  (halve-iter x 0))(define (fast-mul a b )  (cond    [(= b 0) 0]    [(even? b) (fast-mul (double a) (halve b) )]    [else (+ a (fast-mul a (- b 1)  )])) 

练习1.18
迭代版

(define (fast-mul-iter a b y )  (cond    [(= b 0) y]    [(even? b) (fast-mul-iter (double a) (halve b) y )]    [else (fast-mul-iter a (- b 1)  (+ y a ))]))(define (fast-mul a b)  (if  (or (= a 0) (= b 0))      0      (fast-mul-iter a b 0)))

练习1.19
不会
练习1.20
应用序中掉用了5次remainder
正则序大于5次
练习1.21

(define (smallest-divisor n)  (find-divisor n 2))(define (find-divisor n test)  (cond    [(> (square test) n) n]    [(divides? test n) test]    [else (find-divisor n (+ test 1))]))(define (divides? a b)  (= (remainder b a) 0))(define (square x)  (* x x))
> (smallest-divisor 199)199> (smallest-divisor 1999)1999> (smallest-divisor 19999)7

练习1.22

(define (search-for-primes n)  (cond    [(prime? n) (and (timed-prime-test n) (search-for-primes (+ n 2)))]    [else (search-for-primes (+ n 1)) ]))(define (timed-prime-test n)  (and (newline)   (display n)  (start-prime-test n (runtime))))(define (start-prime-test n start-time)  (report-prime(- (runtime ) start-time)))(define (report-prime t)  (and (display "***")  (display t)))
(search-for-primes 1000)1009***241013***01019***0
(search-for-primes 10000)10007***1910009***010037***0
(search-for-primes 100000)100003***26100019***1100043***0
(search-for-primes 1000000)1000003***271000033***01000037***0

结果不论范围从哪开始耗时并不是根号10倍的关系
也不符合步数正比于耗时。
练习1.23
原版12个素数总耗时24s

1009***211013***01019***01021***11031***01033***01039***11049***01051***01061***01063***01069***0

next版28s

1009***261013***11019***01021***11031***01033***01039***01049***01051***01061***01063***01069***01087***0

不符合快一倍的预期。
大约为85比100。(其中有几次是1比2,原因不明)
编译器处理next的速度低于内置的基本运算符,但当输入的数量级变大后,使用next的收益会大于使用基本运算符的收益。
练习1.24

#lang planet neil/sicp(define (square x)  (* x x))(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) true]    [(fermat-test n) (fast-prime? n (- times 1))]    [else false]))(define (time-prime-test n)  (newline)  (display n)  (start-prime-test n (runtime)))(define (start-prime-test n start-time)  (report-prime (- (runtime) start-time)))(define (report-prime t)  (display "***")  (display t))(define (search-su n number t)  (cond    [(= number 0) (and (newline) (display (- (runtime) t)))]    [(fast-prime? n 10)  (time-prime-test n) (search-su (+ n 2) (- number 1) t)]    [(even? n) (search-su (+ n 1) number t)]    [(odd? n) (search-su (+ n 2) number t )]))(define (search-f n number )  (search-su n number (runtime)))
(search-f 1000000 12)1000003***11000033***11000037***11000039***11000081***01000099***11000117***01000121***11000133***01000151***01000159***01000171***11533
(search-f 1000 12)1009***11013***11019***11021***11031***01033***01039***11049***11051***01061***11063***21069***11679

可以看出俩个时间基本相等。算法复杂度考虑的是增长速度的快慢:比如说,当我们说一个算法 A 的复杂度比另一个算法 B 的复杂度要高的时候,意思是说,算法 A 计算所需的资源(时间或空间)要比算法 B 要多。一般来说,复杂度更低的算法,实际的运行速度总比一个复杂度更高的算法要来得更快,有时候在输入比较小时会比较难看出差别,但是当输入变得越来越大的时候,低复杂度算法的优势就会体现出来。

练习1.29

#lang planet neil/sicp(define (sps 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 ]      [(odd? k) 4]      [(even? k) 2]))  (define (term k)    (* (factor k) (y k)))  (define (next k)    (+ k 1))  (if (not (even? n))        (error "n can't be odd")        (* (/ h 3)           (sum term 0 next n))))(define (sum term a next b)  (if (> a b)      0      (+ (term a)         (sum term (next a ) next b))))(define (cube x)  (* x x x))
(sps cube 0 1 100)1/4> (sps cube 0 1 1000)1/4

结果不对
参考答案后将(sum term 0 next n))))改为
(sum term (exact->inexact 0) next n))))
结果为

(sps cube 0 1 100)0.24999999999999992> (sps cube 0 1 1000)0.2500000000000003
(exact->inexact 1)1.0> (inexact->exact 0)0> (inexact->exact 1.9)1 2026619832316723/2251799813685248> (inexact->exact 2.0)2

根据实验可知这个内置函数可以改变保留小数位数。
练习1.30
sum的迭代版

(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
product递归版

(define (product term a next b)  (if (> a b )      1      (* (term a)         (product term (next a) b))))

迭代版

(define (product term a next b)  (define (p-iter a result)    (if (> a b)      result      (p-iter (next a) (* (term a) result))))  (p-iter a 1))

按照product计算PI

(define (g a)  (cond    [(= a 1) (/ 2 3)]    [(even? a) (/ (+ a 2) (+ a 1))]    [(odd? a) (/ (+ a 1) (+ a 2))]))(define (add123 a)  (+ a 1))(define (pi n)  (exact->inexact (* 4 (product g 1 add123 n) )))

结果

(pi 1)2.6666666666666665> (pi 10)3.2751010413348074

练习1.32
递归版

#lang planet neil/sicp(define (accumulate combiner null-value term a next b)  (cond    [(> a b) null-value]    [else (combiner (term a)     (accumulate combiner null-value term (next a) next b))]    ))

sum就相当于

(accumulate + 0 term a next b)

product相当于

(accumulate1 term a next b)

迭代版

(define (accumulate1 combiner null-value term a next b)  (define (accumulate-iter a  result)    (cond      [(> a b) result]      [else (accumulate-iter (next a)  (combiner (term a) result))]))  (accumulate-iter a null-value))

练习1.33

(define (filtered-accumulate combiner null-value  weici? term a next b)  (cond    [(> a b) null-value]    [(weici? a 10) (combiner (term a)                          (filtered-accumulate combiner null-value weici? term (next a) next b))]    [else (filtered-accumulate combiner null-value weici? term (next a) next b)]    ))(define (new-a a)  (+ a 1))(define (qq x) x)

a:

(filtered-accumulate + 0 prime? qq 1008 new-a 1014)

b:
增加谓词

(define (husu? a b)  (= (gcd a b) 1))

谓词处修改

  [(weici? a b)
(filtered-accumulate * 1 husu? qq 0 new-a 10)189> (filtered-accumulate * 1 husu? qq 0 new-a 1000)数据太长不打了

练习1.34

(f f). . application: not a procedure; expected a procedure that can be applied to arguments  given: 2  arguments...:

这个函数要求一个过程或着说函数作为参数,将自己作为参数传入时,(f f) -》( (lambda (g) (g 2)) (lambda (g) (g 2)) )->(2 2)
没有运算符来处理number所以报错。

练习1.35

#lang planet neil/sicp(define (fixed-point f first-guess)  (define (close-enough? a b)    (< (abs(-  a b)) 0.00001))  (define (try guess)    (let ((next (f guess)))      (if (close-enough? guess next)          next          (try next))))  (try first-guess))(define gold-point (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0))> gold-point1.6180327868852458

练习1.36
修改版fixed-point

#lang planet neil/sicp(define (fixed-point f first-guess)  (define (close-enough? a b)    (< (abs(-  a b)) 0.00001))  (define (try guess)    (let ((next (f guess)))      (cond        [(close-enough? guess next) next]        [else         (newline)         (display next)         (try next)])))  (try first-guess))

效果

(define gold-point (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0))2.01.51.66666666666666651.61.6251.61538461538461541.6190476190476191.61764705882352941.61818181818181821.61797752808988761.61805555555555561.61802575107296141.6180371352785146

不用平均阻尼

(define pjzn (fixed-point (lambda (x) (/ (log 1000) (log x))) 1.1))72.476573784290351.612731847410959314.453501386365252.58626694153850877.2696722733670453.48223836208484675.5365008102367034.0364064062881114.950536820414564.3187073901808054.7217787871451034.4503410688849124.6268214341061154.5093609452932094.5863495009155094.5353726395945894.5689014848453164.5467511007775364.5613419717417424.5517122306412264.5580596716775874.553872264955384.5566331776541674.5548121446964594.5560129677365434.5552209976833074.5557432655522394.5553988302436494.5556259748162754.5554761754321734.5555749645577914.5555098146367534.5555527796477644.5555244449611654.5555431311305894.555530807938518

使用平均阻尼

(define pjzn (fixed-point (average-damp (lambda (x) (/ (log 1000) (log x)))) 1.1))
36.7882868921451719.35217553188251210.841833679575686.8700483521417725.2272249619671564.7019601951592894.5821967732011244.5601342297036814.55632041943096064.5556693617840374.5555584629756394.55553957996306

步骤明显减少

练习1.37
a:
递归版

(define (cont-frac n d k)  (define (cf i)    (if (= i k)      (/ (n k) (d k))        (/ (n i)         (+ (d i) (cf (+ i 1))))))  (cf 1))
(cont-frac (lambda (i) 1.0)             (lambda (i) 1.0)             11)0.6180555555555556

测试知 k=11就可达到
b:迭代版

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

从高位加到低位

练习1.38

(define (e k)  (define (n i) 1)  (define (d i)    (if (= 0 (remainder (+ i 1) 3))        (* 2 (/ (+ i 1) 3))        1))  (+ 2.0 (cont-frac n d k)))

由题可知
i+1 在i=2 5 8 。。。与3可以整除。此时d为(i+1)/3 *2,其他情况都为1.由此的次函数。

练习1.39

(define (tan-cf x k)  (define (d i) (- (* i 2) 1))  (define (n i)    (if (= i 1)        x        (- (* x x))))  (exact->inexact(cont-frac n d k)))

结果为

(tan-cf 10 100)0.6483608274590866> (tan 10)0.6483608274590867

练习1.40

(define (deriv g)  (lambda (x)    (/ (- (g (+ x dx )) (g x)) dx)))(define dx 0.00001)(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 3 2 1) 1)-2.3247179572447267

练习1.41

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

练习1.42

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

练习1.43

(define (repeated f n)  (if (< n 2)       f      (compose f (repeated f (- n 1))))) 
((repeated square 2)5)625

迭代版

(define (repeated1 f n)  (define (iter i n result)    (if (< i n)        (iter (+ i 1) n (compose f result))        result  ))  (iter 1 n f))
((repeated1 square 2) 5)625

练习1.44

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

递归版

(define (re-smooth f n)  (if (= n 0)      f      (smooth (re-smooth f (- n 1)))))

迭代版

(define (re-smooth1 f n)  (define (iter n result)    (if (= n 0)        result        (iter (- n 1) (smooth result))))  (iter n f))

使用repeated版

(define (re-smooth2 f n)  ((repeated smooth n) f))

增加let版

(define (re-smooth2 f n)  (let ( (re (repeated smooth n)))    (re f)))

练习1.45
题目要求我们根据公式 y↦x/y(n−1)次方 ,写出相应的函数,它可以计算出 n 次方根的值y= n次开根号x,并且使用适当次数的平均阻尼对公式进行变换,确保不动点收敛。

接着要解决的问题是,找出计算 n次方根和收敛计算所需的平均阻尼次数之间的关系,以下是一些实验数据:n  1 2 3 4 5 6 7 8 。。。d  1 1 1 2 2 2 2 3 。。。可以看出,要使得计算 n次方根的不动点收敛,最少需要 lgn次平均阻尼。

计算y的次方

(define (expt base n)  (if (= n 0)      1      ((repeated (lambda (x) (* base x)) n) 1)))

使用几次average-damp

(define (average-damp-times f n)  ((repeated average-damp n) f))

输入 y的次方数n 和使用average-damp的次数,fixed-point寻找不动点。整个函数是一个过程,等待一个x的输入。

(define (finally n damp-times)  (lambda (x)    (fixed-point      (average-damp-times        (lambda (y)           (/ x (expt y (- n 1))))        damp-times) 1.0)))

计算使用average-damp达到收敛的次数

(define  (lg n)  (cond    [(> (/ n 2) 1) (+ 1 (lg (/ n 2)))]    [(< (/ n 2) 1) 0]    [else 1]))
(define (n-root n)  (finally n (lg n)))

开平方

》((n-root 2) 9)3.0

开立方

》((n-root 3) 8)1.9999981824788517

第二章

练习2.2

#lang planet neil/sicp(define (average a b)  (/ (+ a b) 2))(define (make-point x y)  (cons x y))(define(x-point point)  (car point))(define (y-point point)  (cdr point))(define (make-segment p1 p2)  (cons p1 p2))(define (start-segment segment)  (car segment))(define (end-segment segment)  (cdr segment))(define (midpoint-segment segment)  (make-point   (average (x-point (start-segment segment))            (x-point (end-segment segment)))   (average (y-point (start-segment segment))            (y-point (end-segment segment)))))(define (print-point p)  (newline)  (display "(")  (display (x-point p))  (display ",")  (display (y-point p))  (display ")"))
> (print-point (midpoint-segment (make-segment (make-point 1 5) (make-point 6 6))))(7/2,11/2)

练习2.3
第一种表示法
构造矩形

(define (make-rectangle  l1 l2 w1 w2)  (cons   (cons l1 l2)   (cons w1 w2)))

选择器

(define (length-l1 r)  (car (car r)))(define (length-l2 r)  (cdr (car r)))(define (width-w1 r)  (car (cdr r)))(define (width-w2 r)  (cdr (cdr r)))

计算周长

(define (perimeter-rectangle  length width)  (* 2 (+ length width)))

计算面积

(define (area-rectangle length width)  (* length width))

计算俩点间距离

(define (distance segment)  (sqrt   (+ (square    (- (x-point (start-segment segment))    (x-point (end-segment segment))))      (square    (- (y-point (start-segment segment))    (y-point (end-segment segment)))))))

设定长和宽

(define (rec-length segment)  (distance segment))(define (rec-width segment)  (distance segment))(define length (rec-length (length-l1 r)))(define width (rec-width (width-w1 r)))

设定4条线段

(define l1 (make-segment (make-point 1 4) (make-point 4 4)))(define l2 (make-segment (make-point 1 2) (make-point 4 2)))(define w1 (make-segment (make-point 1 4) (make-point 1 2)))(define w2 (make-segment (make-point 4 4) (make-point 4 2)))

构造矩形

(make-rectangle l1 l2 w1 w2)

计算面积和周长

>(perimeter-rectangle  length width)10.000000000000004> (area-rectangle length width)6.000000000000007

第二种表示法
俩条线段表示

(define (make-rec1 l01 w01)  (cons l01 w01))(define (length-l01 rec1)  (car rec1))(define (length-w01 rec1)  (cdr rec1))

使用方式与前一种方法相同。

练习2.4

(define (cons x y)  (lambda (m) (m x y)))(define (car z)  (z (lambda (p q) p)))(define (cdr z)  (z (lambda (p q) q)))
> (car (cons 2 3))2> (cdr (cons 2 3))3

练习2.5
以下函数仅在

(cons 2 3))

下成立

#lang planet neil/sicp(define (square x)  (* x x))(define (cons x y)  (* (square x)     (square y)))(define (car z)  (if (= 0 (remainder z 2))      (+ 1 (car (/ z 2)))      0))(define (cdr z)  (if (= 0 (remainder z 3))      (+ 1 (car (/ z 3)))       0))
> (car(cons 2 3))2> (cdr (cons 2 3))3

练习2.6
不会

2.1.4区间算术
练习2.7

(define (make-interval a b)  (cons a b))(define (lower-bound item)  (car item))(define (upper-bound item)  (cdr item))

练习2.8
区间减法

(define (sub-interval x y)  (add-interval x                (make-interval (- (upper-bound y))                               (- (lower-bound y)))))

练习2.9
根据定义的运算规则,加和减是在被加数区间的下界和上界同时加上加数的下界和上界。可得加法的宽度是俩个区间的宽度之和,减法是俩个区间的宽度之差。
例如 (1 3) (2 4),俩数相乘宽度为5,和他们的宽度没啥关系。

练习2.10
检查除数,保证它的上下界都不为0。

(define (div-interval x y)  (if (and       (= (lower-bound y) 0)       (= (upper-bound y) 0))      (error "ioerror")      (mul-interval x                    (make-interval (/ 1.0 (upper-bound y))                                   (/ 1.0 (upper-bound y))))))

练习2.11
多了一倍的分支,但是不会化简了

(define (mul-interval x y)  (let ((a (lower-bound x))        (b (upper-bound x))        (c (lower-bound y))        (d (upper-bound y)))    (if (> a 0)        (if (> c 0)            (make-interval (* a c) (* b d))            (if (> d 0)                (make-interval (* b c) (* b d))                (make-interval (* b c) (* a d))))        (if (> c 0)            (if (> b 0)                (make-interval (* a d) (* b d))                (make-interval (* a d) (* b c)))            (if (> a c)                (if (> b 0)                    (if (> d 0)                        (if (> b d)                            (if (> (* b d) (* a c))                                (make-interval (* b c) (* b d))                                (make-interval (* b c) (* a c)))                            (if (> (* b d) (* a c))                                (make-interval (* d c) (* b d))                                (make-interval (* d c) (* a c))))                        (make-interval (* b c) (* a c)))                    (if (> d 0)                        (make-interval (* a d) (* a c))                        (make-interval (* b d) (* a c))))                (if (> b 0)                    (if (> d 0)                        (if (> (* b d) (* a c))                                (make-interval (* a d) (* b d))                                (make-interval (* a d) (* a c)))                        (make-interval (* b c) (* a c)))                    (if (> d 0)                        (make-interval (* a d) (* a c))                        (make-interval (* b d) (* a c)))))))))

练习2.12

(define (percent item)  (/ (width item) (center item)))(define (make-center-percent center 100number)  (cons center 100number))

练习2.13
不会

练习2.17

(define (last-pair l)  (cond    [(null? l) 0]    [(null? (cdr l))  (car l)]    [else (last-pair (cdr l))]))

练习2.18

(define (reverse l)  (define (reverse-t l n)    (cond      [(null? l) n]      [else (reverse-t (cdr l) (cons (car l) n))]))  (reverse-t l '()))

练习2.19

(define (no-more? l)    (null? l))   (define (except-first-denomination l)    (cdr l))  (define (first-denomination l)    (car l))

改变顺序不会改变结果,因为不论表如何排列每个元素都会被遍历。

练习2.20

(define (filter predicate sequence)  (cond    [(null? sequence) '()]    [(predicate (car sequence))     (cons (car sequence) (filter predicate (cdr sequence)))]    [else (filter predicate (cdr sequence))]))(define (same-parity x . w)  (filter (if (odd? x)       odd?      even?) (cons x w))) 

练习2.21

(define (square-list item)  (if (null? item)      '()      (cons (* (car item) (car item))            (square-list (cdr item)))))(define (square-list item)   (map square item))

练习2.22
a:因为只能顺序取得表里的值,所以当他cons是顺序久反了。
b;换位置后answer还是只能顺序取到表里的值。
解决办法是再调用一个迭代的reverse,重排顺序就可以了。

练习2.23

(define (for-each f items)  (if (not (null? items))      (begin (f (car items))      (for-each f (cdr items)))))

练习2.24

(mcons 1 (mcons (mcons 2 (mcons (mcons 3 (mcons 4 '())) '())) '()))

这里写图片描述

练习2.25

(car (cdr (car (cdr (cdr (list 1 3 (list 5 7) 9))))))
(car (car (list (list 7))))
(car (cdr      (car (cdr                (car (cdr                          (car (cdr                                    (car (cdr                                              (car (cdr                                                        (list 1                                                              (list 2                                                                    (list 3                                                                          (list 4                                                                                (list 5                                                                                      (list                                                                            6 7))))))))))))))))))

形如这样的嵌套表结构,要取到7 ,要6组 (car (cdr ( xxxx)))的组合,取到6要5组,以此类推2要一组。只有第一个数据情况不同。

(list 1 (list 2 (list 3 (list 4 (list 5 (list   6 7))))))

练习2.26

> (append x y)(mcons 1 (mcons 2 (mcons 3 (mcons 4 (mcons 5 (mcons 6 '()))))))> (cons x y)(mcons (mcons 1 (mcons 2 (mcons 3 '()))) (mcons 4 (mcons 5 (mcons 6 '()))))> (list x y)(mcons (mcons 1 (mcons 2 (mcons 3 '()))) (mcons (mcons 4 (mcons 5 (mcons 6 '()))) '()))

练习2.27

(define (deep-reverse item)  (define (iter iter-item n)    (if (null? iter-item)        n        (iter (cdr iter-item)              (cons (if (pair? (car iter-item))                    (deep-reverse (car iter-item))                    (car iter-item))                    n))))  (iter item '()))

练习2.28

(define (fringe item)  (cond    [(null? item) '()]    [(not (pair? item)) (list item)]    [else (append (fringe (car item))                (fringe (cdr item)))]))

练习2.29
a:

(define (left-branch mobile)  (car mobile))(define (right-branch mobile)  (car (cdr mobile)))(define (branch-length branch)  (car branch))(define (branch-structure branch)  (car (cdr branch)))

b:

(define (total-weight mobile)  (+ (branch-weight (left-branch mobile))     (branch-weight (right-branch mobile))))(define (branch-weight branch)  (if (pair? (branch-structure branch))      (total-weight (branch-structure branch))      (branch-structure branch)))

c:

(define (another-mobile? branch)  (pair? branch-structure branch))(define (mobile-balance? mobile)  (let ((left (left-branch mobile))        (right (right-branch mobile)))    (and     (same-torque? left right)     (branch-balance? left)     (branch-balance? right))))(define (same-torque? left right)    (= (branch-torque left)       (branch-torque right)))(define (branch-balance? branch)    (if (another-mobile? branch)        (mobile-balance? (branch-structure branch))        #t))

d:

只需要改选择器就可以了。

练习2.30
第一种

(define (square-three items )  (define (iter l f n)    (cond      [(null? l) '()]      [(not (pair? l)) (f l)]      [else (cons (iter (car l) f )                  (iter (cdr l) f))]))  (iter items square ))

第二种

(define (square-three1 items)  (define (s-t sub-item f)    (map (lambda (sub-item)         (if (pair? sub-item)             (s-t sub-item f)             ( f sub-item)))         sub-item))  (s-t items square))

练习2.31

(define (tree-map f sub-item)  (map (lambda (sub-item)         (if (pair? sub-item)             (tree-map f sub-item)             ( f sub-item)))         sub-item))
(define (square2 tree)  (tree-map square tree))
(define z (list 1 (list 2 (list 3 4) 5) (list 6 7)))
> (square2 z)(mcons 1 (mcons  (mcons 4 (mcons (mcons 9 (mcons 16 '())) (mcons 25 '())))  (mcons (mcons 36 (mcons 49 '())) '())))

练习2.32

(define (subsets s)  (if (null? s)      (list nil)      (let ( (rest (subsets (cdr s))))        (append rest (map (lambda (x)                            (cons (car s) x))rest)))))
(define (map1 f l)  (if (null? l)      '()      (cons ( f (car l))            (map1 f (cdr l)))))

原理是,每一层递归,rest中会少一个元素,而前一层的cons 会组合所有,这层rest除去的元素。原理与找零钱类似。

2.33
lambda 中的是用来积累结果的。

(define (map2 p sequence)  (accumulate (lambda (x y)                (cons(p x) y))              nil sequence))(define (append2 seq1 seq2)  (accumulate cons seq2 seq1))(define (length2 sequence)  (accumulate (lambda (x y)                (if (not (= x 0))                         (+ 1 y))) 0 sequence))

练习2.34
根据 Horner 规则,算式 1+3x+5(x3)+(x5)=(1 + x(3 + x(0 + x(5 + x(0 + x)))))

=(+ 1 (* x (+ 3 (* x (+ 0 (* x (+ 5 (* x (+ 0 x)))))))))

(define (horner-eval x coefficient-sequence)  (accumulate (lambda (this-coeff higher-terms)                (+ this-coeff  (* x higher-terms)))              0              coefficient-sequence))
> (horner-eval 2 (list 1 3 0 5 0 1))79

练习2.35

(define (count-leaves t)  (accumulate +              0              (map (lambda (x)                     (if (pair? x)                         (count-leaves x)                          1)) t)))

练习2.36

(define (accumulate-n op n seqs)  (if (null? (car seqs))      '()      (cons (accumulate op n  (map car seqs))            (accumulate-n op n (map cdr seqs))))) 
(accumulate-n + 0 (list (list 1 2 3)                          (list 4 5 6)                          (list 7 8 9)                          (list 10 11 12)))(mcons 22 (mcons 26 (mcons 30 '())))

练习2.37

(define (matrix-*-vector m v)  (map (lambda (col)         (dot-product (col v)))       m))(define (transpose mat)  (accumulate-n cons '() mat))(define (matrix-*-matrix m n)  (let ((n-t (transpose n)))    (map (lambda (x)           (matrix-*-vector  n-t x)           m))))

练习2.38

(define (fold-left op n seqs)  (define (iter result rest)    (if (null? rest)        result        (iter (op result (car rest)) (cdr rest))))  (iter n seqs))
> (fold-left / 1 (list 1 2 3))1/6> (fold-left list '() (list 1 2 3))(mcons (mcons (mcons '() (mcons 1 '())) (mcons 2 '())) (mcons 3 '()))> (accumulate  / 1 (list 1 2 3))1 1/2> (accumulate list '() (list 1 2 3))(mcons 1 (mcons (mcons 2 (mcons (mcons 3 (mcons '() '())) '())) '()))

俩个函数的计算序列不同,只要op服从结合律就可以得到相同的结果,比如* +。

练习2.39

(define (reverse seqs)  (fold-left (lambda (x y)               (cons y x)) '() seqs))(define (reverse1 seqs)  (accumulate (lambda (x y)               (append y (list x)))              '() seqs))

2.40

(define (unique-pairs n)  (flatmap (lambda (i)              (map (lambda (j) (list i j))               (enumerate-interval 1 (- i 1))))                   (enumerate-interval 1 n)))
(define (enumerate-interval x y)  (if (> x y)      '()      (append (list x) ( enumerate-interval (+ 1 x) y))))
(define (prime-sum? pair)  (prime?  (+ (car pair) (cadr pair))))(define (make-pair-sum pair)  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))(define (prime-sum-pairs n)  (map make-pair-sum       (filter prime-sum?               (unique-pairs n))))

练习2.41
产生和小于n的i j k 有序三元组。

(define (lower-sum-pairs n)  (define (sum<n? pair)    (> n (+ (car pair) (cadr pair))))  (map make-pair-sum       (filter sum<n?               (unique-pairs n))))

#练习2.42
由题意得p 85图2-8可以表示为

(list 6 3 1 7 5 8 2 4) 

表第一项看作第8列,最后一项看作第一列。
要求得到8皇后的所有解所以结果为

(list (list 6 3 1 7 5 8 2 4)      (list ...............)      .....................))

首先定义

(define empty-board '())

然后

(define (adjoin-position new-row k rest-of-queens)  (cons new-row rest-of-queens))

这里的new-row 是k列中的行序数。
然后定义筛选函数。

(define (safe? k positions)  (check (car positions)         (cdr positions)         1))

这里的k 是新放入的列
positions是 (queen-cols (- k 1))中插入新列并在每一行上都摆上了皇后。

形式大概是这样的

(list (list 1 6 3 1 7 5 8 2 4)      (list 2................)                .                .                 .      (list k...............))

check的第一个参数是我们新放入的new-row,
第二个参数是之前的(queen-cols (- k 1)) 然后进行筛选,

(define (check row-of-new-queen rest-of-queens i)  (if (null? rest-of-queens)      #t      (let ((row-of-current-queen (car rest-of-queens)))        (if (or (= row-of-new-queen row-of-current-queen)                (= row-of-new-queen (+ row-of-current-queen i))                (= row-of-new-queen (- row-of-current-queen i)))            #f            (check row-of-new-queen (car rest-of-queens) (+ i 1))))))

queens函数

(define (queens board-size)  (define (queen-cols k)    (if (= k 0)        (list empty-board)        (filter         (lambda (positions) (safe? k positions))         (flatmap          (lambda (rest-of-queens)            (map (lambda (new-row)                   (adjoin-position new-row k rest-of-queens))                 (enumerate-interval 1 board-size)))          (queen-cols (- k 1))))))  (queen-cols board-size))

练习2.43
2.42中的queens函数对于每个(queen-cols k)棋盘,产生board-size个棋盘。
而louis的queens函数对于(enumerate-interval 1 board-size) 中的每个k,都要产生 (queen-cols (- k 1)) 个棋盘。
Louis 的 queens 函数的运行速度大约是原来 queens 函数的 board-size 倍。

练习2.44

(define (up-split painter n)  (if (= n 0)      (painter)      (let (( smaller (up-split painter (- n 1))))        (below painter (beside smaller smaller)))))

练习2.45

(define (split first second)  (lambda (painter n)    (if (= n 0)          (painter)          (let (( smaller             ((split first second) painter (- n 1))))             (first painter              (second smaller smaller))))))

练习2.53

> (list 'a 'b 'c)(mcons 'a (mcons 'b (mcons 'c '())))> (list (list 'g))(mcons (mcons 'g '()) '())> (cdr '((x1 x2) (y1 y2)))(mcons (mcons 'y1 (mcons 'y2 '())) '())> (cadr '((x1 x2) (y1 y2)))(mcons 'y1 (mcons 'y2 '()))> (pair? (car '(a short list)))#f> (memq 'red '((red shoes) (blue socks)))#f> (memq 'red '(red shoes blue socks))(mcons 'red (mcons 'shoes (mcons 'blue (mcons 'socks '()))))

练习2.54

(define (equal? x y)    (cond ((and (symbol? x) (symbol? y))            (symbol-equal? x y))          ((and (list? x) (list? y))            (list-equal? x y))          [(and (number? x) (number? y))            (number-equal? x y)]          (else            (error "Wrong type input x and y -- EQUAL?" x y))))(define (number-equal? x y)  (= x y))(define (symbol-equal? x y)    (eq? x y))(define (list-equal? x y)    (cond ((and (null? x) (null? y))    ; 空表            #t)          ((or (null? x) (null? y))     ; 长度不同的表            #f)          ((equal? (car x) (car y))     ; 对比 car 部分            (equal? (cdr x) (cdr y)))   ; 递归对比 cdr 部分          (else            #f)))
> (equal? '(this is a list) '(this is a list))#t> (equal? '(this is a list) '(this (is a) list))#f

练习2.55

> ' 'abracadabra(mcons 'quote (mcons 'abracadabra '()))

引号后加空格 lisp会解释为’quote。所以打印出来了quote。

练习2.56
在deriv函数的cond中增加

    [(exponentiation? exp)     (* (expt (base exp) (- (exponent exp) 1))        (exponent exp) (deriv (base exp) var))]

选择函数,筛选函数以及构造函数。

(define (exponentiation? x)  (and (pair? x) (eq? (car x) '**)))(define (make-exponentiation base exponent)  (cond    [(=number? exponent 0) 1]    [(=number? exponent 1) base]    [else (list '** base exponent)]))(define (base x)  (cadr x))(define (exponent x)  (caddr x))

练习2.59

(define (union-set set1 set2)  (define (iter l1 l2 n)    (cond      [(null? l1) n]      [(null? l2) n]      [(not (element-of-set? (car l1) l2))        (iter (cdr l1) l2 (append (list (car l1)) n ))]      [else (iter (cdr l1) l2 n )]))  (iter set1 set2 set2))
> (union-set (list 10 2 9) (list 2 4 9))(mcons 10 (mcons 2 (mcons 4 (mcons 9 '()))))

练习2.60

(define (adjoin x set)      (cons x set))
(define (remove-duo set)  (define (iter l n)    (if (null? l )        n        (if (element-of-set?  (car l) n)            (iter (cdr l) n)            (iter (cdr l) (append (list (car l)) n)))))    (iter set '()))

大部分操作都相同,并集,交集需要用remove-duo做一次筛选。

加入操作更加简单。
操作效率变差了。
对于插入操作频繁的应用来说,可以使用有重复元素的集合。
而对于频繁进行查找、交集、并集这三个操作的应用来说,使用无重复元素的集合比较好。

练习2.61

(define (adjoin-set-1 x set)  (if (element-of-set? x set)      (set)      (if (> x (car set))          (cons (car set) (adjoin-set-1 x (cdr set)))          (cons x set))))

练习2.62

(define (union-set-1 set1 set2)    (cond      [(and (null? set1) (null? set2))            '()]      [(null? set1) set2]      [(null? set2) set1]      [else       (let ((x (car set1)) (y (car set2)))         (cond           [(= x y) (cons x (union-set-1 (cdr set1) (cdr set2)))]           [(< x y) (cons x (union-set-1 (cdr set1)  set2))]           [(> x y) (cons y (union-set-1  set1 (cdr set2)))]))]))

练习2.63
a:都产生同样的结果
b:不一样 ,第二种增长的慢一点。
第一种方法中使用了append和cons,对于树中每个节点,需要调用一次 append。所以对于n个节点的树,复杂度为n的平方。
第二种只使用了cons,所以对于n个节点的树,复杂度为n。

练习2.64
a:
partial-tree的工作流程,
1.quotient (- n 1) 2 得到n的一半,并指向left-size,右边比左边多一个用作当前的节点。
2.然后使用(partial-tree elts left-size)得到左支的树。
3.对elts剩下的节点,取第一个节点。
4,由于剩下的elts已经被取走一个节点所以 (- n (+ left-size 1)指向right-size。
5,使用(partial-tree (cdr non-left-elts) right-size)得到右支的树,
这里的(cdr non-left-elts)相当与左支树elts剩下的节点,再去掉第一个节点。
6,使用cons组合起来
(cons
(make-tree this-entry left-tree right-tree)
remaining-elts)
cons的第一项为 树 ,第二项为右支未用的节点。对于第一项树来说,其中每一项树内部的分支,递归的使用上面的过程。

这里写图片描述

b:每一节点list-》tree调用一个make-tree 复杂度为1,所以有n个节点,复杂度为n。

练习2.65

(define (union-set tree1 tree2)  (list->tree     (union-set-1 (tree->list-2 tree1)                  (tree->list-2 tree2))))(define (intersection-set tree1 tree2)  (list->tree   (intersection-set (tree->list-2 tree1)                     (tree->list-2 tree2))))

练习2.66

(define (look-up key database)  (if (null? database)      #f      (cond        [(= key (entry database)) (entry database)]        [(> key (entry database))         (look-up key (right-branch database))]        [(< key (entry database))         (look-up key (left-branch database))])))

练习2.67

> (decode s-m sample-tree)('a 'd  'a  'b  'b 'c  'a ')
(define sample-tree  (make-code-tree (make-leaf 'A 4)                  (make-code-tree                   (make-leaf 'B 2)                   (make-code-tree (make-leaf 'D 1)                                   (make-leaf 'C 1)))))(define s-m '(0 1 1 0 0 1 0 1 0 1 1 1 0))

练习2.68

(define (encode-symbol symbol tree)  (cond    [(leaf? tree) '()]    [(symbol-tree? symbol (left-branch tree))     (cons 0           (encode-symbol symbol (left-branch tree)))]    [(symbol-tree? symbol (right-branch tree))     (cons 1           (encode-symbol symbol (right-branch tree)))]    [else (error "This symbol not in tree:" symbol)]))
(define (have? symbol tree)  (if (leaf? tree)      (if (eq? (symbol-leaf tree) symbol)         (cons #t '())         (cons  #f '()))      (let (( amount (caddr tree)))        (map (lambda (x)           (if (eq? symbol x)               #t               #f))           amount))))

辅助函数,判断在符号在哪一边。

(define (symbol-have? list )  (cond  [(null? list) #f]  [else (if (car list)      #t      (symbol-have? (cdr list)))]))(define (symbol-tree? symbol tree)  (symbol-have? (have? symbol tree)))

sample-tree 在dr-racket版本中生成的树都是小写字符,所以只能输入小写字符。

> (encode '(a b a b a c a) sample-tree)(mcons 0 (mcons  1  (mcons   0   (mcons    0    (mcons     1     (mcons 0 (mcons 0 (mcons 1 (mcons 1 (mcons 1 (mcons 0 '())))))))))))

练习2.69

(make-leaf-set (cons '(A 4) (cons  '(B 2) (cons  '(C 1) (cons '(D 1) '())))))

生成列表

(mcons (mcons 'leaf (mcons 'D (mcons 1 '()))) (mcons  (mcons 'leaf (mcons 'C (mcons 1 '())))  (mcons   (mcons 'leaf (mcons 'B (mcons 2 '())))   (mcons (mcons 'leaf (mcons 'A (mcons 4 '()))) '()))))

所以successive-merge的工作为

 (make-code-tree (cadddr list)          (make-code-tree (caddr list)                         (make-code-tree (car list)                                         (cadr list))))))
(define (successive-merge ordered-set)  (cond    [(= 0 (length ordered-set)) '()]    [(= 1 (length ordered-set)) (car ordered-set)]    [else      (let ((new-sub-tree (make-code-tree (car ordered-set)                                          (cadr ordered-set)))            (remained-ordered-set (cddr ordered-set)))        (successive-merge (adjoin-set new-sub-tree remained-ordered-set)))]))

练习2.70
需要84个二进制位。
采用定长需要108个。
节省了24个位。

练习2.71

        *       /\      *  16     /\    *  8   / \  *   4 /\1  2

可以看出,对于这种类型的树,编码使用最频繁的字符需要 1 个二进制位,而编码最不常用的字符需要 n−1 个二进制位。

练习2.72
对于出现最频繁的字符,每次编码它需要下降 1 层,而对于出现最不频繁的字符,每次编码它需要下降 n−1 层。
最频繁的字符,复杂度为n。
最不频繁,复杂度为n的平方。

练习2.73
a:将求导的类型和操作放入操作表中,谓词number?和same-variable?属于的lisp内置谓词,不必要做重复的工作。

第三章

练习3.1
累加器

(define (make-accumulator first)  (let ((amount  first))    (lambda (x)      (if (number? x)          (begin (set! amount (+ x amount))                 amount)          (error "io error:" x)))))

练习3.2

(define (make-monitored f)  (let ((count 0))    (lambda (x)      (cond        [(eq? 'how-many-calls? x) count]        [(eq? 'reset-count x) (set! count 0)]        [else  (begin (set! count (+ count 1))               (f x))]))))
> (s 100)10>  (s 'how-many-calls?)1> (s 'reset-count)> (s 'how-many-calls?)0

练习3.3

(define (make-account balance password)  (define (withdraw amount)    (if (>= balance amount)        (begin (set! balance (- balance amount))               balance)        "Insufficient funds"))  (define (deposit amount)    (set! balance (+ balance amount))    balance)  (define (dispatch word m)    (let ((secret-password password))      (if (eq? secret-password  word)          (cond            [(eq? m 'withdraw) withdraw]            [(eq? m 'deposit) deposit]            [else (error "Unknown request - -MAKE-ACCOUNT")])          (error "Incorrect password"))))  dispatch)

练习3.4

(define (make-account balance password)  (let ((max-try-times 7)        (try-times 0)        (secret-password password))    (define (withdraw amount)      (if (>= balance amount)          (begin (set! balance (- balance amount))                 balance)          "Insufficient funds"))    (define (deposit amount)      (set! balance (+ balance amount))      balance)    (define (call-the-cops)      (display "calling the cops"))    (define (dispatch word m)      (if (eq? secret-password word)          (begin            (set! try-times 0)            (cond              [(eq? m 'withdraw) withdraw]              [(eq? m 'deposit) deposit]              [else (error "Unknown request - -MAKE-ACCOUNT")]))          (begin            (set! try-times (+ 1 try-times))            (if (>= try-times max-try-times)                (call-the-cops)                (display "Incorrect password")))))   dispatch))

练习3.5
在DrRacket中random只能接受整数输入,
即使在文档头使用#lang planet neil/sicp,也无法使用,
所以(random (exact->inexact range)这个定义只能在MIT-scheme下才能适用。

(define (estimate-integral p? x1 x2 y1 y2 times)  ( * 4(monte-carlo times               (lambda ()                 (p? (random-in-range x1 x2)                     (random-in-range y1 y2))))))(define (get-pi times)  (exact->inexact   (estimate-integral (lambda (x y)                         (< (+ (square x)                            (square y))                            1.0))                      0                      1.0                      0                      1.0                      times)))
(define (random-in-range low high)  (let ((range (- high low)))        (+ low           (random (exact->inexact range)))))

练习3.6
buhui

练习3.7

(define (make-joint origin-acc  origin-password another-password)  (lambda (given-password m)        (if (eq? given-password another-password)            (origin-acc origin-password m)            display-wrong-another-password-message)))(define (display-wrong-another-password-message useless-arg)    (display "Incorrect another password"))

练习3.8

(define f    (lambda (first-value)        (set! f (lambda (second-value) 0))        first-value))
> (+ (f 1) (f 0))1
> (+ (f 0) (f 6))0

说明DrRocket是从左往右计算的

练习3.9
递归版
1.首先,在全局环境中定义factorial,
2.在求(factorial 6)的时候。第一步创建环境e1 ,然后把6约束到n上。
3.求过程的主体,求值( 5))在全局环境下再创建一个e2环境
4.循环上一步直到求值结束。
迭代版
1.首先,在全局环境中定义factorial
2.在求(factorial 6)的时候。第一步创建环境e1 ,然后把6约束到n上。求factorial-iter,对f-i创建e2环境
3.循环上一步直到f-i求值结束。

练习3.12

> z{mcons 'a {mcons 'b {mcons 'c {mcons 'd '()}}}}> (cdr x){mcons 'b '()}
> w{mcons 'a {mcons 'b {mcons 'c {mcons 'd '()}}}}> (cdr x){mcons 'b {mcons 'c {mcons 'd '()}}}

append! 改变了x的值将cddr的指针指向了y。

练习3.13

> z#0={mcons 'a {mcons 'b {mcons 'c #0#}}}> (last-pair z). . user break

make-cycle将x的cdddr的指针指向了x本身。
如果计算last-pair z
会无限的寻找,因为 ‘() 被替换掉了

练习3.14

(mystery (list 'a 'b 'c))(c b a)
v --> [*]----> [*]----> [*]----> '()       |        |        |       v        v        v       'a       'b       'c
v---------------                          |                          vw --> [*]----> [*]----> [*]----> '()       |        |        |       v        v        v       'c       'b       'a

练习3.15

z1 --> [*][*]        |  |        v  v x --> [*][*]--> [*][/]        |         |        v         v      'wow!     'wow!
z2 --> [*][*]--> [*][*]--> [*][/]        |         |         |        |         v         v        |        'a        'b        |                   ^        |                   |        +------> [*][*]--> [*][/]                  |                  v                'wow!

练习3.17

(define (count-pairs x)    (length (inner x '())))(define (inner x memo-list)    (if (and (pair? x)             (not (memq x memo-list)))        (inner (car x)               (inner (cdr x)                      (cons x memo-list)))        memo-list))

练习3.18

(define (loop? x)  (let (( first (cons '() '())))    (define (iter x)      (cond        [(null? x) #f]        [(eq? (car x) first) #t]        [else (set-car! x first)              (iter (cdr x))]))  (iter x)))

练习3.19

(define (loop?-1 x)  (define (iter x y)    (let ((x-walk (list-walk 1 x))          (y-walk (list-walk 2 y)))      (cond        [(or (null? x-walk) (null? y-walk)) #f]        [(eq? x-walk y-walk) #t]        [else (iter x-walk y-walk)])))  (iter x x))(define (list-walk step lst)    (cond ((null? lst)            '())          ((= step 0)            lst)          (else            (list-walk (- step 1)                       (cdr lst)))))

练习3.21

(define (print-queue queue)  (define (iter print-item )    (if (null? print-item )               '()              (begin (cons (car print-item)                      (iter  (cdr print-item))))))  (if (empty-queue? queue)      'empty      (iter (car queue))))
> (print-queue q1){mcons 'c {mcons 'b {mcons 'a '()}}}

练习3.22

(define (make-queue)    (let ((front-ptr '())          (rear-ptr '()))        (define (insert-queue! item)            (cond ((empty-queue?)                    (let ((init-list (list item)))                        (set! front-ptr init-list)                        (set! rear-ptr init-list)                        front-ptr))                  (else                    (let ((new-item (list item)))                        (set-cdr! rear-ptr new-item)                        (set! rear-ptr new-item)                        front-ptr))))        (define (delete-queue!)            (cond ((empty-queue?)                    (error "DELETE! called with an empty queue" queue))                  (else                    (set! front-ptr (cdr front-ptr))                    front-ptr)))        (define (empty-queue?)            (null? front-ptr))        (define (dispatch m)            (cond ((eq? m 'insert-queue!)                    insert-queue!)                  ((eq? m 'delete-queue!)                    (delete-queue!))                  ((eq? m 'empty-queue?)                    (empty-queue?))                  (else                    (error "Unknow operation -- DISPATCH" m))))        dispatch))

练习3.23
。。。。

练习3.24

(define (make-table proc)  (let ((local-table (list '*table*)))  (define (look-up key-1 key-2)    (let ((subtable (assoc key-1 (cdr local-table))))      (if subtable          (let ((recode (assoc key-2 (cdr subtable))))            (if recode                (cdr recode)                ('false))            'false))))  (define (assoc key records)    (cond      [(null? recodes) 'false]      [(proc key (caar records)) (car records)]      [else (saaoc key (cdr records))]))  (define (insert! key-1 key-2 value)    (let ((subtable (assoc key-1 (cdr local-table))))      (if subtable          (let ((record (assoc key-2 (cdr subtable))))            (if record                (set-cdr! recode value)                (set-cdr! subtable                          (cons (cons key-2 value)                                (cdr subtable)))))          (set-cdr! local-table                    (cons (list key-1                                (cons key-2 value))                          (cdr local-table)))))    'ok)  (define (dispatch m)    (cond      [(eq? m 'lookup-proc) lookup]      [(eq? m 'insert-proc) insert!]      [else (error "Unknown operation -- table" m)]))  dispatch))(define (same-key?  key-1 key-2)  (if (equal-enough? key-1 key-2)      #t      #f))(define (equal-enough? x y)  (< (abs (- x y)) 1))

练习3.25

(define (mul-make-table . table-name)     (if (null? table-name)        (list '*table*)        table-name))(define (lookup key-list table)    (if (list? key-list)        (let ((current-key (car key-list))              (remain-key (cdr key-list)))            (let ((record (assoc current-key (cdr table))))                (if record                    (if (null? remain-key)                        (cdr record)                        (lookup remain-key record))                    #f)))        (lookup (list key-list) table)))(define (join-in-table new-record table)    (set-cdr! table              (cons new-record (cdr table))))(define (insert! key-list value table)    (if (list? key-list)        (let ((current-key (car key-list))              (remain-key (cdr key-list)))            (let ((record (assoc current-key (cdr table))))                (cond                     ; 1) 有记录,且没有其他关键字                    ;    更新记录的值                    ((and record (null? remain-key))                         (set-cdr! record value)                         table)                    ; 2) 有记录,且还有其他关键字                    ;    说明这个记录实际上是一个子表                    ;    使用 insert! 递归地进行插入操作                    ((and record remain-key)                        (insert! remain-key value record)                        table)                    ; 3) 无记录,且有其他关键字                    ;    需要执行以下三步:                    ;    一、 创建子表                    ;    二、 对子表进行插入                    ;    三、 将子表加入到 table                    ;    这三个步骤可以用一句完成,wow!                    ((and (not record) (not (null? remain-key)))                        (join-in-table (insert! remain-key value (make-table current-key)) table)                        table)                    ; 4) 无记录,且无其他关键字                    ;    创建记录并将它加入到 table                    ((and (not record) (null? remain-key))                        (let ((new-record (cons current-key value)))                            (join-in-table new-record table)                            table)))))        (insert! (list key-list) value table))) 

。。。

原创粉丝点击