sicp-ex-2.29

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

Version one using lists

  
 (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))) 

Version two using cons instead of lists

 (define (make-mobile left right) 
   (cons left right)) 
  
 (define (left-branch mobile) 
   (car mobile)) 
 (define (right-branch mobile) 
   ;; Have to use cdr at this point  
   (cdr mobile))  
  
 (define (make-branch length structure) 
   (cons length structure)) 
  
 (define (branch-length branch) 
   (car branch)) 
 (define (branch-structure branch) 
   (cdr branch)) 

Rest of the problem

 ;; Finding the total weight of a binary mobile 
 ;; Using wishful thinking to recurse the addition of left-branch and right-branch mobiles 
  
 (define (total-weight mobile) 
   (cond ((null? mobile) 0) 
         ((not (pair? mobile)) mobile) 
         (else (+ (total-weight (branch-structure (left-branch mobile))) 
                  (total-weight (branch-structure (right-branch mobile))))))) 
  
 ;; Test  
 (define a (make-mobile (make-branch 2 3) (make-branch 2 3))) 
 (total-weight a) ;; 6 
  
 (define (torque branch) 
   (* (branch-length branch) (total-weight (branch-structure branch)))) 
  
 ;; Finally to check if the torques of both sides are equal 
 ;; And if the sub-mobiles are balanced using recursion 
  
 (define (balanced? mobile) 
   (if (not (pair? mobile)) 
       true 
       (and (= (torque (left-branch mobile)) (torque (right-branch mobile))) 
            (balanced? (branch-structure (left-branch mobile))) 
            (balanced? (branch-structure (right-branch mobile)))))) 
  
 ;; Test 
  
 (define d (make-mobile (make-branch 10 a) (make-branch 12 5))) 
 ;; Looks like: ((10 ((2 3) (2 3))) (12 5)) 
  
 (balanced? d) ;; #t 

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

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)) 
 ) 

Here's my solution. I prefer to factor out the code that calculates the branch weight from total-weight, which makes both weight and total-weight much cleaner and easier to understand. One could argue that the name total-weight then isn't appropriate anymore and really we have two functions, which calculate either the branch weight or mobile weight. They are mutually recursive but that's because the data structure is mutually recursive in a sense, mobiles contain branches which can contain other mobiles, etc.

 (define (weight branch) 
   (let ((submobile (branch-structure branch))) 
     (if (not (mobile? submobile)) 
         submobile 
         (total-weight submobile)))) 
  
 (define (total-weight mobile) 
   (let ((left (left-branch mobile)) 
         (right (right-branch mobile))) 
     (+ (weight left) (weight right)))) 
  
 (define (balanced? mobile) 
   (define (torque branch) 
     (* (branch-length branch) (weight branch))) 
   (if (not (mobile? mobile)) 
       #t 
       (let ((left (left-branch mobile)) 
             (right (right-branch mobile))) 
         (and (= (torque left) (torque right)) 
              (balanced? (branch-structure left)) 
              (balanced? (branch-structure right))))))