<< Previous exercise (2.28) | Index | Next exercise (2.30) >>

Use the same recursion over the construction of the mobile for defining the function 'total-weight' as; well as the predicate 'balanced?'. Take advantage of the fact that a variable has no type. The variab;le 'm' can in different calls take as a value a mobile, a branch or a number or empty list.

; Definition of constructors and selectors (define (make-mobile left right) (list left right)) (define (left-branch mobile) (car mobile)) (define (right-branch mobile) (car (cdr mobile))) (define (make-branch length structure) (list length structure)) (define (branch-length branch) (car branch)) (define (branch-structure branch) (car (cdr branch))) ;; Redefinition of constructors and selectors (define (make-mobile left right) (cons left right)) (define (left-branch mobile) (car mobile)) (define (right-branch mobile) (cdr mobile)) (define (make-branch length structure) (cons length structure)) (define (branch-length branch) (car branch)) (define (branch-structure branch) (cdr branch)) (define (total-weight m) (cond ((null? m) 0) ((not (pair? m)) m) (else (+ (total-weight (branch-structure (left-branch m))) (total-weight (branch-structure (right-branch m))))))) (define m1 (make-mobile (make-branch 4 6) (make-branch 5 (make-mobile (make-branch 3 7) (make-branch 9 8))))) ;; 4 | 5 ;; +----+-----+ ;; 6 3 | 9 ;; +---+---------+ ;; 7 8 ; (total-weight m1) ; Value: 21 (define (balanced? m) (cond ((null? m) #t) ((not (pair? m)) #t) (else (and (= (* (branch-length (left-branch m)) (total-weight (branch-structure (left-branch m)))) (* (branch-length (right-branch m)) (total-weight (branch-structure (right-branch m))))) (balanced? (branch-structure (left-branch m))) (balanced? (branch-structure (right-branch m))))))) (define m2 (make-mobile (make-branch 4 6) (make-branch 2 (make-mobile (make-branch 5 8) (make-branch 10 4))))) ;; 4 | 2 ;; +----+--+ ;; 6 5 | 10 ;; +-----+----------+ ;; 8 4 (balanced? m2) ;Value: #t (balanced? m1) ;Value: #f

My solution for c. consists of only one tree traversal instead of recursive tree traversal due to 'total-weight' procedure in every node.

(define (make-mobile l r) (list l r)) (define (make-branch len struct) (list len struct)) ;; a. (define (left-branch m) (car m)) (define (right-branch m) (cadr m)) (define (branch-length b) (car b)) (define (branch-structure b) (cadr b)) ;; b. (define (total-weight m) ;; m should be mobile (if (not (pair? m)) m (+ (branch-structure (left-branch m)) (branch-structure (right-branch m))))) ;; c. ;; Defined [ sum-balanced?-pair :: mobile |-> (sum, balanced?) ] instead of using total-weight to reduce recursions. (define (balanced? m) ;; m should be mobile (define (sum-balanced?-pair m) (if (not (pair? m)) (cons m #t) (let ((left (sum-balanced?-pair (branch-structure (left-branch m)))) (right (sum-balanced?-pair (branch-structure (right-branch m))))) (cons (+ (car left) (car right)) (and (cdr left) (cdr right) (= (* (branch-length (left-branch m)) (car left)) (* (branch-length (right-branch m)) (car right)))))))) (cdr (sum-balanced?-pair m))) ;; d. ;; Modifying selectors is sufficient. ;; test cases from http://community.schemewiki.org/?sicp-ex-2.29 (define a (make-mobile (make-branch 2 3) (make-branch 2 3))) (total-weight a) (define d (make-mobile (make-branch 10 a) (make-branch 12 5))) (balanced? d)

My solution for 'balanced?' function. Aoivd using total-weight to reduce recursive tree, also only use one return value.

```
(define (balanced? mb)
(define (balanced-rec? mb)
;; balance? returns #f if mb is not balanced
;; returns its weight if mb is balanced
(cond ((null? mb) 0)
((number? mb) mb)
((pair? mb)
(let ((left (balanced-rec? (branch-structure (left-branch mb))))
(right (balanced-rec? (branch-structure (right-branch mb)))))
;; because (and number #t) = #t
;; (and #f #t) = #f
(if (or (not (and left #t)) (not (and right #t)))
;; if left or right is not balanced, return #f
#f
;; else calculate torque
(if (= (* left (branch-length (left-branch mb)))
(* right (branch-length (right-branch mb))))
;; if balanced return its weight
(+ left right)
;; else return #f
#f))))))
(and (balanced-rec? mb) #t))
```

This solution touches each branch once and goes the full depth until it hits a node which has only weights on its branches. It returns a list of two values, the first one tells if the node is balanced and the second one captures the weight on the node. So every time the function returns I am able to retrieve the weights of the children (i.e. branches) and calculating torque is only a matter of multiplication. No separate procedure calls for torque.

(define (make-mobile left right) (list left right) ) (define (make-branch length structure) (list length structure) ) (define (left-branch mobile) (car mobile)) (define (right-branch mobile) (cadr mobile)) (define (branch-length branch) (car branch)) (define (branch-structure branch) (cadr branch)) (define (total-weight mobile) (cond ((and (not (pair? (branch-structure (left-branch mobile)))) (not (pair? (branch-structure (right-branch mobile))))) (+ (branch-structure (left-branch mobile)) (branch-structure (right-branch mobile)))) ((not (pair? (branch-structure (left-branch mobile)))) (+ (branch-structure (left-branch mobile)) (total-weight (branch-structure (right-branch mobile))))) ((not (pair? (branch-structure (right-branch mobile)))) (+ (total-weight (branch-structure (left-branch mobile))) (branch-structure (right-branch mobile)))) (else (+ (total-weight (branch-structure (left-branch mobile))) (total-weight (branch-structure (right-branch mobile))))) ) ) (define (balanced? mbl) (define (balanced-aux? mobile) (cond ((and (not (pair? (branch-structure (left-branch mobile)))) (not (pair? (branch-structure (right-branch mobile))))) (list (= (* (branch-length (left-branch mobile)) (branch-structure (left-branch mobile))) (* (branch-length (right-branch mobile)) (branch-structure (right-branch mobile)))) (+ (branch-structure (left-branch mobile)) (branch-structure (right-branch mobile))))) ((not (pair? (branch-structure (left-branch mobile)))) (let ((balR (balanced-aux? (branch-structure (right-branch mobile))))) (list (and (car balR) (= (* (branch-length (left-branch mobile)) (branch-structure (left-branch mobile))) (* (branch-length (right-branch mobile)) (cadr balR)))) (+ (branch-structure (left-branch mobile)) (cadr balR))))) ((not (pair? (branch-structure (right-branch mobile)))) (let ((balL (balanced-aux? (branch-structure (left-branch mobile))))) (list (and (car balL) (= (* (branch-length (right-branch mobile)) (branch-structure (right-branch mobile))) (* (branch-length (left-branch mobile)) (cadr balL)))) (+ (cadr balL) (branch-structure (right-branch mobile)))))) (else (let ((balL (balanced-aux? (branch-structure (left-branch mobile)))) (balR (balanced-aux? (branch-structure (right-branch mobile))))) (list (and (car balL) (car balR) (= (* (branch-length (left-branch mobile)) (cadr balL)) (* (branch-length (right-branch mobile)) (cadr balR)))) (+ (cadr balL) (cadr balR))))) ) ) (car (balanced-aux? mbl)) )

Making the constructors and selectors first for building the bigger solution on.

Version one using lists

Version two using cons instead of lists

Rest of the problem

The test cases were used from Bill the Lizard's blog on SICP