2.1

#lang racket

(define (make-rat n d)
  (let ((g (gcd n d)))
    (cond ((< (* n d) 0)
            (cons
              (* -1 (abs (/ n g)))
              (abs (/ d g))))
          (else
            (cons (abs(/ n g)) (abs(/ d g)))))))

(define (add-rat x y)
  (make-rat (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))

(define (sub-rat x y)
  (make-rat (- (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))

(define (mul-rat x y)
  (make-rat (* (numer x) (numer y))
            (* (denom x) (denom y))))

(define (div-rat x y)
  (make-rat (* (numer x) (denom y))
            (* (denom x) (numer y))))

(define (equal-rat? x y)
  (= (* (numer x)(denom y))
     (* (numer y)(denom x))))

(define (numer x) (car x))
(define (denom x) (cdr x))

(define (print-rat x)
  (newline)
  (display (numer x))
  (display "/")
  (display (denom x)))

2.2

#lang Racket
;点の定義
(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
;線分の定義
(define (make-segment start end) (cons start end))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))

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

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

2.3

実装1
（長辺と短辺を1つずつ指定。各辺は斜めでもOK。指定する2辺が長方形を構成可能かどうかの判断は省略）

#lang Racket
;周長
(define (perimeter-rectangle rec)
  (* (+ (long-rectangle-length rec)
        (short-rectangle-length rec))
     2))
;面積
(define (area-rectangle rec)
  (* (long-rectangle-length rec)
     (short-rectangle-length rec)))

;辺の長さ
(define (length-segment seg)
   (let ((start (start-segment seg))
        (end (end-segment seg)))
     (sqrt
      (+ (square (- (x-point end) (x-point start)))
         (square (- (y-point end) (y-point start)))))))
;長方形の定義: (cons 長辺 短辺)
(define (make-rectangle long short) (cons long short))
;長編の長さ
(define (long-rectangle-length rec) (length-segment (car rec)))
;短辺の長さ
(define (short-rectangle-length rec) (length-segment (cdr rec)))

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (make-segment start end) (cons start end))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))
(define (square x) (* x x))

実装2 （4点を指定。効率は悪い。ホントは3点でも一意に定まるが、、、）

#lang racket

;長方形の定義 (cons 左上 右上 左下 右下)
(define (make-rectangle top-left top-right bottom-left bottom-right)
  (cons (cons top-left top-right)
        (cons bottom-left bottom-right)))

;短辺の長さ（ここに抽象化の壁がある）
(define (short-rectangle-length rec)
  (let ((vertical
          (length-segment
             (make-segment (car (car rec)) (car (cdr rec)))))
        (horizontal
          (length-segment
             (make-segment (car (car rec)) (cdr (car rec))))))
    (if (< vertical horizontal) vertical horizontal)))

;長辺の長さ（ここに抽象化の壁がある）
(define (long-rectangle-length rec)
  (let ((vertical
          (length-segment
             (make-segment (car (car rec)) (car (cdr rec)))))
        (horizontal
          (length-segment
             (make-segment (car (car rec)) (cdr (car rec))))))
    (if (> vertical horizontal) vertical horizontal)))

;面積と周長の関数定義はそのまま
(define (perimeter-rectangle rec)
  (* (+ (long-rectangle-length rec)
        (short-rectangle-length rec))
     2))
(define (area-rectangle rec)
  (* (long-rectangle-length rec)
     (short-rectangle-length rec)))

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (make-segment start end) (cons start end))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))
(define (length-segment seg)
   (let ((start (start-segment seg))
        (end (end-segment seg)))
     (sqrt
      (+ (square (- (x-point end) (x-point start)))
         (square (- (y-point end) (y-point start)))))))
(define (square x) (* x x))

2.4

cdrの定義

#lang Racket
(define (cdr z)
  (z (lambda (p q) q)))

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

(car (cons x y))がxを生じることを証明

(car (cons x y))
;carを展開
;->((cons x y) (lambda (p q) p))
;consを展開
;->((lambda (m) (m x y)) (lambda (p q) p))
;mに(lambda (p q) p)を束縛
;->((lambda (p q) p) x y)
; p, q に x, y を束縛
;-> x

2.5

非負の整数の対は数と算術演算だけを使って表現出来ることを示せ

(a b) -> 2^a*3^b なので、
与えられた非負整数nが
奇数の場合:
  2^0*3^bなので、1になるまで3で除算し、除算回数をbとする（b->log3(n))
偶数の場合:
  2^a*3^bなので、奇数mが得られるまで2で除算し、除算回数をaとする。
  奇数mは2^0*3^bとなるので、bはnが奇数の場合と同じ求め方で得る(b->log3(m))

これに対応する手続き cons, carおよびcdrの定義

#lang Racket
;cons
(define (cons x y)
  (* (base 2 x) (base 3 y)))
;car
(define (car z)
  (count-n z 2))
;cdr
(define (cdr z)
  (count-n z 3))


(define (base x n)
  (if (= n 0) 1
      (* x (base x (- n 1)))))
(define (count-n x divider)
  (define (iter x divider n)
    (if (= (remainder x divider) 0)
        (iter (/ x divider) divider (+ n 1))
        n))
  (iter x divider 0))

2.6

oneの定義

;one
(add-1 zero)
(lambda (f) (lambda (x) (f ((zero f) x))))
(lambda (f) (lambda (x) (f (lambda (f) (lambda (x) x) f) x)))
(lambda (f) (lambda (x) (f (lambda (x) x) x)))
(lambda (f) (lambda (x) (f x)))

twoの定義

;two
(add-1 one)
(lambda (f) (lambda (x) (f ((one f) x))))
(lambda (f) (lambda (x) (f ((lambda (f) (lamda (x) (f x))) f) x)))
(lambda (f) (lambda (x) (f (lambda (x) (f x)) x)))
(lambda (f) (lambda (x) (f (f x))))

加算手続きの定義

(define (add a b)
  (lambda (f) (lambda (x) ((a f) ((b f) x)))))

;(add one two)
(lambda (f) (lambda (x) ((one f) ((two f) x))))
(lambda (f) (lambda (x)
  (((lambda (f) (lambda(x) (f x))) f)
   (((lambda (f) (lambda(x) (f (f x)))) f) x))))
(lambda (f) (lambda (x)
  ((lambda (x) (f x)) (lambda (x) (f (f x)) x))))
(lambda (f) (lambda (x)
  ((lambda (x) (f x)) (f (f x)))))
(lambda (f) (lambda (x) (f (f (f x)))))
; =>three

2.7

#lang Racket
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))

2.8

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

2.9

区間Xの幅

 X_width = X_max - X_min

和の幅

 (X_max + Y_max) - (X_min + Y_min)
 = (X_max - X_min) + (Y_max - Y_min)
 = X_width + Y_width

差の幅

 (X_max - Y_min) - (X_min - Y_max)
 = (X_max - X_min) + (Y_max - Y_min)
 = X_width + Y_width

積の幅

 max(X_maxY_min X_maxY_max X_minY_min X_minY_max)
 -  min(X_maxY_min X_maxY_max X_minY_min X_minY_max)
 よって、以下の16パターンだが、いずれもwidthのみの関数にはならない
 X_max(Ymin - Y_max)
 X_max(Ymax - Y_min)
 X_min(Ymin - Y_max)
 ...
 Y_min(Xmax - X_min)
 X_maxY_max-X_minY_min
 X_minY_min-X_maxY_max

商の幅も席の幅と同様、widthだけの関数にならない。

 max(X_max/Y_min X_max/Y_max X_min/Y_min X_min/Y_max)
 -  min(X_max/Y_min X_max/Y_max X_min/Y_min X_min/Y_max)

2.10

0をまたがる区間で割ると、正負それぞれの0近傍で+∞,-∞に発散してしまう。また、0では解無しとなる。

エラーを返すコード

(define (div-interval x y)
  (if (> 0 (* (lower-bound y) (upper-bound y)))
      (print "error")
      (mul-interval
        x
        (make-interval
          (/ 1.0 (upper-bound y))
          (/ 1.0 (lower-bound y))))))

2.11

区間 [min,max] の符号のパターンは、 [正,正],[負,正],[負,負]となる。よって、x,yを考慮すると3*3=9通りになる。

それぞれのパターンにおける、min,maxは具体例を交えると以下のようになる。（ [負,正]の場合はminとmaxの絶対値の大小関係により場合分けして考える）

[正,正] * [正,正]
[1,2] * [2,4]
min: x_min * y_min >0
max: x_max * y_max > max(x_min*y_max, x_max*y_min) > x_min*y_min (max<0)

[正,正] * [負,正]
[1,2] * [-2,4]
[1,2] * [-4,2]
何方のパターンも同じ
min: x_max * y_min < x_min*y_min < 0
max: x_max * y_max > x_min*y_max > 0

[正,正] * [負,負]
[1,2] * [-4, -2]
min: x_max * y_min < min(x_min*y_min,x_max*y_min) < 0
max: x_min * y_max > max(x_min*y_min,x_max*y_min) (max<0)

[負,正] * [正,正]
[-1,2] * [2,4]
[-2,1] * [2,4]
何方のパターンも同じ
min: x_min * y_max < x_min*y_min < 0
max: x_max * y_max > x_max*y_min > 0

[負,正] * [負,正]
[-1,2] * [-2,4]
[-2,1] * [-4,2]
パターンごとに大小が変化する
min: min(x_min * y_max, x_max * y_min) <0
max: max(x_max * y_max, x_min * y_min) >0

[負,正] * [負,負]
[-1,2] * [-4,-2]
[-2,1] * [-4,-2]
何方のパターンも同じ
min: x_max * y_min < x_max*y_max < 0
max: x_min * y_min > x_min*y_max > 0

[負,負] * [正,正]
[-2,-1] * [2,4]
min: x_min * y_max < x_min*y_min < x_max*y_max
max: x_max * y_min > x_max*y_max (max<0)

[負,負] * [負,正]
[-2,-1] * [-2,4]
[-2,-1] * [-4,2]
何方のパターンも同じ
min: x_min * y_max < x_max*y_max < 0
max: x_min * y_min > x_max*y_min > 0

[負,負] * [負,負]
[-2,-1] * [-4,-2]
min: x_max * y_max < min(x_min*y_max, x_max*y_min) (0<min)
max: x_min * y_min > max(x_min*y_max, x_max*y_min)

よって、 [負,正] * [負,正]のパターン以外は、最大、最小の組み合わせが一意に定まるので乗算回数は2回で良い。

これを実装する

#lang racket
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))

(define (mul-interval2 x y)
  (let ((xl (lower-bound x))
        (xu (upper-bound x))
        (yl (lower-bound y))
        (yu (upper-bound y)))
    (cond     
      ((and (< 0 (* xl xu)) (< 0 (* yl yu)))
        (cond
          ((and (< 0 xl) (< 0 yl))
            ;[正,正]*[正,正]
            (make-interval (* xl yl) (* xu yu)))
          ((and (< xl 0) (< yl 0))
            ;[負,負]*[負,負]
           (make-interval (* xu yu) (* xl yl)))
          ((and (< xl 0) (< 0 yl))
            ;[負,負]*[正,正]
           (make-interval (* xl yu) (* xu yl))))
          ((and (< 0 xl) (< yl 0))
            ;[正,正]*[負,負]
           (make-interval (* xu yl) (* xl yu))))
      ((< (* xl xu yl yu) 0)
        (if (< 0 (* xl xu))
          (if (< 0 xl)
             ;[正,正] * [負,正]
             (make-interval (* xu yl) (* xu yu))
             ;[負,負] * [負,正]
             (make-interval (* xl yu) (* xl yl)))
          (if (< 0 yl)
             ;[負,正] * [正,正]
             (make-interval (* xl yu) (* xu yu))
             ;[負,正] * [負,負]
             (make-interval (* xu yl) (* xl yl)))))
      (else
        ;[負,正] * [負,正]
        (make-interval
          (min (* xl yu) (* xu yl))
          (max (* xu yu) (* xl yl)))))))

動作確認

;test methods
(define (old-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 (eql-interval? x y)
  (and (= (lower-bound x) (lower-bound y))
       (= (upper-bound x) (upper-bound y))))

(define (mul-test xl xu yl yu)
  (let ((x (make-interval xl xu))
        (y (make-interval yl yu)))
    (if
      (eql-interval?
        (old-mul-interval x y)
        (mul-interval2 x y))
      true
      (error "failed"
             x
             y
             (old-mul-interval x y)
             (mul-interval2 x y)))))

;test code
(mul-test 2 3 4 5)
(mul-test 2 3 -4 5)
(mul-test 2 3 4 -5)
(mul-test 2 3 -4 -5)
(mul-test 2 3 0 5)
(mul-test 2 3 -4 0)

(mul-test -2 3 4 5)
(mul-test -2 3 -4 5)
(mul-test -2 3 4 -5)
(mul-test -2 3 -4 -5)
(mul-test -2 3 0 5)
(mul-test -2 3 -4 0)

(mul-test 2 -3 4 5)
(mul-test 2 -3 -4 5)
(mul-test 2 -3 4 -5)
(mul-test 2 -3 -4 -5)
(mul-test 2 -3 0 5)
(mul-test 2 -3 -4 0)

(mul-test -2 -3 4 5)
(mul-test -2 -3 -4 5)
(mul-test -2 -3 4 -5)
(mul-test -2 -3 -4 -5)
(mul-test -2 -3 0 5)
(mul-test -2 -3 -4 0)

(mul-test -2 0 4 5)
(mul-test -2 0 -4 5)
(mul-test -2 0 4 -5)
(mul-test -2 0 -4 -5)
(mul-test -2 0 0 5)
(mul-test -2 0 -4 0)

(mul-test 0 3 4 5)
(mul-test 0 3 -4 5)
(mul-test 0 3 4 -5)
(mul-test 0 3 -4 -5)
(mul-test 0 3 0 5)
(mul-test 0 3 -4 0)

2.12

#lang racket
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))

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

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

(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2.0))

(define (make-center-percent c p)
  (let ((w (* c (/ p 100))))
    (make-interval (- c w) (+ c w))))

(define (percent i)
   (* (/ (width i) (center i)) 100))

;test
(define i (make-interval 900 1100))
(center i)
(width i)
(percent i)

(define i2 (make-center-percent 1000 10))
(lower-bound i)
(upper-bound i)
(center i)
(width i)
(percent i)

2.13

Ci,Wi をインターバルi の中央値(center)、許容誤差(width)と仮定

この時、x,yは以下のように示せる

x = [x_min, x_max]
  x_min = Cx*(1-0.5*Wx)
  x_max = Cx*(1-0.5*Wx)

y = [y_min, y_max]
  y_min = Cy*(1-0.5*Wy)
  y_max = Cy*(1-0.5*Wy)

すべての数が正の場合、 xy = [x_miny_min, x_maxy_max] = [CxCy(1-0.5(Wx+Wy)+WxWy), CxCy*(1+0.5(Wx+Wy)-WxWy)]

相対許容誤差が小さいと仮定できる場合、 WxWyは無視できる。

よって xy≒ [CxCy(1-0.5(Wx+Wy)), CxCy(1+0.5(Wx+Wy))] となり、 xyの許容誤差は (Wx+Wy) となる。

2.14

(define A (make-interval 89999 90001))
(define B (make-interval 100 900))

(define (test x y)
  (let ((ans (div-interval x y)))
    (center ans)
    (percent ans)))
(display "C_a ")
(center A)
(display "P_a ")
(percent A)
(display "C_b ")
(center B)
(display "P_b ")
(percent B)
(newline)
(display "A/A ")
(test A A)
(display "A/B ")
(test A B)
(display "B/B ")
(test B B)
(display "B/A ")
(test B A)

実行結果

C_a 90000.0
P_a 0.0011111111111111111
C_b 500.0
P_b 80.0

A/A 0.002222222221954537
A/B 80.00039999644447
B/B 97.56097560975611
B/A 80.0003999964445

A/A, B/B は本来１となるべきなのに、相対誤差が増大している。

これは本プログラムが、A,Bを一つの値ではなく「区間の中のいずれかの値」と規定しているが、その「いずれかの値」を固定できないからである。

※以下、「固定」という言い方が正しいか自信無いので具体例...

本来は、同じ区間A[1,3],B[1,3]があった場合、式中のAとBはそれぞれ1<a<3, 1<b<3を満たす任意の数値a,bになる。 (a, bの間に相関はないが、式中のa,bはそれぞれ一意の値となる）そのため、A/A=B/B=1かつA/B≠1 となるべきだが、本プログラムでは、 A/A,B/B共に1にならない。

これが、計算式によって答えに差分が生じる原因である。

2.15

Evaは正しい。 2.14の結果を踏まえると、上記プログラムを使う限り、 par1よりpar2のほうが正確な値を出力する。

par1のように、同じ値を示す区間変数が複数回登場する場合、2.14で述べた通り本来同じ値となるべきところを違う値として評価してしまうためである。

2.16

2.14に書いたとおり。 intervalのデータ構造にシリアル番号のような識別子を追加し、識別子が同じ場合を特別扱いするような改造をすれば、問題は解決できるのではないか。

識別子が同じ場合、減算結果は0、除算結果は1とする。（加算と積算は通常通りの区間演算で良い）

syagi's blog

SICP 演習問題 2.1

2.1

2.2

2.3

2.4

2.5

2.6

2.7

2.8

2.9