Completed up to 2.54

2_27.sch

@@ -0,0 +1,8 @@
+(define (deep-reverse l)
+  (define (reverse-acc l acc)
+    (cond ((null? l) acc)
+	  ((pair? (car l)) 
+	    (reverse-acc (cdr l) (cons (deep-reverse (car l)) acc)))
+	  (else 
+	    (reverse-acc (cdr l) (cons (car l) acc)))))
+  (reverse-acc l '()))

2_28.sch

@@ -0,0 +1,5 @@
+(define (fringe t)
+  (cond ((null? t) '())
+	((not (pair? t)) (list t))
+	(else (append (fringe (car t))
+		      (fringe (cdr t))))))

2_29.sch

@@ -0,0 +1,60 @@
+;(define (make-mobile left right)
+  ;(list left right))
+
+(define (make-mobile left right)
+  (cons left right))
+
+;(define (make-branch length structure)
+  ;(list length structure))
+
+(define (make-branch length structure)
+  (cons length structure))
+
+(define (left-branch mobile)
+  (car mobile))
+
+;(define (right-branch mobile)
+  ;(cadr mobile))
+
+(define (right-branch mobile)
+  (cdr mobile))
+
+(define (branch-length branch)
+  (car branch))
+
+;(define (branch-structure branch)
+  ;(cadr branch))
+
+(define (branch-structure branch)
+  (cdr branch))
+
+
+(define (mobile? m) (pair? m))
+
+(define (branch-weight branch)
+  (let ((struct (branch-structure branch)))
+       (if (mobile? struct)
+	   (total-weight struct)
+	   struct)))
+
+(define (total-weight mobile)
+  (+ (branch-weight (left-branch mobile))
+     (branch-weight (right-branch mobile))))
+
+
+(define (torque branch)
+  (* (branch-length branch)
+     (branch-weight branch)))
+
+(define (balanced? struct)
+  (cond ((null? struct) #t)
+	((not (mobile? struct)) #t)
+	(else 
+	  (let* ((l (left-branch struct))
+		 (r (right-branch struct))
+		 (l-struct (branch-structure l))
+		 (r-struct (branch-structure r)))
+	       (and (balanced? l-struct)
+		     (balanced? r-struct)
+		     (= (torque l) (torque r)))))))
+

2_30.sch

@@ -0,0 +1,23 @@
+(define (square x) (* x x))
+
+(define (square-tree tree)
+  (cond ((null? tree) '())
+	((not (pair? tree)) (square tree))
+	(else
+	  (cons (square-tree (car tree)) 
+		(square-tree (cdr tree))))))
+
+(define (square-tree-map tree)
+  (map (lambda (sub-tree)
+	 (if (pair? sub-tree)
+	     (square-tree-map sub-tree)
+	     (square sub-tree)))
+       tree))
+
+(define (tree-map fn tree)
+  (map (lambda (sub-tree)
+	 (if (pair? sub-tree)
+	     (tree-map fn sub-tree)
+	     (fn sub-tree)))
+       tree))
+

2_32.sch

@@ -0,0 +1,10 @@
+(define (subsets s)
+  (if (null? s)
+      (list '())
+      (let ((rest (subsets (cdr s))))
+	(append rest (map (lambda (l) (cons (car s) l)) rest)))))
+
+; By induction: Empty case is obvious.  Suppose we have T_n, the set of subsets of
+; S_n = {s_1, ... , s_n}.  Let S_{n+1} = S + {s_{n+1}}.  Then T_n is a subset of
+; T_{n+1}.  Any element of T_{n+1}\T_n must contain s_{n+1}, otherwise it would
+; have been in T_n.

2_33.sch

@@ -0,0 +1,14 @@
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+      initial
+      (op (car sequence)
+          (accumulate op initial (cdr sequence)))))
+
+(define (map p sequence)
+  (accumulate (lambda (x y) (cons (p x) y)) '() sequence))
+
+(define (append seq1 seq2)
+  (accumulate cons seq2 seq1))
+
+(define (length sequence)
+  (accumulate (lambda (x y) (+ 1 y)) 0 sequence))

2_34.sch

@@ -0,0 +1,5 @@
+(define (horner-eval x coefficient-sequence)
+  (accumulate (lambda (this-coeff higher-terms) 
+		      (+ (* higher-terms x) this-coeff))
+	      0
+	      coefficient-sequence))

2_35.sch

@@ -0,0 +1,19 @@
+;(define (count-leaves x)
+;  (cond ((null? x) 0)
+;        ((not (pair? x)) 1)
+;        (else (+ (count-leaves (car x))
+;                 (count-leaves (cdr x))))))
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+      initial
+      (op (car sequence)
+          (accumulate op initial (cdr sequence)))))
+
+
+(define (count-leaves x)
+  (accumulate + 0 (map (lambda (y) 
+			 (if (not (pair? y)) 
+			     1 
+			     (+ (count-leaves (car y))
+				(count-leaves (cdr y))))) x)))

2_36.sch

@@ -0,0 +1,11 @@
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+      initial
+      (op (car sequence)
+          (accumulate op initial (cdr sequence)))))
+
+(define (accumulate-n op init seqs)
+  (if (null? (car seqs))
+      '()
+      (cons (accumulate op init (map car seqs))
+	    (accumulate-n op init (map cdr seqs)))))

2_44.sch

@@ -0,0 +1,58 @@
+;: (define wave2 (beside wave (flip-vert wave)))
+;: (define wave4 (below wave2 wave2))
+
+
+(define (flipped-pairs painter)
+  (let ((painter2 (beside painter (flip-vert painter))))
+    (below painter2 painter2)))
+
+
+;: (define wave4 (flipped-pairs wave))
+
+
+(define (right-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (right-split painter (- n 1))))
+        (beside painter (below smaller smaller)))))
+
+
+(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 (square-limit painter n)
+  (let ((quarter (corner-split painter n)))
+    (let ((half (beside (flip-horiz quarter) quarter)))
+      (below (flip-vert half) half))))
+
+
+; 2.44
+(define (up-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (up-split painter (- n 1))))
+        (below painter (beside smaller smaller)))))
+
+(define (right-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (right-split painter (- n 1))))
+        (beside painter (below smaller smaller)))))
+
+; 2.45
+(define (split inner-op outer-op)
+  (define (compose painter n)
+    (if (= n 0)
+	painter
+	(let ((smaller (compose painter (- n 1))))
+	  (outer-op painter (inner-op smaller smaller)))))
+  (compose))

2_54.sch

@@ -0,0 +1,6 @@
+(define (equal? a b)
+  (cond ((eq? a b) #t)
+	((not (and (pair? a) (pair? b))) #f)
+	(else (and (equal? (car a) (car b))
+	       	   (equal? (cdr a) (cdr b))))))
+