]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_29.clj
rewrite `quote->cons' using `match'.
[sicp.git] / src / sicp / ex2_29.clj
1 (ns sicp.ex2_29
2   (:use [clojure.test]))
3
4 (defn make-mobile [left right]
5   (list left right))
6
7 (defn make-branch [length structure]
8   (list length structure))
9
10 ;; a.  Write the corresponding selectors left-branch and
11 ;;     right-branch, which return the branches of a mobile, and
12 ;;     branch-length and branch-structure, which return the
13 ;;     components of a branch.
14 (defn left-branch [mobile]
15   (first mobile))
16
17 (defn right-branch [mobile]
18   (first (rest mobile)))
19
20 (defn branch-length [branch]
21   (first branch))
22
23 (defn branch-structure [branch]
24   (first (rest branch)))
25
26 (deftest test-constructors-selectors
27   (let [m (make-mobile (make-branch 3 8)
28                        (make-branch 9
29                                     (make-mobile (make-branch 2 1)
30                                                  (make-branch 1 2))))]
31     (are [x y] [= x y]
32          m '((3 8) (9 ((2 1) (1 2))))
33          (right-branch m) '(9 ((2 1) (1 2)))
34          (left-branch m) '(3 8)
35          (branch-length (left-branch m)) 3
36          (branch-length (right-branch m)) 9
37          (branch-structure (left-branch m)) 8
38          (branch-structure (right-branch m)) '((2 1) (1 2)))))
39
40 ;; b.  Using your selectors, define a procedure total-weight that
41 ;;     returns the total weight of a mobile.
42
43 (declare total-branch-weight)
44
45 (defn total-weight [mobile]
46   (+ (total-branch-weight (right-branch mobile))
47      (total-branch-weight (left-branch mobile))))
48
49 (defn total-branch-weight [branch]
50   (let [structure (branch-structure branch)]
51     (cond (number? structure) structure
52           :else (total-weight structure))))
53
54 (deftest test-weights
55   (let [m (make-mobile (make-branch 3 8)
56                        (make-branch 9
57                                     (make-mobile (make-branch 2 1)
58                                                  (make-branch 1 2))))]
59     (are [x y] [= x y]
60          (total-weight m) 11)))
61
62 ;; c. A mobile is said to be balanced if the torque applied by its
63 ;;    top-left branch is equal to that applied by its top-right branch
64 ;;    (that is, if the length of the left rod multiplied by the weight
65 ;;    hanging from that rod is equal to the corresponding product for
66 ;;    the right side) and if each of the submobiles hanging off its
67 ;;    branches is balanced. Design a predicate that tests whether a
68 ;;    binary mobile is balanced.
69
70 (defn torque [branch]
71   (* (branch-length branch) (total-branch-weight branch)))
72
73 (defn mobile? [structure]
74   (seq? structure))
75
76 (defn balanced? [mobile]
77   (let [lstructure   (branch-structure (left-branch mobile))
78         rstructure   (branch-structure (right-branch mobile))]
79     (and (= (torque (left-branch mobile))
80             (torque (right-branch mobile)))
81          (if (mobile? lstructure)
82            (balanced? lstructure)
83            true)
84          (if (mobile? rstructure)
85            (balanced? rstructure)
86            true))))
87
88 (deftest test-balance
89   (let [m1 (make-mobile (make-branch 3 9)
90                         (make-branch 9
91                                      (make-mobile (make-branch 2 1)
92                                                   (make-branch 1 2))))
93         m2 (make-mobile (make-branch 2 4)
94                         (make-branch 3
95                                      (make-mobile (make-branch 2 1)
96                                                   (make-branch 4 2))))]
97     (are [x y] [= x y]
98          (balanced? m1) true
99          (balanced? m2) false)))
100
101 ;; d. Suppose we change the representation of mobiles.
102 ;;    How much do you need to change your programs to convert
103 ;;    to the new representation?
104
105 ;; soln
106 ;; if I were to do it in scheme, then oly selectors would change.