計算機プログラムの構造と解釈問題の解

λ2.1節

問題 2.1　問題 2.2　問題 2.3　問題 2.4　問題 2.5　
問題 2.6　問題 2.7　問題 2.8　問題 2.9　問題 2.10　
問題 2.11　問題 2.12　問題 2.13　問題 2.14　問題 2.15　
問題 2.16　

問題 2.1

(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))

(define (make-rat n d)
  (let ((g (abs (gcd n d))))
     (if (< d 0)
         (cons (/ (- n) g) (/ (- d) g))
         (cons (/ n g) (/ d g)))))

問題 2.2

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))

(define (make-segment s e) (cons s e))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))

(define (midpoint-segment seg)
  (define (average a b) (/ (+ a b) 2))
  (make-point
    (average (x-point (start-segment seg))
             (x-point (end-segment seg)))
    (average (y-point (start-segment seg))
             (y-point (end-segment seg)))))

(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

問題 2.3

長方形を相隣る2辺の長さ side0, side1の長さで表現する. 

(define (make-rectangle side0 side1) (cons side0 side1))
(define (side0 rec) (car rec))
(define (side1 rec) (cdr rec))

(define (perimeter rec) (* (+ (side0 rec) (side1 rec)) 2))
(define (area rec) (* (side0 rec) (side1 rec)))

(define rec0 (make-rectangle 30 40))

(perimeter rec0)
(area rec0)


辺がx軸, y軸に平行な長方形を対角で相対する頂点 corner0, corner1 の座標で表現する. 

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))

(define (make-rectangle corner0 corner1)
  (cons corner0 corner1))
(define (corner0 rec) (car rec))
(define (corner1 rec) (cdr rec))
(define (side0 rec) (abs (- (x-point (corner0 rec))
                            (x-point (corner1 rec)))))
(define (side1 rec) (abs (- (y-point (corner0 rec))
                            (y-point (corner1 rec)))))

(define (perimeter rec) (* (+ (side0 rec) (side1 rec)) 2))
(define (area rec) (* (side0 rec) (side1 rec)))

問題 2.4

(define (cons x y)
  (lambda (m) (m x y)))

(define (car z)
  (z (lambda (p q) p)))

(define (cdr z)
  (z (lambda (p q) q)))

(car (cons x y)) = x をやってみる. 

(car (cons 1 2)) consを定義で置き換える. 

(car (lambda (m) (m 1 2))) carを定義で置き換える. 

((lambda (m) (m 1 2)) (lambda (p q) p)) mを(lambda (p q) p)で置き換える. 

((lambda (p q) p) 1 2) p q を1 2 で置き換える. 

1

問題 2.5

(define (fast-expt b n)
  (cond ((= n 0) 1)
        ((even? n) (square (fast-expt b (/ n 2))))
        (else (* b (fast-expt b (- n 1))))))

(define (even? n)
  (= (remainder n 2) 0))

(define (square x) (* x x))

(define (pcons x y)
  (* (fast-expt 2 x) (fast-expt 3 y)))

(define (pcar z)
  (if (= (remainder z 2) 0)
      (+ 1 (pcar (/ z 2)))
      0))

(define (pcdr z)
  (if (= (remainder z 3) 0)
      (+ 1 (pcdr (/ z 3)))
      0))

問題 2.6

(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
 (lambda (f) (lambda (x) (f ((n f) x)))))

one=(add-1 zero)
{定義を代入}
=((λ(n) (λ(f) (λ(x) (f ((n f) x))))) (λ(f) (λ(x) x)))
{(λ(f) (λ(x) (f ((n f) x))))の n に(λ(f) (λ(x) x))を代入}
=(λ(f) (λ(x) (f (((λ(f) (λ(x) x)) f) x))))
{((λ(f) (λ(x) x)) f)を評価する (λ(x) x)のfにfを代入}
=(λ(f) (λ(x) (f ((λ(x) x) x))))
{((λ(x) x) x)を評価する xになる}
=(λ(f) (λ(x) (f x)))

one= (lambda (f) (lambda (x) (f x)))

two=(add-1 one)
{定義を代入}
=((λ(n) (λ(f) (λ(x) (f ((n f) x))))) (λ(f) (λ(x) (f x))))
{(λ(f) (λ(x) (f ((n f) x))))の n に(λ(f) (λ(x) (f x)))を代入}
=(λ(f) (λ(x) (f (((λ(f) (λ(x) (f x))) f) x))))
{((λ(f) (λ(x) (f x))) f)を評価する (λ(x) (f x))のfにfを代入}
=(λ(f) (λ(x) (f ((λ(x) (f x)) x))))
{((λ(x) (f x)) x)を評価する (f x)になる}
=(λ(f) (λ(x) (f (f x))))

two= (lambda (f) (lambda (x) (f (f x))))

(define (church+ m n)
 (lambda (f) (lambda (x) ((m f) ((n f) x)))))


注 これをSchemeを使って調べてみる．

(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
 (lambda (f) (lambda (x) (f ((n f) x)))))

(define one (lambda (f) (lambda (x) (f x))))

(define two (lambda (f) (lambda (x) (f (f x)))))

と定義しておく．これを見ると one は 引数として1引数の関数をとり，それ
を1回作用させる関数を返し, two は同様に2回作用させる関数を返す．そこで
作用させる関数として inc を定義し，(one inc)が返した関数を0に作用させ
るようなことをやってみる．

(define (inc n) (+ n 1))

((zero inc) 0) ==> 0

((one inc) 0) ==> 1

((two inc) 0) ==> 2

次に church+ を使い two + two で four を作り，同様にやってみる．

(define (church+ m n)
 (lambda (f) (lambda (x) ((m f) ((n f) x)))))

(define four (church+ two two))

((four inc) 0) ==> 4

問題 2.7

問題 2.10の解答の始めの方参照.

問題 2.8

(define (sub-interval x y)
  (make-interval (- (lower-bound x) (upper-bound y))
                 (- (upper-bound x) (lower-bound y))))

問題 2.9
区間 a の幅 a_wは(a↑-a↓)/2.　区間 x と区間 y の和 x+y の幅は

(x+y)_w=((x+y)↑-(x+y)↓)/2=((x↑+y↑)-(x↓+y↓))/2
=(x↑-x↓)/2 + (y↑-y↓)/2=x_w+y_w

区間 x と区間 y の差 x-y の幅は

(x-y)_w=((x-y)↑-(x-y)↓)/2=((x↑-y↓)-(x↓-y↑))/2
=(x↑-x↓)/2 + (y↑-y↓)/2=x_w+y_w

乗算, 除算についてはテストしてみると

(define a (make-interval 9 11))
(width a) ==> 1
(define b (make-interval 1 3))
(width b) ==> 1
(define c (make-interval 19 21))
(width c) ==> 1
(width (mul-interval a b)) ==> 12
(width (mul-interval a c)) ==> 30
(width (div-interval a b)) ==> 4

となり乗数, 被乗数, 除数, 被除数の単純な関数にはならない.

問題 2.10

(define (make-interval a b) (cons a b))
(define (lower-bound x) (car x))
(define (upper-bound x) (cdr x))

(define (new-mul-interval x y)
  (let ((xl (lower-bound x)) (xu (upper-bound x))
        (yl (lower-bound y)) (yu (upper-bound y)))
  (cond ((< xu 0)
         (cond ((< yu 0) (make-interval (* xu yu) (* xl yl)))
               ((< yl 0) (make-interval (* xl yu) (* xl yl)))
               (else     (make-interval (* xl yu) (* xu yl)))))
        ((< xl 0)
         (cond ((< yu 0) (make-interval (* xu yl) (* xl yl)))
               ((< yl 0) (make-interval (min (* xl yu) (* xu yl)) 
                                        (max (* xl yl) (* xu yu))))
               (else     (make-interval (* xl yu) (* xu yu)))))
        (else
         (cond ((< yu 0) (make-interval (* xu yl) (* xl yu)))
               ((< yl 0) (make-interval (* xu yl) (* xu yu)))
               (else     (make-interval (* xl yl) (* xu yu))))))))

(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

(define (new-div-interval x y)
  (let ((yl (lower-bound y)) (yu (upper-bound y)))
    (if (and (< yl 0) (< 0 yu))
        (error "divisor interval spans zero" yl yu)
        (mul-interval x
                      (make-interval (/ 1.0 yu) (/ 1.0 yl))))))

問題 2.11
Benの指摘した九つの場合は次のとおり. x↓はxのlower bound, x↑はxのupper bound. ↓()はmin, ↑()はmaxの意.
x < 0は x↑ < 0 (当然 x↓ < 0), x > 0は x↓ > 0 (当然 x↑ > 0), x = 0はx↓ < 0でx↑ > 0. (yについても同様)
各場合について積のlower, upper boundに何の積を計算するかを示す.

	y < 0	y = 0	y > 0
x < 0	x↑y↑, x↓y↓	x↓y↑, x↓y↓	x↓y↑, x↑y↓
x = 0	x↑y↓, x↓y↓	↓(x↓y↑, x↑y↓), ↑(x↓y↓, x↑y↑)	x↓y↑, x↑y↑
x > 0	x↑y↓, x↓y↑	x↑y↓, x↑y↑	x↓y↓, x↑y↑

この表からわかるように, 中央の場合だけが乗算を4回必要とする.

(define (make-interval a b) (cons a b))
(define (lower-bound x) (car x))
(define (upper-bound x) (cdr x))

(define (new-mul-interval x y)
  (let ((xl (lower-bound x)) (xu (upper-bound x))
        (yl (lower-bound y)) (yu (upper-bound y)))
  (cond ((< xu 0)
         (cond ((< yu 0) (make-interval (* xu yu) (* xl yl)))
               ((< yl 0) (make-interval (* xl yu) (* xl yl)))
               (else     (make-interval (* xl yu) (* xu yl)))))
        ((< xl 0)
         (cond ((< yu 0) (make-interval (* xu yl) (* xl yl)))
               ((< yl 0) (make-interval (min (* xl yu) (* xu yl)) 
                                        (max (* xl yl) (* xu yu))))
               (else     (make-interval (* xl yu) (* xu yu)))))
        (else
         (cond ((< yu 0) (make-interval (* xu yl) (* xl yu)))
               ((< yl 0) (make-interval (* xu yl) (* xu yu)))
               (else     (make-interval (* xl yl) (* xu yu))))))))

(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

(define xp (make-interval 2 3))
(define yp (make-interval 4 5))
(define xm (make-interval -5 -4))
(define ym (make-interval -3 -2))
(define xz (make-interval -2 1))
(define yz (make-interval -1 2))

(display (new-mul-interval xp yp)) (display (mul-interval xp yp)) (newline)
(display (new-mul-interval xp yz)) (display (mul-interval xp yz)) (newline)
(display (new-mul-interval xp ym)) (display (mul-interval xp ym)) (newline)
(display (new-mul-interval xz yp)) (display (mul-interval xz yp)) (newline)
(display (new-mul-interval xz yz)) (display (mul-interval xz yz)) (newline)
(display (new-mul-interval xz ym)) (display (mul-interval xz ym)) (newline)
(display (new-mul-interval xm yp)) (display (mul-interval xm yp)) (newline)
(display (new-mul-interval xm yz)) (display (mul-interval xm yz)) (newline)
(display (new-mul-interval xm ym)) (display (mul-interval xm ym)) (newline)

問題 2.12

(define (make-center-percent c p)
  (let ((w (/ (* c (/ p 100)) 2)))
    (make-center-width c w)))

(define (percent i)
  (* (/ (- (upper-bound i) (lower-bound i)) (center i)) 100))

問題 2.13
掛ける数をm0, m1としそれぞれの中央値をc0, c1, パーセント誤差の100分の1を p0, p1とするとm0, m1の下限, 上限はそれぞれ
m0_l=c0-(c0*p0)/2, m0_u=c0+(c0*p0)/2
m1_l=c1-(c1*p1)/2, m1_u=c1+(c1*p1)/2
m0,m1が正だから積pの下限, 上限は被乗数の下限の積, 上限の積になる. したがって
p_l=c0*c1-c0*(c1*p1)/2-c1*(c0*p0)/2+(c0*p0)*(c1*p1)/4
第4項はp0*p1が小さいとして無視すれば
=c0*c1-(c0*c1)*(p0+p1)/2
同様に
p_u=c0*c1+c0*(c1*p1)/2+c1*(c0*p0)/2+(c0*p0)*(c1*p1)/4
=c0*c1+(c0*c1)*(p0+p1)/2
つまりp0+p1をパーセント誤差とする式になる.

問題 2.14

(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

(define (sub-interval x y)
  (make-interval (- (lower-bound x) (lower-bound y))
                 (- (upper-bound x) (upper-bound y))))

(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

(define (div-interval x y)
  (mul-interval x 
                (make-interval (/ 1.0 (upper-bound y))
                               (/ 1.0 (lower-bound y)))))

(define (make-interval a b) (cons a b))
(define (upper-bound i) (cdr i))
(define (lower-bound i) (car i))

(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))

(define (make-center-percent c p)
  (let ((w (/ (* c (/ p 100)) 2)))
    (make-center-width c w)))

(define (percent i)
  (* (/ (- (upper-bound i) (lower-bound i)) (center i)) 100))

(define (center i)
  (/ (+ (upper-bound i) (lower-bound i)) 2))

;以上の準備のあと, いろいろ計算し, 誤差を調べてみる. 

(define a (make-center-percent 100 1))
(define b (make-center-percent 200 1))
(percent a) ==> 1
(percent b) ==> 1
(define q0 (div-interval a a))
(percent q0) ==> 1.9999500012499796  ;1%どうしを割って2$の誤差になった. 
(define q1 (div-interval a b))
(percent q1) ==> 1.9999500012499796  ;同様

;1を定義して抵抗の計算みたいなことをやってみる. 

(define one (make-center-percent 1 0))

(define p (mul-interval a b))
(define s (add-interval a b))
(percent p) ==>  80000/40001
(exact->inexact (percent p)) ==> 1.9999500012499687  ;積の誤差は2%
(percent s) ==> 1                                    ;和の誤差は1%
(percent (div-interval p s)) ==> 2.999800014998875   ;並列抵抗の誤差は3%

(define r0 (div-interval one a))
(percent r0) ==> 1.0000000000000036     ;1/aの誤差は1%
(define r1 (div-interval one b))
(percent r1) ==> 1.0000000000000036     ;1/bの誤差は1%
(define s0 (add-interval r0 r1))
(percent s0) ==>  .9999999999999978     ;分母の誤差は1%
(define r (div-interval one s0))
(percent r) ==> .9999999999999858       ;並列抵抗の誤差は1%

誤差のあるデータが演算に入るたびに誤差が増える傾向にある.

問題 2.15

;par1には不確かな変数が4回, par2には2回現れる. 実験してみると


(define (par1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))
(define (par2 r1 r2)
  (let ((one (make-interval 1 1))) 
    (div-interval one
                  (add-interval (div-interval one r1)
                                (div-interval one r2)))))

(define r1 (make-center-percent 200 5))
(define r2 (make-center-percent 300 5))

(define p1 (par1 r1 r2)) ;par1で計算した結果をp1
(define p2 (par2 r1 r2)) ;par2で計算した結果をp2とする 正確な並列抵抗は120

p1 ==> (111.29268292682927 . 129.30769230769232)

p2 ==> (116.99999999999999 . 123.00000000000001)

(center p1) ==> 120.3001876172608

(percent p1) ==> 14.975046787273868

(center p2) ==> 120.

(percent p2) ==> 5.000000000000024