implementing some of the sec 2.2 examples in Racket

diff --git a/src/sicp/ch2_2.rkt b/src/sicp/ch2_2.rkt
new file mode 100644 (file)
index 0000000..db58d8c
--- /dev/null
+++ b/src/sicp/ch2_2.rkt
@@ -0,0 +1,66 @@
+#lang scheme
+
+(require (planet soegaard/sicp:2:1/sicp))
+
+;; count-leaves
+(define (count-leaves x)
+  (cond 
+    [(null? x) 0]
+    [(not (pair? x)) 1]
+    [else (+ (count-leaves (first x))
+             (count-leaves (rest x)))]))
+
+;; scale tree
+(define (scale-tree tree factor)
+  (cond [(null? tree) '()]
+        [(not (pair? tree)) (* tree factor)]
+        [else (cons (scale-tree (first tree) factor)
+                    (scale-tree (rest tree) factor))]))
+
+(define (scale-tree-map tree factor)
+  (map (lambda (x)
+         (if (not (pair? x))
+             (* x factor)
+             (scale-tree-map x factor)))
+       tree))
+
+(define (square-of-four tl tr bl br)
+  (lambda (painter)
+    (let ((top (beside (tl painter) (tr painter)))
+          (bottom (beside (bl painter) (br painter))))
+      (below bottom top))))
+
+(define (flipped-pairs painter)
+  (let ((combine4 (square-of-four identity flip-vert
+                                  identity flip-vert)))
+    (combine4 painter)))
+
+(define (identity x) x)
+
+(define (corner-split painter n)
+  (if (= n 0)
+      painter
+      (let ((up (up-split painter (- n 1)))
+            (right (right-split painter (- n 1))))
+        (let ((top-left (beside up up))
+              (bottom-right (below right right))
+              (corner (corner-split painter (- n 1))))
+          (beside (below painter top-left)
+                  (below bottom-right corner))))))
+
+(define (right-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (right-split painter (- n 1))))
+        (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (up-split painter (- n 1))))
+        (below painter (beside smaller smaller)))))
+
+(define (square-limit painter n)
+  (let ((combine4 (square-of-four flip-horiz identity
+                                  rotate180 flip-vert)))
+    (combine4 (corner-split painter n))))

diff --git a/src/sicp/ch2_2.scm b/src/sicp/ch2_2.scm
deleted file mode 100644 (file)
index 8d03232..0000000
--- a/src/sicp/ch2_2.scm
+++ /dev/null
@@ -1,44 +0,0 @@
-#lang scheme
-
-(require (planet soegaard/sicp:2:1/sicp))
-
-(define (square-of-four tl tr bl br)
-  (lambda (painter)
-    (let ((top (beside (tl painter) (tr painter)))
-          (bottom (beside (bl painter) (br painter))))
-      (below bottom top))))
-
-(define (flipped-pairs painter)
-  (let ((combine4 (square-of-four identity flip-vert
-                                  identity flip-vert)))
-    (combine4 painter)))
-
-(define (identity x) x)
-
-(define (corner-split painter n)
-  (if (= n 0)
-      painter
-      (let ((up (up-split painter (- n 1)))
-            (right (right-split painter (- n 1))))
-        (let ((top-left (beside up up))
-              (bottom-right (below right right))
-              (corner (corner-split painter (- n 1))))
-          (beside (below painter top-left)
-                  (below bottom-right corner))))))
-
-(define (right-split painter n)
-  (if (= n 0)
-      painter
-      (let ((smaller (right-split painter (- n 1))))
-        (beside painter (below smaller smaller)))))
-
-(define (up-split painter n)
-  (if (= n 0)
-      painter
-      (let ((smaller (up-split painter (- n 1))))
-        (below painter (beside smaller smaller)))))
-
-(define (square-limit painter n)
-  (let ((combine4 (square-of-four flip-horiz identity
-                                  rotate180 flip-vert)))
-    (combine4 (corner-split painter n))))