From 6bf176f3e091328ceb43de82b6514a23ccef755e Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Mon, 15 Jul 2019 19:21:01 -0400 Subject: two/twentynine.scm: Add mobile-balanced? * net/ricketyspace/sicp/two/twentynine.scm (has-submobile?) (torque, mobile-balanced?): New functions. --- net/ricketyspace/sicp/two/twentynine.scm | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'net/ricketyspace') 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 -- cgit v1.2.3