sicp(8)m2.6〜m2.11まで

問題2.11がとても時間かかった。

;;
;m2.6
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))
(define (inc x) (+ x 1))
;;コードから考えて使い方はこんな感じ。
;	gosh> ((zero inc) 1)
;	1
;;ということで、one,twoはたぶんこんな感じ。
(define one (lambda (f) (lambda (x) (f x))))
(define two (lambda (f) (lambda (x) (f (f x)))))
;	gosh> ((two inc) 2)
;	4
;;これでいいんじゃないかな？。
;;で、作りたいのはこんな感じのものだと思う。
;;(+ではなくaddにします。)
;	(((add one two) inc ) 3)
;	((three inc) 3)
;	6
(define (add f1 f2)
  (lambda (g) (lambda (x) ((f1 g) ((f2 g) x)))))
;	gosh> (((add (add one two) two) inc) 3)
;	8
;;できた！（昨日悩んだ甲斐があった）
;;addを作ってから、add-1の意味が分かった。
;; ;(add引く1じゃなくて、足す1の意味でした＞＜）


;;2.1.4
(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 ((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)))))
;;m2.7
(define (make-interval a b)
  (cons a b))
(define (upper-bound z) (cdr z))
(define (lower-bound z) (car z))

;;m2.8
;;めんどうなので、抽象化
(define (op-interval op x y )
  (make-interval (op (lower-bound x) (lower-bound y))
                 (op (upper-bound x) (upper-bound y))))
(define (minus-interval x y)
  (op-interval - x y))

;;m2.9
(define (calc-width z)
  (/ (+ (upper-bound z) (lower-bound z)) 2))
;;問題の意味が分からなかったので調べました。
;;http://sicp.naochan.com/memo.pl?p=%CC%E4%C2%EA2.9
;;代替意味は分かりました。
;;めんどうなので(op = (+ or -))ということで話を進めます。
;;区間AとBの和(もしくは差)の幅がf(width(A),width(B)」
;;であることを示せばいいのだと思います。
;;width(A)と書くとめんどうなのでwaにします。
;	(op-interval A B)
;	(op-interval (cons la ua) (cons lb ub))
;	((op la lb) (op ua ub))
;;幅を計算
;	(calc-width (cons (op la lb) (op ua ub)))
;	(/ (+ (op la lb) (op ua ub)) 2)
;	(/ (op (+ la ua) (+ lb ub)) 2)
;	(op (/ (+ la ua) 2) (/ (+ lb ub) 2))
;	(op wa wb)
;;最終的に幅だけの関数になる
;	
;	;;乗算除算の時。(例だけでいいみたいなので例だけ)
(define (check f-interval a b)
  (display(calc-width (f-interval a b)))
  (display " = f(")
  (display (calc-width a))
  (display ", ")
  (display (calc-width b))
  (display ")"))
;	9 = f(7/2, 11/2) ;+
;	gosh> (check minus-interval (cons 3 4) (cons 5 6))
;	-2 = f(7/2, 11/2) ;-
;	gosh> (check mul-interval (cons 3 4) (cons 5 6))
;	39/2 = f(7/2, 11/2) ;*
;	gosh> (check div-interval (cons 3 4) (cons 5 6))
;	0.65 = f(7/2, 11/2) ;/

;;m2.10
;;単純に0を跨いでいるかどうか調べればいいっぽいので,
;;こんな感じかな？
(define (div-interval+check x y)
  (if (> 0 (* (lower-bound y) (upper-bound y)))
      (display "error!")
      (div-interval x y)))
;	(div-interval+check (cons 3 4) (cons -1 1))
;	error!#<undef>

;;m2.11
;;mul-intervalを9つの場合にわけることができる。
;;lower<upperなので
;	9=3*3
;	 =((--),(-+),(++))^2
;;これで9通り。
(define (mul-interval2 x y)
  (define (condition z do1 do2 do3)
    (cond ((and (< (lower-bound z) 0) (< (upper-bound z) 0)) do1) ;;--
          ((< (lower-bound z) 0) do2) ;-+
          (else do3))) ;++
  (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))))
    (condition x
               (condition y
                          (make-interval p4 p1)
                          (make-interval p2 p1)
                          (make-interval p2 p3))
               (condition y
                          (make-interval p3 p1)
                          (make-interval (min p2 p3) (max p1 p4)) ;後でこっちに変更
                          ;(make-interval p2 p4) ;下の実験はこちらを使っている。
                          (make-interval p2 p4))
               (condition y
                          (make-interval p3 p2)
                          (make-interval p3 p4)
                          (make-interval p1 p4)))))

;;以下を使って調べた。
(define (search-mul-interval x y min-or-max)
  (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))))
    (display (min-or-max p1 p2 p3 p4))
    (display ":  ")
    (display "lxly=")
    (display p1)
    (display ", lxuy=")
    (display p2)
    (display ", uxly=")
    (display p3)
    (display ", uxuy=")
    (display p4)))
(define f search-mul-interval)
(define x-- (cons -2 -1))
(define x-+ (cons -1 1))
(define x++ (cons 1 2))
(define y-- (cons -4 -3))
(define y-+ (cons -1 2))
(define y++ (cons 3 4))
;	gosh> (f x-- y-- min)
;	3:  lxly=8, lxuy=6, uxly=4, uxuy=3#<undef>
;	gosh> (f x-- y-+ min)
;	-4:  lxly=2, lxuy=-4, uxly=1, uxuy=-2#<undef>
;	gosh> (f x-- y++ min)
;	-8:  lxly=-6, lxuy=-8, uxly=-3, uxuy=-4#<undef>
;	gosh> (f x-+ y-- min)
;	-4:  lxly=4, lxuy=3, uxly=-4, uxuy=-3#<undef>
;	gosh> (f x-+ y-+ min)
;	-2:  lxly=1, lxuy=-2, uxly=-1, uxuy=2#<undef>
;	gosh> (f x-+ y++ min)
;	-4:  lxly=-3, lxuy=-4, uxly=3, uxuy=4#<undef>
;	gosh> (f x++ y-- min)
;	-8:  lxly=-4, lxuy=-3, uxly=-8, uxuy=-6#<undef>
;	gosh> (f x++ y-+ min)
;	-2:  lxly=-1, lxuy=2, uxly=-2, uxuy=4#<undef>
;	gosh> (f x++ y++ min)
;	3:  lxly=3, lxuy=4, uxly=6, uxuy=8#<undef>
;	gosh> "次はmax"
;	"次はmax"
;	gosh> (f x-- y-- max)
;	8:  lxly=8, lxuy=6, uxly=4, uxuy=3#<undef>
;	gosh> (f x-- y-+ max)
;	2:  lxly=2, lxuy=-4, uxly=1, uxuy=-2#<undef>
;	gosh> (f x-- y++ max)
;	-3:  lxly=-6, lxuy=-8, uxly=-3, uxuy=-4#<undef>
;	gosh> (f x-+ y-- max)
;	4:  lxly=4, lxuy=3, uxly=-4, uxuy=-3#<undef>
;	gosh> (f x-+ y-+ max)
;	2:  lxly=1, lxuy=-2, uxly=-1, uxuy=2#<undef>
;	gosh> (f x-+ y++ max)
;	4:  lxly=-3, lxuy=-4, uxly=3, uxuy=4#<undef>
;	gosh> (f x++ y-- max)
;	-3:  lxly=-4, lxuy=-3, uxly=-8, uxuy=-6#<undef>
;	gosh> (f x++ y-+ max)
;	4:  lxly=-1, lxuy=2, uxly=-2, uxuy=4#<undef>
;	gosh> (f x++ y++ max)
;	8:  lxly=3, lxuy=4, uxly=6, uxuy=8#<undef>

;;ここからは、check
(define (check-same?-mul-interval-1and2 x y)
  (if (and (= (car (mul-interval2 x y)) (car(mul-interval x y)))
           (= (cdr (mul-interval2 x y)) (cdr(mul-interval x y))))
      "ok!"
      "error!"))
(define g check-same?-mul-interval-1and2)
(define x-- (make-interval -7 -3))
(define x-+ (make-interval -5 13))
(define x++ (make-interval 2 11))
(define y-- (make-interval -32 -22))
(define y-+ (make-interval -22 22))
(define y++ (make-interval 20 50))
;;x-+ y-+のところだけ違うみたい。
;	gosh> (g x-- y--)
;	"ok!"
;	gosh> (g x-- y-+)
;	"ok!"
;	gosh> (g x-- y++)
;	"ok!"
;	gosh> (g x-+ y--)
;	"ok!"
;	gosh> (g x-+ y-+)
;	"error!"
;	gosh> (g x-+ y++)
;	"ok!"
;	gosh> (g x++ y--)
;	"ok!"
;	gosh> (g x++ y-+)
;	"ok!"
;	gosh> (g x++ y++)
;	"ok!"

;前回の結果
;;gosh> (f x-+ y-+ max)
;;2:  lxly=1, lxuy=-2(min), uxly=-1, uxuy=2(max)#<undef>
;今回の結果
;;gosh> (search-mul-interval x-+ y-+ max)
;;286:  lxly=110, lxuy=-110, uxly=-286(min), uxuy=286(max)#<undef>
;あとこんなのも
;;(search-mul-interval (cons -100 10) (cons -30 20) min)
;;-2000:  lxly=3000, lxuy=-2000, uxly=-300, uxuy=200#<undef>
;というわけで、x-+ y-+ のところを
;;(make-interval (min lxuy uxly) (max lxly uxuy))に変更！
;;これで完成。
;	gosh> (g x-+ y-+)
;	"ok!"
;	gosh> (g (cons -100 10) (cons -30 20))
;	"ok!"