]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_11.clj
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / 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))))))