学步园

这些是以前做好的，先贴上来。第一章部分习题：

;1.34<br /> (define (f g)<br /> (g 2))<br /> ;(f square)<br /> ;(f (lambda (z) (* z (+ z 1))))<br /> ;(f f)<br /> ;<br /> (define (search f neg-point pos-point)<br /> ( let ((midpoint (average neg-point pos-point)))<br /> (if (close-enough? neg-point pos-point)<br /> midpoint<br /> (let ((test-value (f midpoint)))<br /> (cond ((positive? test-value)<br /> (search f neg-point midpoint))<br /> ((negative? test-value)<br /> (search f midpoint pos-point))<br /> (else midpoint))))))<br /> (define tolerance 0.00001)<br /> (define (close-enough? x y)<br /> (< (abs (- x y)) tolerance))<br /> (define (half-interval-method f a b)<br /> ( let ((a-value (f a))<br /> (b-value (f b)))<br /> (cond ((and (negative? a-value) (positive? b-value))<br /> (search f a b))<br /> ((and (negative? b-value) (positive? a-value))<br /> (search f b a))<br /> (else (error "values are not of opposite sign" a b)))))<br /> ;(half-interval-method sin 2.0 4.0)<br /> ;(half-interval-method (lambda (x) (- (* x x x) (* 2 x) 3)) 1.0 2.0)<br /> (define (fixed-point f first-guess)<br /> (define (try guess)<br /> (let ((next (f guess)))<br /> (if (close-enough? guess next)<br /> next<br /> (try next))))<br /> (try first-guess))<br /> ;(fixed-point cos 1.0)<br /> ;(fixed-point (lambda (y) (+ (sin y) (cos y))) 1.0)<br /> ;1.35<br /> ;(fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0)<br /> ;1.36<br /> (define (fixed-point2 f first-guess)<br /> (define (try guess times)<br /> (let ((next (f guess)))<br /> (newline)<br /> (display "guess ")<br /> (display times)<br /> (display " is: ")<br /> (display next)<br /> (if (close-enough? guess next)<br /> next<br /> (try next (+ times 1)))))<br /> (try first-guess 1))<br /> ;(fixed-point2 (lambda (x) (/ (log 1000) (log x))) 2.0)<br /> ;(fixed-point2 (lambda (x) (average x (/ (log 1000) (log x)))) 2.0)<br /> ;1.37<br /> (define (cont-frac n d k)<br /> (define (iter i)<br /> (if (= i k) 0<br /> (/ (n i) (+ (d i) (iter (+ i 1))))))<br /> (iter 1))<br /> ;(/ 1.0 (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) 1000))<br /> (define (cont-frac2 n d k)<br /> (define (iter i res)<br /> (if (= i 0) res<br /> (iter (- i 1) (/ (n i) (+ (d i) res)))))<br /> (iter k 0))<br /> ;(/ 1.0 (cont-frac2 (lambda (i) 1.0) (lambda (i) 1.0) 1000))<br /> ;1.38<br /> (define (dn i)<br /> ( cond ((= i 1) 1)<br /> ((= i 2) 2)<br /> ((= 0 (remainder (- i 2) 3)) (+ 2 (/ (* 2 (- i 2)) 3)))<br /> (else 1)))<br /> ;(dn 5)<br /> ;(+ 2 (cont-frac (lambda (i) 1.0) dn 1000))<br /> (define (average-damp f)<br /> (lambda (x) (average x (f x))))<br /> ;((average-damp square) 10)<br /> (define (sqrt2 x)<br /> (fixed-point (average-damp (lambda (y) (/ x y))) 1.0))<br /> ;(sqrt2 625)<br /> (define (cube-root x)<br /> (fixed-point (average-damp (lambda (y) (/ x (square y)))) 1.0))<br /> ;(cube-root 64)<br /> (define dx 0.000001)<br /> (define (deriv g)<br /> (lambda (x)<br /> (/ (- (g (+ x dx)) (g x))<br /> dx)))<br /> ;((deriv cube) 5)<br /> (define (newton-transform g)<br /> (lambda (x)<br /> (- x (/ (g x) ((deriv g) x)))))<br /> (define (newtons-method g guess)<br /> (fixed-point (newton-transform g) guess))<br /> (define (sqrt3 x)<br /> ;(newtons-method (lambda (y) (/ x y)) 1.0)) ;why wrong??<br /> (newtons-method (lambda(y) (- (square y) x)) 1.0))<br /> ;(sqrt3 625)<br /> (define (fixed-point-of-transform g transform guess)<br /> (fixed-point (transform g) guess))<br /> (define (sqrt4 x)<br /> (fixed-point-of-transform (lambda (y) (/ x y)) average-damp 1.0))<br /> (define (sqrt5 x)<br /> (fixed-point-of-transform (lambda(y) (- (square y) x)) newton-transform 1.0))<br /> ;(sqrt4 625)<br /> ;(sqrt5 625)<br /> ;1.40<br /> (define (cubic a b c)<br /> (lambda(x) (+ (cube x) (* a (square x)) (* b x) c)))<br /> ;(newtons-method (cubic a b c) 1)<br /> ;(newtons-method (cubic 2 2 3) 1)<br /> ;1.41<br /> (define (double f)<br /> (lambda(x) (f (f x))))<br /> ;(((double (double double)) inc) 5)<br /> ;1.42<br /> (define (compose f g)<br /> (lambda(x) (f (g x))))<br /> ;((compose square inc) 6)<br /> ;1.43<br /> (define (repeated f n)<br /> (define (iter i)<br /> (if (= i 1)<br /> f<br /> (compose f (iter (- i 1)))))<br /> (iter n))<br /> ;((repeated square 2) 5)<br /> ;1.44<br /> (define (smooth f)<br /> (lambda(x) (/ (+ (f (+ x dx)) (f x) (f (- x dx))) 3)))<br /> (define (smooth-n f n)<br /> ((repeated smooth n) f))<br /> ;((smooth-n square 2) 5)<br /> ;1.45<br /> (define (nth-power-root x n)<br /> (fixed-point ((repeated average-damp (/ (log n) (log 2))) (lambda (y) (/ x (expr y (- n 1))))) 1.0))<br /> ;(nth-power-root 64 3)<br /> ;(nth-power-root 16 4)<br /> ;(nth-power-root 64 32)<br /> ;(nth-power-root 64 64)<br /> ;(/ (log 1024) (log 2))<br /> ;1.46<br /> (define (iterative-improve good? improve-method)<br /> (define (iter-imp guess x)<br /> (if (good? guess x)<br /> guess<br /> (iter-imp (improve-method guess x) x)))<br /> (lambda (guess x) (iter-imp guess x)))<br /> (define (sqrt6 x)<br /> ((iterative-improve good-enough? improve) 1.0 x))<br /> (sqrt6 9)<br /> ;(sqrt2 9)<br />

第二章部分习题：

;2.1<br /> (define (make-rat a b)<br /> (let ((g (gcd (abs a) (abs b))))<br /> (cond ((and (< a 0) (< b 0))<br /> (cons (/ (abs a) g) (/ (abs b) g)))<br /> ((< b 0)<br /> (cons (/ (- a) g) (/ (abs b) g)))<br /> (else<br /> (cons (/ a g) (/ b g))))))<br /> (define (numer x)<br /> (car x))<br /> (define (denom x)<br /> (cdr x))<br /> (define (print-rat x)<br /> (newline)<br /> (display (numer x))<br /> (display "/")<br /> (display (denom x)))<br /> ;(print-rat (mul-rat (make-rat 2 4) (make-rat 1 -5)))<br /> ;(print-rat (sub-rat (make-rat 1 4) (make-rat 1 2)))<br /> ;(print-rat (add-rat (make-rat 2 4) (make-rat 1 4)))<br /> ;(print-rat (div-rat (make-rat 2 4) (make-rat 1 4)))<br /> ;(print-rat (make-rat 2 4))<br /> ;2.2<br /> (define (make-segment s t)<br /> (cons s t))<br /> (define (start-segment seg)<br /> (car seg))<br /> (define (end-segment seg)<br /> (cdr seg))<br /> (define (make-point x y)<br /> (cons x y))<br /> (define (x-point p)<br /> (car p))<br /> (define (y-point p)<br /> (cdr p))<br /> (define (print-point p)<br /> (newline)<br /> (display "(")<br /> (display (x-point p))<br /> (display ",")<br /> (display (y-point p))<br /> (display ")"))<br /> (define (midpoint-segment seg)<br /> (let ((s (start-segment seg))<br /> (t (end-segment seg)))<br /> (make-point (/ (+ (x-point s) (x-point t)) 2)<br /> (/ (+ (y-point s) (y-point t)) 2))))<br /> (define a-seg<br /> (make-segment (make-point 1 2) (make-point 5 8)))<br /> ;(print-point (start-segment a-seg))<br /> ;(print-point (end-segment a-seg))<br /> ;(print-point (midpoint-segment a-seg))<br /> ;2.3<br /> (define (make-rect lbp rtp)<br /> (cons lbp rtp))<br /> (define (get-long rect)<br /> (let ((lbp (car rect))<br /> (rtp (cdr rect)))<br /> (- (x-point rtp) (x-point lbp))))<br /> (define (get-width rect)<br /> (let ((lbp (car rect))<br /> (rtp (cdr rect)))<br /> (- (y-point rtp) (y-point lbp))))<br /> ;计算长方形周长<br /> (define (rect-perim long width)<br /> (* (+ long width) 2))<br /> (define (rect-area long width)<br /> (* long width))<br /> (define a-rect<br /> (make-rect (make-point 0 0) (make-point 2 8)))<br /> ;(rect-perim (get-long a-rect) (get-width a-rect))<br /> ;(rect-area (get-long a-rect) (get-width a-rect))<br /> ;2.4<br /> (define (cons1 x y)<br /> (lambda (m) (m x y)))<br /> (define (car1 z)<br /> (z (lambda (p q) p)))<br /> (define (cdr1 z)<br /> (z (lambda (p q) q)))<br /> ;(car1 (cons1 3 5))<br /> ;(cdr1 (cons1 3 5))<br /> ;2.5<br /> (define (cons2 x y)<br /> (* (exp (* x (log 2))) (exp (* y (log 3))))) ; 没找到求幂的库函数来计算2^x * 3^y<br /> (define (car2 z)<br /> (define (iter n z)<br /> (if (= (remainder z 2) 0)<br /> (iter (+ n 1) (/ z 2))<br /> n))<br /> (iter 0 z))<br /> (define (cdr2 z)<br /> (define (iter n z)<br /> (if (= (remainder z 3) 0)<br /> (iter (+ n 1) (/ z 3))<br /> n))<br /> (iter 0 z))<br /> ;(car2 (cons2 3 7))<br /> ;(cdr2 (cons2 3 7))<br /> ;(car2 17496)<br /> ;(cdr2 17496)<br /> ;2.6<br /> ;2.7<br /> (define (add-interval x y)<br /> (make-interval (+ (lower-bound x) (lower-bound y))<br /> (+ (upper-bound x) (upper-bound y))))<br /> (define (mul-interval x y)<br /> (let ((p1 (* (lower-bound x) (lower-bound y)))<br /> (p2 (* (lower-bound x) (upper-bound y)))<br /> (p3 (* (upper-bound x) (lower-bound y)))<br /> (p4 (* (upper-bound x) (upper-bound y))))<br /> (make-interval (min p1 p2 p3 p4)<br /> (max p1 p2 p3 p4))))<br /> (define (div-interval x y)<br /> (mul-interval x (make-interval (/ 1.0 (upper-bound y))<br /> (/ 1.0 (lower-bound y)))))<br /> (define (make-interval a b)<br /> (cons a b))<br /> (define (lower-bound x)<br /> (car x))<br /> (define (upper-bound x)<br /> (cdr x))<br /> (define (print-interval x)<br /> (newline)<br /> (display "[")<br /> (display (lower-bound x))<br /> (display ", ")<br /> (display (upper-bound x))<br /> (display "]"))<br /> ;(print-interval (add-interval (make-interval 1.2 1.4) (make-interval 3.5 4.0)))<br /> ;(print-interval (mul-interval (make-interval 1 2) (make-interval 3 8)))<br /> ;(print-interval (div-interval (make-interval 2 8) (make-interval 1 2)))<br /> ;2.8<br /> (define (sub-interval x y)<br /> (make-interval (- (lower-bound x) (upper-bound y))<br /> (- (upper-bound x) (lower-bound y))))<br /> ;(print-interval (sub-interval (make-interval 3 6) (make-interval 1 2)))<br /> ;<br /> ;2.9<br /> ;...<br /> ;(car (cdr (list 1 2 3 4 5)))<br /> ;(cadddr (list 1 2 3 4))<br /> (define squares (list 1 4 9 16 25))<br /> (define odds (list 1 3 5 7))<br /> (define (append1 list1 list2)<br /> (if(null? list1)<br /> list2<br /> (cons (car list1) (append1 (cdr list1) list2))))<br /> ;(append1 squares odds)<br /> ;(append1 odds squares)<br /> ;2.17<br /> ;(if (cdr (list 1 2)) 'nil<br /> ; 'not-nil)<br /> (define (last-pair list1)<br /> (cond ((or (null? list1) (null? (cdr list1))) '())<br /> ((null? (cddr list1)) (cdr list1))<br /> (else (last-pair (cdr list1)))))<br /> ;(last-pair (list 23 72 149 34))<br /> ;2.18<br /> (define (reverse1 list1)<br /> (if(or (null? list1) (null? (cdr list1)))<br /> list1<br /> (append (reverse1 (cdr list1)) (list (car list1)))))<br /> ;(reverse1 (list 1 4 9 16 25))<br /> ;(list 3)<br /> ;(cons 3 '())<br /> ;2.19 (from 1.2.2)<br /> (define (count-change amount)<br /> (cc amount 5))<br /> (define (cc amount kinds-of-coins)<br /> (cond ((= amount 0) 1)<br /> ((or (< amount 0) (= kinds-of-coins 0)) 0)<br /> (else (+ (cc amount (- kinds-of-coins 1))<br /> (cc (- amount (first-denomination kinds-of-coins))<br /> kinds-of-coins)))))<br /> (define (first-denomination kinds-of-coins)<br /> ( cond ((= kinds-of-coins 1) 1)<br /> ((= kinds-of-coins 2) 5)<br /> ((= kinds-of-coins 3) 10)<br /> ((= kinds-of-coins 4) 25)<br /> ((= kinds-of-coins 5) 50)))<br /> ;(count-change 100)<br /> ;<br /> (define us-coins (list 50 25 10 5 1))<br /> (define uk-coins (list 100 50 20 10 5 2 1 0.5))<br /> (define (cc1 amount coin-values)<br /> (cond ((= amount 0) 1)<br /> ((or (< amount 0) (no-more? coin-values)) 0)<br /> (else<br /> (+ (cc1 amount (except-first-denomination coin-values))<br /> (cc1 (- amount (first-denomination1 coin-values))<br /> coin-values)))))<br /> (define (no-more? coin-values)<br /> (null? coin-values))<br /> (define (except-first-denomination coin-values)<br /> (cdr coin-values))<br /> (define (first-denomination1 coin-values)<br /> (car coin-values))<br /> ;(cc1 100 us-coins)<br /> ;(cc1 100 uk-coins)<br /> ;<br /> ;2.20<br /> ;<br /> (define (filter pred? seq)<br /> (cond ((null? seq) '())<br /> ((pred? (car seq)) (cons (car seq) (filter pred? (cdr seq))))<br /> (else (filter pred? (cdr seq)))))<br /> ;(map (lambda(x) (cond ((= (remainder x 2) 0) x))) (list 1 2 3 4 5 6))<br /> ;(filter (lambda(x) (if (= (remainder x 2) 0) true false)) (list 1 2 3 4 5 6))<br /> (define (same-parity first . others)<br /> (if (odd? first) (cons first (filter odd? others))<br /> (cons first (filter even? others))))<br /> ;(same-parity 1 2 3 4 5 6 7)<br /> ;(same-parity 2 3 4 5 6 7)<br /> ;2.21<br /> (define (square x) (* x x))<br /> (define (square-list items)<br /> (if (null? items) '()<br /> (cons (square (car items)) (square-list (cdr items)))))<br /> (define (square-list1 items)<br /> (map square items))<br /> ;(square-list (list 1 2 3 4))<br /> ;(square-list1 (list 1 2 3 4))<br /> ;<br /> ;2.22<br /> ;cons是非对称的，<br /> ;cons 一个list和一个elem，不能形成一个线性的list<br /> ;但cons 一个elem和一个list，可以形成一个线性的list<br /> ;(cons 4 5)<br /> ;(cons 3 (list 4 5))<br /> ;(cons (list 4 5) 3)<br /> ;(list (list 4 5) 3)<br /> ;(list 3 (list 4 5) )<br /> ;(append (list 4 5) (list 3))<br /> ;(append (list 3) (list 4 5) )<br /> ;2.23<br /> (define (for-each1 func items)<br /> (if (null? items) true<br /> (and (func (car items)) (for-each1 func (cdr items)))))<br /> ;(for-each1 (lambda (x) (newline) (display x)) (list 57 232 88))<br /> ;(cons (list 1 2) (list 3 4))<br /> ;(cons (list 1 2) (list (list 3 4)))<br /> ;2.24<br /> ;(pair? (cons (list 1 2) (list 3 4)))<br /> ;<br /> ;(list 1 (list 2 (list 3 4)))<br /> ;(1 (2 (3 4)))<br /> ;<br /> ;2.25<br /> ;<br /> ;(car (cdr (car (cdr (cdr (list 1 3 (list 5 7) 9))))))<br /> ;(caar (list (list 7)))<br /> ;(car (cadadr (cadadr (cadadr (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7)))))))))))<br /> ;<br /> ;2.27<br /> (define x (list (list 1 2) (list 3 4)))<br /> (define (deep-reverse items)<br /> (if (null? items)'()<br /> (append (deep-reverse (cdr items))<br /> (if (pair? (car items) )<br /> (list (deep-reverse (car items)))<br /> (list (car items))))))<br /> ;(reverse1 x)<br /> ;(deep-reverse x)<br /> ;2.28<br /> (define (fringe items)<br /> (if (null? items)<br /> '()<br /> (append (if (pair? (car items))<br /> (fringe (car items))<br /> (list (car items)))<br /> (fringe (cdr items)))))<br /> ;(fringe x)<br /> ;(fringe (list x x))<br /> ;2.29<br /> ;(cdr (cons 2 3))<br /> ;(cdr (list 2 3))<br /> ;a)<br /> ;(define (make-mobile left right)<br /> ; (list left right))<br /> ;(define (make-branch length structure)<br /> ; (list length structure))<br /> ;(define (left-branch mobile)<br /> ; (car mobile))<br /> ;(define (right-branch mobile)<br /> ; (cadr mobile))<br /> ;(define (branch-length br)<br /> ; (car br))<br /> ;(define (branch-structure br)<br /> ; (cadr br))<br /> ;d)<br /> (define (make-mobile left right)<br /> (cons left right))<br /> (define (make-branch length structure)<br /> (cons length structure))<br /> (define (left-branch mobile)<br /> (car mobile))<br /> (define (right-branch mobile)<br /> (cdr mobile))<br /> (define (branch-length br)<br /> (car br))<br /> (define (branch-structure br)<br /> (cdr br))<br /> ;b)<br /> (define (br-weight br)<br /> (let ((bs (branch-structure br)))<br /> (if (pair? bs)<br /> (total-weight bs)<br /> bs)))<br /> (define (total-weight mobile)<br /> (+ (br-weight (left-branch mobile))<br /> (br-weight (right-branch mobile))))<br /> (define m1 (make-mobile (make-branch 2 3) (make-branch 1 2)))<br /> (define m2 (make-mobile (make-branch 5 8) (make-branch 3 m1)))<br /> ;(total-weight m2)<br /> ;c)<br /> (define (mobile-balanced? mobile)<br /> (define (branch-balanced? br)<br /> (let ((bs (branch-structure br)))<br /> (if (pair? bs)<br /> (mobile-balanced? bs)<br /> true)))<br /> (let ((lbr (left-branch mobile))<br /> (rbr (right-branch mobile)))<br /> (and (branch-balanced? lbr)<br /> (branch-balanced? rbr)<br /> (= (* (branch-length lbr) (br-weight lbr))<br /> (* (branch-length rbr) (br-weight rbr))))))<br /> (define m3 (make-mobile (make-branch 4 9) (make-branch 6 6)))<br /> (define m4 (make-mobile (make-branch 6 5) (make-branch 2 m3)))<br /> ;(mobile-balanced? m1)<br /> ;(mobile-balanced? m2)<br /> ;(mobile-balanced? m3)<br /> ;(mobile-balanced? m4)<br /> ;2.30<br /> (define (square-tree items)<br /> (if (null? items) '()<br /> (map (lambda (x) (if (pair? x) (square-tree x) (square x))) items)))<br /> (define (square-tree1 items)<br /> (if (null? items) '()<br /> (append<br /> (if (pair? (car items))<br /> (list (square-tree1 (car items)))<br /> (list (square (car items))))<br /> (square-tree1 (cdr items)))))<br /> (define (square-tree2 items)<br /> (if (null? items) '()<br /> (cons<br /> (if (pair? (car items))<br /> (square-tree2 (car items))<br /> (square (car items)))<br /> (square-tree2 (cdr items)))))<br /> ;(square-tree2 (list 1 (list 2 (list 3 4) 5) (list 6 7)))<br /> ;2.31<br /> (define (tree-map proc tree)<br /> (if (null? tree) '()<br /> (map (lambda (x) (if (pair? x) (tree-map proc x) (proc x))) tree)))<br /> (define (square-tree3 tree)<br /> (tree-map square tree))<br /> ;(square-tree3 (list 1 (list 2 (list 3 4) 5) (list 6 7)))<br /> ;2.32<br /> (define (subset s)<br /> (if (null? s)<br /> (list '())<br /> (let ((rest (subset (cdr s))))<br /> (append rest (map (lambda (x) (cons (car s) x)) rest)))))<br /> ;(subset (list 1 2 3 4))<br /> (define (sum-odd-squares tree)<br /> (cond ((null? tree) 0)<br /> ((not (pair? tree))<br /> (if (odd? tree) (square tree) 0))<br /> (else (+ (sum-odd-squares (car tree))<br /> (sum-odd-squares (cdr tree))))))<br /> ;(sum-odd-squares (list 1 (list 2 (list 3 4) 5) (list 6 7)))<br /> (define (fib n)<br /> (cond ((= n 0) 0)<br /> ((= n 1) 1)<br /> (else (+ (fib (- n 1))<br /> (fib (- n 2))))))<br /> (define (even-fibs n)<br /> (define (next k)<br /> (if (> k n)<br /> '()<br /> (let ((f (fib k)))<br /> (if (even? f)<br /> (cons f (next (+ k 1)))<br /> (next (+ k 1))))))<br /> (next 0))<br /> ;(even-fibs 10)<br /> (define (enum-tree tree)<br /> (cond ((null? tree) '())<br /> ((pair? tree) (append (enum-tree (car tree)) (enum-tree (cdr tree))))<br /> (else (list tree))))<br /> ;(enum-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))<br /> (define (accumulate1 proc init_val items) ;这个实现竟在练习2.33中运行不正确！为什么？？<br /> (if (null? items) init_val<br /> (accumulate1 proc (proc init_val (car items)) (cdr items)))) ;因为它(proc了init_val，而init_val有可能为空！用户传进来的proc，可能会对init_val进行操作，所以就挂了<br /> (define (accumulate proc init_val items)<br /> (if (null? items) init_val<br /> (proc (car items) (accumulate proc init_val (cdr items)))))<br /> ;(accumulate + 0 (map square (filter odd? (enum-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))))))<br /> ;<br /> ;(accumulate * 1 (map square (filter odd? (enum-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))))))<br /> (define (enum-interval n)<br /> (if (= n 0) (list 0)<br /> (append (enum-interval (- n 1)) (list n))))<br /> ;(filter even? (map fib (enum-interval 10)))<br /> ;2.33<br /> (define (map1 p sequence)<br /> (accumulate (lambda (x y) (cons (p x) y)) '() sequence))<br /> (define (append2 seq1 seq2)<br /> (accumulate cons seq2 seq1 ))<br /> (define (length1 sequence)<br /> (accumulate (lambda (x y) (+ 1 y)) 0 sequence))<br /> ;(map1 square (list 1 2 3 4 5))<br /> ;(append2 (list 1 2 3) (list 4 5))<br /> ;(length1 (list 1 2 3 4 5))<br /> ;2.34<br /> (define (horner-eval x coefficient-sequence)<br /> (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms))) 0 coefficient-sequence))<br /> ;(horner-eval 2 (list 1 3 0 5 0 1))<br /> ;<br /> ;2.35<br /> (define (count-leaves t)<br /> (accumulate + 0 (map (lambda (x) (if (pair? x) (count-leaves x) 1)) t)))<br /> (define (count-leaves1 t)<br /> (accumulate (lambda (x y)<br /> (if (pair? x)<br /> (+ (count-leaves1 x) y)<br /> (+ 1 y)))<br /> 0 t))<br /> (define xe (cons (list 1 2) (list 3 4)))<br /> ;(count-leaves xe)<br /> ;(count-leaves (list xe xe))<br /> ;(count-leaves1 xe)<br /> ;(count-leaves1 (list xe xe))<br /> ;<br /> ;<br /> ;2.36<br /> (define (accumulate-n op init seqs)<br /> (if (null? (car seqs))<br /> '()<br /> (cons (accumulate op init (map car seqs))<br /> (accumulate-n op init (map cdr seqs)))))<br /> ;(define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))<br /> ;(accumulate-n + 0 s)<br /> ;<br /> ;<br /> ;2.37<br /> ;<br /> (define (dot-product v w)<br /> (accumulate + 0 (map * v w)))<br /> (define (matrix-*-vector m v)<br /> (map (lambda (x) (dot-product x v)) m))<br /> (define (transpose mat)<br /> (accumulate-n cons '() mat))<br /> (define (matrix-*-matrix m n)<br /> (let ((cols (transpose n)))<br /> (map (lambda (x) (matrix-*-vector cols x)) m)))<br /> (define m (list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9)))<br /> (define v (list 2 2 2 2))<br /> (define w (list 3 3 3 3))<br /> (define n (list (list 1 1) (list 1 1) (list 1 1) (list 1 1)))<br /> ;(dot-product v w)<br /> ;(matrix-*-vector m v)<br /> ;(transpose m)<br /> ;(transpose n)<br /> ;(matrix-*-matrix m n)<br /> ;<br /> ;<br /> ;2.38<br /> ;(accumulate list '() (list 1 2 3))<br /> ;<br /> (define (fold-left op initial sequence)<br /> (define (iter result rest)<br /> (if (null? rest)<br /> result<br /> (iter (op result (car rest))<br /> (cdr rest))))<br /> (iter initial sequence))<br /> (define (fold-right op initial sequence)<br /> (accumulate op initial sequence))<br /> ;(fold-right / 1 (list 1 2 3))<br /> ;(fold-left / 1 (list 1 2 3))<br /> ;(fold-right list '() (list 1 2 3))<br /> ;(fold-left list '() (list 1 2 3))<br /> ;2.39<br /> (define (reverse2 sequence)<br /> (fold-right (lambda (x y) (append y (list x))) '() sequence))<br /> (define (reverse3 sequence)<br /> (fold-left (lambda (x y) (cons y x)) '() sequence))<br /> (reverse2 (list 1 2 3 4))<br /> (reverse3 (list 1 2 3 4))<br />