From e8b1d8968e4bd5b0709b64336c8d88b7be6d031b Mon Sep 17 00:00:00 2001 From: Ramakrishnan Muthukrishnan Date: Sun, 17 Oct 2010 01:10:38 +0530 Subject: [PATCH] section 2.2.3 in scheme --- src/sicp/ch2_2_3.rkt | 67 ++++++++++++++++++++++++++++++++++++++++++++ src/sicp/utils.rkt | 24 +++++++++++++++- 2 files changed, 90 insertions(+), 1 deletion(-) create mode 100644 src/sicp/ch2_2_3.rkt diff --git a/src/sicp/ch2_2_3.rkt b/src/sicp/ch2_2_3.rkt new file mode 100644 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 b81f601..f84c739 100644 --- 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 -- 2.37.2