diff options
Diffstat (limited to 'chap2/part2.rkt')
| -rw-r--r-- | chap2/part2.rkt | 223 |
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))))) + |