Hatena::Groupcsnagoya-sicp

toyoshiのSICP宿題帖

 | 

2009-04-11

2.11

| 22:23 | はてなブックマーク - 2.11 - toyoshiのSICP宿題帖

1回だけ2回計算するのは(-a,+b) (-c,+d)のとき

-a*+dと+b*-cのどちらが大きいかがわからないため

検証用のコードはhttp://csnagoya-sicp.g.hatena.ne.jp/clairvy/20090411/sicp_ex_2_11から拝借しました。

(define (make-interval a b) (cons a b))

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

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

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


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

(define (mul-interval x y)
  (let* ((l1 (lower-bound x))
	(u1 (upper-bound x))
	(l2 (lower-bound y))
	(u2 (upper-bound y))
	(p1 (* l1 l2))
	(p2 (* l1 u2))
	(p3 (* u1 l2))
	(p4 (* u1 u2)))
    (cond ((>= l1 0)
	   (cond ((>= l2 0) (make-interval p1 p4))
		 ((< u2 0) (make-interval p3 p2))
		 (else (make-interval p3 p4))))
	  ((< u1 0)
	   (cond ((>= l2 0) (make-interval p2 p3))
		 ((< u2 0) (make-interval p4 p1))
		 (else (make-interval p2 p1))))
	  (else
	   (cond ((>= l2 0) (make-interval p2 p4))
		 ((< u2 0) (make-interval p3 p1))
		 (else (make-interval (min p2 p3) p4)))))))
  
(define i1 (make-interval 1 2))
(define i2 (make-interval -1 1))
(define i3 (make-interval -2 -1))

(define (display-interval-org-and-new x y)
  (define (display-interval-2d i)
    (format #t "[~@d, ~@d]" (lower-bound i) (upper-bound i)))
  (define (display-prompt x y)
    (display-interval-2d x)
    (display " * ")
    (display-interval-2d y)
    (display " = "))
  (let ((org-result (mul-interval-org x y))
        (new-result (mul-interval x y)))
    (display-prompt x y)
    (display-interval-2d new-result)
    (if (equal? org-result new-result)
        (display " org and new result are same"))
    (newline)))

(display-interval-org-and-new i1 i1)
(display-interval-org-and-new i1 i2)
(display-interval-org-and-new i1 i3)
(display-interval-org-and-new i2 i1)
(display-interval-org-and-new i2 i2)
(display-interval-org-and-new i2 i3)
(display-interval-org-and-new i3 i1)
(display-interval-org-and-new i3 i2)
(display-interval-org-and-new i3 i3)
 |