;; 2.1
(define (make-rat n d)
(if (< d 0)
(make-rat (- n) (- d))
(cons n d)))
;; 2.2
(define (make-point x y)
(cons x y))
(define (x-point p)
(car p))
(define (y-point p)
(cdr p))
(define (make-segment start end)
(cons start end))
(define (start-segment s)
(car s))
(define (end-segment s)
(cdr s))
(define (midpoint-segment s)
(let ((a (start-segment s))
(b (end-segment s)))
(make-point (/ (+ (x-point a) (x-point b)) 2)
(/ (+ (y-point a) (y-point b)) 2))))
;; 2.3
; 第一种表示
(define (make-rect mid-point width height)
(cons mid-point
(cons (/ width 2) (/ height 2))))
(define (rect-left r)
(- (x-point (car r)) (car (cdr r))))
(define (rect-right r)
(+ (x-point (car r)) (car (cdr r))))
(define (rect-bottom r)
(- (y-point (car r)) (cdr (cdr r))))
(define (rect-top r)
(+ (y-point (car r)) (cdr (cdr r))))
; 第二种表示
(define (make-rect bottom-left top-right)
(cons bottom-left top-right))
(define (rect-left r)
(x-point (car r)))
(define (rect-right r)
(x-point (cdr r)))
(define (rect-bottom r)
(y-point (car r)))
(define (rect-top r)
(y-point (cdr r)))
; 公用函数
(define (rect-width r)
(- (rect-right r) (rect-left r)))
(define (rect-height r)
(- (rect-top r) (rect-bottom r)))
(define (rect-area r)
(* (rect-width r) (rect-height r)))
(define (rect-perimeter r)
(* 2 (+ (rect-width r) (rect-height r))))
;; 2.4
(define (my-cons x y)
(lambda (m) (m x y)))
(define (my-car z)
(z (lambda (p q) p)))
(define (my-cdr z)
(z (lambda (p q) q)))
;; 2.5
(define (cons-n x y) ; x and y are natural numbers
(if (= x 0)
(if (= y 0) 1
(* 3 (cons x (- y 1))))
(* 2 (cons (- x 1) y))))
(define (car-n z)
(if (= 0 (remainder z 2))
(+ 1 (car (/ z 2)))
0))
(define (cdr-n z)
(if (= 0 (remainder z 3))
(+ 1 (cdr (/ z 3)))
0))
;; 2.6 目前最激动人心的题目
(define zero
(lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))
(define one
(lambda (f) (lambda (x) (f x))))
(define two
(lambda (f) (lambda (x) (f (f x)))))
(define (add m n)
(lambda (f) (lambda (x) ((m f) ((n f) x)))))
;; 2.7 为什么这么重复的题目啊
(define (make-interval a b) (cons a b))
(define (lower-bound x) (car x))
(define (upper-bound x) (cdr x))
;; 2.8
(define (sub-interval x y)
(make-interval (- (lower-bound x) (upper-bound y))
(- (upper-bound x) (lower-bound y))))
;; 2.9 对于加法，结果的上（下）界即两上（下）界之和，故宽度就是两宽度之和，即(a-b)+(c-d)=(a-c)-(b-d)。减法有相同的结论。对于乘法，(a-b)*(c-d)!=(ac-bd)；例如宽度相同的(0,1)、(1,2)、(2,3)两两做乘法运算得到(0,2)、(0,3)、(2,6)三个宽度不同的区间。除法类似。
;; 2.10
(define (div-interval x y)
(if (and (< (lower-bound y) 0) (< 0 (upper-bound)))
(error "Divide by a interval that contains zero -- div-interval")
(mul-interval x
(make-interval (/ 1 (upper-bound y))
(/ 1 (lower-bound y))))))
;; 2.11 其实归结起来只有三种情况：0、1或2个区间包括0。
(define (print-interval i)
(display "[")
(display (lower-bound i))
(display ",")
(display (upper-bound i))
(display "]\n"))
(define (neg-interval i)
(make-interval (- (lower-bound i)) (- (upper-bound i))))
(define (mul-interval x y)
(define (do-it a b c d)
(cond ((< b 0) (neg-interval(do-it (- b) (- a) c d)))
((< d 0) (neg-interval(do-it a b (- d) (- c))))
((and (> a 0) (< c 0)) (do-it c d a b))
((and (< a 0) (> c 0)) (make-interval (* a d) (* b d)))
((and (< a 0) (< c 0)) (make-interval 0 (max (* a c) (* b d))))
((and (> a 0) (> c 0)) (make-interval (* a c) (* b d))))
)
(let ((a (lower-bound x))
(b (upper-bound x))
(c (lower-bound y))
(d (upper-bound y)))
(do-it a b c d)))
;;;
(define (mul-interval-test-cases)
(print-interval (mul-interval (make-interval 2 3) (make-interval 4 5)))
(print-interval (mul-interval (make-interval 2 3) (make-interval -4 5)))
(print-interval (mul-interval (make-interval 2 3) (make-interval -5 -4)))
(print-interval (mul-interval (make-interval -2 3) (make-interval 4 5)))
(print-interval (mul-interval (make-interval -2 3) (make-interval -4 5)))
(print-interval (mul-interval (make-interval -2 3) (make-interval -5 -4)))
(print-interval (mul-interval (make-interval -3 -2) (make-interval 4 5)))
(print-interval (mul-interval (make-interval -3 -2) (make-interval -4 5)))
(print-interval (mul-interval (make-interval -3 -2) (make-interval -5 -4))))
;; 2.12
(define (make-center-percent center percent)
(define delta (/ (* center percent) 100))
(make-interval (- center percent) (+ center percent)))
(define (center i)
(/ (+ (lower-bound i) (upper-bound i)) 2))
(define (percent i)
(abs (* 50 (/ (- (upper-bound i) (lower-bound i)) (center i)))))
(define (print-center-percent i)
(display (center i))
(display "±")
(display (percent i))
(newline)
)
;; 2.13 a(1+b%)*c(1+d%)=ac(1+b%+d%+b%d%)~=ac(1+b%+d%)
;; 2.14 程序将 (div-interval A A) 与 (div-interval A B) 做相同的处理，而没有意识到前者的两个参数并非是独立的。也即，当同一个变量在式子中多次出现时，程序不能意识到它的每次出现必须取相同的值。
(define (check-interval-arithmetic)
(let ((A (make-interval 2 3))
(B (make-interval 2 3)))
(print-interval (div-interval A A))
(print-interval (div-interval A B))))
(define (check-interval-arithmetic-center-percent)
(let ((A (make-center-percent 100.0 3))
(B (make-center-percent 100.0 3)))
(print-center-percent (div-interval A A))
(print-center-percent (div-interval A B))))
;; 2.15 我认为这公式的两个形式是完全等价的，在Alyssa系统上产生的区间限界不同，是由于Alyssa系统的本质缺陷，而非两个形式的优劣。
;; 2.16 当同一个变量在式子中多次出现时，程序不能意识到它的每次出现必须取相同的值。每个变量出现的次数不同会导致Alyssa系统得出的结果不同。无缺陷的区间算术包等价于以下问题：多变量的多项式，每个变量有其取值范围，求多项式的值的取值范围。这个问题属于 Interval Computation 的范畴：http://www.lsi.upc.edu/~robert/mirror/interval-comp/
;; 2.17
(define (last-pair l)
(cond ((null? (cdr l)) l)
(else (last-pair (cdr l)))))
;; 2.18
(define (reverse l)
(define (do-it a b)
(if (null? a) b
(do-it (cdr a) (cons (car a) b))))
(do-it l nil))
;; 2.19
(define (cc amount coin-values)
(cond ((= amount 0) 1)
((or (< amount 0) (no-more? coin-values)) 0)
(else
(+ (cc amount
(except-first-denomination coin-values))
(cc (- amount
(first-denomination coin-values))
coin-values)))))
(define (no-more? l) (null? l))
(define (except-first-denomination l) (cdr l))
(define (first-denomination l) (car l))
; 根据问题的定义，改变表中元素的顺序不会影响回答。
;; 2.20
(define (same-parity x . s)
(define (iter a)
(if (null? a) nil
(let ((b (iter (cdr a))))
(if (even? (- x (car a)))
(cons (car a) b) b))))
(cons x (iter s)))
;; 2.21
(define (square-list items)
(if (null? items)
nil
(cons (square (car items)) (square-list (cdr items)))))
(define (square-list items)
(map square items))
;; 2.22 第一个程序中，程序从前往后处理things中的元素，却每次把平方后的元素加到answer的头部，故结果的顺序会相反。第二个程序中，当cons的两个参数分别是list和元素时，结果并不是把元素加到list后面。
;; 2.23
(define (for-each f l)
(cond ((not (null? l))
(f (car l))
(for-each f (cdr l)))))
;; 2.24 (1 (2 (3 4)))。
;; 2.25
(car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))
(car (car '((7))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr '(1 (2 (3 (4 (5 (6 7))))))))))))))))))
;; 2.26
; (1 2 3 4 5 6)
; ((1 2 3) 4 5 6)
; ((1 2 3) (4 5 6))
;; 2.27
(define (deep-reverse t)
(if (list? t)
(map deep-reverse (reverse t))
l))
;; 2.28
(define (fringe t)
(cond ((null? t) nil)
((list? t) (append (fringe (car t)) (fringe (cdr t))))
(else (list t))))
;; 2.29
(define (make-mobile left right)
(list left right))
(define (make-branch length structure)
(list length structure))
; (a)
(define (left-branch mobile)
(car mobile))
(define (right-branch mobile)
(cadr mobile))
(define (branch-length branch)
(car branch))
(define (branch-structure branch)
(cadr branch))
; (b)
(define (total-weight x)
(if (number? x)
x
(+ (total-weight (branch-structure (left-branch x))) (total-weight (branch-structure (right-branch x))))))
; (c)
(define (branch-torque x)
(* (total-weight (branch-structure x))
(branch-length x)))
(define (balanced? x)
(cond ((number? x) true)
(else
(let ((left (left-branch x))
(right (right-branch x)))
(and (= (branch-torque left) (branch-torque right)) (balanced? (branch-structure left)) (balanced? (branch-structure right)))))))
; (d) 只需更改right-branch和branch-structure中的cadr为cdr
;; 2.30
; 直接定义
(define (square-tree t)
(cond ((null? t) nil)
((number? t) (square t))
(else (cons (square-tree (car t)) (square-tree (cdr t))))))
; 使用高阶函数
(define (square-tree t)
(map (lambda (x)
(if (list? x)
(square-tree x)
(square x)))
t))
;; 2.31
(define (tree-map f t)
(map (lambda (x)
(if (list? x)
(tree-map x)
(f x)))
t))
;; 2.32 将子集分为包含与不包含(car s)两种情况。
(define (subsets s)
(if (null? s)
(list nil)
(let ((rest (subsets (cdr s))))
(append rest (map (lambda (x) (cons (car s) x)) rest)))))
;; 2.33
(define (unary-map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) nil sequence))
(define (apppend seq1 seq2)
(accumulate cons seq2 seq1))
(define (length sequence)
(accumulate (lambda (x y) (+ 1 y)) 0 sequence))
;; 2.34
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
0
coefficient-sequence))
;; 2.35
(define (count-leaves t)
(accumulate (lambda (x y)
(+
(if (list? x) (count-leaves x) 1)
y))
0
t))
; 或
(define (count-leaves t)
(accumulate + 0 (map (lambda (x) (if (list? x) (count-leaves x) 1)) t)))
;; 2.36
(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)))))
;; 2.37
(define (dot-product v w)
(accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
(map (lambda (x) (dot-product x v)) m))
(define (transpose mat)
(accumulate-n cons nil mat))
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map (lambda (x) (matrix-*-vector cols x)) m)))
;; 2.38
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest))
(cdr rest))))
(iter initial sequence))
(define fold-right accumulate)
; 3/2
; 1/6
; (1 (2 (3 ())))
; (((() 1) 2) 3)
; 结合律，以及inital是op的零元。
;; 2.39
(define (reverse sequence)
(fold-right (lambda (x y) (append y (list x))) nil sequence))
(define (reverse sequence)
(fold-left (lambda (x y) (cons y x)) nil sequence))
;; 2.40
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (unique-pairs n)
(flatmap
(lambda (i)
(map
(lambda (x) (cons x i))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
;; 2.41
(define (pair-sum-no-more-than n)
(flatmap
(lambda (x)
(map (lambda (y) (cons y x))
(enumerate-interval 1 (min (- x 1) (- n x)))))
(enumerate-interval 1 (- n 1))))
(define (triple-sum-is n)
(filter
(lambda (x) (not (or (= (car x) (cadr x)) (= (car x) (caddr x)))))
(map
(lambda (x) (list (- n (car x) (cdr x)) (car x) (cdr x)))
(pair-sum-no-more-than (- n 1)))))
;; 2.42
(define empty-board nil)
(define (safe? k p)
(define (not-same p)
(null? (filter (lambda (x) (= (car p) x)) (cdr p))))
(and
(not-same p)
(not-same (map + p (enumerate-interval 1 k)))
(not-same (map + p (reverse (enumerate-interval 1 k))))))
(define (adjoin-position n k r)(cons n r))
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (rest-of-queens)
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
;; 2.43 原程序中每个 (queen-cols k) 只需调用一次，而这个程序中，为了计算 (queen-cols k)，需要调用 k 次 (queen-cols (- k 1))；大约需要k!T的时间。
;; 2.44
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
;; 2.45
(define (split combo1 combo2)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(combo1 painter (combo2 smaller smaller))))))
;; 2.46
(define (make-vect x y)
(cons x y))
(define (xcor-vect v)
(car v))
(define (ycor-vect v)
(cdr v))
(define (add-vect v w)
(make-vect (+ (xcor-vect v) (xcor-vect w))
(+ (ycor-vect v) (ycor-vect w))))
(define (sub-vect v w)
(make-vect (- (xcor-vect v) (xcor-vect w))
(- (ycor-vect v) (ycor-vect w))))
(define (scale-vect s v)
(make-vect (* s (xcor-vect v))
(* s (ycor-vect v))))
;; 2.47
(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(caddr frame))
(define (make-frame origin edge1 edge2)
(cons origin (cons edge1 edge2)))
(define (edge2-frame frame)
(cddr frame))
;; 2.48
(define (make-segment v w)
(cons v w))
(define (start-segment s)
(car s))
(define (end-segment s)
(cdr s))
;; 2.49
; (a)
(define outline-painter
(let ((left-bottom (make-vect 0 0))
(left-top (make-vect 0 1))
(right-bottom (make-vect 1 0))
(right-top (make-vect 1 1)))
(segments->painter (list
(make-segment left-top left-bottom)
(make-segment left-bottom right-bottom)
(make-segment right-bottom right-top)
(make-segment right-top left-top)))))
; (b)
(define X-painter
(let ((left-bottom (make-vect 0 0))
(left-top (make-vect 0 1))
(right-bottom (make-vect 1 0))
(right-top (make-vect 1 1)))
(segments->painter (list
(make-segment left-bottom right-top)
(make-segment left-top right-bottom)))))
; (c)
(define diamond-painter
(let ((bottom (make-vect 0.5 0))
(left (make-vect 0 0.5))
(top (make-vect 0.5 1))
(right (make-vect 1 0.5)))
(segments->painter (list
(make-segment bottom left)
(make-segment left top)
(make-segment top right)
(make-segment right bottom)))))
; (d) 来源 http://d.hatena.ne.jp/laughing/20081115/1226737187，有修正
(define wave
(let ((p0 (make-vect 0.4 1.0))
(p1 (make-vect 0.35 0.8))
(p2 (make-vect 0.4 0.6))
(p3 (make-vect 0.3 0.6))
(p4 (make-vect 0.15 0.55))
(p5 (make-vect 0 0.8))
(p6 (make-vect 0 0.6))
(p7 (make-vect 0.15 0.4))
(p8 (make-vect 0.3 0.55))
(p9 (make-vect 0.35 0.5))
(p10 (make-vect 0.3 0))
(p11 (make-vect 0.4 0))
(p12 (make-vect 0.5 0.3))
(p13 (make-vect 0.6 0))
(p14 (make-vect 0.7 0))
(p15 (make-vect 0.6 0.45))
(p16 (make-vect 1.0 0.2))
(p17 (make-vect 1.0 0.4))
(p18 (make-vect 0.8 0.6))
(p19 (make-vect 0.6 0.6))
(p20 (make-vect 0.65 0.8))
(p21 (make-vect 0.6 1.0)))
(segments->painter
(list
(make-segment p0 p1)
(make-segment p1 p2)
(make-segment p2 p3)
(make-segment p3 p4)
(make-segment p4 p5)
(make-segment p6 p7)
(make-segment p7 p8)
(make-segment p8 p9)
(make-segment p9 p10)
(make-segment p11 p12)
(make-segment p12 p13)
(make-segment p14 p15)
(make-segment p15 p16)
(make-segment p17 p18)
(make-segment p18 p19)
(make-segment p19 p20)
(make-segment p20 p21)))))
;; 2.50
(define (flip-horiz painter)
(transform-painter painter
(make-vect 1 0)
(make-vect 0 0)
(make-vect 1 1)))
(define (rotate-180 painter)
(transform-painter painter
(make-vect 1 1)
(make-vect 0 1)
(make-vect 1 0)))
(define (rotate-270 painter)
(transform-painter painter
(make-vect 0 1)
(make-vect 0 0)
(make-vect 1 1)))
;; 2.51
(define (below painter1 painter2)
(let ((paint-bottom
(transform-painter painter1
(make-vect 0 0)
(make-vect 1 0)
(make-vect 0 0.5)))
(paint-top
(transform-painter painter2
(make-vect 0 0.5)
(make-vect 1 0.5)
(make-vect 0 1))))
(lambda (frame)
(paint-bottom frame)
(paint-top frame))))
(define (below painter1 painter2)
(rotate-270 (beside (rotate-90 painter1) (rotate-90 painter2))))
;; 2.52
; (a) 略
; (b)
(define (corner-split painter n)
(if (= n 0)
painter
(let ((up (up-split painter n))
(right (right-split painter n)))
(let ((top-left up)
(bottom-right right)
(corner (corner-split painter (- n 1))))
(beside (below painter top-left)
(below bottom-right corner))))))
; (c)
(define (square-limit painter n)
(let ((combine4 (square-of-four identity flip-horiz
flip-vert rotate180)))
(combine4 (corner-split painter n)))) |
December 12, 2008
· Filed under 程序园
;; 1.29
(define (simpson-integral f a b n)
(define (coefficient i)
(cond ((or (= i 0) (= i n)) 1)
((even? i) 2)
(else 4)))
(let ((h (/ (- b a)n )))
(* (/ h 3)
(sum (lambda (i) (* (f (+ a (* i h))) (coefficient i)))
0
(lambda (i) (+ i 1))
n))))
;; 1.30
(define (sum term a next b)
(define (iter a result)
(if (> a b)
result
(iter (next a) (+ result (term a)))))
(iter a 0))
;; 1.31 只需要把sum改动两处。
; 递归实现
(define (product term a next b)
(if (> a b)
1
(* (term a)
(product term (next a) next b))))
; 迭代实现
(define (product term a next b)
(define (iter a result)
(if (> a b)
result
(iter (next a) (* result (term a)))))
(iter a 1))
; 阶乘
(define (factorial n)
(product (lambda (x) x) 1 (lambda (i) (+ 1 i)) n))
; π的近似值
(define (calc-pi n)
(define (term i)
(/ (- (square i) 1) (square i)))
(define (next i)
(+ 2 i))
(* 4 (product term 3.0 next n)))
;; 1.32
(define (accumulate combiner null-value term a next b)
(if (> a b)
null-value
(combiner (term a)
(accumulate combiner null-value term (next a) next b))))
(define (accumulate combiner null-value term a next b)
(define (iter a result)
(if (> a b)
result
(iter (next a) (combiner result (term a)))))
(iter a null-value))
;; 1.33
; filtered-accumulate 的两种实现
(define (filtered-accumulate combiner null-value term a next b filter)
(define (do-filter x)
(if (filter x) x null-value))
(if (> a b)
null-value
(combiner (do-filter (term a))
(filtered-accumulate combiner null-value term (next a) next b filter))))
(define (filtered-accumulate combiner null-value term a next b filter)
(define (do-filter x)
(if (filter x) x null-value))
(define (iter a result)
(if (> a b)
result
(iter (next a) (combiner result (do-filter (term a))))))
(iter a null-value))
; (a)
(filtered-accumulate + 0 (lambda (x) x) a (lambda (i) (+ 1 i)) b prime?)
; (b)
(filtered-accumulate * 1 (lambda (x) x) 1 (lambda (i) (+ 1 i)) (- 1 n) (lambda (a) (= 1 (gcd a n))))
;; 1.34 (f f)相当于(f 2)，相当于(2 2)，会因为2并非可以调用的函数而出错。
;; 1.35 证明不动点直接计算即可，计算的(fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0)。
;; 1.36 全部代码如下
(define tolerance 0.00001)
(define (fixed-point f first-guess)
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(define (try guess)
(display guess)
(newline)
(let ((next (f guess)))
(if (close-enough? guess next)
next
(try next))))
(try first-guess))
(define (f x) (/ (log 1000) (log x)))
(display (fixed-point f 2))
(newline) (newline)
(display (fixed-point (lambda (x) (average x (f x))) 2))
(newline) (newline)
; 使用与不使用平均阻尼的步数分别为9与34步。
;; 1.37
; 递归版本
(define (cont-frac n d k)
(define (shift f)
(lambda (i) (f (+ 1 i))))
(if (= 0 k)
0
(/ (n 1) (+ (d 1) (cont-frac (shift n) (shift d) (- k 1))))))
; 迭代版本
(dsefine (cont-frac n d k)
(define (iter result i)
(if (= 0 i)
result
(iter (/ (n i) (+ (d i) result)) (- i 1))))
(iter 0 k))
; 当k不小于11时，结果有4位精度。
;; 1.38
(define (e-2 k)
(cont-frac (lambda (i) 1.0)
(lambda (i)
(if (= 2 (remainder i 3))
(* 2 (/ (+ 1 i) 3))
1))
k))
;; 1.39
(define (tan-cf x k)
(cont-frac (lambda (i)
(if (= 1 i) x (- (square x))))
(lambda (i)
(- (* 2 i) 1))
k))
;; 1.40
(define (cubic a b c)
(lambda (x)
(+ c (* x (+ b (* x (+ a x)))))))
;; 1.41
; double函数
(define (double f)
(lambda (x)
(f (f x))))
;; (((double (double double)) inc) 5) 的值为21。因为 (double double) 得到一个把参数过程应用四次的函数，而 (double (double double)) 事实上是将“把参数过程应用四次”的过程应用两次，也就是一个将参数过程应用十六次的函数。
;; 1.42
(define (compose f g)
(lambda (x) (f (g x))))
;; 1.43
(define (repeated f n)
(if (= 1 n)
f
(compose f (repeated f (- n 1)))))
;; 1.44
(define (n-times-smooth f dx n)
((repeated (lambda (f) (smooth f dx)) n) f))
;; 1.45
(define (calc-nth-root-with-t-average-damps x n t)
(fixed-point ((repeated average-damp t) (lambda (y) (/ x (fast-expt y (- n 1))))) 1.0))
;; 通过实验，得到的规律是，当 2^t>=n 时，用 t 次平均阻尼求 n 次方根是可行的，于是有下面的程序。
(define (nth-root x n)
(define (minimal-t n)
(if (= 1 n)
0
(+ 1 (minimal-t (quotient n 2)))))
(calc-nth-root-with-t-average-damps x n (minimal-t n)))
;; 1.46
(define (iterative-improve guess improve good-enough?)
(if (good-enough? guess)
guess
(iterative-improve (improve guess) improve good-enough?)))
(define (sqrt x)
(define (improve y)
(/ (+ x (square y)) (* 2 y)))
(define (good-enough? y)
(> tolerance (abs (- (square y) x))))
(iterative-improve 1.0 improve good-enough?))
(define (fixed-point f first-guess)
(define (improve x)
(f x))
(define (good-enough? x)
(> tolerance (abs (- (f x) x))))
(iterative-improve first-guess improve good-enough?)) |
November 27, 2008
· Filed under 程序园
;; 1.1-2 略
;; 1.3
(define (greater-two a b c)
(-
(+ a b c)
(min a b c)))
; 或
(define (greater-two a b c)
(cond ((and (> b a) (> c a))
(+ b c))
((and (> a b) (> c b))
(+ a c))
(else (+ a b))))
;; 1.4 (if (> b 0) + -) 根据b的正负性返回函数+或-。
;; 1.5 函数p的定义 (define (p) (p)) 是不断递归调用自己，所以欲对其进行求值/展开会产生死循环。调用 (test 0 (p)) 时，若采用应用序求值，会先对函数的参数，包括 (p) 求值，因而产生死循环，无法输出结果；若采用正则序求值，则由于 (p) 的值事实上不会被展开，故会正常返回0。
;; 1.6 将在调用函数 new-if 时，应用序要求先算出其所有参数的值，new-if 的后两个参数——代表 if 的两个分支的代码都将被执行。所以 (sqrt-iter guess x) 必然需要调用 (sqrt-iter (improve guess x) x)，这导致死循环。
;; 1.7
(define (sqrt x)
(define (sqrt-iter guess)
(define (good-enough?)
(< (abs (/ (- (* guess guess) x) x)) 0.001))
(define (improve)
(define (average a b)
(/ (+ a b) 2))
(average guess (/ x guess)))
(if (good-enough?)
guess
(sqrt-iter (improve))))
(sqrt-iter 1.0))
;; 1.8
(define (cube-root x)
(define (iter guess)
(define (good-enough?)
(< (abs (/ (- (* (* guess guess) guess) x) x)) 0.001))
(define (improve)
(/ (+ ( / x (* guess guess)) (* 2 guess)) 3))
(if (good-enough?)
guess
(iter (improve))))
(iter 1.0))
;; 1.9 第一个过程是递归的，表达式被递归地逐渐展开再合并；第二个过程中的递归是尾递归，不妨理解为迭代的。
;; 1.10 (f n)是n的2倍，(g n)是2的n次方，(h n)是2的(h (- n 1))次方。
;; 1.11
; 递归方式
(define (f n)
(if (< n 3) n
(+ (f (- n 1))
(* 2 (f (- n 2)))
(* 3 (f (- n 3))))))
; 迭代方式
(define (f n)
(define (iter a b c i)
(if (= i n) c
(iter b c
(+ (* 3 a) (* 2 b) c)
(+ i 1))))
(if (< n 3) n
(iter 0 1 2 2)))
;; 1.12
(define (C n i)
(if (or (= i 0) (= i n))
1
(+ (C (- n 1) (- i 1)) (C (- n 1) i))))
;; 1.13 可利用归纳法和定义直接证。
;; 1.14 空间复杂度为 O(amount)，因为任何时刻调用链的长度（栈上的函数数量）不超过 amount+1；时间复杂度为 O(amount * result)，因为每得到一种方案都调用一次 (cc 0 kinds-of-coins)。
;; 1.15 空间与时间复杂度均为O(log a)。
;; 1.16 prod*a^m是不变量。
(define (fast-expt b n)
(define (iter prod a m)
(if (= 0 m) prod
(if (= 0 (remainder m 2))
(iter prod (* a a) (/ m 2))
(iter (* prod a) (* a a) (/ (- m 1) 2)))))
(iter 1 b n))
;; 1.17
(define (fast-multi a b)
(if (= 1 a) b
(if (= 0 (remainder a 2))
(double (fast-multi (halve a) b))
(+ b (double (fast-multi (halve (- a 1)) b))))))
;; 1.18
(define (fast-multi a b)
(define (iter sum i n)
(if (= 0 n) sum
(if (= 0 (remainder n 2))
(iter sum (double i) (halve n))
(iter (+ sum i) (double i) (halve (- n 1))))))
(iter 0 a b))
;; 1.19 p’ = pp + qq，q’ = qq + 2pq。
;; 1.20 应用序需要4次；正则序需要更多，没仔细数，因为gcd函数体中出现了三处b，当b是调用remainder的形式时，它需要被展开若干次。
;; 1.21 略。
;; 1.22-24 我用的DrScheme没有定义runtime……555
;; 1.25 如果不在计算乘幂时随时取模，每次乘法将由于被乘数位数的迅速增长而不能被看做单位时间的原子操作。
;; 1.26 每次(expmod base exp m)当exp为正偶数时会调用两次而非一次(expmod base exp m)，f(N)=2*f(N/2)+Θ(1)导致f(N)=Θ(N)，而原始版本的f(N)=f(N/2)+Θ(1)导致f(N)=Θ(log N)。
;; 1.27 以下程序中，(find-carmichael n)找出不超过n的Carmichael数
(define (prime? n)
(define (iter i)
(cond
((> (square i) n) true)
((= 0 (remainder n i)) false)
(else (iter (+ i 1)))))
(iter 2))
(define (carmichael? n)
(define (iter i)
(cond
((= i n) true)
((not (= i (expmod i n n))) false)
(else (iter (+ i 1)))))
(and (not (prime? n)) (iter 2)))
(define (find-carmichael n)
(define (iter i)
(cond ((carmichael? i) (display i) (display "\n")))
(cond ((< i n) (iter (+ i 1)))))
(iter 2))
;; 1.28
(define (miller-rabin n)
(define (exp-iter prod base exp)
(cond ((and (< 1 prod) (< prod (- n 1)) (= (remainder (* prod prod) n) 1)) 0)
((= 0 exp) prod)
(else (if (even? exp)
(exp-iter
prod
(remainder (* base base) n)
(/ exp 2))
(exp-iter
(remainder (* prod base) n)
(remainder (* base base) n)
(/ (- exp 1) 2))))))
(define (check i)
(= 1 (exp-iter 1 i (- n 1))))
(define (check-iter i)
(cond ((= i 0) true)
(else (if (check (+ 2 (random (- n 3))))
(check-iter (- i 1)) false))))
(or (= 2 n) (= 3 n)
(and (< 2 n) (= 1 (remainder n 2)) (check-iter 20)))) |
November 26, 2008
· Filed under 程序园
