src/sicp/ex2_11.clj

   1 (ns sicp.ex2_11
   2   (:use [sicp utils ch2_1_extended ex2_7]
   3         [clojure.test]))
   4
   5 ;; let [l1, u2] be lower and upper bound of range x
   6 ;; and [l2, u2] that of range y.
   7
   8 ;; based on the signs of l1, u1, l2, u2, we have 16 combinations
   9
  10 ;; l1 :u1 :l2 :u2
  11 ;; +   +   +   +
  12 ;; +   +   +   -
  13 ;; +   +   -   +
  14 ;; +   +   -   -
  15 ;; +   -   +   +
  16 ;; +   -   +   -
  17 ;; +   -   -   +
  18 ;; +   -   -   -
  19 ;; -   +   +   +
  20 ;; -   +   +   -
  21 ;; -   +   -   +
  22 ;; -   +   -   -
  23 ;; -   -   +   +
  24 ;; -   -   +   -
  25 ;; -   -   -   +
  26 ;; -   -   -   -
  27
  28 ;; Now, if lower bound is +ve and upper is -ve, then it is invalid. So,
  29 ;; l1 :u1 :l2 :u2
  30 ;; +   +   +   +
  31 ;; +   +   +   -  => invalid
  32 ;; +   +   -   +
  33 ;; +   +   -   -
  34 ;; +   -   +   +  => invalid
  35 ;; +   -   +   -  => invalid
  36 ;; +   -   -   +  => invalid
  37 ;; +   -   -   -  => invalid
  38 ;; -   +   +   +
  39 ;; -   +   +   -  => invalid
  40 ;; -   +   -   +
  41 ;; -   +   -   -
  42 ;; -   -   +   +
  43 ;; -   -   +   -  => invalid
  44 ;; -   -   -   +
  45 ;; -   -   -   -
  46
  47 (defn new-mul-interval [x y]
  48   (let [l1 (lower-bound x)
  49         u1 (upper-bound x)
  50         l2 (lower-bound y)
  51         u2 (upper-bound y)
  52         sl1? (pos? l1)
  53         su1? (pos? u1)
  54         sl2? (pos? l2)
  55         su2? (pos? u2)]
  56     (cond (and sl1? su1? sl2? su2?)             (make-interval (* l1 l2) (* u1 u2))
  57           (and sl1? su1? (not sl2?) su2?)       (make-interval (* u1 l2) (* u1 u2))
  58           (and sl1? su1? (not sl2?) (not su2?)) (make-interval (* u1 l2) (* u2 l1))
  59           (and (not sl1?) su1? sl2? su2?)       (make-interval (* l1 u2) (* u1 u2))
  60           (and (not sl1?) su1? (not sl2?) (not su2?)) (make-interval (* u1 l2) (* l1 l2))
  61           (and (not sl1?) (not su1?) sl2? su2?) (make-interval (* l1 u2) (* u1 l2))
  62           (and (not sl1?) (not su1?) (not sl2?) su2?) (make-interval (* l1 u2) (* l1 l2))
  63           (and (not sl1?) (not su1?) (not sl2?) (not su2?)) (make-interval (* u1 u2) (* l1 l2))
  64           (and (not sl1?) su1? (not sl2?) su2?) (let [p1 (* l1 l2)
  65                                                       p2 (* l1 u2)
  66                                                       p3 (* u1 l2)
  67                                                       p4 (* u1 u2)]
  68                                                   (make-interval (min p1 p2 p3 p4)
  69                                                                  (max p1 p2 p3 p4))))))