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