計算機プログラムの構造と解釈 第二版 P53 問題2.10

・0に跨がる区間があったら、エラーを出す！

と言うのをやればいい。

ちょっと自信ないけど、もう実装です。

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

(use ggc.debug.trace)
(use math.mt-random)


;;P53
;;和
(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)))))


;;問題2-7
(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)
  (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))))

;;問題2-10
(define (straddle? x)
  (if (>= 0 (* (upper-bound x) (lower-bound x)))
    #t
  #f))

(define (new-sub-interval x y)
 (if (straddle? y)
    (error "straddle 0" 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 interval1 (make-interval -4 9))
(define interval2 (make-interval 3 5))
(define interval3 (make-interval 3 7))

(define interval-sub (sub-interval interval1 interval2))



;; main
(define (main args)

  (newline)

  (display "interval1: ")
  (display interval1)
  (newline)
  (display "interval2: ")
  (display interval2)
  (newline)
  (display "interval3: ")
  (display interval3)
  (newline)

  (display "(straddle? interval1): ")
  (display (straddle? interval1))(newline)

  (display "(straddle? interval2): ")
  (display (straddle? interval2))(newline)

  (display "(straddle? interval3): ")
  (display (straddle? interval3))(newline)

  (display (new-sub-interval interval2 interval3))(newline)
  (display (new-sub-interval interval2 interval1))(newline)

  (newline)
0)

実行

interval1: (-4 . 9)
interval2: (3 . 5)
interval3: (3 . 7)
(straddle? interval1): #t
(straddle? interval2): #f
(straddle? interval3): #f
(-4 . 2)
*** ERROR: straddle 0 (-4 . 9)
Stack Trace:
_______________________________________
  0  (error "straddle 0" y)
        At line 61 of "././2-10.scm"
  1  (new-sub-interval interval2 interval1)
        At line 103 of "././2-10.scm"
  2  (display (new-sub-interval interval2 interval1))
        At line 103 of "././2-10.scm"

うぬ。