問題3.5-3.20

実は3章までやってあるので、途中から始めます。
今日は問題3.5-3.20を飛ばしつつやりました。

3.5

(define (estimate-pi trials)
  (sqrt (/ 6 (monte-carlo trials cesaro-test))))
(define (cesaro-test)
  (= (gcd (+ 1 (random 1000)) (+ 1 (random 1000))) 1))
(define (monte-carlo trials experiment)
  (define (iter trials-remaining trials-passed)
    (cond ((= trials-remaining 0)
           (/ trials-passed trials))
          ((experiment)
           (iter (- trials-remaining 1) (+ trials-passed 1)))
          (else
           (iter (- trials-remaining 1) trials-passed))))
  (iter trials 0))

(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (random range))))
(define (estimate-integral P x1 y1 x2 y2 n)
  (* (- x2 x1)
     (- y2 y1)
     (monte-carlo n (lambda () (P (random-in-range x1 x2)
                                  (random-in-range y1 y2))))))
;x^2 + y^2 <= 1
(define (P1 x y) (<= (+ (sqr x) (sqr y)) 1))

(define (estimate-pi-2 n) (estimate-integral P1 -1 -1 1 1 n))

> (estimate-pi-2 10000.0)
3.0072
> (estimate-pi-2 100000.0)
2.99964

精度はあまりよくないらしい。

3.6

省略

3.7

(define (make-account2 balance pass)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (call-the-cops amount) "call-the-cops")
  (define (pass-error amount) "Incorrect password")
  (define (element-of-set x set)
    (cond ((null? set) #f)
          ((eq? x (car set)) #t)
          (else (element-of-set x (cdr set)))))
  (define pass-list (list pass))
  (define (add-pass lst new-pass)
    (if (null? (cdr lst))
        (set-cdr! lst (cons new-pass '()))
        (add-pass (cdr lst) new-pass)))
  (let ((count 0))
    (define (dispatch p m)
      (cond ((not (element-of-set p pass-list)) 
             (set! count (+ count 1))
             (if (>= count 7)
                 call-the-cops
                 pass-error))
            ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            ((eq? m 'add-pass) (lambda (x) (add-pass pass-list x))) ;;added
            (else (error "Unknown request -- MAKE=ACCOUNT"
                         m))))
    dispatch))

(define (make-joint acc pass1 pass2)
  ((acc pass1 'add-pass) pass2)
  acc)

add-passというメッセージを追加して、パスワードをリストで管理するようにしてみました。
ただ、口座の名前に対応するパスワードでなくても、口座にアクセスできるようになってます。
口座の名前とパスワードを組にしたリストを作ればたぶん直せるはずだけど、
面倒なのでとりあえずこれでいいや。共有口座だし別にいいよね…。

3.8

(define f
  (let ((n 1))
    (lambda (x) 
      (if (= x n)
          (begin (set! n 1) 1)
          (begin (set! n 0) 0)))))

(f 0) (f 1) の順に評価すると、

> (f 0)
0
> (f 1)
0

(f 1) (f 0) の順に評価すると、

> (f 1)
1
> (f 0)
0

となります。
(+ (f 0) (f 1))を評価すると、

> (+ (f 0) (f 1))
0

ということなので、左から評価されているみたいです。

3.9-3.13

やったけど図を載せるのがめんどいので省略。

3.14

(define (mystery x)
  (define (loop x y)
    (if (null? x)
        y
        (let ((temp (cdr x)))
          (set-cdr! x y)
          (loop temp x))))
  (loop x '()))

mysteryは一般にリストxの要素を逆順にしたリストを返す手続き。
箱とポインタ図は省略。

3.15

省略

3.16

(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
         (count-pairs (cdr x))
         1)))

リスト構造中の少なくとも1つの対で、carとcdr両方が既にある対を指しているような時、正しくない。たぶん。
二つ以上の矢印で指されているような対が1つでもあれば正しくない、に訂正しておきます。これもたぶんですが。(12/17 3:57)


特に3つの対で出来ているようなリスト構造で、この手続きが3,4,7を返すもの、何も返さないものをそれぞれ例として挙げる。
箱とポインタ図は省略。

3を返す
> (count-pairs (cons 1 (cons 2 (cons 3 '()))))
3
4を返す
> (define a '(3))
> (count-pairs (cons 1 (cons a a)))
4
7を返す
> (define a '(3))
> (define b (cons a a))
> (count-pairs (cons b b))
7
何も返さない
> (define a '(3))
> (define b (cons 2 a))
> (define c (cons 1 b))
> c
(1 2 3)
> (set-cdr! a c)
> c
#0=(1 2 3 . #0#)
> (count-pairs c)

3.17

(define (count-pairs2 x)
  (define (iter2 examineds)
    (define (iter x)
      (cond ((not (pair? x)) 0)
            ((memq x examineds) 0)
            (else (set! examineds (cons x examineds))
                  (+ (iter (car x))
                     (iter (cdr x))
                     1))))
    iter)
  ((iter2 '()) x))

examinedsに既に調べた対をいれて、リストとして管理します。
なので、memqによって現在の対と同じ対がexaminedsに入っていれば、既に調べたものなので足さなくていいことになります。

memqはどうやらアドレスで比較をしているみたいなので、これで上手くいくみたいです。

> (define a '(1 2))
> (define b '(1 2))
> (memq a (list a b))
((1 2) (1 2))
> (memq a (list b b ))
#f
> (memq '(1 2) '((1 2) (1 2)))
#f
> (memq a '((1 2) (1 2)))
#f

3.18

3.17のようにリストを作ればいいので省略

3.19

よく分からないので省略

3.20

図を載せられないので省略


今日はここまで。