section 2.2.3 in scheme

diff --git a/src/sicp/ch2_2_3.rkt b/src/sicp/ch2_2_3.rkt
new file mode 100644 (file)
index 0000000..a84539d
--- /dev/null
+++ b/src/sicp/ch2_2_3.rkt
@@ -0,0 +1,67 @@
+#lang racket/load
+(require "utils.rkt")
+
+(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 (even-fibs n)
+  (define (next k)
+    (if (> k n)
+        '()
+        (let ((f (fib k)))
+          (if (even? f)
+              (cons f (next (+ k 1)))
+              (next (+ k 1))))))
+  (next 0))
+
+(define (filter pred? coll)
+  (cond 
+    ((empty? coll) '())
+    ((pred? (car coll)) (cons (car coll) (filter pred? (cdr coll))))
+    (else (filter pred? (cdr coll)))))
+
+(define (accumulate op initial coll)
+  (if (null? coll)
+      initial
+      (op (car coll)
+          (accumulate op initial (cdr coll)))))
+
+(define (enumerate-tree tree)
+  (cond 
+    ((null? tree) '())
+    ((not (pair? tree)) (list tree))
+    (else (append (enumerate-tree (car tree))
+                  (enumerate-tree (cdr tree))))))
+
+(define (sum-odd-squares tree)
+  (accumulate +
+              0
+              (map square
+                   (filter odd?
+                           (enumerate-tree tree)))))
+
+(define (even-fibs n)
+  (accumulate cons 
+              '()
+              (filter even?
+                      (map fib 
+                           (range 0 n)))))
+
+(define (list-fib-squares n)
+  (accumulate cons
+              '()
+              (map square 
+                   (map fib 
+                        (range 0 n)))))
+
+(define (product-of-squares-of-odd-elements coll)
+  (accumulate *
+              1
+              (map square
+                   (filter odd? coll))))
+

diff --git a/src/sicp/utils.rkt b/src/sicp/utils.rkt
index b81f60128ce1f9e56f9a86be14773799bca960f7..f84c739ba80d5fbba7b81e81c282fd5462844055 100644 (file)
--- a/src/sicp/utils.rkt
+++ b/src/sicp/utils.rkt
@@ -13,4 +13,26 @@
     a
     (gcd b (remainder a b))))
 
-(provide square)    
\ No newline at end of file
+;; naive fibonacci definition
+(define (fib n)
+  (cond 
+    ((or (= n 0) (= n 1)) 1)
+    (else (+ (fib (- n 1))
+             (fib (- n 2))))))
+
+(define (range low high (step 1))
+  (cond 
+    ((or (and (< low high)
+              (positive? step))
+         (and (> low high)
+          (negative? step)))
+     (cons low (range (+ low step) high step)))
+    (else '())))
+
+(define (accumulate op initial coll)
+  (if (empty? coll)
+      initial
+      (op (car coll)
+          (accumulate op initial (cdr coll)))))
+
+(provide square fib range accumulate)    
\ No newline at end of file