1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
3 665c255d 2023-08-04 jrmu (display "Actual: ")
4 665c255d 2023-08-04 jrmu (display actual)
6 665c255d 2023-08-04 jrmu (display "Expected: ")
7 665c255d 2023-08-04 jrmu (display expected)
10 665c255d 2023-08-04 jrmu ;; Exercise 2.29. A binary mobile consists of two branches, a left branch and a right branch. Each branch is a rod of a certain length, from which hangs either a weight or another binary mobile. We can represent a binary mobile using compound data by constructing it from two branches (for example, using list):
12 665c255d 2023-08-04 jrmu ;; A branch is constructed from a length (which must be a number) together with a structure, which may be either a number (representing a simple weight) or another mobile:
14 665c255d 2023-08-04 jrmu ;; a. Write the corresponding selectors left-branch and right-branch, which return the branches of a mobile, and branch-length and branch-structure, which return the components of a branch.
16 665c255d 2023-08-04 jrmu ;; b. Using your selectors, define a procedure total-weight that returns the total weight of a mobile.
18 665c255d 2023-08-04 jrmu ;; c. A mobile is said to be balanced if the torque applied by its top-left branch is equal to that applied by its top-right branch (that is, if the length of the left rod multiplied by the weight hanging from that rod is equal to the corresponding product for the right side) and if each of the submobiles hanging off its branches is balanced. Design a predicate that tests whether a binary mobile is balanced.
20 665c255d 2023-08-04 jrmu (define (make-mobile left right)
21 665c255d 2023-08-04 jrmu (list left right))
22 665c255d 2023-08-04 jrmu (define (make-branch length structure)
23 665c255d 2023-08-04 jrmu (list length structure))
24 665c255d 2023-08-04 jrmu (define (left-branch mobile)
25 665c255d 2023-08-04 jrmu (car mobile))
26 665c255d 2023-08-04 jrmu (define (right-branch mobile)
27 665c255d 2023-08-04 jrmu (cadr mobile))
28 665c255d 2023-08-04 jrmu (define (branch-length branch)
29 665c255d 2023-08-04 jrmu (car branch))
30 665c255d 2023-08-04 jrmu (define (branch-structure branch)
31 665c255d 2023-08-04 jrmu (cadr branch))
32 665c255d 2023-08-04 jrmu (define (weight? mobile)
33 665c255d 2023-08-04 jrmu (not (pair? mobile)))
34 665c255d 2023-08-04 jrmu (define (total-weight mobile)
35 665c255d 2023-08-04 jrmu (if (weight? mobile)
37 665c255d 2023-08-04 jrmu (+ (total-weight (branch-structure (left-branch mobile)))
38 665c255d 2023-08-04 jrmu (total-weight (branch-structure (right-branch mobile))))))
40 665c255d 2023-08-04 jrmu (define m1 (make-mobile (make-branch 4 5) (make-branch 10 3)))
41 665c255d 2023-08-04 jrmu (define m2 (make-mobile (make-branch 2 3) (make-branch 3 4)))
42 665c255d 2023-08-04 jrmu (define m3 (make-mobile (make-branch 4 m1) (make-branch 5 m1)))
43 665c255d 2023-08-04 jrmu (define m4 (make-mobile (make-branch 7 m3) (make-branch 15 m2)))
44 665c255d 2023-08-04 jrmu (define m5 (make-mobile (make-branch 1 m4) (make-branch 3 m3)))
46 665c255d 2023-08-04 jrmu ;; (test-case (total-weight 4) 4)
47 665c255d 2023-08-04 jrmu ;; (test-case (total-weight m1) 8)
48 665c255d 2023-08-04 jrmu ;; (test-case (total-weight m2) 7)
49 665c255d 2023-08-04 jrmu ;; (test-case (total-weight m3) 16)
50 665c255d 2023-08-04 jrmu ;; (test-case (total-weight m4) 23)
51 665c255d 2023-08-04 jrmu ;; (test-case (total-weight m5) 39)
53 665c255d 2023-08-04 jrmu (define (balanced? mobile)
54 665c255d 2023-08-04 jrmu (if (weight? mobile)
56 665c255d 2023-08-04 jrmu (let* ((lb (left-branch mobile))
57 665c255d 2023-08-04 jrmu (rb (right-branch mobile))
58 665c255d 2023-08-04 jrmu (ls (branch-structure lb))
59 665c255d 2023-08-04 jrmu (rs (branch-structure rb)))
61 665c255d 2023-08-04 jrmu (balanced? ls)
62 665c255d 2023-08-04 jrmu (balanced? rs)
63 665c255d 2023-08-04 jrmu (= (* (branch-length lb)
64 665c255d 2023-08-04 jrmu (total-weight ls))
65 665c255d 2023-08-04 jrmu (* (branch-length rb)
66 665c255d 2023-08-04 jrmu (total-weight rs)))))))
68 665c255d 2023-08-04 jrmu (define m6 (make-mobile (make-branch 6 6) (make-branch 9 4))) ;; weight 10
69 665c255d 2023-08-04 jrmu (define m7 (make-mobile (make-branch 4 5) (make-branch 10 2))) ;; weight 7
70 665c255d 2023-08-04 jrmu (define m8 (make-mobile (make-branch 5 m6) (make-branch 2 25))) ;; wgt 35
71 665c255d 2023-08-04 jrmu (define m9 (make-mobile (make-branch 2 m8) (make-branch 10 m7))) ;; wgt 42
72 665c255d 2023-08-04 jrmu (define m10 (make-mobile (make-branch 1 m9) (make-branch 6 m7))) ;; wgt 49
74 665c255d 2023-08-04 jrmu (test-case (balanced? m1) #f)
75 665c255d 2023-08-04 jrmu (test-case (balanced? m2) #f)
76 665c255d 2023-08-04 jrmu (test-case (balanced? m3) #f)
77 665c255d 2023-08-04 jrmu (test-case (balanced? m4) #f)
78 665c255d 2023-08-04 jrmu (test-case (balanced? m5) #f)
79 665c255d 2023-08-04 jrmu (test-case (balanced? m6) #t)
80 665c255d 2023-08-04 jrmu (test-case (balanced? m7) #t)
81 665c255d 2023-08-04 jrmu (test-case (balanced? m8) #t)
82 665c255d 2023-08-04 jrmu (test-case (balanced? m9) #t)
83 665c255d 2023-08-04 jrmu (test-case (balanced? m10) #t)
85 665c255d 2023-08-04 jrmu ;; d. Suppose we change the representation of mobiles so that the constructors are
87 665c255d 2023-08-04 jrmu (define (make-mobile left right)
88 665c255d 2023-08-04 jrmu (cons left right))
89 665c255d 2023-08-04 jrmu (define (make-branch length structure)
90 665c255d 2023-08-04 jrmu (cons length structure))
92 665c255d 2023-08-04 jrmu ;; How much do you need to change your programs to convert to the new representation?
94 665c255d 2023-08-04 jrmu ;; Just need to change these 4:
96 665c255d 2023-08-04 jrmu (define (left-branch mobile)
97 665c255d 2023-08-04 jrmu (car mobile))
98 665c255d 2023-08-04 jrmu (define (right-branch mobile)
99 665c255d 2023-08-04 jrmu (cdr mobile))
100 665c255d 2023-08-04 jrmu (define (branch-length branch)
101 665c255d 2023-08-04 jrmu (car branch))
102 665c255d 2023-08-04 jrmu (define (branch-structure branch)
103 665c255d 2023-08-04 jrmu (cdr branch))
