3.81
不太明白，如果generate也和原来一样，每使用一次变一下，那不就是同样的过程返回不同结果了么。

3.82
需要实现random-in-range：
这里遇到一个问题：两个随机序列到底是应该从一个random-numbers中陆续的抽取，还是直接生成两个random-numbers?
暂且选择是从一个random-numbers中抽取：
(define (random-update x)                       ;一种简便的生成随机数的方法
    (remainder (+ 37 (* x 16807)) 2147487))
(define rand
  (cons-stream 1
               (stream-map random-update rand)))
(define rand-numbers (scale-stream rand (/ 1 2147487.0)))    ;使得随机数值在0~1之间
(define (helper rand-stream)
    (cons-stream (stream-car rand-stream)
                 (helper (stream-cdr (stream-cdr rand-stream)))))
(define random-1 (helper rand-numbers))
(define random-2 (helper (stream-cdr rand-numbers)))
(define (random-in-range low high rand-strm)
  (stream-map (lambda(x) (+ low x)) (scale-stream rand-strm (- high low))))
 
estimate-integral过程：
(define (estimate-integral x1 x2 y1 y2 p?)
  (define random-x (random-in-range x1 x2 random-1))
  (define random-y (random-in-range y1 y2 random-2))
  (define p-test (stream-map p? random-x random-y))
  (define rect-area
    (* (abs (- x1 x2))
       (abs (- y1 y2))))
  (define e-i-result (scale-stream (monte-carlo p-test 0 0) rect-area))
  e-i-result)
 
测试：
(define (f? x y)
  (<= (+ (square (- x 5))
         (square (- y 7)))
     9))
(define result (estimate-integral 2.0 8.0 4.0 10.0 f?))
结果还不错，看了10000项，最后稳定在28.11左右


终于完成了传说中"平易近人"的前三章——至少是对绝大部分习题都有了个交代。至于很多内容的延伸，就留给以后了，毕竟这本书涉及到的东西很广……

在integral过程迷惑了一段时间才明白：这里的t就是平时做积分的自变量x，输入流integrand是自变量以dt逐渐变化时，因变量y所对应的值。则根据积分定义，如果输入integrand是y的值，输出就是y的积分；y0就是y(0)，可以说是用来确定积分后面+的那个C的；积分区间从t=0开始，到输出流某元素的stream-ref*dt那个值为止。
另外一个地方我与书上意见不同：对于dy/dt=f(y)那个图，map:f输出的应该是dy/dt，而不单单是dy吧。

3.77
加几个force，加一个delay
(define (integral integrand init-value dt)
  (cons-stream init-value
               (if (empty-stream? (force integrand))
                   '()
                   (integral (delay (stream-cdr (force integrand)))
                             (+ (* dt (stream-car (force integrand)))
                                init-value)
                             dt))))

3.78
感觉知其然不知其所以然……就这么用数值解2阶线性微分方程？
(define (solve-2nd a b dt y0 dy0)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (add-streams (scale-stream dy a)
                           (scale-stream y b)))
  y)

>(stream-ref (solve-2nd 0 1 0.001 1 1) 1000)
2.716923932235896

3.79
(define (solve-2nd dt y0 dy0 f)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (f dy y))
  y)
 
3.80
字面上的证明很容易，略之。
(define (RLC R L C dt)
  (define (RLC-helper vc0 il0)
    (define vc (integral (delay dvc) vc0 dt))
    (define il (integral (delay dil) il0 dt))
    (define dvc (scale-stream il (/ -1 C)))
    (define dil (add-streams (scale-stream vc (/ 1 L))
                             (scale-stream il (/ (* -1 R) L))))
   
   
    (stream-map cons vc il))
  RLC-helper)
(define xx ((RLC 1 1 0.2 0.1) 10 0))


总结：只是照样子把过程都写了出来，但是每个过程的意思到现在还没什么概念。以后应该重看这一节


                            

3.63
回想当初的银行账户：
(define (make-account amount)
  (let ((balance amount))
    (lambda(m)
      (cond ((eq? m 'balance) balance)
            ((eq? m 'withdraw)
             (lambda(x)
               (begin (set! balance (- balance x))
                      balance)))))))
只有像(define a (make-account 100))这样define了一个a，才能实现连续的改变帐户中的钱数，而直接应用过程(((make-account 100) 'withdraw) 27)是不行的。我认为原因就在于a给了一个位置，这样使得后来的withdraw过程都只会去访问a中包含的balance；而直接应用make-account的话，每一次访问的都是一个新的balance。

联系本题，定义了guesses的话，当再次访问流中某stream-cdr时，memo-proc就会查找同一个already-run?和result；而如果没有guesses这个位置的话，memo-proc就不知从何去找了。



3.64
(define (stream-limit s n)
  (cond ((empty-stream? s) "No such elements")
        ((< (abs (- (stream-car s)
                    (stream-car (stream-cdr s))))
            n)
         (stream-car (stream-cdr s)))
        (else (stream-limit (stream-cdr s) n))))

3.65
(define (ln2-series n)
  (cons-stream (/ 1.0 n)
               (stream-map - (ln2-series (+ n 1)))))
(define ln2 (partial-sums (ln2-series 1)))
(define ln2-euler (euler-transform ln2))
(define super-ln2 (accelerated-sequence euler-transform ln2))

3.66
由于interleave是轮流取值，所以(a b)前面元素中诸如(x y) (x>=a)这种就大约应该是(x=a)的2倍；确定了本层的，再逐渐上升求出上一层，知道a=0。
具体说：1)本层中在本元素前的个数： 对于(a b)，当a!=b时，个数为(b-a)*2-1；当a=b，0
        2)令本层所求元素前的元素个数为x，那么上一层相应个数就应为(x+1)*2，迭代n次的话结果为x*2^n+2^(n+1)-2。如此迭代(a-0)次。
        这样得到最终结果：对于(a b), a!=b时，(b-a)*2^(a+1)+2^a-2; a=b时，2^(a+1)-2。
       
3.67
先把其余的序对列举出来，然后和原来的用interleave合成
(define (miner-pairs s t)
  (cons-stream
   (list (stream-car (stream-cdr s)) (stream-car t))
   (interleave
    (stream-map (lambda(x) (list x (stream-car t)))
                (stream-cdr (stream-cdr s)))
    (miner-pairs (stream-cdr s) (stream-cdr t)))))
(define (real-pairs s t)
  (interleave (pairs s t)
              (miner-pairs s t)))
             
3.68
Louis同学的过程不会返回值，怀疑是与延迟求值有关系

3.69
和pairs类似的分割方法，调用了pairs
(define (triples s t u)
  (cons-stream (list (stream-car s) (stream-car t) (stream-car u))
               (interleave (stream-map (lambda(x)
                                         (cons (stream-car s) x))
                                       (stream-cdr (pairs t u)))   ;;第一项是t0u0 已算过
                           (triples (stream-cdr s)
                                    (stream-cdr t)
                                    (stream-cdr u)))))   

3.70
这题费了点时间
先写个merge。相比较之前的merge过程，除了增加了一个参数weight，还取消了删除相同项的功能——这一点是必需的。
(define (merge s1 s2 weight)
  (cond ((empty-stream? s1) s2)
        ((empty-stream? s2) s1)
        ((> (weight (stream-car s2)) (weight (stream-car s1)))
         (cons-stream (stream-car s1)
                      (merge (stream-cdr s1) s2 weight)))
        (else (cons-stream (stream-car s2)
                           (merge s1 (stream-cdr s2) weight)))))
上三角矩阵(A[i,j] i<=j)可以这样排序：A[0,0]在先，接下来的是A[0 ,1~n] 和 A[1~n, 1~n]中的较小项。其中A[0,1~n]是排好序的，A[1~n, 1~n]可以递归到上三角矩阵的排序。
(define (min-matrix-triangle s t weight)
  (cons-stream (list (stream-car s) (stream-car t))
               (merge (stream-map (lambda(x) (list (stream-car s) x))
                                  (stream-cdr t))
                      (min-matrix-triangle (stream-cdr s) (stream-cdr t) weight)
                      weight)))
类似的下三角：
(define (min-matrix-down-triangle s t weight)
  (cons-stream (list (stream-car (stream-cdr s)) (stream-car t))
               (merge (stream-map (lambda(x) (list x (stream-car t)))
                                  (stream-cdr (stream-cdr s)))
                      (min-matrix-down-triangle (stream-cdr s) (stream-cdr t) weight)
                      weight)))
如果需要整个矩阵，只需把两个三角merge起来就行了                     
1)只需要上三角
(define S (min-matrix-triangle integers integers sum-weight))
(define (sum-weight a)
  (+ (car a) (cadr a)))
2)只需要上三角
(define x (min-matrix-triangle 235-series 235-series 235sum-weight))
(define (235sum-weight a)
  (let ((a1 (car a)) (a2 (cadr a)))
    (+ (* 2 a1) (* 3 a2) (* 5 a1 a2))))
这里生成数列所用的merge需要排除掉重复元素
(define 235-series (merge-with-equal (scale-stream integers 3)
                                     (merge-with-equal (scale-stream integers 2)
                                                       (scale-stream integers 5)
                                                       value-weight)
                                     value-weight))
(define (merge-with-equal s1 s2 weight)
  (cond ((empty-stream? s1) s2)
        ((empty-stream? s2) s1)
        ((> (weight (stream-car s2)) (weight (stream-car s1)))
         (cons-stream (stream-car s1)
                      (merge-with-equal (stream-cdr s1) s2 weight)))
        ((> (weight (stream-car s1)) (weight (stream-car s2)))
         (cons-stream (stream-car s2)
                      (merge-with-equal s1 (stream-cdr s2) weight)))
        (else (cons-stream (stream-car s1)
                           (merge-with-equal (stream-cdr s1) (stream-cdr s2) weight)))))

3.71
修改了一下merge-with-equal，使得Ramanujan数更明显一点
(define (merge-with-equal s1 s2 weight)
  (cond ((empty-stream? s1) s2)
        ((empty-stream? s2) s1)
        ((> (weight (stream-car s2)) (weight (stream-car s1)))
         (cons-stream (stream-car s1)
                      (merge-with-equal (stream-cdr s1) s2 weight)))
        ((> (weight (stream-car s1)) (weight (stream-car s2)))
         (cons-stream (stream-car s2)
                      (merge-with-equal s1 (stream-cdr s2) weight)))
        (else (cons-stream (append (stream-car s1) (stream-car s2) (cons '!!! (weight (stream-car s1))))
                           (merge-with-equal (stream-cdr s1) (stream-cdr s2) weight)))))
(define (cube x) (* x x x))
(define (cube-sum-weight x)
  (let ((a1 (car x)) (a2 (cadr x)))
    (+ (cube a1) (cube a2))))
(define S (min-matrix-triangle integers integers cube-sum-weight))   
用这个过程来检查：
(define (Raman s)
  (if (= (cube-sum-weight (stream-car s))
         (cube-sum-weight (stream-car (stream-cdr s))))
      (cons-stream (list (cons (stream-car s) (stream-car (stream-cdr s)))
                         (cube-sum-weight (stream-car s)))
                   (Raman (stream-cdr s)))
      (Raman (stream-cdr s))))
(display-stream(Raman S))

输出：
(((9 10) 1 12) 1729)
(((9 15) 2 16) 4104)
(((18 20) 2 24) 13832)
(((19 24) 10 27) 20683)
(((18 30) 4 32) 32832)
(((15 33) 2 34) 39312)
(((16 33) 9 34) 40033)
(((27 30) 3 36) 46683)
(((26 36) 17 39) 64232)
(((31 33) 12 40) 65728)
(((36 40) 4 48) 110656)
(((27 45) 6 48) 110808)
(((38 43) 12 51) 134379)
(((29 50) 8 53) 149389)
(((38 48) 20 54) 165464)
(((24 54) 17 55) 171288)...

3.72
(define (square-sum-weight a)
  (define (square x) (* x x))
  (+ (square (car a)) (square (cadr a))))
(define X (min-matrix-triangle integers integers square-sum-weight))
(define (choose x weight)
  (let ((x0 (stream-ref x 0))
        (x1 (stream-ref x 1))
        (x2 (stream-ref x 2)))
    (if (= (weight x0) (weight x1) (weight x2))
        (cons-stream (list x0 x1 x2 (list (weight x0)))
                     (choose (stream-cdr x) weight))
        (choose (stream-cdr x) weight))))
(define ym (choose X square-sum-weight))

> (display-stream ym)
((10 15) (6 17) (1 18) (325))
((13 16) (8 19) (5 20) (425))
((17 19) (11 23) (5 25) (650))
((14 23) (10 25) (7 26) (725))
((19 22) (13 26) (2 29) (845))
((15 25) (11 27) (3 29) (850))
((21 22) (14 27) (5 30) (925))
((20 25) (8 31) (1 32) (1025))
((23 24) (12 31) (9 32) (1105))
((12 31) (9 32) (4 33) (1105))
((25 25) (17 31) (5 35) (1250))
((20 30) (12 34) (2 36) (1300))
((22 29) (13 34) (10 35) (1325))
……


3.73
(define (RC R C dt)
  (lambda (i-stream init-v)
    (add-streams (stream-map (lambda(x) (+ (* x R) init-v)) i-stream)
                 (scale-stream (integral i-stream 0 dt) (/ 1 C)))))       
大概是这样吧，没测试

3.74
差别在于原过程可以附一个初始值last-value来比较
(define zero-crossings
  (stream-map sign-change-detector sense-data (stream-cdr sense-data)))       

3.75
Louis同学的平均值不是对应的sense-data的两个元素的平均值，一直累加的平均值运算
(define (make-zero-crossings input-stream last-value last-avg)
  (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
    (cons-stream (sign-change-detector avpt last-avg)
                 (make-zero-crossings (stream-cdr input-stream)
                                      (stream-car input-stream)
                                      avpt))))
last-value是用来做平均值的，last-avg是用来求sign-change-detector的                                     

3.76
(define (smooth2 s)
  (stream-map average s (stream-cdr s)))
(define (make-zero-crossings the-strm smooth-method)
  (stream-map sign-change-detector
              (smooth-method the-strm)
              (stream-cdr (smooth-method the-strm))))
 

  3.53
 1, 2, 4, 8, 16...
 
 3.54
 (define (mul-streams s1 s2)
  (stream-map * s1 s2))
 (define factorials (cons-stream 1 (mul-streams integers factorials)))
 
 3.55
 (define (partial-sums strm)
  (cons-stream (stream-car strm)
               (add-streams (partial-sums strm)
                            (stream-cdr strm))))
                           
3.56
感觉这个很神奇：
(define S (cons-stream 1 (merge (scale-stream S 2)
                                (merge (scale-stream S 3)
                                       (scale-stream S 5)))))   

3.57
有memo-proc: 执行的加法次数就是书中所给的长串加法式子里的次数，即n-2(n>=3)
无memo-proc: 这时求值过程都不会保存，即每次求一个流的stream-car都要从头开始，那么(fib n)的加法次数也就相当于(fib (- n 1))和(fib (- n 2))次数之和再+1——与最开始介绍的那个递归过程相同。
也就是说，stream相对于list改变的只是惰性求值，而存储功能方面两者是没有本质区别的，都需要自行加载memo过程。

3.58
这不就相当于除法么
(expand 1 7 10)--->(1 4 2 8 5 7 1 4 2...)
(expand 3 8 10)--->(3 7 5 0 0 ...)
不过这过程还是不能用来计算其他进制，即radix一般也就是10

3.59
a)
(define (div-streams s1 s2)
  (stream-map / s1 s2))
(define (integrate-series series)
  (div-streams series integers))
   
b)真是感觉很神奇……完成如此功能代码量却这么少，但是每个方面道理又是很简单，还需要再好好理解一下
(define consine-series
  (cons-stream 1 (scale-stream (integrate-series sine-series)
                               -1)))
(define sine-series
  (cons-stream 0 (integrate-series consine-series)))
 
3.60
第二章计算多项式s1,s2乘法时，系数是这样计算的：写了一个单项与多项式相乘的过程，之后把s1分解为单项之和，分别于s2乘积最后求和。
但这种方法本题是不行的，因为流s1,s2都是无穷长的。流的观点是每次求出最后结果中的当前部分——本题来说也就是乘积次数最低项的系数(流中的先后顺序表示着次数的高低)。
这里每次我们只能确定最低的两个系数
(define (mul-series s1 s2)
  (cond ((empty-stream? s1) '())
        ((empty-stream? s2) '())
        (else (cons-stream (* (stream-car s1)
                              (stream-car s2))
                           (add-streams (mul-series s1 (stream-cdr s2))
                                        (scale-stream (stream-cdr s1) (stream-car s2)))))))
;test
(define isone (add-streams (mul-series cosine-series cosine-series)
                           (mul-series sine-series sine-series)))
>(display-stream isone)
1
0
0
0
...                          
                                       
3.61   
相对于3.62的除法，我觉得这个求倒数的过程要神奇的多。思想很明确：每次确定次数最低的项。不清楚第一个想出这方法的牛是怎么得到这个结果的。
(define (X s)
  (cons-stream 1
               (mul-series (scale-stream (stream-cdr s) -1)
                           (X s))))

3.62
(define (div-series s1 s2)
  (let ((scale (stream-car s2)))
    (if (not (= scale 0))
        (mul-series (scale-stream s1 (/ 1 scale))
                    (X (scale-stream s2 (/ 1 scale))))
        (error "Div-by-0  ---div-series" s2))))
tan-series显而易见：
(define tan-series (div-series sine-series cosine-series))       
> (display-stream tan-series)

0
1
0
1/3
0
2/15
...
                                      

3.50
(define (stream-map proc . argstreams)
  (if (empty-stream? (car argstreams))
      '()
      (cons-stream
       (apply proc (map stream-car argstreams))
       (apply stream-map
              (cons proc (map stream-cdr argstreams))))))
             
3.51
> (define x (stream-map show (stream-enumerate-interval 0 10)))

0
> (stream-ref x 5)

1
2
3
4
55
> (stream-ref x 7)

6
77

解释：由于这里采用的odd-stream，所以定义stream时候就已经把stream-car求出来了，所以第一句会有显示；后面每次stream-cdr一次，就要求值一次stream-car，至于为什么第二句里面没有0、第三句里没有012345，是由于memo-proc的缘故——只记录返回值，不再重复求值过程。
我用even-stream又做了一次，第一句没有输出，第二句输出012345，第三句不变。

3.52
> (stream-ref y 7)
136
> (display-stream z)

10
15
45
55
105
120
190
210done

当memo-proc存在时，赋值语句只执行一次，如果以后再次访问accum中已计算过的元素，程序会从memo中直接取值，而不执行set!语句。
如果不用memo-proc，那么accum就是一个变化的流——每访问一次值就发生变化。

在文档:SRFI 40: A Library of Streams 中找到的:
由于stream中的cons-stream需要实现为special-form，所以仅仅(define (cons-stream a b) (cons a (delay b)))是不行的，下面的过程是在Drscheme的文档里面找的，直接拷过去就能用。
(define (empty-stream? strm)               
  (null? strm))                    
                   
(define-syntax cons-stream               
  (syntax-rules ()                 
    ((cons-stream obj strm)              
      (cons obj (delay strm)))))   
                   
(define (stream-car strm)                
  (car strm))                      
                   
(define (stream-cdr strm)                
  (force (cdr strm)))
——force，delay是scheme的基本过程,不知道delay里面有没有memo-proc过程。

另外在文档里还发现一个小知识：流的这种惰性求值分两种：一种就是一般scheme用的，也是SICP里面讲的，叫做odd streams; 另外一种是Haskell这种纯函数式语言用的,叫做even streams. 区别在于odd中的stream-cdr是lazy的, 但是stream-car不是lazy的; 而even中两者都是lazy的, 在需要时候才求值.
两种stream的实现:
;;; FIGURE 1 -- ODD                
                   
(define nil1 '())                  
                   
(define (nil1? strm)               
  (null? strm))                    
                   
(define-syntax cons1               
  (syntax-rules ()                 
    ((cons1 obj strm)              
      (cons obj (delay strm)))))   
                   
(define (car1 strm)                
  (car strm))                      
                   
(define (cdr1 strm)                
  (force (cdr strm)))              
                   
(define (map1 func strm)           
  (if (nil1? strm)                 
    nil1                           
    (cons1                         
      (func (car1 strm))           
      (map1 func (cdr1 strm)))))   
                   
(define (countdown1 n)             
  (cons1 n (countdown1 (- n 1))))  
                   
(define (cutoff1 n strm)           
  (cond                            
    ((zero? n) '())                
    ((nil1? strm) '())             
    (else                          
      (cons                        
        (car1 strm)                
        (cutoff1 (- n 1)            
                 (cdr1 strm))))))   

;;; FIGURE 2 -- EVEN

(define nil2 (delay '()))

(define (nil2? strm)
  (null? (force strm)))

(define-syntax cons2
  (syntax-rules ()
    ((cons2 obj strm)
     (delay (cons obj strm)))))

(define (car2 strm)
  (car (force strm)))

(define (cdr2 strm)
  (cdr (force strm)))

(define (map2 func strm)
  (delay (force
    (if (nil2? strm)
      nil2
      (cons2
        (func (car2 strm))
        (map2 func (cdr2 strm)))))))

(define (countdown2 n)
  (delay (force
    (cons2 n (countdown2 (- n 1))))))

(define (cutoff2 n strm)
  (cond
    ((zero? n) '())
    ((nil2? strm) '())
    (else
      (cons
        (car2 strm)
        (cutoff2 (- n 1)
                 (cdr2 strm))))))
                 
之后举了个例子区别两者:
> (define (12div n) (/ 12 n))      
> (cutoff1 4                       
    (map1 12div (countdown1 4)))   
error: divide by zero              

> (define (12div n) (/ 12 n))
> (cutoff2 4
    (map2 12div (countdown2 4)))
(3 4 6 12)

原因就是在计算(cutoff 0 stream)的时候, 本来是不需要考虑stream的值, 但是odd-stream会把stream-car计算出来,也就出现了除数为0的错误; even-stream则一直懒着, 反正又没计算到头上, 不去管它. 和当时迷糊人的习题1.5有些类似.

感觉那个parallel-execute过程那么混乱呢……完全不能用来观察并发中各种可能的结果，所以下面结果只是自己人脑演算出来而不是具体过程试验结果。

3.38 不画图了，大概说一下
a) 令a=Peter, b=Paul, c=Mary
    45(abc/bac)/35(acb)/50(bca)/40(cba/cab)
b)
30：(set! balance ..Peter.. (/ balance 2))  Paul   ----表示在Peter得到(/ balance 2)之后但是set!之前运行Peter的过程，然后运行Paul的过程，下同
55：(set! balance ..Paul.. (+ balance 10))   Mary
80: (set! balance ..Peter.. ..Mary.. (- balance 2))
90: (set! balance ..Mary.. (+ balance 10))  Paul
110:(set! balance ..Paul.. ..Mary.. (+ balance 10))
其他的都是重复的值

3.39
100/101/121  跟上面差不多道理

3.40
可能出现10^2/10^3/10^4/10^5/10^6
如果采用了串行化过程，只会10^6

3.41
由于查询balance并不改变balance的值，所以我认为对于这类没有赋值在内的过程没必要进行串行化控制。

3.42
在安全性或者并发性方面没看出什么不同……

3.43
假设有(exchange a1 a2)/(exchange a2 a3)两个交换进程。如果e2插在e1的withdraw和deposit之间完成，那么最后结果就是(20 20 20)。
不画图了

3.44
transfer和exchange都有一个withdraw和一个deposit，本质区别在于要改变多少，即transfer的amount和exchange的difference。可以看出，amount相对于时间是个绝对的值，而difference是相对的，因为它要读取当前两个帐户的状态而进行运算。由于这个区别的存在，transfer过程就不需要像exchange那样的串行过程。Louis同学多虑了。

3.45
先分析本来的过程——关键一点是注意到serialized-exchange是被两个serializer约束的，其中用来改变帐户的withdraw和deposit过程都没用serializer约束！
而Louis同学的serialized-exchange过程中的withdraw和deposit相当于套了两层的串行约束，这样就相当于子过程与父过程变成了串行的，父进程完成之前子进程阻塞，而子进程不进行的话父进程也不可能完成——死锁了。

3.46
如果test-and-set!不是原子操作，假设两个进程t1和t2都执行了(mutex 'acquire)，当t2的申请过程在t1检查完(car cell)之后、(set-car! cell true)之前，那么t1和t2都能得到运行，也就失去了串行化的控制。

3.47
记得操作系统里面讲过怎么构造这东西，不过好像当时只用了mutex，没说test-and-set!(当时貌似叫做test&lock)的方面。
(define (make-n-serializer n)
  (let ((semaphore (make-semaphore n)))
    (lambda(f)
      (define (serialized-f . args)
        (semaphore 'P)
        (let ((val (apply f args)))
          (semaphore 'V)
          val))
      serialized-f)))
a) 用mutex
(define (make-semaphore n)
  (let ((limit n)
        (mutex (make-mutex)))
    (define (dispatch m)
      (cond ((eq? m 'P)
             (begin (mutex 'acquire)
                    (if (< n 0)
                        (begin (mutex 'release)
                               (dispatch 'P))
                        (begin (set! n (- n 1))
                               (mutex 'release)))))
            ((eq? m 'V)
         (begin
           (mutex 'acquire)
           (set! n (+ n 1))
           (mutex 'release)))))
    dispatch))
b) 用test-and-set!
如果用规约的方法就是用test-and-set!实现一个mutex，再调用上面的过程……
(define (make-semaphore n)
  (let ((limit n)
        (cell (list false)))
    (define (dispatch m)
      (cond ((eq? m 'P)
             (if (test-and-set! cell)
                 (dispatch 'P)
                 (if (< n 0)
                     (begin (clear! cell)
                            (dispatch 'P))
                     (begin (set! n (- n 1))
                            (clear! cell)))))
            ((eq? m 'V)
             (if (test-and-set! cell)
                 (dispatch 'V)
                 (begin ((set! n (+ n 1))
                         (clear! cell)))))))
      dispatch))
     
3.48
原来实现中出现死锁的原因是a1和a2的环路等待，即持有a1的进程去申请a2,持有a2的进程去申请a1。如果对帐户编号，使得不管(exchange a1 a2)还是(exchange a2 a1)都先去申请a1再申请a2，那样就不会存在环路等待的条件。
(define (make-account balance rank)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (let ((balance-serializer (make-serializer)))
    (define (dispatch m)
      (cond ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            ((eq? m 'balance) balance)
            ((eq? m 'serializer) balance-serializer)
            ((eq? m 'rank) rank)
            (else (error "Unknown request---Make-account") m)))
    dispatch))

(define (serialized-exchange a1 a2)
  (let ((s1 (a1 'serializer))
        (s2 (a2 'serializer))
        (r1 (a1 'rank))
        (r2 (a2 'rank)))
    (cond ((< r1 r2) ((s1 (s2 exchange)) a1 a2))
          ((> r1 r2) ((s2 (s1 exchange)) a1 a2))
          (else (error "Same rank?" (list a1 a2))))))
         
3.49
正如提示所说，如果进程不能确定自己都需要什么资源，那就很难用这种资源优先级的方法来防止死锁发生了。具体例子没想到。

---------constraint-----------
3.33
(load "constraint.scm")
(define (averager a b c)
  (let ((temp (make-connector))
        (const-2 (make-connector)))
    (adder a b temp)
    (multiplier const-2 c temp)
    (constant 2 const-2)
    'ok))

3.34
LouisReasoner同学的平方器不能计算平方根。原因也很明显：我们平时也不能简单的用除法计算平方根，当然constraint系统也不会那么聪明。

3.35
(load "constraint.scm")
(define (squarer a b)
  (define (process-new-value)
    (if (has-value? b)
        (if (< (get-value b) 0)
            (error "Square less than 0--SQUARER" (get-value b))
            (set-value! a (sqrt (get-value b)) me))
        (if (has-value? a)
            (set-value! b (* (get-value a) (get-value a)) me))))
  (define (process-forget-value)
    (forget-value! a me)
    (forget-value! b me)
    (process-new-value))
  (define (me request)
    (cond ((eq? request 'I-have-a-value) (process-new-value))
          ((eq? request 'I-lost-my-value) (process-forget-value))
          (else (error "Unknown request----SQUARER" request))))
  (connect a me)
  (connect b me)
  me)
 
3.36
见图

3.37
(load "constraint.scm")
(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))
(define (c* x y)
  (let ((z (make-connector)))
    (multiplier x y z)
    z))
(define (c/ x y)
  (let ((z (make-connector)))
    (multiplier y z x)
    z))
(define (cv n)
  (let ((z (make-connector)))
    (constant n z)
    z))

以后改为章节为单位组织答案，这样整齐一些。
--------digital-circuit-------
3.30
建立一个局部list:l-c，用来传递进位信号。然后用connect过程把最后一个仅为信号与输出c连接起来。
(load "digital_circuit.scm")
(define (ripple-carry-adder l-a l-b l-s c) ;假设l-a l-b相同长度
  (let ((l-c (make-wire-list (+ (length l-a) 1))))  ;c的car为c-in，cadr为c-out
    (define (helper la lb ls lc)
      (if (null? la)
          'ok
          (let ((a (car la))
                (b (car lb))
                (c-in (car lc))
                (s (car ls))
                (c-out (cadr lc)))
            (begin (full-adder a b c-in s c-out)
                   (helper (cdr la) (cdr lb) (cdr ls) (cdr lc))))))
    (helper l-a l-b l-s l-c)
    (connect (last l-c) c)))
(define (connect in out)
  (define (connect-proc)
    (after-delay 0 (lambda() (set-signal! out (get-signal in)))))
  (add-action! in connect-proc))
;一些边边角角的过程：
(define (last l)
  (cond ((not (pair? l)) (error "Not a pair--" l))
        ((null? (cdr l)) (car l))
        (else (last (cdr l)))))
(define (make-wire-list n)
  (define (helper nn)
    (if (= nn 0)
        '()
        (cons (make-wire)
              (helper (- nn 1)))))
  (helper n))
 
  ;test
 l-a/l-b/l-s都是低位在左，高位在右。比如(1 0 0)+(1 0 0)=(0 1 0)--0
 (0 0 1)+(0 0 1)=(0 0 0)--1
 
 3.31
 对比两个digital_circuit对下面过程的不同结果：
(define a (make-wire))
(define o (make-wire))
(inverter a o)
(probe 'c-out o)
在未执行(propagate)或者set-signal!之前，本题的the-agenda里面是什么都没有的，而原系统的the-agenda里面时间段为2时已经有了过程。
再上面的基础上执行(set-signal! a 1)，可以看到，这时the-agenda里面才有了过程，但是执行(propagate)却看不到probe过程起作用。只有执行(set-signal! a 1) (set-signal! a 0)这样对a赋值两次以上再执行(propagate)时才能看到probe的结果。

究其原因，make-wire里面的add-action!增加的都是"向the-agenda里面添加过程"的过程，也就是说只有当add-action!增加的过程得到执行的时候，the-agenda中才会添加and-gate/or-gate/inverter等行为，而实际执行这些行为要等到propagate执行的时候。
从数字电路的角度看，原系统在(inverter a o)的时候就已经把相应的导线连好了；而本题的过程直到set-signal!的时候才开始连线，如果想得到相应的结果，只能再set-signal!一次……

3.32
这题比较简单，如果把queue改成类似堆栈的LIFO，就会造成时间上的混乱。比如本题：
(and-gate a b c)
(set-signal! a 0)
(set-signal! b 1)
(propagate)

(set-signal! a 1)
(set-signal! b 0)
(propagate)
第一段执行情况两者一致，最后c都变为0，the-agenda被清空；之后当(set-signal! a 1)时，a和b均为1，the-agenda中加入(set-signal! c 1)，然后(set-signal! b 0)，the-agenda中加入(set-signal! c 0)——不同就在这里产生！本题中由于用了stack结构，使得c=0的语句在c=1之前执行，所以最后就得到了错误结果a=1,b=0,c=1。

;3.27
大体层次结构应该没错的，table在x外层。问题在于为什么不同的x可以共享一个环境中的table。我认为是因为table上一层的环境是(memoize f)的环境，而f一直是memo-fib中的(lambda(n)...)，所以可以共享。
(memo-fib 3)中，3是传递给x的，(lambda(n)...)是传递给f的。之所以时间为O(n)，是因为它不会计算重新以前计算过的值，而只是在table中查找。
至于直接(memoize fib)是不行的，因为memo-fib内部调用的是memo-fib，而这里调用的是fib。

尝试着用这个改写之前计算硬币组合的2.19题：
(define (memorize f)
  (let ((table (make-table)))
    (lambda(x y)
      (let ((pre-result (lookup x y table)))
        (or pre-result
            (let ((result (f x y)))
              (insert! x y result table)
              result))))))
(define memo-cc
  (memorize (lambda (amount coin-values)
              (cond ((= amount 0) 1)
                    ((or (< amount 0)
                         (no-more? coin-values)) 0)
                    (else (+ (memo-cc amount (rest-coins coin-values))
                             (memo-cc (- amount (first-denomination coin-values))
                                      coin-values)))))))
(define (rest-coins x) (cdr x))
(define (no-more? x) (null? x))
(define (first-denomination x) (car x))

与当初2.19里的相比，计算(cc 1000 '(1 5 10 25 50)) 可以感觉到明显的差别。

.;3.26
引入环境模型，出现了许多代换模型中没有的问题，我举两个：
1. 时间因素，set语句的先后的微妙差别会导致错误。估计这一点在后面的"并发"那节会表现的更突出。
2. 相等与共享：a、b的值相同，如果a改变，b随之改变，则两者就是共享的关系；反之只是两者的值相等。由于代换模型中没有赋值改变谁这些事情，也就不需要区分两者——感觉很像C++中的值调用和引用调用——在本题我遇到的麻烦就是这里的。
具体的举个例子：
现有下面过程：
(define (set-to-250! x)  ;这是个无效的过程
  (set! x 250) x)
(define (set-car-250! x)
  (set-car! x 250) x)
(define p1 (cons 1 2))
(define xx (cons p1 p1))

不过(set-car-250! xx)是不会改变xx的值的，它改变的只是内部参数x的值——这对我们毫无用途；我们知道，改变平
的话xx也会随之改变，但是用(set-car-250! xx)却只能改变xx的car，对p1毫无影响。就像是这里的引用是单向的，不对称。

我开始没意识到这些问题，然后就开始打算用赋值语句直接在local-tree上做修改，花了很多时间没有结果。虽然这样的思路肯定是行得通的，但不可否认的是要花很大精力去分辨一些微妙的东西——而且这些东西跟具体语言实现的关系要比跟解题思路的关系还要大。

下面是我对"多维二叉树表"的解决方案——在尽量少的地方使用赋值语句：
;------binary tree------
(define (make-tree left right key value)
  (list left right key value))
(define (make-leaf key value)
  (list '() '() key value))
  
(define (left tree) (car tree))
(define (right tree) (cadr tree))
(define (key tree) (caddr tree))
(define (value tree) (cadddr tree))

(define (tree? x)
  (cond ((null? x) #f)
        ((not (pair? x)) #f)
        ((not (pair? (cdr x))) #f)
        ((not (pair? (cddr x))) #f)
        ((not (pair? (cddr x))) #f)
        ((not (pair? (cdddr x))) #f)
        (else #t)))
(define (set-left! t x)
  (set-car! t x) t)
(define (set-right! t x)
  (set-car! (cdr t) x) t)
(define (set-key! t x)
  (set-car! (cddr t) x) t)
(define (set-value! t x)
  (set-car! (cdddr t) x) t)
;adjoin-list-tree把高一级的节点放在了上层叶节点的value下面
(define (adjoin-list-tree k-l v tree)
  (if (null? (cdr k-l))
      (cond ((null? tree) (make-leaf (car k-l) v))
            ((not (tree? tree)) (make-leaf (car k-l) v))
            ((=? (key tree) (car k-l)) (make-tree (left tree)
                                                  (right tree)
                                                  (key tree)
                                                  v))
            ((<? (car k-l) (key tree)) (make-tree (adjoin-list-tree k-l v (left tree))
                                                  (right tree)
                                                  (key tree)
                                                  (value tree)))
            ((<? (key tree) (car k-l)) (make-tree (left tree)
                                                  (adjoin-list-tree k-l v (right tree))
                                                  (key tree)
                                                  (value tree)))
            (else (error "Unknown situation!" tree)))
      (cond ((null? tree) (make-leaf (car k-l) (adjoin-list-tree (cdr k-l) v '())))
            ((not (tree? tree)) (make-leaf (car k-l) (adjoin-list-tree (cdr k-l) v '())))
            ((=? (car k-l) (key tree)) (make-tree (left tree)
                                                  (right tree)
                                                  (key tree)
                                                  (adjoin-list-tree (cdr k-l) v (value tree))))
            ((<? (car k-l) (key tree)) (make-tree (adjoin-list-tree k-l v (left tree))
                                                  (right tree)
                                                  (key tree)
                                                  (value tree)))
            ((<? (key tree) (car k-l)) (make-tree (left tree)
                                                  (adjoin-list-tree k-l v (right tree))
                                                  (key tree)
                                                  (value tree)))
            (else (error "Unknown situation" tree)))))
(define =?
  (lambda(a b) (= a b)))
(define <?
  (lambda(a b) (< a b)))
;------ make-table----------
(define (make-table same-key?)
  (let ((local-tree (make-tree '() '() '*ROOT* '())))
    (define (lookup key-list)
      (let ((record (assoc-list key-list local-tree)))
        (if (pair? record)
            (value record)
            false)))
    (define (assoc the-key tree)
      (cond ((null? tree) false)
            ((not (tree? tree)) false)
            ((same-key? the-key (key tree)) tree)
            ((< the-key (key tree))
             (assoc the-key (left tree)))
            (else (assoc the-key (right tree)))))
    (define (assoc-list key-list root)   ;这里的root是上层的树
      (if (pair? key-list)
          (let ((subtree (assoc (car key-list) (value root))))
            (if subtree
                (if (null? (cdr key-list))
                    subtree
                    (assoc-list (cdr key-list) subtree))
                false))
          (error "Wrong key-list" key-list)))
     
    (define (insert! key-list val)  ;引用调用的一大陀
      (set-value! local-tree (adjoin-list-tree key-list val (value local-tree))))
     
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "UNKNOWN OPERATION  ----TABLE" m))))
    dispatch))
;test
> (insert! '(1 10) 1000 t1)
(() () *ROOT* (() () 1 (() () 10 1000)))
> (insert! '(1 9) 90 t1)
(() () *ROOT* (() () 1 ((() () 9 90) () 10 1000)))
> (insert! '(1 5) 50 t1)
(() () *ROOT* (() () 1 (((() () 5 50) () 9 90) () 10 1000)))
> (lookup '(1 9) t1)
90
>  (lookup '(1 10) t1)
1000

;3.25
;以下过程是make-table的内部过程
    (define (lookup key-list)
      (let ((record (assoc-list key-list local-table)))
        (if (pair? record)
            (cdr record)
            false)))
    (define (assoc key records)
      (cond ((null? records) false)
            ((not (pair? records)) false)
            ((not (pair? (car records))) false)
            ((same-key? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
    (define (assoc-list key-list table)
      (if (pair? key-list)
          (let ((subtable (assoc (car key-list) (cdr table))))
            (if subtable
                (if (null? (cdr key-list))
                    subtable
                    (assoc-list (cdr key-list) subtable))
                false))
          (error "Wrong key-list" key-list)))
      ;insert-helper!过程每次只插入一个key，然后调用自身——是个迭代过程。
      ;另外一个思路，当k-l的某处发现subtable为假，就直接把剩下的k-l组合好，直接安装过去。这样会快一点。
    (define (insert! key-list value)
      (define (insert-helper! k-l v table)
        (if (pair? k-l)
            (let ((subtable (assoc (car k-l) (cdr table))))
              (if subtable
                  (if (null? (cdr k-l))
                      (set-cdr! subtable v)
                      (insert-helper! (cdr k-l) v subtable))
                  (if (null? (cdr k-l))
                      (set-cdr! table
                                (cons (cons (car k-l) v)
                                      (cdr table)))
                      (begin (set-cdr! table
                                       (cons (list (car k-l))
                                             (cdr table)))
                             (insert-helper! k-l v table)))))
            (error "Wrong key-list" k-l)))
      (insert-helper! key-list value local-table))
     
;test
(insert! '(a a1) 1 t1)
(insert! '(a a1 a2) 20 t1)

> (lookup '(a a1) t1)
((a2 . 20) . 1)
> (lookup '(a a1 a2) t1)
20
> (lookup '(a a1 a3) t1)
#f
----------------------无奈的分割线-----------------
忙活了这么半天，后来在以色列牛那看到，其实有个简单的方法：直接把list作为key，做一个一维的表格就行了，这样只需要写一个表示表格相等的过程就OK了。死脑筋了

;3.24
(define (make-table same-key?)
    ...
    (define (assoc key records)
      (cond ((null? records) false)
            ((same-key? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
    ...
    dispatch)

;test
(define (same? a b)
  (if (and (number? a)
           (number? b))
      (< (abs (- a b)) 2)
      (equal? a b)))
(define t1 (make-table same?))
(insert! 'c 10 1000 t1)
(insert! 'c 9 90 t1)
> (lookup 'c '10 t1)
90
> (lookup 'c '11.4 t1)
90
可以看到，(c 10 1000)那条记录已经被覆盖掉了，变成了(c 10 90)

2.93
除了把make-rat改了，还要把apply-generic中的drop语句弄掉，否则当时用的round过程会报错。
2.94
  (define (gcd-terms l1 l2)
    (if (empty-termlist? l2)
        l1
        (gcd-terms l2 (remainder-terms l1 l2))))
  (define (remainder-terms a b)
    (cadr (div-terms a b)))
然后加上interface:poly，g-c-d

2.95
Drscheme返回的结果：
(polynomial x (2 8+106/169) (1 -17+43/169) (0 8+106/169))，可以看到这与x^2-2*x+1的对应项系数是成比例的。
原因在于除法的计算过程，每次上的商的系数都是(div (coeff t1) (coeff t2))，这里没有考虑这个系数是否为整数。然后之后的相减就出现了一系列的分数。

2.96
方法题目中已经讲的很细了，要做的只是简单实现一下。又一次看到SICP是怎样把一个复杂的问题一点一点嚼碎了喂给我们的。
(define (gcd-terms l1 l2)
    (define (div-term-by-number l a)
        (if (null? l)
            '()
            (let ((t (first-term l)))
              (adjoin-term (make-term (order t)
                                      (/ (coeff t) a))
                           (div-term-by-number (rest-terms l) a)))))
    (define (gcd-terms-helper l1 l2)
      (if (empty-termlist? l2)
          l1
          (gcd-terms-helper l2 (pseduoremainder-terms l1 l2))))
    (define (gcd-coeff l)
      (define (coeff-list term-list)
        (if (empty-termlist? term-list)
            '()
            (cons (coeff (first-term term-list))
                  (coeff-list (rest-terms term-list)))))
      (apply gcd (coeff-list l)))
    (div-term-by-number (gcd-terms-helper l1 l2)
                        (gcd-coeff (gcd-terms-helper l1 l2))))

 (define (pseduoremainder-terms a b)
    (let ((t1 (first-term a))
          (t2 (first-term b)))
      (let ((o1 (order t1))
            (o2 (order t2))
            (c2 (coeff t2)))
        (let ((pseduo-c (expt c2 (+ 1 (- o1 o2)))))
          (cadr (div-terms (mul-terms (list pseduo-c) a)
                           b))))))
                          
2.97
a) poly包里面：
(define (reduce-terms n d)
    (let ((the-gcd-term (gcd-terms n d)))
      (let ((nn (car (div-terms n the-gcd-term)))
            (dd (car (div-terms d the-gcd-term))))
        (list nn dd))))
(define (reduce-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (let ((reduce-temp (reduce-terms (term-list p1) (term-list p2))))
          (list (make-poly (variable p1) (car reduce-temp))
                (make-poly (variable p1) (cadr reduce-temp))))
        (error "Poly not in the same variable--REDUCE-POLY"
               (list p1 p2))))
(put 'reduce '(polynomial polynomial)
       (lambda (p1 p2)
         (list (tag (car (reduce-poly p1 p2)))
               (tag (cadr (reduce-poly p1 p2))))))
              
b) (define (make-rat number denom)
    (let ((reduce-temp (reduce number denom)))
      (cons (car reduce-temp)
            (cadr reduce-temp))))
看着以前写的一大坨代码有条不紊的互相合作，感觉真是相当不错——尽管这是被一步一步引导的。

一看提示“这绝不简单!" ……希望有机会写上

  本题比较简单了，只有一个小问题，除法返回的有商和余式，所以不可以直接作为多项式返回。我给加的tag是div-poly，感觉加上polynomial可能也是可行的，不过需要修改很多选择函数。不过主要注意的是div-term，别的也就不管了
 (define (div-terms l1 l2)
    (if (empty-termlist? l1)
        (list (the-empty-termlist) (the-empty-termlist))
        (let ((t1 (first-term l1))
              (t2 (first-term l2)))
          (if (> (order t2) (order t1))
              (list (the-empty-termlist) l1)
              (let ((new-c (div (coeff t1) (coeff t2)))
                    (new-o (- (order t1) (order t2))))
                (let ((new-term (make-term new-o new-c)))
                  (let ((rest-of-result (sub-terms l1 (mul-terms l2 (list new-term)))))
                    (list (adjoin-term new-term
                                       (car (div-terms rest-of-result l2)))
                          (cadr (div-terms rest-of-result l2))))))))))

2.89
我基本没修改add-term以上的过程，只在下面的first-term(rest-term两者相同)/make-term/adjoin-term/coeff/order这些上区分了两者。
first-term要携带order的信息：(define (first-term x) x)
(make-term order coeff)生成一个car为coeff,其余项为0，总长度为order+1的list
adjoin-term：由于此过程都用于高次项加入低次的项表中，所以直接连接term和term-list，空项由0来填充。
coeff/order返回一个数值，具体过程实现后面会写。

2.90
为了通用稍微修改了一下add-term过程：
  (define (add-terms l1 l2)  
    (cond ((and (empty-termlist? l1)
                (empty-termlist? l2)) '())
          (else (let
                    ((t1 (first-term l1))
                     (t2 (first-term l2)))
                  (cond ((> (order t1) (order t2))
                         (adjoin-term (make-term (order t1) (coeff t1))
                                      (add-terms (rest-terms l1) l2)))
                        ((< (order t1) (order t2))
                         (adjoin-term (make-term (order t2) (coeff t2))
                                      (add-terms (rest-terms l2) l1 )))
                        (else
                         (adjoin-term (make-term (order t1)
                                                 (add (coeff t1)
                                                      (coeff t2)))
                                      (add-terms (rest-terms l1)
                                                 (rest-terms l2)))))))))
对比之前存在rect和polar两种表示的复数过程。当时是把各个表示前分别cons上了'rectangular和'polar，这样可行的原因之一是由于两种表示方法所区分的过程都是直接应用在这个复数上的，如real-part。
本题遇到的最大麻烦在于虽然first-term这样的过程是用在term-list上的，而coeff、order这些是应用在term上的过程。怎样区分两种term-list的表示方法，而又怎样把term-list区分的结果传递到提取的term上，是本题的关键。
    1.两种term-list表示方法我命名为thin和dense(thin太丑陋了……貌似应该是sparse)。在表示term-list方面两者的分别是：thin为一个序对组成的list，而dense是由一个个系数组成的list。
    2.注意到整个系统中只有first-term是用来取单个term的，所以在这里根据term-list的区别分别加上'dense或是'thin的标签。
ps.才指导有load这东西，总算不用把之前敲的大片大片的粘过来了。
具体实现：里面返回的多项式采用了dense-term-list的表示方法
(define (install-dense-term)
    ;=======procedures of termlist=========
    (define (first-term term-list)
      (if (null? term-list)
          (attach-tag 'dense '(0))
          (attach-tag 'dense term-list)))
    ;======procedures of terms=========  
    ;~~~~~~~~~~~~~~~~~
    (define (adjoin-term term term-list) ;term-list次数一定比term要低
      (let ((order-dense (get 'order '(dense))))
        (if (= (order-dense term-list) (order-dense term))
            term-list
            (cons (car term)
                  (adjoin-term (cdr term) term-list))))) 
    (define (make-term order coeff)
      (define (make-term-helper temp-order)
        (if (> temp-order 0)
            (append (make-term-helper (- temp-order 1))
                    '(0))
            (list coeff)))
      (make-term-helper order))      
    ;~~~~~~~~~~~~~~~~~
    (define (order t)
      (cond ((null? t) -1)
            ((null? (cdr t)) 0)
            (else (+ 1 (order (cdr t))))))
    (define (coeff t) (car t))
    ;interface
    (put 'first-term '(dense-term-list) first-term)
    (put 'coeff '(dense) coeff)
    (put 'order '(dense) order)
    'Done-dense-termlist)
 
  ;--------install-thin---------
  (define (install-thin-term)
    ;======procedures-of-termlist==========
    (define (first-term term-list)
      (if (null? term-list)
          (attach-tag 'thin '(0 0))
          (attach-tag 'thin (car term-list))))
    ;=====procedure-of-terms============
    ;~~~~~~~~~~~~~~~~~~
    (define (adjoin-term term term-list)
      (let ((coeff-thin (get 'coeff '(thin))))
        (if (=zero? (coeff-thin term))  
            term-list
            (cons term term-list))))  
    (define (make-term order coeff)
      (list order coeff))
    ;~~~~~~~~~~~~~~~~~~~~
   
    (define (order t) (car t))
    (define (coeff t) (cadr t))
   
    ;interface
    (put 'first-term '(thin-term-list) first-term)
    (put 'coeff '(thin) coeff)
    (put 'order '(thin) order)
    'Done-thin-termlist)
 
  ;-----procedures of term-list------
  (define (the-empty-termlist) '())
  (define (empty-termlist? term-list)
      (null? term-list))
  (define (rest-terms term-list)
    (if (null? term-list)
        '()
        (cdr term-list)))
  (define (dense-termlist? term-list)
    (cond ((null? term-list) #f)
          ((pair? (car term-list)) #f)
          (else #t)))
  (define (first-term term-list)
    (if (dense-termlist? term-list)
        ((get 'first-term '(dense-term-list)) term-list)
        ((get 'first-term '(thin-term-list)) term-list)))
  (define (coeff term) (apply-generic 'coeff term))
  (define (order term) (apply-generic 'order term))
  ;========adjoin-term, make-term需要手动交换========
  (define (adjoin-term term term-list)
      (let ((order-dense (get 'order '(dense))))
        (if (= (order-dense term-list) (order-dense term))
            term-list
            (cons (car term)
                  (adjoin-term (cdr term) term-list))))) 
  (define (make-term order coeff)
    (define (make-term-helper temp-order)
      (if (> temp-order 0)
          (append (make-term-helper (- temp-order 1))
                  '(0))
          (list coeff)))
    (make-term-helper order))       
 
 
  ;rest-terms相同，暂且不写
 

http://eli.thegreenplace.net/2008/06/06/signed-copy-of-sicp/#comments

那位做完习题的以色列牛，竟然收到了作者寄来的免费的签名紫皮书，太爽了。

一个微妙的问题：在polynomial包中写了一个negative-poly的过程，在put的时候才加上'polynomial；而其他的如scheme-number,rational,complex都没有相应的negative-complex等等。开始在poly中我也是不分negative和negative-poly，结果(add-poly p1 (negative p2)的时候发生错误。对于内部negative(如negative-poly)和外部negative何时该分别对待这个问题，我觉得如果内部对于本类型没有负操作的需要，那么不用区分内外的negative；如果有需要，则可能需要区分……待验证
(define (sub-poly p1 p2)
    (add-poly p1 (negative-poly p2)))
(define (negative-poly poly)
    (define (negative-term-list term-list)
      (if (null? term-list)
          '()
          (let ((t1 (first-term term-list)))
            (adjoin-term (make-term (order t1)
                                    (negative (coeff t1)))
                         (negative-term-list (rest-terms term-list))))))
  (make-poly (variable poly)
             (negative-term-list (term-list poly))))
(put 'negative '(polynomial)
     (lambda (poly)
       (tag (negative-poly poly))))
;-------scheme-number---------
(put 'negative '(scheme-number)
     (lambda(x) (make-scheme-number (* -1 x))))
;---------rational------------
(put 'negative '(rational)
     (lambda(x) (make-rational (negative (numer x))
                               (denom x))))
;---------complex-------------
(put 'negative '(complex)
     (lambda(x) (make-complex-from-real-imag (negative (real-part x))
                                             (imag-part x))))

ps. 今天是7月2日，DrScheme里多了个按钮，点开一看是Happy Birthday,Robby!看了下帮助，有个作者叫Robby Findler，有点意思

把第二章落下的一些东西补完：
书中的思路清晰的很，add-poly剥离了变量的复杂性；add-term剥离的项表表示的复杂度，只解决运算的关系；然后adjoin-term、make-term这些用来完成项表的具体实现。
在敲代码的时候把add-terms里面相加的语句写成了(add-terms (rest-terms l1) (adjoin-term t1 l2))，开始还以为只是另一种写法，后来发现这样是会出现死循环的。

关于本题的=zero?过程，写进install-polynomial-package中
(define (coeff-zero? term-list)
    (cond ((null? term-list) #t)
          ((not (= (coeff (first-term term-list)) 0))
           #f)
          (else (coeff-zero? (rest-terms term-list)))))
  (put '=zero? '(polynomial)
       (lambda(poly)
         (if (empty-termlist? (term-list poly))
             #t
             (coeff-zero? (term-list poly)))))