3fen's Notebook: 2008年4月

4月25日

2.86 答案

感觉这道题比较无聊，把complex包中的+-*/编程add sub mul div，再把square sqrt cosine sine atan稍微改写一下（大部分都是体力活）就ok了，我只简单测试了一下，不知道里面有没有别的玄机。

2.85 答案

这里我遇到一个问题：虽然project和drop都写出来了，但是当drop用来化简apply-generic时，drop又需要调用apply-generic过程，造成死循环，解决方法未明，待续……

08/5/19 :把drop改的很丑陋，目的就是尽量的不调用apply-generic，不过实验结果是（add complex1 complex2）结果ok，

但是(add complex1 rational-number1)就又进入死循环。
08/7/2 决定再看看这题，终于发现了问题所在：原因不是drop递归调用，而是因为apply-generic会自动调用drop化简结果，所以其中用来进行类型转换的raise语句如果也用(apply-generic 'raise ...)就起不到转换的作用，从而使类型raise后又drop掉，造成死循环。解决方法是用了句很生硬的(apply (get 'raise (list type1)) (list (contents a1)))进行raise的操作

(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (drop (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 (< (type->weight type1)
                           (type->weight type2))
                        (apply-generic op (apply (get 'raise (list type1)) (list (contents a1))) a2)
                        (apply-generic op a1 (apply (get 'raise (list type2)) (list (contents a2)))))))
              (else (error "No method for these types"
                           (list op type-tags))))))))

(define (drop x)
(let ((project-for-this (get 'project (list (type-tag x)))))
    (if (not project-for-this)
        x
        (let ((project-result (project-for-this (contents x))))
          (let ((raise-for-this (get 'raise
                                     (list (type-tag project-result)))))
            (let ((raise-result (raise-for-this (contents project-result))))
              (if (not (equ? raise-result x))
                  x
                  (drop project-result))))))))

0:06 | 添加评论 | 固定链接 | 写入日志 | SICP

2.84 答案

我觉得难点在于怎样比较类型的“高度”。我用了比较笨的方法——为每一个类型加一个权重。以后想到或者看到更好的方法再改吧。

在apply-generic中判断了一下“高度”再进行相互的转化，而且可以连续raise。这样就不需要scheme-number->complex这样的过程了。

;------------type/weight--------
(define (type->weight t)
(cond ((eq? t 'scheme-number) 0)
        ((eq? t 'rational) 1)
        ((eq? t 'complex) 2)
        (else (error "Unknown type: " t))))

(define (weight->type w)
(cond ((= w 0) 'scheme-number)
        ((= w 1) 'rational)
        ((= w 2) 'complex)))
;----------apply-generic---------
(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 (< (type->weight type1)
                           (type->weight type2))
                        (apply-generic op (raise a1) a2)
                        (apply-generic op a1 (raise a2)))))
              (else (error "No method for these types"
                           (list op type-tags))))))))

0:05 | 添加评论 | 固定链接 | 写入日志 | SICP

2.83 答案

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

(put 'raise '(scheme-number)
(lambda(x) (make-rational x 1)))

(put 'raise '(rational)
(lambda(x) (make-complex-from-real-imag (/ (numer x) (denom x)) 0)))

complex包中没有raise过程

0:01 | 添加评论 | 固定链接 | 写入日志 | SICP

2.82 答案

;例子：安装包内有complex的exp运算，但是没有scheme-number的。当运算(exp scheme-number1 scheme-number2)时就会发生错误。
;我想出的解决方法是后面题中用的raise，把所有参数从低到高都试一次。

0:00 | 添加评论 | 固定链接 | 写入日志 | SICP

4月24日

2.81 答案

;a)死循环。因为apply-generic执行的时候会把两个复数自己转换类型，然后重新拿apply-generic来运行。
;b)没有，之前如果同类型的运算不存在的话会弹错，但是Louis的程序会造成死循环。
;c)在第一个let后面加入判断类型语句即可。

;----------apply-generic---------
(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))
                    (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))))))
                (else (error "No method for these types"
                             (list op type-tags)))))))))

23:59 | 添加评论 | 固定链接 | 写入日志 | SICP

2.80 答案

(define (=zero? x) (apply-generic '=zero? x))
(put '=zero? '(scheme-number)
     (lambda(x) (= x 0)))
(put '=zero? '(rational)
     (lambda(x) (= (numer x) 0)))
(put '=zero? '(complex)
     (lambda(z) (= (magnitude z) 0)))

23:58 | 添加评论 | 固定链接 | 写入日志 | SICP

2.79 答案

(define (equ? x y) (apply-generic 'equ? x y))
(put 'equ? '(scheme-number scheme-number)
     (lambda(x y) (= x y)))
(put 'equ? '(rational rational)
     (lambda(x y) (= (/ (numer x) (denom x))
                     (/ (numer y) (denom y)))))
(put 'equ? '(complex complex)
     (lambda(x y) (and (= (real-part x) (real-part y))
                       (= (imag-part x) (imag-part y)))))

只写出了改动的部分，第一句在最外层，剩下的各包含在各自的pachage中.

23:58 | 添加评论 | 固定链接 | 写入日志 | SICP

2.78 答案

;----------type-tag-----------
(define (type-tag datum)
(if (pair? datum)
      (car datum)
      'scheme-number))
;---------contents------------
(define (contents datum)
(if (pair? datum)
      (cdr datum)
      datum))

(define (tag x) (attach-tag 'complex x))

23:56 | 添加评论 | 固定链接 | 写入日志 | SICP

2.77 答案

除了加入题中所说的put语句，还要在最外层加入(define (magnitude z) (apply-generic 'magnitude z))

题目很简单，容易看出apply-generic分派了两次:一次去掉complex，一次去掉rectangular或者polar。

敲了这么长的代码，出了点小错误，不过也从中了解到为什么make过程中的类型都没有括号：比如'rectangular 'polar 'rational 'complex，而用apply-generic分派计算过程的时候就需要'(rectangular) '(complex)。这个我认为是由于apply-generic过程中的type-tags是一个list，所以总会比make中的类型多出一层括号。

0:04 | 添加评论 | 固定链接 | 写入日志 | SICP

4月20日

3.8 答案

;2008/4/20
;3.8
;加了全局变量，不知算不算犯规
(define bug 1)
(define (f x)
(set! bug (* bug x))
bug)

23:11 | 添加评论 | 固定链接 | 写入日志 | SICP

3.7 答案

;2008/4/20
;3.7

;需要一个可以沟通make-joint和make-account的路径,这里用的全局变量。不过这样在有并发存在的时候，不同帐户的切换可能出现问题。
(define is-psw-right? #f)

(define (make-joint account old-password new-password)
(account old-password 'do-nothing)
(if is-psw-right?
      (lambda(new-psw act)
        (if (eq? new-psw new-password)
            (account old-password act)
            (lambda(x)
              "Wrong Joint Password")))        (lambda(new-psw act)
        (lambda(x)
          "Unavailable Joint"))))

;---------
(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 m)
    (cond ((eq? m 'withdraw) withdraw)
          ((eq? m 'deposit) deposit)
          (else "UNKNOWN request")))
(lambda (psw act)
    (if (eq? psw password)
        (begin
          (set! is-psw-right? #t)
          (dispatch act))
        (begin
          (set! is-psw-right? #f)
          (lambda(x)"Incorrect password!")))))

;;-------test
(define Hanmeimei (make-account 100 'hmm))
(define Lilei (make-joint Hanmeimei 'hmm 'll))
(define Jim (make-joint Hanmeimei 'ilovejim 'metoo))

> ((Hanmeimei 'hmm 'withdraw) 10)
90
> ((Lilei 'll 'withdraw) 10)
80
> ((Lilei 'lll 'withdraw) 10)
"Wrong Joint Password"
> ((Jim 'metoo 'withdraw) 10)
"Unavailable Joint"

23:11 | 添加评论 | 固定链接 | 写入日志 | SICP

3.6答案

;2008/4/22
;3.6

(define random
(let ((seed 1))
    (define (rand-update x)
      (remainder (+ 37 (* x 16807)) 2147483647))

    (lambda(act)
      (cond ((eq? act 'generate)
             (begin (set! seed (rand-update seed))
                    seed))
            ((eq? act 'reset)
             (lambda(new-value)
               (begin (set! seed (new-value))
                      (rand-update seed))))
            (else "Unknown act")))))

;-------------开始写的一个错误结果----------
;(define (random act)
; (let ((seed 1))
;    (define (rand-update x)
;      (remainder (+ 37 (* x 16807)) 2147483647))
;
;
;      (cond ((eq? act 'generate)
;             (begin (set! seed (rand-update seed))
;                    seed))
;            ((eq? act 'reset)
;             (lambda(new-value)
;               (begin (set! seed (new-value))
;                      (rand-update seed))))
;            (else "Unknown act"))))

后来把错误简化了一下提出来看就是：

(define add-by-1
(let ((seed 1))
    (lambda()
      (begin (set! seed (+ seed 1))
             seed))))
;-------------------------
(define (add-by--1)
(let ((seed 1))
    (begin(set! seed (+ seed 1))
          seed)))

这两个过程反复执行结果是不一样的，前者是2/3/4..后者是2/2/2...

原因不明，推测是解释器解释的不同么

23:09 | 添加评论 | 固定链接 | 写入日志 | SICP

3.5 答案

;2008/4/18
;3.5

(define (random-in-range low high)
(let ((range (- high low)))
(+ low (* (random) range))))

;用(* (random) range)而不是(random range)有两个好处：
; 1、random参数只能为正，所以前者省却了一些绝对值转化的语句
; 2、貌似前者得出的结果比后者要准确一点(我计算的题目中的面积：前者28左右，后者27左右)
;-------monte-carlo---------
(define (monte-carlo trials experiment)
(define (iter trials-remaining trials-passing)
    (cond ((= trials-remaining 0)
           (/ trials-passing trials))
          ((experiment)
           (iter (- trials-remaining 1) (+ trials-passing 1)))
          (else (iter (- trials-remaining 1) trials-passing))))
(iter trials 0))
;----estimate-integral-----------

(define (estimate-integral p x1 x2 y1 y2 times)
(define (e-i-test)
    (p (random-in-range x1 x2)
       (random-in-range y1 y2)))
(define (rect-area)
      (* (abs (- x1 x2))
         (abs (- y1 y2))))
(let ((possibility (monte-carlo times e-i-test)))
    (* possibility (rect-area))))

23:09 | 添加评论 | 固定链接 | 写入日志 | SICP

4月17日

3.4 答案

;2008/4/17
;3.4
(define (make-account balance password)
(let ((deadtimes 0))
    (define (withdraw amount)
      (if (>= balance amount)
          (begin (set! balance (- balance amount))
                 balance)
          "Insufficient funds"))
    (define (deposit amount)
      (set! balance (+ balance amount))
      balance)
    (define (dispatch m)
      (cond ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            (else "UNKNOWN request")))
    (define (incorrect-psw)
      (define (call-the-cops)
        (display "你栽了！"))
      (set! deadtimes (+ deadtimes 1))
      (if (>= deadtimes 7)
          (call-the-cops)
          "Incorrect Passord"))

    (lambda (psw act)
      (if (eq? psw password)
          (begin (set! deadtimes 0)
                 (dispatch act))
          (lambda(x)(incorrect-psw))))))

22:10 | 添加评论 | 固定链接 | 写入日志 | SICP

3.3 答案

;2008/4/17
;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 m)
    (cond ((eq? m 'withdraw) withdraw)
          ((eq? m 'deposit) deposit)
          (else "UNKNOWN request")))
(lambda (psw act)
    (if (eq? psw password)
        (dispatch act)
        (lambda(x)"Incorrect password!"))))

22:08 | 添加评论 | 固定链接 | 写入日志 | SICP

3.2 答案

(define (make-monitored f)
(let ((times 0))
    (lambda(x)(if (= x 'how-many-calls?)
                  times
                  (begin (set! times (+ 1 times))
                         (f x))))))

22:08 | 添加评论 | 固定链接 | 写入日志 | SICP

3.1 答案

颓了先写简单的第二章剩下的那部分以后补完

;2008/4/17
(define (make-accumulator init)
(lambda(x)(set! init (+ init x))
init))

22:07 | 添加评论 | 固定链接 | 写入日志 | SICP