MENU

SICP 习题解答记录(第 1-3 章)

最近终于正式决定转行了,先从 SICP 看起,在自己的博客记录一下习题解答,随阅读进度更新。之前看的时候,没有记录的意识,前段的习题解答没记录下来,每天补上一点不补了再也不补了。

Chapter 1

1.1

10
10

(+ 5 3 4)
12

(- 9 1)
8

(/ 6 2)
3

(+ (* 2 4) (- 4 6))
6

(define a 3)

(define b (+ a 1))

(+ a b (* a b))
19

(= a b)
#f

(if (and (> b a) (< b (* a b)))
    b
    a)
4

(cond ((= a 4) 6)
      ((= b 4) (+ 6 7 a))
      (else 25))
16

(+ 2 (if (> b a) b a))
6

(* (cond ((> a b) a)
         ((< a b) b)
         (else -1))
   (+ a 1))
16

1.2

(/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5)))))
   (* 3 (- 6 2) (- 2 7)))

1.3

(define (larger-sum-2 a b c)
  (cond ((and (< a b) (< a c)) (+ b c))
        ((and (< b a) (< b c)) (+ a c))
        ((and (< c a) (< c b)) (+ a b))))

1.4

  • b > 0 ,则返回 (+ a b)
  • b < 0 ,则返回 (- a b)

综合来看是 a 加上 b 的绝对值

1.5

  • 如果是应用序,则程序将陷入无限循环。因为 (test 0 (p)) 中,将会先对操作数之一的 (p) 进行求值,进入无限循环
  • 如果是正则序,则程序将返回 0 ,因为 (test 0 (p)) 中的两个操作数不会被率先求值,执行时将先进行 if 判断,返回 0

1.6

将会陷入无限循环,因为 new-if 是自己定义的过程,不论 predicate 的判断结果如何,仍然会对所有操作数进行求值,包括 sqrt-iter

1.7

(define (goodenough? guess pre-guess)
    (< (/ (abs (- guess pre-guess)) guess) 0.001))

1.8

这里用的是改进后的 good-enough?

(define (cbrt-iter guess pre-guess x)
  (define (goodenough? guess pre-guess)
    (< (/ (abs (- guess pre-guess)) guess) 0.001))

  (define (improve guess x)
    (/ (+ (/ x (square y)) (* 2 y)) 3))

  (if (goodenough? guess pre-guess)
      guess
      (sqrt-iter (improve guess x) guess x)))

1.9

第一个定义的代换模型如下,显然是递归

(+ 4 5)
(inc (+ (dec 4) 5))
(inc (inc (+ (dec 3) 5)))
(inc (inc (inc (+ (dec 2) 5))))
(inc (inc (inc (inc (+ (dec 1) 5)))))
(inc (inc (inc (inc (+ 0 5)))))
(inc (inc (inc (inc 5))))
(inc (inc (inc 6)))
(inc (inc 7))
(inc 8)
9

第二个定义的代换模型如下,显然是迭代

(+ 4 5)
(+ (dec 4) (inc 5))
(+ (dec 3) (inc 6))
(+ (dec 2) (inc 7))
(+ (dec 1) (inc 8))
(+ 0 9)
9

1.10

这个函数我自己代换得到的结论是用于计算 $2^{2^{2^n}}$ 的函数,第一个参数决定有几个 2,第二个参数决定最后是 2 的几次方,所以结果如下:

(A 1 10) $2^{10}$

(A 2 4) $2^{2^{4}}$

(A 3 3) $2^{2^{2^3}}$

1.11

递归:

(define (f n)
  (if (< n 3)
      n
      (+ (f (- n 1))
         (* 2 (f (- n 2)))
         (* 3 (f (- n 3))))))

迭代:

(define (f n)
  (define (iter a b c i n)
    (if (= i n)
        c
        (f-iter (+ a (* 2 b) (* 3 c))   
                a                       
                b                       
                (+ i 1)
                n)))
  (iter 2 1 0 0 n))

1.12

这道题看了半天没想明白用 Scheme 怎么输出一个这样规整的三角形..最后去看习题解才知道是翻译的问题,是要求输出杨辉三角中的某个元素而不是整个三角

(define (pascal row col)
    (cond ((> col row)
            (error "unvalid col value"))
          ((or (= col 0) (= row col))
            1)
          (else (+ (pascal (- row 1) (- col 1))
                   (pascal (- row 1) col)))))

1.13

数学证明被我选择性跳过了..

1.14

Chapter 2

2.67

(a d a b b c a)

2.68

(define (encode-symbol symbol tree)
  (cond ((leaf? tree) '())
        ((not (element-of-set? symbol (symbols tree)))
         (error "symbol not found -- ENCODE-SYMBOL" symbol))
        ((element-of-set? symbol (symbols (left-branch tree)))
         (append (list 0)
                 (encode-symbol symbol (left-branch tree))))
        ((element-of-set? symbol (symbols (right-branch tree)))
         (append (list 1)
                 (encode-symbol symbol (right-branch tree))))))

2.69

(define (successive-merge leaf-set)
  (if (null? (cddr leaf-set))
      (make-code-tree (car leaf-set)
                      (cadr leaf-set))
      (successive-merge (adjoin-set (make-code-tree (car leaf-set)
                                                    (cadr leaf-set))
                                    (cddr leaf-set)))))

2.70

(define rock-tree (generate-huffman-tree '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1))))

(display (encode '(GET A JOB) rock-tree))
(newline)
(display (encode '(SHA NA NA NA NA NA NA NA) rock-tree))
(newline)
(display (encode '(GET A JOB) rock-tree))
(newline)
(display (encode '(SHA NA NA NA NA NA NA NA) rock-tree))
(newline)
(display (encode '(WAH YIP YIP YIP YIP YIP YIP YIP YIP YIP) rock-tree))
(newline)
(display (encode '(SHA BOOM) rock-tree))

输出:

(1 1 1 1 1 1 1 0 0 1 1 1 1 0)
(1 1 1 0 0 0 0 0 0 0 0)
(1 1 1 1 1 1 1 0 0 1 1 1 1 0)
(1 1 1 0 0 0 0 0 0 0 0)
(1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0)
(1 1 1 0 1 1 0 1 1)

总共用了 82 位,若采用定常编码,需要 36*3 = 108 位

2.71

n = 5 时

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

最频繁的符号只需要用 $1$ 位,而最不频繁的需要用 $(n-1)$ 位,$n = 10$ 时同理

2.72

  • 对于最频繁的符号,由于其实际在树中符号表的第一个位置,所以每次 elment-of-set? 过程的复杂度是 $\Theta(1)$ ,而由于它只需要一位进行编码,总复杂度仍为 $\Theta(1)$
  • 对于最不频繁的符号,由于其在树中符号表的最某位,所以每次 element-of-set? 过程的复杂度为 $\Theta(n)$ ,由于需要 $(n - 1)$ 位进行编码,总复杂度为 $\Theta(n^2)$

2.73

a) 对于常数,直接返回 $0$ ,对于单个的与 var 相同的表达式,返回 $1$ ,对于其他种类的运算,分派到表格中的不同操作里。不分配 number?same-variable? 是因为它们没有像和与积那样对应的操作符

b)

(define (install-deriv-by-type)
  (define (deriv-sum exp var)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))

  (define (deriv-product exp var)
    (make-sum (make-product (multiplier exp)
                            (deriv (multiplicand exp) var))
              (make-product (deriv (multiplier exp))
                            (multiplicand exp))))

  (put 'deriv '+ deriv-sum)
  (put 'deriv-product '* deriv-product))

c) 只需要在上面的过程中加入下面这一段

(define (deriv-exp exp var)
  (make-product (exponent exp)
                (make-product (make-exponentiation (base exp)
                                                   (- (exponent exp) 1))
                              (deriv (base exp) var))))

(put 'deriv 'exponentiation deriv-exp)

d) 只需要将上面的代码中的 put 的前两个操作数交换即可。这里我没有把所有的实现全部放到表里,因为对于上述的操作而言,似乎不会有其他的类型了,于是觉得(似乎)没有必要。(很快就被 2.5 节打脸了)

2.74

这道题给出的信息不够明确,故放弃。但大体的思路是为每个分支机构加上一个 tag ,然后为每个机构去单独实现题目中所述的过程。

2.75

(define (make-from-mag-ang x y)
  (define (dispatch op)
    (cond ((eq? op 'magnitude) x)
          ((eq? op 'angle) y)
          ((eq? op 'real-part) (* x (cos y)))
          ((eq? op 'imag-part) (* x (sin y)))
          (else (error "Unknon op -- MAKE-FROM-REAL-IMAG" op)))))

这里有点像书中所谓的没有提到的“闭包”的另一种含义,一个引用了自由变量的函数

2.76

显式分派

  • 加入新类型
    • 需要实现这个类型所有的操作
    • 需要去修改通用型操作的过程,增加子句
  • 加入新操作
    • 需要为所有类型实现新操作
    • 需要去修改通用型操作的过程,增加子句

数据导向

  • 加入新类型
    • 需要实现一个新类型的包,并安装入表
  • 加入新操作
    • 需要实现一个新的通用性操作
    • 需要在各个类型包里加入新操作的子句,并安装入表

消息传递

  • 加入新类型
    • 实现一个新的类型过程,包含所有操作
  • 加入新操作
    • 为现有的所有类型过程加入新操作的子句

我个人怎么感觉后两种实现的方式从工作量来说是差不多的呢..

2.77

  • 未加入题中所述定义时,表中根本没有 complex 类型,为 maginitude 传入 complex 类型的对象自然会报错,此时调用了一次 apply-genric
  • 加入后,magnitude 中的 apply-genric 首先在表中找到了 complex 对应的 magnitude 通用型操作过程,而在 magnitude 中, apply-genirc 又一次在表中找到了对应 rectangular 的操作

这里值得提到的是我在第一次看的时候忽略了 apply-genric 中有一个 (map contents args) 的调用,相当于为 args 剥去了第一个 tag ,导致前一页的内容有些难以理解(主要是这一部分大多都是大段的重复代码让人看的有些急躁..)

2.78

(define (type-tag datum)
  (cond ((number? datum) datum)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))

(define (contents datum)
  (cond ((number? datum) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

(define (attach-tag type-tag contents)
  (if (number? contents)
      contents
      (cons type-tag contents)))

2.79

(define (equ? x y)
  (aplly-genric 'equ? x y))

; add to scheme-number-package
(put 'equ? '(scheme-number scheme-number)
     (lambda (x y)
       (= x y)))

; addd to raional-package
(put 'equ? '(rational rational)
     (lambda (x y)
       (= (* (numer x) (denom y))
          (* (numer y) (denom x)))))

; add to complex-package
(put 'equ? '(complex complex)
     (lambda (x y)
       (and (= (real-part x) (real-part y))
            (= (imag-part x) (imag-part y)))))

2.80

这题和上一题几乎完全一样..我觉得领会意思就行了..重复劳动没有必要

2.81

a) 由于 Louis 所定义的转换程序实际没有改变两个操作数的类型,但每次进入 apply-generic 都将产生一次强制,最终将陷入无限循环

b) 如上,没有解决问题,不能正常工作

c)

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (if (eq? type1 type2)  ; add predicate
                    (error "No method for these types"
                           (list op type-tags))
                    (let ((t1->t2 (get-coercion type1 type2))
                          (t2->t1 (get-coercion type2 type1)))
                      (cond (t1->t2
                             (apply-generic op (t1->t2 a1) a2))
                            (t2->t1
                             (apply-generic op a1 (t2->t1 a2)))
                            (else
                             (error "No method for these types"
                                    (list op type-tags))))))
                (error "No method for these types"
                       (list op type-tags))))))))

2.82

反例:假定存在 1 -> 2 -> 3 的转换方法(数字代表类型,箭头方向代表可向该类型转换),那么在操作数为 1 2 3 的情况下,可以看出可以将所有操作数转换为类型 3,但如题中描述,找不到一次性将所有操作数转换成类型 3 的方法

具体要去实现的话,就如书中所说的,将会涉及到图论,我现在这个水平是做不了了..

2.83

(define (raise x)
  (apply-generic 'raise x))

; add to integer-package
(put 'raise 'integer
     (lambda (x)
       (attach-tag 'rational (make-rational x))))

; add to rational-package
(put 'raise 'rational
     (lambda (x)
       (attach-tag 'real (make-real (/ (numer x) (denom x))))))

; add to real-package
(put 'raise 'real
     (lambda (x)
       (attach-tag 'complex (make-complex-from-real-imag x 0))))

2.84

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (if (eq? type1 type2)
                    (error "No method for these types"
                           (list op type-tags))
                    (if (higher-level? type1 type2)
                        (apply-generic op a1 (raise a2))
                        (apply-generic op (raise a2) a1))
                (error "No method for these types"
                       (list op type-tags)))))))))

(define (higher-level? l1 l2)
  (define (raise-count x count)
    (if (get 'raise (type-tag))
        (raise-count (raise x) (+ count 1))
        count))
  (< (raise-count l1 0) (raise-count l2 0)))

2.85

(define (project x)
  (apply-generic 'project x))

; add to complex-package
(put 'project 'complex
     (lambda (x)
       (attach-tag 'real (make-real (real-part x)))))

; add to real-package
(put 'project 'real
     (lambda (x)
       (attach-tag 'integer (make-integer (round x))))

(define (drop x)
  (let ((pro-x (project x)))
    (if (equ? pro-x (raise pro-x))
        (drop (pro-x))
        x)))

并没有编写从实数到有理数的 project ,因为不会..最后对 apply-generic 的修改,只需要将 apply 的结果用 drop 处理即可

2.86

这道题的基本思路是修改 complexpolar rectangular 的构造函数和选择函数的层级。而要使所有的数据类型支持如 sine 这样的运算,只需要在各个包中去实现,并且实现一个通用型过程即可。

2.87

在多项式的包里添加下列代码

(define (=zero?-poly poly)
  (define terms (term-list poly))
  (define (=zero?-term terms)
    (cond ((null? terms) true)
          ((=zero? (coeff (first-term terms)))
           (=zero?-term (rest-terms terms)))
          (else false)))
  (=zero?-term terms))

(put '=zero? 'polynomial =zero?-poly)

2.88

(define (neg x)
  (apply-generic 'neg x))

; add to complex-package
(put 'neg 'complex
     (lambda (x)
       (tag (make-from-real-imag (neg (real-part x))
                                 (neg (imag-part x))))))

; add to scheme-number-package
(put 'neg 'scheme-number
     (lambda (x)
       (- x))))

; add to rational-package
(put 'neg 'rational
     (lambda (x)
       (tag (make-rational (- (numer x))
                           (- (denom x))))))

; add to polynomial-package
(define (neg-poly p)
  (make-poly (variable p)
             (neg-terms (term-list p))))

(define (neg-terms L)
  (if (empty-termlist? L)
      (the-empty-termlist)
      (let ((t1 (firs-term L)))
        (adjoin-term
         (make-term (order t1)
                    (neg (coeff t1)))
         (neg-terms (rest-terms L))))))

(put 'neg 'polynomial
     (lambda (p)
       (tag (neg-poly p))))

(define (sub-poly p1 p2)
  (add-poly p1 (neg p2)))

(put 'sub '(polynomial polynomial)
     (lambda (p1 p2)
       (tag (sub-poly p1 p2))))

我写到这里的时候突然发现我们讨论好像早就已经不是书中之前提到的那个塔状结构的数据结构了..但是意思上几乎相差无几..只是我多写了一些重复代码..

2.90

稍早时候刚开始读 Programatic Programmer,刚好读到 DRY 原则。而当这本书上的任何一道题目告诉你“这很难”,“这需要很多工作”基本上就意味着“一个学术界尚未解决的问题”和“超多重复工作”,我选择跳过

2.91

(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 ((rest-of-result
                     (div-terms
                      (sub-terms L1
                                 (mul-terms (list (make-term new-o new-c))
                                            L2))
                      L2)))
                (list (adjoin-term
                       (make-term new-o new-c)
                       (car rest-of-result))
                      (cadr rest-of-result))))))))

2.92

出现了!“这绝不简单!”跳过!

2.93

由于现在有理数的分子分母不一定是整数了,所以只需要把 rational-package 中的各种方法使用的 + - * / 等换成 add sub mul div ,就可以正常工作

2.94

; add to polynomial-package
(define (remainder-terms a b)
  (cadr (div-terms a b)))

(define (gcd-terms a b)
  (if (empty-termlist? b)
      a
      (gcd-terms b (remainder-terms a b))))

(define (gcd-poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (gcd-terms (term-list p1) (term-list p2))
      (error "Polys not in same var -- GCD-POLY"
             (list p1 p2))))

(put 'greatest-common-divisor '(polynomial polynomial)
     (lambda (p1 p2)
       (tag (gcd-poly p1 p2))))

; add to scheme-number-package
(put 'greatest-common-divisor '(scheme-number scheme-number)
     (lambda (a b)
       (tag (gcd a b))))

执行检查还是算了..自从书上开始为了描述数字运算加入了大量重复代码之后我就几乎没有手敲上那些代码到环境里了..

2.95

跳过。

2.96

a)

(define (pseudoremainder-terms L1 L2)
  (let ((t1 (first-term L1))
        (t2 (first-term L2)))
    (let ((o1 (order t1))
          (o2 (order t2)))
      (let ((c (- (+ 1 o1) o2)))
        (let (c-term (make-term 0 c))
          (cadr (div-term (mul (list c-term) L1)
                          L2)))))))

(define (gcd-terms a b)
  (if (empty-termlist? b)
      a
      (gcd-terms b (pseudoremainder-terms a b))))

b)

(define (gcd-terms-at-last terms)
  (define (gcd-coeff terms)
    (if (null? (rest-terms terms))
        '()
        (let ((t1 (first-term terms))
              (t2 (first-term (rest-terms terms))))
          (let ((c1 (coeff t1))
                (c2 (coeff t2)))
            (append (list (gcd c1 c2))
                    (gcd-coeff (rest-terms terms)))))))
  (let ((simplified-terms (gcd-coeff terms)))
    (if (null? (cdr simplified-terms))
        simplified-terms
        (gcd-coeff simplified-terms))))

(define (gcd-terms a b)
  (if (empty-termlist? b)
      (gcd-term-at-last a)
      (gcd-terms b (pseudoremainder-terms a b))))

2.97

这题的内容完全是前面内容的重复了..不做了

Chapter 3

3.1

(define (make-accumulator initial)
  (lambda (x)
    (set! initial (+ initial x))
    initial))

3.2

(define (make-monitored f)
  (let ((count 0))
    (lambda (op)
      (cond ((eq? op 'how-many-calls?) count)
            ((eq? op 'reset-count) (set! count 0))
            (else (begin (set! count (+ count 1))
                         (f op)))))))

3.3

(define (make-account balance password)
  (define (withdraw amount)
    (if (> balance amount)
      (begin (set! balance (- balance amount))
            balance)
      (display "Insufficient balance")))

  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)

  (define (password-match? given-password)
    (eq? given-password password))

  (define (dispatch given-password op)
    (if (password-match? given-password)
        (cond ((eq? op 'withdraw) withdraw)
              ((eq? op 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" op)))
        (lambda (x) (display "Incorrect password"))))

  dispatch)

3.4

(define (make-account balance password)
  (let ((tried-times 0)
        (max-try-times 7))
    (define (withdraw amount)
      (if (>= balance amount)
          (begin (set! balance (- balance amount))
                 balance)
          (display "Insufficient balance")))

    (define (deposit amount)
      (set! balance (+ balance amount))
      balance)

    (define (password-match? given-password)
      (eq? given-password password))

    (define (display-wrong-password-message useless-arg)
      (display "Incorrect password"))

    (define (call-the-cops)
      (display "Call the cops"))

    (define (dispatch given-password op)
      (if (password-match? given-password)
          (begin (set! tried-times 0) ; reset try count after login success
                 (cond ((eq? op 'withdraw) withdraw)
                       ((eq? op 'deposit) deposit)
                       (else (error "Unknown request -- MAKE-ACCOUNT" op))))
          (begin (set! tried-times (+ tried-times 1))
                 (if (>= tried-times max-try-times)
                     (call-the-cops)
                     display-wrong-password-message))))

    dispatch))

3.5

(define (estimate-integral p x1 x2 y1 y2 trails)
  (let ((x-len (- x2 x1))
        (y-len (- y2 y1)))
    (* (monte-carlo trails
                    (lambda () (integral-test p x1 x2 y1 y2)))
       (* x-len y-len))))

(define (in-circle? center-x center-y radius x y)
  (<= (+ (square (- x center-x))
         (square (- y center-y)))
      (square radius)))

(define (random-in-range low high)
  (+ low (rand (- high low))))

(define (rand n)
  (* n (/ (random 10000) 10000)))

(define (integral-test p x1 x2 y1 y2)
  (let ((rand-x (random-in-range x1 x2))
        (rand-y (random-in-range y1 y2)))
    (p rand-x rand-y)))

由于我用的不是 MIT-Scheme 而是 DrRacket,所以好像 random 过程的实现和书中描述的不一样..是只接受整数,返回一个小于输入值的非负整数,所以额外实现了一下书中的 random 过程为 rand

执行结果:

> (estimate-integral (lambda (x y)
                       (in-circle? 5 7 3 x y))
                     2 8 4 10 100000)
#e28.24704

> (estimate-integral (lambda (x y)
                       (in-circle? 1 1 1 x y))
                     0 2 0 2 100000)
#e3.13892

3.6

(define (rand op)
         (let ((x random-init))
           (lambda ()
             (cond ((eq? op 'generate)
                    (begin (set! x (rand-update x))
                           x))
                   ((eq? op 'reset)
                    (begin (set! x random-init)
                           x))))))

3.7

(define (make-account balance password)
  (let ((password-list (list password)))
    (define (withdraw amount)
      (if (> balance amount)
      (begin (set! balance (- balance amount))
             balance)
      (display "Insufficient balance")))

    (define (deposit amount)
      (set! balance (+ balance amount))
      balance)

    (define (password-match? given-password password-list)
      (cond ((null? password-list) false)
            ((eq? given-password (car password-list)) true)
            (else (password-match? given-password (cdr password-list)))))

    (define (adjoin-new-member new-password)
      (set! password-list (cons new-password password-list))
      dispatch)

    (define (dispatch given-password op)
      (if (password-match? given-password password-list)
          (cond ((eq? op 'withdraw) withdraw)
                ((eq? op 'deposit) deposit)
                ((eq? op 'adjoin-new-member) adjoin-new-member)
                (else (error "Unknown request -- MAKE-ACCOUNT" op)))
          (lambda (x) (display "Incorrect password"))))

    dispatch))

(define (make-joint account old-password new-password)
  ((account old-password 'adjoin-new-member) new-password))

这里实现的思路是为 make-account 对象增加了一个 password-list 属性,以使得我们可以通过 make-joint 过程为对象加入新的密码到 password-list 中,让它可以访问账户

但是这样的实现的问题是无法将账户和密码对应起来,也就是对 peter-acc 也可以用 paul-acc 的密码通过检查,反之亦然。

于是在 练习 3.7 — SICP 解题集 看到了这样的解答:

make-joint 是对 make-account 所产生的对象的一次再包装。

(define (make-joint  origin-acc origin-password another-password)
    (lambda (given-password mode)
        (if (eq? given-password another-password)
            (origin-acc origin-password mode)
            display-wrong-another-password-message)))

(define (display-wrong-another-password-message useless-arg)
    (display "Incorrect another password"))

完美的避开了这一问题。

3.8

(define f
  (let ((result 1))
    (lambda (x)
      (set! result (* x result))
      result)))

3.9

画图题就草稿纸上解决了,不记录下来

3.10

同上

3.11

同上

3.12

<response 1>
(b)

<reponse 2>
(b c d)

3.13

画图题

3.14

这题稍微在草稿纸上写两个列表模拟一下过程就知道 loop 这个过程是反转列表中的元素的,类似第二章里的 list-reverse

3.15

画图题

3.16

画图题

3.17

(define (count-pairs x)
  (let ((cons-list '()))
    (define (inner x)
      (cond ((not (pair? x)) 0)
            ((not (memq x cons-list))
             (begin (set! cons-list (cons x cons-list))
                    (+ (inner (car x))
                       (inner (cdr x))
                       1)))
            (else 0)))
    (inner x)))

这里在内部定义了一个过程 inner ,保证所有的递归调用的外部环境都是一致的,一开始没有加入inner 的定义,写了半天不管怎么写都不行..后来反应过来画图才发现每次直接调用 count-pairs 都将形成一个新的 let 环境..也就是一个新的 cons-list ,不管怎样都会通过检查..

3.18

(define (has-loop? x)
  (let ((cons-list '()))
    (define (inner x)
      (cond ((null? x) false)
            ((memq x cons-list) true)
            (else (begin (set! cons-list (cons x cons-list))
                         (inner (cdr x))))))
    (inner x)))

和上一题基本一样

3.19

这题我自己是想不出来..贴上一个答案

(define (loop? lst)
    (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 lst lst))

(define (list-walk step lst)
    (cond ((null? lst)
            '())
          ((= step 0)
            lst)
          (else
            (list-walk (- step 1)
                       (cdr lst)))))

3.20

画图题

3.21

表的实质结构是两个指针组成的序对,删除项目只是移动第一个指针的位置,打印出来自然是书上的内容

(define (print-queue queue)
  (display (front-ptr queue)))

3.22

一个重复性操作..跳过

3.23

(define (make-deque)
  (cons '() '()))

(define (empty-deque? deque)
  (or (null? (front-deque deque))
      (null? (rear-deque deque))))

(define (front-deque deque)
  (car deque))

(define (rear-deque deque)
  (cdr deque))

(define (front-insert-deque! deque item)
  (let ((new-pair (cons (cons '() item) '())))
    (cond ((empty-deque? deque)
           (set-front-ptr! deque new-pair)
           (set-rear-ptr! deque new-pair)
           deque)
          (else
           (set-cdr! new-pair (front-deque deque))
           (set-car! (car (front-deque deque)) new-pair)
           (set-front-ptr! deque new-pair)
           deque))))

(define (rear-insert-deque! deque item)
  (let ((new-pair (cons (cons '() item) '())))
    (cond ((empty-deque? deque)
           (set-front-ptr! deque new-pair)
           (set-rear-ptr! deque new-pair)
           deque)
          (else
           (set-cdr! (rear-deque deque) new-pair)
           (set-car! (car new-pair) (rear-deque deque))
           (set-rear-ptr! deque new-pair)
           deque))))

(define (front-delete-deque! deque)
  (cond ((empty-deque? deque)
         (error "DELETE called with an empty deque" deque))
        (else
         (set-front-ptr! deque (cdr (front-deque deque)))
         deque)))

(define (rear-delete-deque! deque)
  (cond ((empty-deque? deque)
         (error "DELETE called with an empty deque" deque))
        (else
          (set-rear-ptr! deque (caar (rear-deque deque)))
          deque)))

(define (print-deque deque)
  (define (deque->list deque rear-ptr)
    (cond ((eq? deque rear-ptr) (cons (cdar deque) '()))
          (else (cons (cdar deque)
                      (deque->list (cdr deque) rear-ptr)))))
  (cond ((empty-deque? deque) (display '()))
        (else (display (deque->list (front-deque deque) (rear-deque deque))))))

最开始写的时候感觉挺简单的..写到 rear-delete-deque! 过程的时候发现不对劲了..没办法在 $\Theta(1)$ 复杂度的前提下获取到尾部的上一个元素

这里因为不知道 scheme 里的双向链表应该怎么写于是查了一下别人的解答..基本的思路是把表里的每个元素的 car 做成一个序对,其中一个元素是指向上一个元素的指针,另一个元素是实际的内容,cdr 和原来一样,指向下一个元素,这里按照抽象的思路其实应该多写几个选择函数但是因为懒就没做..(怕不是 SICP 白读了)

3.24

(define (make-table same-key?)
  (let ((local-table (list '*table*)))
    (define (assoc key table)
      (cond ((null? table) false)
            ((same-key? key (caar table)) (car table))
            (else (assoc key (cdr table)))))

    (define (lookup key-1 key-2)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  false))
            false)))

    (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! record 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 "Unkown operation -- TABLE" m))))

    dispatch))

3.25

将子表格作为记录存在子表格里,反复嵌套之后就可以拥有多维表格。要将 lookup insert! 过程实现为递归过程来操作这种表格

3.26

和第二章中描述的二叉树并无本质区别,只是 entry 部分变成了 (key, value) 的键值对

3.27

(memoize f) 本身返回的是一个 lambda 过程,定义 memo-fib 之后,memo-fib 本身指向一个被 memoize 返回的过程,这时调用 (memo-fib n) 将调用这个过程,而不是再次调用 (memoize f) 定义一个新的过程。

这个被 memo-fib 指向的过程在 memoizelet 下定义,于是它的环境指针也指向这个框架(table 在这个框架里)。这时调用 memo-fib 将生成一个框架,它的环境指针指向包含 table 的框架。因此这个模式可以工作

这一题的第二个问题。如果简单的定义成 (memoize fib) ,区别就在于:过程体内,调用 memo-fib 的部分变成了直接调用 fib 。那么在调用之后第一次计算 (f x) 的过程里就会将整个树形迭代过程完成。其他的代码会被完全忽视。所以这个模式失效了。

3.28

(define (or-gate a1 a2 output)
  (define (or-action-procedure)
    (let ((new-value (logical-or (get-signal a1)
                                 (get-signal a2))))
      (after-delay or-gate-delay
                   (lambda () (set-signal! output new-value)))))
  (add-action! a1 or-action-procedure)
  (add-aciton! a2 or-action-procedure)
  'ok)

(define (logical-or s1 s2)
  (cond ((or (= s1 1) (= s2 1)) 1)
        ((and (= s1 0) (= s2 0) 0))
        (else (error "Invalid signal" s1 s2))))

3.29

(define (or-gate a1 a2 output)
  (inverter a1 b1)
  (inverter a2 b2)
  (and-gate b1 b2 c)
  (inverter c output))

延时因为我没学过数字电路不是很懂..似乎只是所有电路器件的延时简单相加

3 * inverter-delay + and-gate-delay

3.30

(define (ripple-carry-adder A B S C)
  (define (inner A B S Ck)
    (let ((Ak (car A))
          (Bk (car B))
          (Sk (car S))
          (Ck+1 (make-wire))
          (remain-A (cdr A))
          (remain-B (cdr B))
          (remain-S (cdr S)))
      (cond ((null? remain-A)
             (full-adder Ak Bk Ck Sk C))
            (else
             (full-adder Ak Bk Ck Sk Ck+1)
             (inner remain-A remain-B remain-S Ck+1)))))
  (inner A B S (make-wire)))

n = 1 时的延时为

ripple-carry-adder = full-adder-delay
                   = or-gate-delay + 2 * (half-adder-delay)
                   = or-gate-delay + 2 * (or-gate-delay + inveter-delay + (2 * and-gate-delay))
                   = or-gate-delay + (2 * or-gate-delay) + (2 * inveter-delay) + (4 * and-gate-delay)
                   = (3 * or-gate-delay) + (2 * inveter-delay) + (4 * and-gate-delay)

总延时为 n * ripple-carry-adder

3.31

因为在第一次连接线路的时候,元件的输出值,就需要通过运行该过程对输入值进行计算得出。

3.32

如果是后进先出的栈结构,追踪一个与门:

  • 输入1 从 0 变成 1 ,输入 2 仍为 1logical-and 的返回值是 1 这时在栈中压入 action1
  • 输入2 从 1 变成 0 ,输入 1 为 0logical-and 的结果是 0 ,这时在栈中压入 action2

然而,如果按照 action2 -> action1 的处理顺序,最后与门的输出是 1

但若正常按照 action1 -> action2 的处理顺序,输出是正常的 0

3.33

(define (averager a b c)
  (let ((sum (make-connector))
        (half (make-connector)))
    (adder a b sum)
    (multiplier half sum c)
    (constant 0.5 half)))

3.34

很显然,缺陷在于,对 b 设置值,a 不会被计算,因为对于内部的 multiplier 而言,它只设置了输出口的一个值,而 multiplier 需要至少三个口设置了值才能进行计算

3.35

(define (squarer a b)
  (define (process-new-value)
    (if (has-value? b)
        (if (< (get-value b) 0)
            (error "suquare less than 0 --SQUARER" (get-value b))
            (set-value! a (sqrt (get-value b)) me))
        (if (has-value? a)
            (set-value! b (square (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)
  'ok)

3.36

画图题

3.37

(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 x z y)
    z))

(define (cv x)
  (let ((c (make-connector)))
    (constant x c)
    c))

3.38

a)

Peter->Paul->Mary: 45
Peter->Mary->Paul: 35
Paul->Peter->Mary: 45
Paul->Mary->Peter: 50
Mary->Peter->Pual: 40
Mary->Paul->Peter: 40

b) 值太多了..这里不列举了

3.39

101
121
100

3.40

把第一个 lambda 过程称作 P1 ,把第二个 lambda 过程称作 P2

1000000:
P1->P2 or P2->P1

100:
P1 和 P2 的 set 执行在序列最后, P1 在最后

10000:
P2 访问第二个 x 时, P1 已完成: 10000

1000:
P1 和 P2 的 set 执行在序列最后, P2 在最后 or
P2 访问第三个 x 时, P1 已完成 or 
P1 访问第二个 x 时, P2 已完成

串行后之后只会出现 1000000

3.41

Ben 的担心没有必要,对 banlance 的访问即使穿插在 withdrawdeposit 的执行过程中,也可以正确的获得当前的值,且不会对其他并行进程产生影响

3.42

这样的修改安全,串行化后的过程每次调用的时候是正常的按照串行的过程的执行方式去等待,在并发性方面并没有什么不同。

3.43

画图题

3.44

Louis 是错误的。这个转账的问题可以完全分解为对各个账户分别进行操作的问题,而各个账户自己的操作都是串行化了的,所以不会出现问题。

这个问题和交换余额的问题的本质区别是,交换余额时需要获取余额来决定差额,而这个过程可能被并行计算的其他过程穿插进入,导致问题。

3.45

注意此时 exchange 中的 withdrawdeposit 过程也被同一个串行组串行化了,因此在 exchange 运行时,withdrawdeposit 都无法运行,产生死锁。

3.46

另一个调用 test-and-set! 的进程,在第一个进程还没有完成设置值的时候去获取 (car cell) 的值,就会出现两个 test-and-set! 都返回假而且设置了 (car cell) 内容的问题。

3.47

(define (make-semaphore n)
  (let ((mutex (make-mutex)))

    (define (acquire)
      (mutex 'acquire)
      (if (> n 0)
          (begin (set! n (- n 1))
                 (mutex 'release))
          (begin (mutex 'release)
                 (acquire))))

    (define (release)
      (mutex 'acquire)
      (set! n (+ n 1))
      (mutex 'release))

    (define (dispatch m)
      (cond ((eq? m 'acquire) acquire)
            ((eq? m 'release) release)
            (else
             (error "Unkown mode -- MAKE-SEMAPHORE" m))))

    dispatch))

3.48

前文所提到的串行化进程导致的死锁的问题,本质上是对两个账户交错进行了串行化,而为账户编号且先访问较小编号的账户后,可以保证串行化账户的顺序相同,也就不存在交错问题。

3.49

(define make-account
  (let ((acc-count 0))
    (define (inner balance password)
      (define serial-number
        (let ((sn acc-count))
          (set! acc-count (+ acc-count 1))
          sn))

      (define (withdraw amount)
        (if (> balance amount)
            (begin (set! balance (- balance amount))
                   balance)
            (display "Insufficient balance")))

      (define (deposit amount)
        (set! balance (+ balance amount))
        balance)

      (define (password-match? given-password)
        (eq? given-password password))

      (define (dispatch given-password op)
        (if (password-match? given-password)
            (cond ((eq? op 'withdraw) withdraw)
                  ((eq? op 'deposit) deposit)
                  ((eq? op 'get-number) serial-number)
                  (else (error "Unknown request -- MAKE-ACCOUNT" op)))
            (lambda (x) (display "Incorrect password"))))

      dispatch)
    inner))

(define (serialized-exchange account1 account2)
  (let ((serializer1 (account1 'serializer))
        (serializer2 (account2 'serializer))
        (sn1 (account1 'get-number))
        (sn2 (account2 'get-number)))
    (if (< sn1 sn2)
        ((serializer2 (serializer1 exchange)) account1 account2)
        ((serializer1 (serializer2 exchange)) account1 account2))))

3.49

以下答案来自 练习 3.49 — SICP 解题集

假设 peter 和 mary 是两夫妇,他们各自拥有自己的帐号 peter-accmary-acc ,并且这两个帐号都将对方的帐号设置成了关联帐号,也即是,当 peter-acc 的余额不足以支付的时候,它会去提取 mary-acc 的余额;而当 mary-acc 的余额不足以支付的时候,它也回去提取 peter-acc 的余额。

现在,考虑这样一种情况, peter 和 mary 分别在不同的地方消费,然后各自账户的余额都不足以支付订单,于是 peter-acc 尝试访问关联帐号 mary-acc,而 mary-acc 也在同一时间访问 peter-acc ,因为两个帐号都已经被打开,而且两个帐号都试图访问关联帐号,这样就造成了一个死锁:除非 peter 或 mary 的其中一个主动退出账户,否则支付永远都无法完成。

3.50

(define (stream-map proc . argstreams)
  (if (stream-null? (car argstreams))
      the-empty-stream
      (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
5
5 ; 此为返回值,上方为 (display) 打印的值

> (stream-ref x 7)
6
7
7 ; 解释同上

> (stream-ref x 1)
1 ; 此时只有返回值,没有打印值了

可以看到,确实是在我们需要的时候才创建了相应的流(打印的同时创建了流)

3.52

> (define sum 0)
; sum = 0

> (define seq (stream-map accum (stream-enumerate-interval 1 20)))
; sum = 1

> (define y (stream-filter even? seq))
; sum = 6

> (define z (stream-filter (lambda (x) (= (remainder x 5) 0)) seq))
; sum = 10

> (stream-ref y 7)
; sum = 136

> (display-stream z)
; sum = 210

显然地,如果我们不使用 memo-proc 提供的优化,在每一次获取 stream-cdr 的值对它进行 force 时,都会重复它的求值过程。

3.53

和前文的 double 流一样,是 2 的各个幂

3.54

(define factorials
  (cons-stream 1 (mul-streams (stream-cdr integers)
                              factorials)))

3.55

(define (partial-sums stream)
  (cons-stream (stream-car stream)
               (add-streams (stream-cdr stream)
                            (partial-sums stream))))

3.56

(define S
  (cons-stream 1
               (merge (scale-stream S 2)
                      (merge (scale-stream S 3)
                             (scale-stream S 5)))))

这题虽然依着题目的提示很轻松就能做出来,但其中具体的原理似乎并不那么显然。我个人的理解是每一次 stream-cdr 实际将会调用这两个复合的 merge 过程,针对 S 这个流中的上一个元素,生成三个值,并且合并后附加在 S 这个流后面。在下一次 stream-cdr 的过程中,重复同样的事情,但针对的也仅是上次新生成的三个值中合并后的第一个。

3.57

直接应用书本上的 fib 过程,时间复杂度是 $\Theta(n)$ 。

如果显示的定义成 (lambda () <exp>) ,一个最突出的问题是所有的值都会被立刻求值,程序很快会溢出,其次,因为没有 memo-proc 的支持,在计算 (stream-cdr fib) 的过程中,整个 fib 会被重新求值一次,最终会产生 $\Theta(n^2)$ 的时间复杂度

3.58

直接将下面的表达式代入上方来计算

(expand 1 7 10) ,第一位是首先计算 1 * 10 / 7 的整除,然后计算余数的十倍 3 * 10 / 7 的整除,再计算余数的十倍 2 * 10 / 7 的整除

稍微一想就会发现,这就是个把分数化成小数的流,和手算除法的过程一模一样

3.59

a)

(define (integrate-series coeff-stream)
  (define (iter coeff-stream factor-den)
    (cons-stream (/ (stream-car coeff-stream) factor-den)
                 (iter (stream-cdr coeff-stream) (+ factor-den 1))))
  (iter coeff-stream 1))

b)

(define cosine-series
  (cons-stream 1 (integrate-series (cons-stream
                                    (- (stream-car sine-series))
                                    (stream-cdr sine-series)))))

(define sine-series
  (cons-stream 0 (integrate-series cosine-series)))

3.60

(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1) (stream-car s2))
               (add-streams
                (scale-stream (stream-cdr s2) (stream-car s1))
                (mul-series (stream-cdr s1) s2))))

3.61

(define (invert-coeff-stream S)
  (cons-stream 1 (scale-stream
                  (mul-streams
                   (stream-cdr S)
                   (invert-coeff-stream S))
                  -1)))

3.62

(define (div-series s1 s2)
  (if (= (stream-car s2) 0)
      (error "Zero denominator")
      (mul-series s1 (invert-coeff-stream s2))))

(define tangent-series
  (div-series sine-series cosine-series))

3.63

一个很显然的问题是 (sqrt-stream x) 是一个过程而非一个简单的约束(用 define guess 实现的版本,guess 就只是一个约束),每次访问流的下一个元素都会计算 (sqrt-stream x) 创造一个新的流。

但如果没有了 memo-proc 的优化,即便是在访问用约束定义的流的下一个元素的时候也需要重复之前的计算。

3.64

(define (stream-limit stream tolerance)
  (let ((s1 (stream-car stream))
        (s2 (stream-car (stream-cdr stream))))
    (if (< (abs (- s1 s2)) tolerance)
        s2
        (stream-limit (stream-cdr stream) tolerance))))

(define (sqrt x tolerance)
  (stream-limit (sqrt-stream x) tolerance))

3.65

(define (ln2-summands n)
  (cons (/ 1.0 n)
        (stream-map - (ln2-summands (+ n 1)))))

(define ln2-stream
  (partial-sums (ln2-summands 1)))

3.66

此题答案有误,但我想不出正确的答案..

(1, 100) 之前的项目个数都是 $\sum\limits_{n=1}^{99}n$

(100, 100) 之前的项目个数是 $\sum\limits_{n=1}^{99}n + 99$

可数组合表示

如图,元素的排列大致是按照上图的方式排列。前方具体有多少项目应该考虑以该项目所在列为界,左方的整个三角形的项目个数,再加上该项目所在列上方的项目数,也就是对于 (m, n) ,前方应该有 $\sum\limits_{a=1}^{n-1}a + (m - 1)$ 个项目

3.67

(define (pairs s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (interleave
    (stream-map (lambda (x) (list x (stream-car s))
                  (stream-cdr t)))
    (interleave
     (stream-map (lambda (x) (list (stream-car s) x))
                 (stream-cdr t))
     (pairs (stream-cdr s) (stream-cdr t))))))

3.68

可数组合的错误表示

更改后的程序中的项目排列顺序如图所示,可以看出不论如何进行 stream-cdr 操作,最多只能获得边界上的这些元素。

3.69

(define (triples s t u)
  (cons-stream
   (list (stream-car s)
         (stream-car t)
         (stream-car u))
   (interleave
    (stream-map
     (lambda (x) (append (list (stream-car s)) x))
     (stream-cdr (pairs t u)))
    (triples (stream-cdr s)
             (stream-cdr t)
             (stream-cdr u)))))

(define pythagorean
  (stream-filter (lambda (x)
                   (= (square (caddr x))
                      (+ (square (car x))
                         (square (cadr x)))))
                 (triples integers integers integers)))

3.70

(define (merge-weighted weight s1 s2)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((< (weight s1car) (weight s2car))
                  (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2)))
                 ((> (weight s1car) (weight s2car))
                  (cons-stream s2car (merge-weighted weight s1 (stream-cdr s2))))
                 (else
                  (cons-stream s1car
                               (cons-stream s2car
                                            (merge-weighted weight (stream-cdr s1) (stream-cdr s2))))))))))

(define (pairs-weighted weight s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (merge-weighted
    weight
    (stream-map (lambda (x) (list (stream-car s) x))
                (stream-cdr t))
    (pairs-weighted weight (stream-cdr s) (stream-cdr t)))))

(define x (pairs-weighted
           (lambda (x) (+ (car x) (cadr x)))
           integers
           integers))

(define y
   (stream-filter
    (lambda (x)
      (let ((i (car x)) (j (cadr x)))
        (or (or (= (remainder i 2) 0) (= (remainder j 2) 0))
            (or (= (remainder i 3) 0) (= (remainder j 3) 0))
            (or (= (remainder i 5) 0) (= (remainder j 5) 0)))))
    (pairs-weighted
     (lambda (x)
       (let ((i (car x)) (j (cadr x)))
         (+ (* 2 i) (* 3 j) (* 5 i j))))
     integers
     integers)))

3.71

(define (cube-sums l)
    (+ (cube (car l)) (cube (cadr l))))

(define (find-ram stream)
  (let ((l1 (stream-car stream))
        (l2 (stream-car (stream-cdr stream))))
    (let ((s1 (cube-sums l1))
          (s2 (cube-sums l2)))
      (if (= s1 s2)
          (cons-stream (list l1 l2 s1)
                       (find-ram (stream-cdr (stream-cdr stream))))
          (find-ram (stream-cdr stream))))))

(define Ramanujan
  (find-ram (pairs-weighted cube-sums integers integers)))
> (display-stream-n Ramajuan 6)
((1 12) (9 10) 1729)
((2 16) (9 15) 4104)
((2 24) (18 20) 13832)
((10 27) (19 24) 20683)
((4 32) (18 30) 32832)
((2 34) (15 33) 39312)
done

这里的 display-stream-n 是我自己写的一个可控的输出流的小过程

3.72

(define (find-ram-ex stream)
  (let ((l1 (stream-car stream))
        (l2 (stream-car (stream-cdr stream)))
        (l3 (stream-car (stream-cdr (stream-cdr stream)))))
    (let ((s1 (cube-sums l1))
          (s2 (cube-sums l2))
          (s3 (cube-sums l3)))
      (if (= s1 s2 s3)
          (cons-stream (list l1 l2 l3 s1)
                       (find-ram-ex (stream-cdr (stream-cdr stream))))
          (find-ram-ex (stream-cdr stream))))))

(define Ramanujan-ex
  (find-ram-ex (pairs-weighted cube-sums integers integers)))
> (display (stream-car Ramanujan-ex))
((167 436) (228 423) (255 414) 87539319)

只敢输出一个结果,太耗时了

3.73

(define (RC R C dt)
  (define (inner i v0)
    (add-streams
     (scale-stream i R)
     (integral (scale-stream i (/ 1.0 C)) v0 dt)))
  inner)

3.74

(define zero-crossings
  (stream-map sign-change-detector sense-data (stream-cdr sense-data)))

3.75

(define (make-zero-crossings input-stream last-value last-avpt)
  (let ((avpt (/ (= (stream-car input-stream) last-value) 2)))
    (cons-stream (sign-cahnge-detector avpt last-avpt)
                 (make-zero-crossings (stream-cdr input-stream)
                                      (stream-car input-stream)
                                      avpt))))

3.76

(define (make-zero-crossings input-stream)
  (let ((smoothed-stream (smooth input-stream)))
    (define (inner stream last-value)
      (cons-stream (sign-cahnge-detector (stream-car stream) last-value)
                   (inner (stream-cdr stream)
                          (stream-car stream))))
    (inner smoothed-stream 0)))

(define (smooth stream)
  (stream-map (lambda (x y)
                (/ (+ x y) 2))
              stream
              (stream-cdr stream)))

3.77

(define (integral integrand initial-value dt)
  (cons-stream initial-value
               (if (stream-null? integrand)
                   the-empty-stream
                   (integral (stream-cdr integrand)
                             (+ (* dt (stream-car (force integrand)))
                                initial-value)
                             dt))))

3.78

(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)

3.79

(define (solve-2nd a b dt y0 dy0)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (stream-map f dy y))
  y)

3.80

(define (RLC R L C dt)
  (define (inner vc0 il0)
    (define vc (integral (delay dvc) vc0 dt))
    (define il (integral (delay dil) il0 dt))
    (define dil (add-streams (scale-stream vc (/ 1.0 L))
                             (scale-stream il (- (/ R L)))))
    (define dvc (scale-stream il (- (/ 1.0 C))))
    (cons vc il)))

3.81

这题不是很清楚它说的“对表示输入的流操作”是什么意思,跳过了..(看了后面的一页..知道是什么意思了,但我还是要跳过!)

3.82

(define (integral-test p x1 x2 y1 y2)
  (let ((rand-x (random-in-range x1 x2)))
    (let ((rand-y (stream-cdr rand-x)))
      (cons-stream (p rand-x rand-y)
                   (integral-test p
                                  (stream-cdr (stream-cdr rand-x))
                                  (stream-cdr (stream-cdr rand-y)))))))

(define (estimate-integral p x1 x2 y1 y2 trails)
  (let ((x-len (- x2 x1))
        (y-len (- y2 y1)))
    (stream-map (lambda(x)
                  (* x x-len y-len))
                (monte-carlo (integral-test p x1 x2 y1 y2) 0 0))))
Archives QR Code
QR Code for this page
Tipping QR Code
Leave a Comment

已有 2 条评论
  1. 迷妹 迷妹

    我的天,看的头皮发麻,大佬球!

  2. 迷弟 迷弟

    我的天,看的头皮发麻,大佬球!