計算機プログラムの構造と解釈 第二版 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"
うぬ。