SICP 解题集

第一章

练习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***24
1013***0
1019***0
(search-for-primes 10000)

10007***19
10009***0
10037***0
(search-for-primes 100000)


100003***26
100019***1
100043***0
(search-for-primes 1000000)


1000003***27
1000033***0
1000037***0

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

1009***21
1013***0
1019***0
1021***1
1031***0
1033***0
1039***1
1049***0
1051***0
1061***0
1063***0
1069***0

next版28s

1009***26
1013***1
1019***0
1021***1
1031***0
1033***0
1039***0
1049***0
1051***0
1061***0
1063***0
1069***0
1087***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***1
1000033***1
1000037***1
1000039***1
1000081***0
1000099***1
1000117***0
1000121***1
1000133***0
1000151***0
1000159***0
1000171***1
1533
(search-f 1000 12)

1009***1
1013***1
1019***1
1021***1
1031***0
1033***0
1039***1
1049***1
1051***0
1061***1
1063***2
1069***1
1679

可以看出俩个时间基本相等。算法复杂度考虑的是增长速度的快慢:比如说,当我们说一个算法 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-point
1.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.0
1.5
1.6666666666666665
1.6
1.625
1.6153846153846154
1.619047619047619
1.6176470588235294
1.6181818181818182
1.6179775280898876
1.6180555555555556
1.6180257510729614
1.6180371352785146

不用平均阻尼

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

72.47657378429035
1.6127318474109593
14.45350138636525
2.5862669415385087
7.269672273367045
3.4822383620848467
5.536500810236703
4.036406406288111
4.95053682041456
4.318707390180805
4.721778787145103
4.450341068884912
4.626821434106115
4.509360945293209
4.586349500915509
4.535372639594589
4.568901484845316
4.546751100777536
4.561341971741742
4.551712230641226
4.558059671677587
4.55387226495538
4.556633177654167
4.554812144696459
4.556012967736543
4.555220997683307
4.555743265552239
4.555398830243649
4.555625974816275
4.555476175432173
4.555574964557791
4.555509814636753
4.555552779647764
4.555524444961165
4.555543131130589
4.555530807938518

使用平均阻尼

(define pjzn (fixed-point (average-damp (lambda (x) (/ (log 1000) (log x)))) 1.1))
36.78828689214517
19.352175531882512
10.84183367957568
6.870048352141772
5.227224961967156
4.701960195159289
4.582196773201124
4.560134229703681
4.5563204194309606
4.555669361784037
4.555558462975639
4.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---------------
                          |
                          v
w --> [*]----> [*]----> [*]----> '()
       |        |        |
       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))) 

。。。

  • 2
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值