two/twentynine.scm: Add mobile-balanced?

* net/ricketyspace/sicp/two/twentynine.scm (has-submobile?)
(torque, mobile-balanced?): New functions.

1 files changed, 21 insertions, 1 deletions

diff --git a/net/ricketyspace/sicp/two/twentynine.scm b/net/ricketyspace/sicp/two/twentynine.scm
index 8e1aaa2..8b763ea 100644
--- a/net/ricketyspace/sicp/two/twentynine.scm
+++ b/net/ricketyspace/sicp/two/twentynine.scm
@@ -7,7 +7,8 @@
             right-branch
             branch-length
             branch-structure
-            total-weight))
+            total-weight
+            mobile-balanced?))
 
 (define (make-mobile left right)
   (list left right))
@@ -37,6 +38,25 @@
   (+ (branch-weight (left-branch mobile))
      (branch-weight (right-branch mobile))))
 
+(define (has-submobile? branch)
+  (not (number? (branch-structure branch))))
+
+(define (torque branch)
+  (* (branch-length branch)
+     (branch-weight branch)))
+
+(define (mobile-balanced? m)
+  (let ((lb (left-branch m))
+        (rb (right-branch m)))
+    (and
+     (cond ((has-submobile? lb)
+            (mobile-balanced? (branch-structure lb)))
+           (else #t))
+     (cond ((has-submobile? rb)
+            (mobile-balanced? (branch-structure rb)))
+           (else #t))
+     (= (torque lb) (torque rb)))))
+
 ;;; Guile REPL
 ;;;
 ;;; scheme@(guile-user)> (make-mobile