Begin sequence exercises

1 files changed, 223 insertions, 0 deletions

diff --git a/chap2/part2.rkt b/chap2/part2.rkt
index b451cfe..b93a4c6 100644
--- a/chap2/part2.rkt
+++ b/chap2/part2.rkt
@@ -301,3 +301,226 @@
         (or (not (pair? l)) (balanced? l))
         (or (not (pair? r)) (balanced? r))
         (= (* lweight llen) (* rweight rlen))))))
+
+(#%provide scale-tree)
+(define (scale-tree tree factor)
+  (cond
+    ((null? tree) nil)
+    ((not (pair? tree)) (* tree factor))
+    (else
+      (cons
+        (scale-tree (car tree) factor)
+        (scale-tree (cdr tree) factor)))))
+
+(#%provide scale-tree-)
+(define (scale-tree- tree factor)
+  (map
+    (lambda (sub-tree)
+      (if (pair? sub-tree)
+        (scale-tree sub-tree factor)
+        (* sub-tree factor)))
+    tree))
+
+#| 2.30 |#
+
+(#%provide square-tree-direct)
+(define (square-tree-direct tree)
+  (cond
+    ((null? tree) nil)
+    ((not (pair? tree)) (square tree))
+    (else
+      (cons
+        (square-tree-direct (car tree))
+        (square-tree-direct (cdr tree))))))
+
+(#%provide square-tree)
+(define (square-tree tree)
+  (map
+    (lambda (sub-tree)
+      (if (pair? sub-tree)
+        (square-tree sub-tree)
+        (square sub-tree)))
+    tree))
+
+#| 2.31 |#
+
+(#%provide tree-map)
+(define (tree-map proc tree)
+  (cond
+    ((null? tree) nil)
+    ((not (pair? tree)) (proc tree))
+    (else
+      (cons
+        (tree-map proc (car tree))
+        (tree-map proc (cdr tree))))))
+
+(#%provide square-tree-)
+(define (square-tree- tree)
+  (tree-map square tree))
+
+#| 2.32 |#
+
+(#%provide subsets)
+(define (subsets s)
+  (if (null? s)
+    (list nil)
+    (let
+      ((rest (subsets (cdr s))))
+      (append rest (map (lambda (x) (cons (car s) x)) rest)))))
+
+(#%provide sum-odd-squares-)
+(define (sum-odd-squares- tree)
+  (cond
+    ((null? tree) 0)
+    ((not (pair? tree))
+     (if (odd? tree) (square tree) 0))
+    (else
+      (+
+        (sum-odd-squares (car tree))
+        (sum-odd-squares (cdr tree))))))
+
+(define (fib n)
+  (define (fib-iter a b p q i)
+    (cond
+      ((= i 0) b)
+      ((even? i)
+       (fib-iter
+         a
+         b
+         (+ (square p) (square q))
+         (+ (* 2 p q) (square q))
+         (/ i 2)))
+      (else
+        (fib-iter
+          (+ (* b q) (* a q) (* a p))
+          (+ (* b p) (* a q))
+          p
+          q
+          (- i 1)))))
+  (fib-iter 1 0 0 1 n))
+
+(#%provide even-fibs-)
+(define (even-fibs- n)
+  (define (next k)
+    (if (> k n)
+      nil
+      (let ((f (fib k)))
+        (if (even? f)
+          (cons f (next (+ k 1)))
+          (next (+ k 1))))))
+  (next 0))
+
+(#%provide filter-)
+(define (filter- predicate sequence)
+  (cond
+    ((null? sequence) nil)
+    ((predicate (car sequence))
+     (cons
+       (car sequence)
+       (filter- predicate (cdr sequence))))
+    (else (filter- predicate (cdr sequence)))))
+
+(#%provide accumulate)
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op
+      (car sequence)
+      (accumulate op initial (cdr sequence)))))
+
+(#%provide enumerate-interval)
+(define (enumerate-interval low high)
+  (if (> low high)
+    nil
+    (cons low (enumerate-interval (+ low 1) high))))
+
+(#%provide enumerate-tree)
+(define (enumerate-tree tree)
+  (cond
+    ((null? tree) nil)
+    ((not (pair? tree)) (list tree))
+    (else
+      (append
+        (enumerate-tree (car tree))
+        (enumerate-tree (cdr tree))))))
+
+(#%provide sum-odd-squares)
+(define (sum-odd-squares tree)
+  (accumulate + 0
+    (map square
+      (filter- odd?
+        (enumerate-tree tree)))))
+
+(#%provide even-fibs)
+(define (even-fibs n)
+  (accumulate cons nil
+    (filter- even?
+      (map fib
+        (enumerate-interval 0 n)))))
+
+(#%provide list-fib-squares)
+(define (list-fib-squares n)
+  (accumulate cons nil
+    (map square
+      (map fib
+        (enumerate-interval 0 n)))))
+
+(#%provide product-of-squares-of-odd-elements)
+(define (product-of-squares-of-odd-elements sequence)
+  (accumulate * 1
+    (map square
+      (filter- odd?
+        sequence))))
+
+#| (define (salary-of-highest-paid-programmer records) |#
+#|   (accumulate max 0 |#
+#|     (map salary |#
+#|       (filter- programmer? |#
+#|         records)))) |#
+
+#| 2.33 |#
+
+(#%provide map--)
+(define (map-- p sequence)
+  (accumulate
+    (lambda (x y) (cons (p x) y))
+    nil
+    sequence))
+
+(#%provide append--)
+(define (append-- seq1 seq2)
+  (accumulate cons seq2 seq1))
+
+(#%provide length--)
+(define (length-- sequence)
+  (accumulate (lambda (x y) (+ y 1)) 0 sequence))
+
+#| 2.34 |#
+
+(#%provide horner-eval)
+(define (horner-eval x coefficient-sequence)
+  (accumulate
+    (lambda (this-coeff higher-terms)
+      (+ (* higher-terms x) this-coeff))
+    0
+    coefficient-sequence))
+
+#| 2.35 |#
+
+(#%provide count-leaves-)
+(define (count-leaves- t)
+  (accumulate
+    (lambda (x y) (+ y 1))
+    0
+    (enumerate-tree t)))
+
+#| 2.36 |#
+
+(#%provide accumulate-n)
+(define (accumulate-n op init seqs)
+  (if (null? (car seqs))
+    nil
+    (cons
+      (accumulate op init (map car seqs))
+      (accumulate-n op init (map cdr seqs)))))
+