Petar Kapriš
1b2b2dfec1
To be noted: the last two exercises, 2.15 and 2.16 were left unfinished, and will be left for another time.
75 lines
2.8 KiB
Scheme
75 lines
2.8 KiB
Scheme
#lang sicp
|
|
|
|
(define (make-interval a b) (cons a b))
|
|
|
|
(define (lower-bound i)
|
|
(car i))
|
|
|
|
(define (upper-bound i)
|
|
(cdr i))
|
|
|
|
|
|
; explanation for sgn-interval:
|
|
; an interval has sign 0 if it has negative and non-negative
|
|
; values (ie. it spans over zero)
|
|
; a sign of -1 if all of it's values are negative
|
|
; and a sign of 1 if all of it's values are non-negative
|
|
(define (sgn-interval a)
|
|
(let ((low-a (lower-bound a))
|
|
(upp-a (upper-bound a)))
|
|
(cond ((< upp-a 0) -1)
|
|
((>= low-a 0) 1)
|
|
(else 0))))
|
|
|
|
(define (mul-interval x y)
|
|
(let* ((sgn-x (sgn-interval x))
|
|
(sgn-y (sgn-interval y))
|
|
(sgn-pair (cons sgn-x sgn-y)))
|
|
(cond ((equal? sgn-pair '(-1 . -1))
|
|
(make-interval (* (upper-bound x)
|
|
(upper-bound y))
|
|
(* (lower-bound x)
|
|
(lower-bound y))))
|
|
((equal? sgn-pair '(-1 . 0))
|
|
(make-interval (* (lower-bound x)
|
|
(upper-bound y))
|
|
(* (lower-bound x)
|
|
(lower-bound y))))
|
|
((equal? sgn-pair '(-1 . 1))
|
|
(make-interval (* (lower-bound x)
|
|
(upper-bound y))
|
|
(* (upper-bound x)
|
|
(lower-bound y))))
|
|
((equal? sgn-pair '(0 . -1))
|
|
(make-interval (* (upper-bound x)
|
|
(lower-bound y))
|
|
(* (lower-bound x)
|
|
(lower-bound y))))
|
|
; the difficult case
|
|
((equal? sgn-pair '(0 . 0))
|
|
(let ((uu (* (upper-bound x) (upper-bound y)))
|
|
(ul (* (upper-bound x) (lower-bound y)))
|
|
(lu (* (lower-bound x) (upper-bound y)))
|
|
(ll (* (lower-bound x) (lower-bound y))))
|
|
(make-interval (min ul lu)
|
|
(max uu ll))))
|
|
((equal? sgn-pair '(0 . 1))
|
|
(make-interval (* (lower-bound x)
|
|
(upper-bound y))
|
|
(* (upper-bound x)
|
|
(upper-bound y))))
|
|
((equal? sgn-pair '(1 . -1))
|
|
(make-interval (* (upper-bound x)
|
|
(lower-bound y))
|
|
(* (lower-bound x)
|
|
(upper-bound y))))
|
|
((equal? sgn-pair '(1 . 0))
|
|
(make-interval (* (upper-bound x)
|
|
(lower-bound y))
|
|
(* (upper-bound x)
|
|
(upper-bound y))))
|
|
((equal? sgn-pair '(1 . 1))
|
|
(make-interval (* (lower-bound x)
|
|
(lower-bound y))
|
|
(* (upper-bound x)
|
|
(upper-bound y)))))))
|