naga:2-1 > 2-16

naga

Todo

2.3長方形の別表現。セレクタの変更で済むようにしないと。
2.6
2.11問題を理解できているか？
2.14問題を理解できているか？
2.15
2.16

Exercise 2.1

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

Exercise 2.2

(define (make-segment p1 p2)
  (cons p1 p2))
(define (start-segment s)
  (car s))
(define (end-segment s)
  (cdr s))
(define (make-point x y)
  (cons x y))
(define (x-point p)
  (car p))
(define (y-point p)
  (cdr p))

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

Exercise 2.3

;; 周囲
(define (rectangle-perimeter r)
  (+ (* (segment-length (v-rectangle r)) 2)
     (* (segment-length (h-rectangle r)) 2)))
;; 面積
(define (rectangle-area r)
  (* (segment-length (v-rectangle r))
     (segment-length (h-rectangle r))))
(define (make-rectangle v h)
  (if (and (have-same-point? v h) (right-angle? v h))
      (cons v h)
      #f))
;;  segmentが同じpointを持つか？
(define (have-same-point? v h)
  (or (same-point? (start-segment v) (start-segment h))
      (same-point? (start-segment v) (end-segment h))
      (same-point? (end-segment v) (start-segment h))
      (same-point? (end-segment v) (end-segment h))))
;;   同じpointか？
(define (same-point? p1 p2)
  (and (= (x-point p1) (x-point p2))
       (= (y-point p1) (y-point p2))))
;;   segmentが直交するか？
(define (right-angle? v h)
  (let ((dvx (- (x-point (end-segment v)) (x-point (start-segment v))))
        (dvy (- (y-point (end-segment v)) (y-point (start-segment v))))
        (dhx (- (x-point (end-segment h)) (x-point (start-segment h))))
        (dhy (- (y-point (end-segment h)) (y-point (start-segment h)))))
    (cond ((or (and (= dvx 0) (= dvy 0)) (and (= dhx 0) (= dhy 0))) #f)
          ((or (and (= dvx 0) (= dhy 0)) (and (= dvy 0) (= dhx 0))) #t)
          ((or (and (not (= dvx 0)) (not (= dhy 0)) (= (/ dvy dvx) (/ dhx dhy)))
               (and (not (= dvy 0)) (not (= dhx 0)) (= (/ dvx dvy) (/ dhy dhx)))) #t)
          (else #f))))
;; selectors for rectangle
(define (v-rectangle r)
  (car r))
(define (h-rectangle r)
  (cdr r))
;; segment長
(define (segment-length s)
  (sqrt (+ (square (- (x-point (start-segment s)) (x-point (end-segment s))))
           (square (- (y-point (start-segment s)) (y-point (end-segment s)))))))

 ;;gosh> (define p00 (make-point 0 0))
;;p00
;;gosh> (define p40 (make-point 4 0))
;;p40
;;gosh> (define p02 (make-point 0 2))
;;p02
;;gosh> (define s0040 (make-segment p00 p40))
;;s0040
;;gosh> (define s0002 (make-segment p00 p02))
;;s0002
;;gosh> (define r (make-rectangle s0040 s0002))
;;r
;;gosh> (rectangle-perimeter r)
;;8.0

別の表現はパス。

Exercise 2.4

;; (car (cons x y))
;;-> (car (lambda (m) (m x y)))              ;;引数(cons x y)を評価
;;-> ((lambda (m) (m x y)) (lambda (p q) p)) ;;carを評価
;;-> ((lambda (p q) p) x y)                  ;;carに引数を適用
;;-> x                                       ;;評価
(define (cons-f x y)
  (lambda (m) (m x y)))
(define (car-f z)
  (z (lambda (p q) p)))
(define (cdr-f z)
  (z (lambda (p q) q)))

;;gosh> (cdr-f (cons-f 'x 'y))
;;y

Exercise 2.5

;; 2と3は互いに素のため(expt 2 a)と(expt 3 b)も互いに素となりa,bの情報を保存できる。
(define (cons-a a b)
  (* (expt 2 a) (expt 3 b)))
(define (car-a n)
  (if (not (= (remainder n 2) 0))
      0
      (+ 1 (car-a (/ n 2)))))
(define (cdr-a n)
  (if (not (= (remainder n 3) 0))
      0
      (+ 1 (cdr-a (/ n 3)))))

;;gosh> (define x (cons-a 7 13))
;;x
;;gosh> x
;;204073344
;;gosh> (car-a x)
;;7
;;gosh> (cdr-a x)
;;13

Exercise 2.6

後日

Exercise 2.7

;; selectors
(define (upper-bound x)
  (max (car x) (cdr x)))
(define (lower-bound x)
  (min (car x) (cdr x)))

Exercise 2.8

;;  difference
(define (sub-interval x y)
    (make-interval (- (upper-bound x) (lower-bound y))
                   (- (lower-bound x) (upper-bound y))))
;;gosh> (define i32 (make-interval 3 2))
;;i32
;;gosh> (define i1-1 (make-interval 1 -1))
;;i1-1
;;gosh> (define r (sub-interval i32 i1-1))
;;r
;;gosh> (upper-bound r)
;;4
;;gosh> (lower-bound r)
;;1

Exercise 2.9

(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))
;;
;;(define w1 (make-interval w1u w1l))
;;(define w2 (make-interval w2u w2l))
;;(width w1)->(w1u-w1l)/2
;;(widht w2)->(w2u-w2l)/2
;;
;;(define w1+w2 (add-interval w1 w2))
;;(width w1+w2)->(/ (- (upper-bound w1+W2) (lower-bound w1+w2)) 2)
;;->((w1u+w2u)-(w1l+w2l))/2->(w1u-w1l)/2+(w2u-w2l)/2
;;->(+ (width w1) (width w2))
;;
;;(define w1-w2 (sub-interval w1 w2))
;;(width w1-w2)->(/ (- (upper-bound w1-w2) (lower-bound w1-w2)) 2)
;;->((w1u-w2l)-(w1l-w2u))/2->(w1u-w1l)/2+(w2u-w2l)/2
;;->(+ (width w1) (width w2))
;;
;;gosh> (define w1 (make-interval 2 1))
;;w1
;;gosh> (define w2 (make-interval 4 3))
;;w2
;;gosh> (define w3 (make-interval -1 -2))
;;w3
;;gosh> (width w1)
;;1/2(
;;gosh> (width w2)
;;1/2
;;gosh> (width w3)
;;1/2
;;gosh> (define w1+w2 (add-interval w1 w2))
;;w1+w2
;;gosh> (define w1+w3 (add-interval w1 w3))
;;w1+w3
;;gosh> (width w1+w2)
;;1
;;gosh> (width w1+w3)
;;1
;;gosh> (define w1*w2 (mul-interval w1 w2))
;;w1*w2
;;gosh> (define w1*w3 (mul-interval w1 w3))
;;w1*w3
;;gosh> (width w1*w2)
;;5/2
;;gosh> (width w1*w3)
;;3/2

Exercise 2.10

(define (div-interval x y)
  (if (not (and (>= (upper-bound y) 0) (<= (lower-bound y) 0)))
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))
      (error "interval spans zero :" y)))

;;gosh> (define w1 (make-interval 2 1))
;;w1
;;gosh> (define w4 (make-interval 1 -1))
;;w4
;;gosh> (div-interval w1 w4)
;;*** ERROR: interval spans zero : (1 . -1)
;;Stack Trace:
;;_______________________________________

Exercise 2.11

(define (mul-interval i1 i2)
 (let ((i1u (upper-bound i1))
       (i1l (lower-bound i1))
       (i2u (upper-bound i2))
       (i2l (lower-bound i2)))
   (cond ((and (>= i1u 0) (>= i1l 0))
          (cond ((and (>= i2u 0) (>= i2l 0))
                 (make-interval (* i1u i2u) (* i1l i2l)))
                ((and (>= i2u 0) (< i2l 0))
                 (make-interval (* i1u i2u) (* i1u i2l)))
                (else (make-interval (* i1l i2u) (* i1u i2l)))))
         ((and (>= i1u 0) (< i1l 0))
          (cond ((and (>= i2u 0) (>= i2l 0))
                 (make-interval (* i1u i2u) (* i1l i2u)))
                ((and (>= i2u 0) (< i2l 0))
                 (make-interval (* i1u i2u) (* i1u i2l)))
                (else (make-interval (* i1l i2l) (* i1u i2l)))))
         (else
          (cond ((and (>= i2u 0) (>= i2l 0))
                 (make-interval (* i1u i2l) (* i1l i2u)))
                ((and (>= i2u 0) (< i2l 0))
                 (make-interval (* i1l i2l) (* i1l i2u)))
                (else (make-interval (* i1l i2l) (* i1u i2u))))))))
;;gosh> (define i21 (make-interval 2 1))
;;i21
;;gosh> (define i1-1 (make-interval 1 -1))
;;i1-1
;;gosh> (define i-1-2 (make-interval -1 -2))
;;i-1-2
;;gosh> (define i21*i21 (mul-interval i21 i21))
;;i21*i21
;;gosh> i21*i21
;;(4 . 1)
;;gosh> (define i21*i1-1 (mul-interval i21 i1-1))
;;i21*i1-1
;;gosh> i21*i1-1
;;(2 . -2)
;;gosh> (define i21*i-1-2 (mul-interval i21 i-1-2))
;;i21*i-1-2
;;gosh> i21*i-1-2
;;(-1 . -4)
;;gosh> (define i1-1*i21 (mul-interval i1-1 i21))
;;i1-1*i21
;;gosh> i1-1*i21
;;(2 . -2)
;;gosh> (define i1-1*i1-1 (mul-interval i1-1 i1-1))
;;i1-1*i1-1
;;gosh> i1-1*i1-1
;;(1 . -1)
;;gosh> (define i1-1*i-1-2 (mul-interval i1-1 i-1-2))
;;i1-1*i-1-2
;;gosh> i1-1*i-1-2
;;(2 . -2)
;;gosh> (define i-1-2*i21 (mul-interval i-1-2 i21))
;;i-1-2*i21
;;gosh> i-1-2*i21
;;(-1 . -4)
;;gosh> (define i-1-2*i1-1 (mul-interval i-1-2 i1-1))
;;i-1-2*i1-1
;;gosh> i-1-2*i1-1
;;(2 . -2)
;;gosh> (define i-1-2*i-1-2 (mul-interval i-1-2 i-1-2))
;;i-1-2*i-1-2
;;gosh> i-1-2*i-1-2
;;(4 . 1)

Exercise 2.12

(define (make-center-percent c p)
  (let ((w (* c (/ p 100))))
    (make-center-width c w)))
(define (percent i)
  (* (/ (width i) (center i)) 100))
;;gosh> (define r6.8+-10% (make-center-percent 6.8 10))
;;r6.8+-10%
;;gosh> (width r6.8+-10%)
;;0.6799999999999997
;;gosh> (percent r6.8+-10%)
;;9.999999999999996

Exercise 2.13

;; i1 = x+dx:x-dx
;; i2 = y+dy:y-dy
;; i1>=0,i2>=0,dx<<x,dy<<yとすると
;; i1*i2 = xy+ydx+xdy+dxdy:xy-ydx-xdy+dxdy
;; dxdyが十分小さいとして良いので
;;       = xy+ydx+ydy:xy-(ydx+xdy)
;; これをpercentで表記するために変形すると
;;       = xy+xy(dx/x+dy/y):xy-xy(dx/x+dy/y)
;; dx/x,dy/yはそれぞれi1,i2のpercentに当たるので
(define (mul-center-percent i1 i2)
  (make-center-percent
   (* (center i1) (center i2))
   (+ (percent i1) (percent i2))))
;;gosh> (define i1 (make-center-percent 100 0.1))
;;i1
;;gosh> (define i2 (make-center-percent 1000 0.2))
;;i2
;;gosh> (define i1*i2 (mul-interval i1 i2))
;;i1*i2
;;gosh> (define i1*i2-simple (mul-center-percent i1 i2))
;;i1*i2-simple
;;gosh> (center i1*i2)
;;100000.20000000001
;;gosh> (percent i1*i2)
;;0.2999994000011927
;;gosh> (center i1*i2-simple)
;;100000.0
;;gosh> (percent i1*i2-simple)
;;0.3

Exercise 2.14

(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)))))
;;以下のように乗算・除算ではwidthが比率として加算される。
;;gosh> (define a (make-center-percent 100 1))
;;an
;;gosh> (define b (make-center-percent 100 2))
;;b
;;gosh> (percent a)
;;1.0
;;gosh> (percent b)
;;2.0
;;gosh> (percent (div-interval a a))
;;1.9998000199980077
;;gosh> (percent (div-interval a b))
;;2.9994001199760016
;;gosh> (percent (div-interval b b))
;;3.998400639744092
;;gosh> (percent (mul-interval a a))
;;1.9998000199980004
;;gosh> (percent (mul-interval a b))
;;2.9994001199760048
;;gosh> (percent (mul-interval b b))
;;3.9984006397441028
;;gosh> (percent (div-interval (make-interval 1 1) a))
;;1.0000000000000036
;;gosh> (percent (mul-interval (make-interval 1 1) a))
;;1.0
;;gosh> (percent (par1 a a))
;;2.999200239928031
;;gosh> (percent (par2 a a))
;;1.000000000000007

Exercise 2.15

後日

Exercise 2.16

後日