learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-29.scm (2983B)

      1 ;; Exercise 2.29
      2 
      3 (define (exercise-2.29)
      4   '(define (make-mobile left-branch right-branch)
      5      (list left-branch right-branch))
      6 
      7   (define (make-mobile left-branch right-branch)
      8     (cons left-branch right-branch))
      9 
     10   '(define (make-branch length structure)
     11      (list length structure))
     12 
     13   (define (make-branch length structure)
     14     (cons length structure))
     15 
     16   (define (left-branch mobile)
     17     (car mobile))
     18 
     19   '(define (right-branch mobile)
     20      (cadr mobile))
     21 
     22   (define (right-branch mobile)
     23     (cdr mobile))
     24 
     25   (define (branch-length branch)
     26     (car branch))
     27 
     28   '(define (branch-structure branch)
     29      (cadr branch))
     30 
     31   (define (branch-structure branch)
     32     (cdr branch))
     33 
     34   (define (total-weight mobile)
     35     (cond
     36      ((number? mobile) mobile)
     37      (else
     38       (let ([left-branch-structure
     39              (branch-structure (left-branch mobile))]
     40             [right-branch-structure
     41              (branch-structure (right-branch mobile))])
     42 
     43         (+ (if (number? left-branch-structure)
     44                left-branch-structure
     45                (total-weight left-branch-structure))
     46            (if (number? right-branch-structure)
     47                right-branch-structure
     48                (total-weight right-branch-structure)))))))
     49 
     50   (define (branch-torque branch)
     51     (* (branch-length branch)
     52        (total-weight (branch-structure branch))))
     53 
     54   (define (balanced mobile)
     55     (= (branch-torque (left-branch mobile))
     56        (branch-torque (right-branch mobile))))
     57 
     58 
     59   (test-begin "2.29")
     60   (test-equal
     61       10
     62     (total-weight
     63      (make-mobile (make-branch 2 3)
     64                   (make-branch 5 7))))
     65   (test-equal
     66       64
     67     (total-weight
     68      (make-mobile (make-branch 2
     69                                (make-mobile (make-branch 3 5)
     70                                             (make-branch 7 11)))
     71                   (make-branch 13
     72                                (make-mobile (make-branch 17 19)
     73                                             (make-branch 23 29))))))
     74   (test-equal
     75       6
     76     (branch-torque (make-branch 2 3)))
     77   (test-equal
     78       #t
     79     (balanced (make-mobile (make-branch 3 5)
     80                            (make-branch 5 3))))
     81   (test-equal
     82       #t
     83     (balanced (make-mobile (make-branch 3
     84                                         (make-mobile (make-branch 4 1)
     85                                                      (make-branch 1 4)))
     86                            (make-branch 5
     87                                         (make-mobile (make-branch 1 2)
     88                                                      (make-branch 2 1))))))
     89   (test-equal
     90       #f
     91     (balanced (make-mobile (make-branch 3
     92                                         (make-mobile (make-branch 4 1)
     93                                                      (make-branch 1 3)))
     94                            (make-branch 5
     95                                         (make-mobile (make-branch 1 2)
     96                                                      (make-branch 2 1))))))
     97   (test-end "2.29"))
     98 
     99 (exercise-2.29)