2.1 データ抽象入門

2.1.1 例: 有理数の算術演算

P49のmake-ratの実装の変更は使用している部分の変更を必要としないから、データ抽象が行えている。

(define (add-rat x y)
  (make-rat (+ (* (number x) (denom y))
               (* (number y) (denom x)))
            (* (denom x) (denom y))))
(define (sub-rat x y)
  (make-rat (- (* (number x) (denom y))
               (* (number y) (denom x)))
            (* (denom x) (denom y))))
(define (mul-rat x y)
  (make-rat (* (number x) (number y))
            (* (denom x) (denom y))))
(define (div-rat x y)
  (make-rat (* (number x) (dnom y))
            (* (denom x) (number y))))
(define (equal-rat? x y)
  (= (* (number x) (denom y))
     (* (number y) (denom x))))

(define (make-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g) (/ d g))))
(define (number x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
  (newline)
  (display (number x))
  (display "/")
  (display (denom x)))

問題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.1.2抽象の壁

うまく抽象の壁を作ることはプログラムの設計で非常に重要なのだろう。この壁が作れていないとプログラムが不必要に複雑になりそうだ。なんか、プロトコルスタックの絵にも似ているね。

問題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)
  (make-point (/ (+ (x-point (start-segment seg))
                    (x-point (end-segment seg)))
                 2)
              (/ (+ (y-point (start-segment seg))
                    (y-point (end-segment seg)))
                 2)))
;; テスト
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y -point p))
  (display ")"))

(print-point (midpoint-segment
              (make-segment (make-point 1 2)
                            (make-point 2 4))))
=> (3/2,3)

問題2.3

;; 長方形の辺は座標軸に対して平行とする

;; 周囲の長さと面積
(define (perimeter r)
  (* 2 (+ (x-length r) (y-length r))))
(define (area r)
  (* (x-length r) (y-length r)))

;; 実装１、左下右上の座標
(define (make-rectangle x1 y1 x2 y2)
  (cons (make-point x1 y1) (make-point x2 y2)))
(define (x-length r)
  (abs (- (x-point (car r)) (x-point (cdr r)))))
(define (y-length r)
  (abs (- (y-point (car r)) (y-point (cdr r)))))

;; 実装2, 左下の座標と幅と高さ
(define (make-rectangle x1 y1 x2 y2)
  (let ((x* (min x1 x2))
        (y* (min y1 y2))
        (x2* (max x1 x2))
        (y2* (max y1 y2)))
    (cons (make-point x* y*)
          (cons (- x2* x*)
                (- y2* y*)))))
(define (x-length r)
  (car (cdr r)))
(define (y-length r)
  (cdr (cdr r)))

2.1.3 データとは何か

データとは何か?というといに対してここでは答えとして

データは選択子と構成子と、これらの手続きが満たすべき条件とで定義される

としている。例えば点を表すデータであれば、構成子point,選択子x,yと (x (point a b)) = a, (y (point a b)) = b という条件で定義される。
脚注にあるが、これを厳密に形式化するのは大変らしい。

問題2.4

置き換えモデルを使ってみる。

(car (cons x y))
(car (lambda (m) (m x y)))
((lambda (m) (m x y)) (lambda (p q) p))
((lambda (p q) p) x y)
x

となり、(car (cons x y)) はxを生じる。consは引数を二つ(x y)を取り、返す値は手続きを一つとりそれにx yを適用する手続きを返す。carはconsの返した手続きに第一引数を返す手続きを渡すのでxになる。cdrはconsの返した手続きに第二引数を返す手続きを渡せばyになるから、

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

(define (cons x y)
  (* (expt 2 x) (expt 3 y)))

(define (divisor-num z d)
  (define (iter z n)
    (let ((r (remainder z d)))
      (if (= r 0)
          (iter (/ z d) (+ n 1))
          n)))
  (iter z 0))

(define (car z)
  (divisor-num z 2))
(define (cdr z)
  (divisor-num z 3))

問題2.6

(add-1 zero)を置き換えていくと、

(add-1 zero)
=> (lambda (f) (lambda (x) (f ((zero f) x))))
=> (lambda (f) (lambda (x) (f ((lambda (x) x) x))))
=> (lambda (f) (lambda (x) (f x)))

きっと、Church数の整数nは,手続きを一つ取り(これをfとする）、引数xにfをn適用する手続きを返す。

(define zero
  (lambda (f)
    (lambda (x) x)))
(define one
  (lambda (f)
    (lambda (x) (f x))))
(define two
  (lambda (f)
    (lambda (x) (f (f x)))))

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

Church数をSchemeの整数に変換する手続き。

(define (church->integer n)
  ((n (lambda (x) (+ x 1))) 0))
(church->integer zero) => 0
(church->integer one)  => 1
(church->integer two)  => 2
(church->integer (add-1 two)) => 3

せっかくなので、もう少しChurch数を楽しんでみよう.よし、四則演算だ。
加算はこれでできる。

(define (add x y)
  (lambda (f)
    (lambda (z) ((x f) ((y f) z)))))
(church->integer (add one two)) => 3
(church->integer (add one (add two two))) => 5

減算どうやるんだろう。zero?と１引く手続きがあればできそうだ.
zero?は

(define (zero? n)
  ((n (lambda (_) #f)) #t))

これでいいのかな。#fとか使っている時点でダメな気がするなぁ.
１引く手続きは.....わからない！Webで答えを見てみよう.
http://ocaml.jp/archive/document/church.html　
にChurch数についてある.zero?の定義もやっぱりこれじゃだめだった。

(define true
  (lambda (t f) t))
(define false
  (lambda (t f) f))
(define (zero? n)
  ((n (lambda (x) false)) true))
(define if-then-else
  (lambda (b t f) (b t f)))
(define cnot
  (lambda (b)
    (b false true)))
(define cand
  (lambda (b1 b2)
    (b1 b2 false)))
(define cor
  (lambda (b1 b2)
    (b1 true b2)))
(define pred
  (lambda (n)
    (lambda (f)
      (lambda (x)
        (((n (lambda (g) (lambda (h) (h (g f)))))
          (lambda (_) x))
         identity)))))

predの定義は非常に分かりづらい。

let pred = fun n s z -> n (fun g h -> h (g s)) (fun _ -> z) (fun i -> i);;

predの定義はocamlではこうなっている.(fun g h -> h (g s))をfとすると、
f (f (... (f (fun _ -> z))))
というように、fをn回適用することになる.１回だけの適用では

(fun h -> h z)

となり、関数を一つ取り、それにzを適用させる関数になる。２回目の適用ではsが渡されるので

(fun h -> h (s z))

となり、関数を一つ取り、それに(s z)を適用させる関数になる。3回目の適用では(s (s z)) というようにsの適用回数はn-1回なので、１引くことになる.

で減算は

(define (sub x y)
  ((y pred) x))

できた！！

調子に乗って、乗算もやってみよう.

(define (mul x y)
  (lambda (f)
    (lambda (z)
      ((x (lambda (g) ((y f) g))) z))))

除算はたぶんこう。schemeは遅延評価ではないので、lambdaを使って、貪欲に評価しないようにしている.

(define (div x y)
  ((if-then-else (zero? x)
                (lambda () zero)
                (lambda () (add one (div (sub x y) y))))))

累乗は非常に簡単。

(define (exp x y)
  (x y))

ここら辺でとりあえずおしまい。

2.1.4 拡張問題: 区間算術演算

問題2.7

(define (lower-bound i) (car i))
(define (upper-bound i) (cdr i))

問題2.8

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

問題2.9

widthは

である。
可算(add)は



となり、widthだけの関数になっている。

減算(sub)は



となり、widthだけの関数になっている。

乗算(mul)の場合。範囲を[low, high]と表すとする。


二つの式の引数のwidthは変わらないにもかかわらず、結果の幅が変わっていることから乗算は結果の幅は引数の幅だけの関数ではない。

除算(div)の場合。


二つの式の引数のwidthは変わらないにもかかわらず、結果の幅が変わっていることから除算は結果の幅は引数の幅だけの関数ではない。

問題2.10

ゼロを含む区間の場合は0除算が発生するので、結果は±∞に発散してしまう。

(define (div-interval x y)
  (if (and (<= (lower-bound y) 0)
           (>= (upper-bound y) 0))
      (error "divided by an interval that spans zero.")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

問題2.11

範囲の上限と下限の記号の組み合わせが３通り( (- -) (- +) (+ +) )なので、3*3で9通りになる。
lower-bound(x) = x, upper-bound(x) = Xとすると、

x\y	- -	- +	+ +
- -	(XY, xy)	(xY, xy)	(xY, Xy)
- +	(Xy, xy)	(min(xY, Xy), max(xy, XY)	(xY, XY)
+ +	(Xy, xY)	(Xy, XY)	(xy, XY)

(define (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) (print "hoge")(make-interval (* xu yl) (* xu yu)))
                 (else     (make-interval (* xl yl) (* xu yu))))))))
                  

問題2.12

;; Alyssaのコード
(define make-interval cons)
(define lower-bound car)
(define upper-bound cdr)
(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))

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

問題2.13

二つの因子（中央値と相対誤差）をそれぞれ、A = (X, δ), B = (Y, ε)とする。A,Bは正数の範囲にあるとする。δ、εは小さい数である。

lower-bound(AB) = A(1-δ)B(1-ε)
                = AB(1-(δ+ε)+δε)
upper-bound(AB) = A(1+δ)B(1+ε)
                = AB(1+δ+ε+δε)

となる。ここで、δε　は無視できるほどに小さい。よって、許容誤差はδ+εで近似できる。

問題2.14

一度、コードをまとめておこう。

(define make-interval cons)
(define lower-bound car)
(define upper-bound cdr)
(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))
(define (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) (print "hoge")(make-interval (* xu yl) (* xu yu)))
                 (else     (make-interval (* xl yl) (* xu yu))))))))
(define (div-interval x y)
  (if (and (<= (lower-bound y) 0)
           (>= (upper-bound y) 0))
      (error "divided by an interval that spans zero.")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))
(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (make-center-percent c p)
  (let ((w (* c (/ p 100.0))))
    (make-center-width c w)))
(define (percent i)
  (* 100 (/ (width i) (center i))))

で、問題。

(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 a (make-interval 1 2))
(define b (make-interval 2 3))
(par1 a b)
=> (0.4 . 3.0)
(par2 a b)
=> (0.5 . 1.0)

(define c (make-center-percent 10 0))
(define d (make-center-percent 10 2))
(div-interval a a)
(div-interval a b)
(percent (div-interval c c))
(percent (div-interval d d))
(percent (div-interval c d))
(center (div-interval c c))

(define (test a b)
  (do-ec (: p1 0 3)
         (: p2 0 3)
         (begin (format #t "~a ~a ~a\n"
                         (percent (div-interval a a))
                         (percent (div-interval b b))
                         (percent (div-interval a b))))))

(define a (make-center-percent 1 1))
(define b (make-center-percent 2 1))
(define (center+percent i)
  (print (center i) " " (percent i)))
(center+percent (par1 a b))
(center+percent (par2 a b))

確かに結果が異なる。中央値すら異なる。

(define c (make-center-percent 1 0))
(center+percent (div-interval a a))
(center+percent (div-interval a b))
(center+percent (div-interval b b))
(center+percent (div-interval c a))
(center+percent (div-interval c b))

幅のある値を除算すると範囲が拡大するようだ。

問題2.15

幅のある値同士の演算は幅が拡大する。par1はそれが３回行われていて、par2は１回である。なので、par2の方が良い。

問題2.16

(未完)
同じ値を複数含む式の場合、Alyssaの方法では幅が不必要に拡大してしまう。例えば、R1+R1という演算では幅は変わらないはずだ。
ちょっと考えても、良い方法がわからないのでこの問題はパス。まあ、欠点がない区間算術演算パッケージは不可能だと思うなぁ。