From a4a4996d7d9c6dcb7e48bafcfa5a91fe69d80f70 Mon Sep 17 00:00:00 2001
From: rsiddharth <s@ricketyspace.net>
Date: Sat, 6 Jul 2019 23:00:06 -0400
Subject: Add (net ricketyspace sicp two twentynine)

Ex 2.29 a, b.

* net/ricketyspace/sicp/two/twentynine.scm: New file.
---
 net/ricketyspace/sicp/two/twentynine.scm | 61 ++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 net/ricketyspace/sicp/two/twentynine.scm

(limited to 'net/ricketyspace/sicp/two/twentynine.scm')

diff --git a/net/ricketyspace/sicp/two/twentynine.scm b/net/ricketyspace/sicp/two/twentynine.scm
new file mode 100644
index 0000000..2340f38
--- /dev/null
+++ b/net/ricketyspace/sicp/two/twentynine.scm
@@ -0,0 +1,61 @@
+;;;; License: CC0-1.0
+
+(define-module (net ricketyspace sicp two twentynine)
+  #:export (make-mobile
+            make-branch
+            left-branch
+            right-branch
+            branch-length
+            branch-structure
+            total-weight))
+
+(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)
+  (car (cdr mobile)))
+
+(define (branch-length branch)
+  (car branch))
+
+(define (branch-structure branch)
+  (car (cdr branch)))
+
+(define (total-weight mobile)
+  (define (branch-weight b)
+    (let ((bs (branch-structure b)))
+      (cond ((not (pair? bs)) bs)
+            (else (branch-weight bs)))))
+  (+ (branch-weight (left-branch mobile))
+     (branch-weight (right-branch mobile))))
+
+;;; Guile REPL
+;;;
+;;; scheme@(guile-user)> ,re (net ricketyspace sicp two twentynine)
+;;; scheme@(guile-user)> (make-mobile (make-branch 3 45) (make-branch 4 (make-branch 5 50)))
+;;; $4 = ((3 45) (4 (5 50)))
+;;; scheme@(guile-user)> (left-branch $4)
+;;; $5 = (3 45)
+;;; scheme@(guile-user)> (right-branch $4)
+;;; $6 = (4 (5 50))
+;;; scheme@(guile-user)> (branch-length (left-branch $4))
+;;; $7 = 3
+;;; scheme@(guile-user)> (branch-structure (left-branch $4))
+;;; $8 = 45
+;;; scheme@(guile-user)> (branch-length (right-branch $4))
+;;; $9 = 4
+;;; scheme@(guile-user)> (branch-structure (right-branch $4))
+;;; $10 = (5 50)
+;;; scheme@(guile-user)> (branch-length (branch-structure (right-branch $4)))
+;;; $11 = 5
+;;; scheme@(guile-user)> (branch-structure (branch-structure (right-branch $4)))
+;;; $12 = 50
+;;; scheme@(guile-user)> (total-weight $4)
+;;; $14 = 95
+
-- 
cgit v1.2.3