Implement up to 2.29

ex-2_18-xx.scm

@@ -1,40 +1,156 @@
-(load "util.scm")
-
 (display "\nex-2.24\n")
 
 (define x (cons (list 1 2) (list 3 4)))
 
 (define (display-spaces n)
-  (cond ((= n 0) ())
-        (else (display " ") (display-spaces (- n 1)))))
+  (cond ((= n 0) ()) (else (display " ") (display-spaces (- n 1)))))
 
 ; Procedure to print a tree (in an ugly way)
 (define (display-tree tree level)
-  (if (null? tree)
-    ()
-    (cond
-      ((pair? (car tree))
-        (display-spaces level) (display tree) (newline)
-        (display-spaces (+ level 1)) (display (car tree)) (newline)
-        (display-tree (car tree) (+ level 1))
-        (display-tree (cdr tree) level))
-      (else
-        (display-spaces level)
-        (display (car tree))
-        (newline)
-        (display-tree (cdr tree) level)))))
+  (cond
+    ((null? tree) ())
+    ((not (pair? tree)) (display-spaces level) (display tree) (newline))
+    (else
+      (display-spaces level) (display tree) (newline)
+      (map (lambda (tree) (display-tree tree (+ level 1))) tree))))
 
+
+(define x (list 1 (list 2 (list 3 4))))
 (display-tree x 0)
 
+; (1 (2 (3 4))) ; result interpreter
+; [. .]->[. /]
+;  |      |
+;  1     [. .]->[. /]
+;         |      |
+;         2     [. .]->[. /]
+;                |      |
+;                3      4
+;   /\
+;  1  \
+;     /\
+;    2  \
+;        \
+;        /\
+;       3  4
 
 (display "\nex-2.25\n")
 
+(define x (list 1 3 (list 5 7) 9))
+(display x) (newline)
+; (1 3 (5 7) 9)
+(display (car (cdr (car (cdr (cdr x)))))) (newline)
+
+(define x (list (list 7)))
+(display x) (newline)
+; ((7))
+(display (car (car x))) (newline)
+
+(define x (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
+(display x) (newline)
+; (1 (2 (3 (4 (5 (6 7))))))
+(display (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr x))))))))))))) (newline)
+(display (cadr (cadr (cadr (cadr (cadr (cadr x)))))))
+(newline)
+
 (display "\nex-2.26\n")
 
-(display "\nex-2.27\n")
+(define x (list 1 2 3))
+(define y (list 4 5 6))
 
-(display "\nex-2.28\n")
+(display (append x y)) (newline)
+; (1 2 3 4 5 6)
+(display (cons x y)) (newline)
+; ((1 2 3) 4 5 6)
+(display (list x y)) (newline)
+; ((1 2 3) (4 5 6))
 
-(display "\nex-2.29\n")
+(display "\nex-2.27 - deep reverse\n")
+
+(define x (list (list 1 2) (list 3 4)))
+
+; I didn't implement in this elegantly when I first did this exercise. I am
+; learning and growing!
+(define (deep-reverse xs)
+  (if (pair? xs)
+    (reverse (map deep-reverse xs))
+    xs))
+
+(display x) (newline)
+(display (reverse x)) (newline)
+(display (deep-reverse x)) (newline)
+
+(display "\nex-2.28 - fringe aka flatten\n")
+
+(define (fringe xs)
+  (cond
+    ((null? xs) xs)
+    ((pair? xs) (append (fringe (car xs)) (fringe (cdr xs))))
+    (else (list xs))))
+
+(display (fringe x)) (newline)
+(display (fringe (list x x))) (newline)
+
+(display "\nex-2.29 - mobile balancing\n")
+
+(define (make-mobile left right)
+  (list left right))
+
+(define (make-branch length structure)
+  (list length structure))
+
+(define m1
+  (make-mobile
+    (make-branch 10 20)
+    (make-branch 5 41)))
+
+(define m2
+  (make-mobile
+    (make-branch 1 70)
+    (make-branch 2
+                 (make-mobile
+                   (make-branch 3 20)
+                   (make-branch 4 15)))))
+
+; 2.29 a)
+(define left-branch car)
+(define right-branch cadr)
+(define branch-length car)
+(define branch-structure cadr)
+(display (branch-length (right-branch m1))) (newline)
+
+; 2.29 b)
+(define (total-weight m)
+  (if (pair? m)
+    (+ (total-weight (branch-structure (left-branch m)))
+       (total-weight (branch-structure (right-branch m))))
+    m))
+
+(display (total-weight m1)) (newline)
+(display (total-weight m2)) (newline)
+
+; 2.29 c)
+(define (balanced? m)
+  (define (torque b)
+    (* (branch-length b) (total-weight (branch-structure b))))
+  (if (pair? m)
+    (let ((l (left-branch m))
+          (r (right-branch m)))
+      (and
+        (balanced? (branch-structure l))
+        (balanced? (branch-structure r))
+        (= (torque l) (torque r))))
+    #t)))
+
+(display (balanced? m1)) (newline)
+(display (balanced? m2)) (newline)
+
+; 2.29 d)
+; Only the selectors must be changed if we change the constructors.
+(define (make-mobile left right)
+  (cons left right))
+(define (make-branch length structure)
+  (cons length structure))
+
+(display "\nex-2.30")
 
-(display "\nex-2.30\n")