2.11.scm

(load "./2.10")

(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))))

; 符号のパターンは9通り(0は+に含む)
;
; (+ +) (+ +)
; (- +) (+ +)
; (+ +) (- +)
; (- -) (+ +)
; (+ +) (- -)
; (- -) (- +)
; (- +) (- -)
; (- +) (- +)
; (- -) (- -)
;
; このうち、(- +) (- +) のパターンが2回を超える乗算を必要とする。

(define (mul-interval2 x y)
  (define (mul max-x max-y min-x min-y)
    (let ((max (* max-x max-y))
          (min (* min-x min-y)))
      (make-interval min max)))
  (define (mul2 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 p2 p3)
                     (max p1 p4))))
  (let ((ux (upper-bound x))
        (lx (lower-bound x))
        (uy (upper-bound y))
        (ly (lower-bound y)))
    (cond ((and (<= 0 lx) (<= 0 ux) (<= 0 ly) (<= 0 uy))
           (mul ux uy lx ly))
          ((and (> 0 lx) (<= 0 ux) (<= 0 ly) (<= 0 uy))
           (mul ux uy lx uy))
          ((and (<= 0 lx) (<= 0 ux) (> 0 ly) (<= 0 uy))
           (mul ux uy ux ly))
          ((and (> 0 lx) (> 0 ux) (<= 0 ly) (<= 0 uy))
           (mul ux ly lx uy))
          ((and (<= 0 lx) (<= 0 ux) (> 0 ly) (> 0 uy))
           (mul lx uy ux ly))
          ((and (> 0 lx) (> 0 ux) (> 0 ly) (<= 0 uy))
           (mul lx ly lx uy))
          ((and (> 0 lx) (<= 0 ux) (> 0 ly) (> 0 uy))
           (mul lx ly ux ly))
          ((and (> 0 lx) (> 0 ux) (> 0 ly) (> 0 uy))
           (mul lx ly ux uy))
          (else
            (mul2 x y)))))

(define (main args)
  (print (mul-interval (make-interval 1 2) (make-interval 1 2)))
  (print (mul-interval (make-interval -1 2) (make-interval 1 2)))
  (print (mul-interval (make-interval 1 2) (make-interval -1 2)))
  (print (mul-interval (make-interval -2 -1) (make-interval 1 2)))
  (print (mul-interval (make-interval 1 2) (make-interval -2 -1)))
  (print (mul-interval (make-interval -2 -1) (make-interval -1 2)))
  (print (mul-interval (make-interval -1 2) (make-interval -2 -1)))
  (print (mul-interval (make-interval -1 2) (make-interval -1 2)))
  (print (mul-interval (make-interval -2 -1) (make-interval -2 -1)))
  (newline)
  (print (mul-interval2 (make-interval 1 2) (make-interval 1 2)))
  (print (mul-interval2 (make-interval -1 2) (make-interval 1 2)))
  (print (mul-interval2 (make-interval 1 2) (make-interval -1 2)))
  (print (mul-interval2 (make-interval -2 -1) (make-interval 1 2)))
  (print (mul-interval2 (make-interval 1 2) (make-interval -2 -1)))
  (print (mul-interval2 (make-interval -2 -1) (make-interval -1 2)))
  (print (mul-interval2 (make-interval -1 2) (make-interval -2 -1)))
  (print (mul-interval2 (make-interval -1 2) (make-interval -1 2)))
  (print (mul-interval2 (make-interval -2 -1) (make-interval -2 -1)))
  )