SICP exercise 2.29 in Haskell and Scheme

2-29.hs

data Branch = Branch { branch_length :: Int, branch_structure :: Mobile } deriving Show
data Mobile = Weight Int | Mobile { left_branch :: Branch, right_branch :: Branch } deriving Show

total_branch_weight (Branch { branch_structure = str }) = total_weight str

total_weight (Weight wt) = wt
total_weight (Mobile lt rt) =
  (total_branch_weight lt) + (total_branch_weight rt) 

-- Verbose constructor syntax
test_mobile = Mobile {
    left_branch  = Branch { branch_length = 1,
                            branch_structure = Weight 10 },
    right_branch = Branch { branch_length = 2,
                            branch_structure = Mobile {
                                                 left_branch = Branch { branch_length = 3,
                                                                        branch_structure = Weight 20 },
                                                 right_branch = Branch { branch_length = 4,
                                                                        branch_structure = Weight 30 }}}}

-- Or use this compact constructor syntax
test_balanced_mobile = Mobile (Branch 7 (Weight 10))
                              (Branch 1 (Mobile (Branch 3 (Weight 40))
                                                (Branch 4 (Weight 30))))

torque br@(Branch len _) = len * total_branch_weight br

is_balanced (Weight _) = True
is_balanced (Mobile lt rt) = 
     torque lt == torque rt
  && is_balanced (branch_structure lt)
  && is_balanced (branch_structure rt)

2-29.scm

#lang racket
;;;; circa 1985-style Scheme

(define (make-mobile left right)
  (list left right))

(define (left-branch mobile)
  (car mobile))

(define (right-branch mobile)
  (car (cdr mobile)))

; a structure is either an integer weight or an entire mobile
(define (branched? structure)
  (pair? structure))

(define (make-branch length structure)
  (list length structure))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (car (cdr branch)))

(define (total-branch-weight branch)
  (total-weight (branch-structure branch)))

(define (total-weight mobile)
  (if (branched? mobile)
      (+ (total-branch-weight (left-branch mobile))
         (total-branch-weight (right-branch mobile)))
      mobile))

(define test-mobile 
  (make-mobile (make-branch 1 10)
               (make-branch 2 (make-mobile (make-branch 3 20)
                                           (make-branch 4 30)))))

(define test-balanced-mobile 
  (make-mobile (make-branch 7 10)
               (make-branch 1 (make-mobile (make-branch 3 40)
                                           (make-branch 4 30)))))


(define (torque branch)
  (* (branch-length branch)
     (total-branch-weight branch)))

(define (balanced? mobile)
  (if (branched? mobile)
      (and (= (torque (left-branch mobile))
              (torque (right-branch mobile)))
           (balanced? (branch-structure (left-branch mobile)))
           (balanced? (branch-structure (right-branch mobile))))
      #t))

2-29b.rkt

#lang racket
;;;; More idiomatic Racket translation, I hope

(struct branch (length structure))
(struct mobile (left-branch right-branch))

(define (total-branch-weight branch)
  (total-weight (branch-structure branch)))

(define (total-weight str)
  (match str
         [ (mobile lt rt) (+ (total-branch-weight lt)
                             (total-branch-weight rt)) ]
         [ weight weight ]))

(define test-mobile (mobile (branch 1 10)
                            (branch 2 (mobile (branch 3 20)
                                              (branch 4 30)))))

(define test-balanced-mobile (mobile (branch 7 10)
                                     (branch 1 (mobile (branch 3 40)
                                                       (branch 4 30)))))

(define (torque br)
  (match br
         [ (branch len _) (* len (total-branch-weight br)) ]))

(define (balanced? str)
  (match str
         [ (mobile lt rt)
           (and (= (torque lt) (torque rt))
                (balanced? (branch-structure lt))
                (balanced? (branch-structure rt))) ]
         [ _ #t ]))

(balanced? test-mobile)
(balanced? test-balanced-mobile)