S.O.W - SICPお勉強Wiki

描画結果

2010-07-12T16:28:44+09:00

* Picture Language ---- ** Painter #ref(painter.png) #highlight(scheme){ ;; rate倍に縮小してframeを中心に移動する ; (後でまともにする) (define (reduction-center rate painter) (let ((origin (/ (- 1.0 rate) 2))) (transform-painter painter (make-vect origin origin) (make-vect (+ origin rate) origin) (make-vect origin (+ origin rate))))) (below (beside (reduction-center 0.8 outline) diagonal) (beside diamond wave)) } ** Corner-split #ref(corner4.png) #highlight(scheme){ (corner-split wave 4) } ** Square-limit #ref(squarelimit.png) #highlight(scheme){ (square-limit wave 4) } Ruby-GDでつくってみたけれど, Gauche-GDで作り直したい ** おまけ #ref(hoge2.gif) #highlight(scheme){ ;Gauche-GDにて作成。関数名が適当なのは気にしない (define aho (lambda (x) (corner-split x 3))) (define aho1 (lambda (x) (rotate90 (corner-split x 3)))) (define aho2 (lambda (x) (rotate180 (corner-split x 3)))) (define aho3 (lambda (x) (rotate270 (corner-split x 3)))) (define hoge (square-of-four aho1 aho2 aho aho3)) (hoge hoshi) }

Exercises 2.2.4

2010-06-25T14:07:23+09:00

* Chapter 2.2.4 ** Picture Language - [[描画結果]] ---- #pcomment(reply, コメント/2.2.2) ---- ** Exercise 2.44 #highlight(scheme){ (define (align-operator combiner op1 op2) (lambda (painter) (combiner (op1 painter) (op2 painter)))) (define align-vert (align-operator below identity identity)) (define align-horiz (align-operator beside identity identity)) (define (up-split painter n) (if (= n 0) painter (below painter (align-horiz (up-split painter (- n 1)))))) } ---- ** Exercise 2.45 #highlight(scheme){ (define right-split (split beside below)) (define up-split (split below beside)) (define (split align-identity align-splitted) (define (splitter painter n) (if (= n 0) painter (align-identity painter ((align-operator align-splitted) (splitter painter (- n 1)))))) splitter) } ---- * 以降はFrame, Painterの実装について ** Exercise 2.46 #highlight(scheme){ ; vector constructor and selectors ; vector operating procedures (define make-vect cons) (define x-vect car) (define y-vect cdr) (define (add-vect u v) (make-vect (+ (x-vect u) (x-vect v)) (+ (y-vect u) (y-vect v)))) (define (sub-vect u v) (make-vect (- (x-vect u) (x-vect v)) (- (y-vect u) (y-vect v)))) (define (scale-vect a v) (make-vect (* a (x-vect v)) (* a (y-vect v)))) } ---- ** Exercise 2.47 #highlight(scheme){ ; implementing a frame (define (make-frame1 origin h-edge v-edge) (list origin h-edge v-edge)) (define origin-frame1 car) (define h-edge-frame1 (lambda (x) (car (cdr x)))) (define v-edge-frame1 (lambda (x) (car (cdr (cdr x))))) (define (make-frame2 origin h-edge v-edge) (cons origin (cons h-edge v-edge))) (define origin-frame2 car) (define h-edge-frame2 (lambda (x) (cdr (car x)))) (define v-edge-frame2 (lambda (x) (cdr (cdr x)))) } ---- ** Exercise 2.48 #highlight(scheme){ ; segment:線分 = 始点, 終点 (define make-segment cons) (define start-segment car) (define end-segment cdr) } ---- ** Exercise 2.49 #highlight(scheme){ implementing some primitive painters ; outline: draws the outlines of the given frame ; diagonal: draws an X by connecting opposite corners ; diamond: draws a diamond shape by connecting midpoint of sides ; wave (define outline (segment->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 0.0)) (make-segment (make-vect 1.0 0.0) (make-vect 1.0 1.0)) (make-segment (make-vect 1.0 1.0) (make-vect 0.0 1.0)) (make-segment (make-vect 0.0 1.0) (make-vect 0.0 0.0))))) (define diagonal (segment->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0)) (make-segment (make-vect 1.0 0.0) (make-vect 0.0 1.0))))) (define diamond (segment->painter (list (make-segment (make-vect 0.0 0.5) (make-vect 0.5 1.0)) (make-segment (make-vect 0.5 1.0) (make-vect 0.5 0.0)) (make-segment (make-vect 0.5 0.0) (make-vect 0.0 0.5))))) (define wave (segment->painter (list (make-segment (make-vect 0.0 0.86) (make-vect 0.14 0.6)) (make-segment (make-vect 0.14 0.6) (make-vect 0.25 0.64)) (make-segment (make-vect 0.25 0.64) (make-vect 0.39 0.64)) (make-segment (make-vect 0.39 0.64) (make-vect 0.36 0.86)) (make-segment (make-vect 0.36 0.86) (make-vect 0.39 1.0)) ;; (make-segment (make-vect 0.61 1.0) (make-vect 0.64 0.86)) (make-segment (make-vect 0.64 0.86) (make-vect 0.61 0.64)) (make-segment (make-vect 0.61 0.64) (make-vect 0.75 0.64)) (make-segment (make-vect 0.75 0.64) (make-vect 1.0 0.35)) ;; (make-segment (make-vect 0.0 0.64) (make-vect 0.14 0.39)) (make-segment (make-vect 0.14 0.39) (make-vect 0.25 0.6)) (make-segment (make-vect 0.25 0.6) (make-vect 0.36 0.5)) (make-segment (make-vect 0.36 0.5) (make-vect 0.25 0.0)) ;; (make-segment (make-vect 0.39 0.0) (make-vect 0.5 0.29)) (make-segment (make-vect 0.5 0.29) (make-vect 0.61 0.0)) ;; (make-segment (make-vect 0.75 0.0) (make-vect 0.61 0.47)) (make-segment (make-vect 0.61 0.47) (make-vect 1.0 0.14))))) } ---- ** Exercise 2.50 #highlight(scheme){ (define (flip-vert painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (define (flip-horiz painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) (define (rotate180 painter) (transform-painter painter (make-vect 1.0 1.0) (make-vect 0.0 1.0) (make-vect 1.0 0.0))) (define (rotate90 painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (define (rotate270 painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) } ---- ** Exercise 2.51 #highlight(scheme){ (define (beside painter1 painter2) (let ((paint-left (transform-painter painter1 (make-vect 0.0 0.0) (make-vect 0.5 0.0) (make-vect 0.0 1.0))) (paint-right (transform-painter painter2 (make-vect 0.5 0.0) (make-vect 1.0 0.0) (make-vect 0.5 1.0)))) (lambda (frame) (paint-left frame) (paint-right frame)))) (define (below painter1 painter2) (let ((paint-bottom (transform-painter painter1 (make-vect 0.0 0.0) (make-vect 1.0 0.0) (make-vect 0.0 0.5))) (paint-top (transform-painter painter2 (make-vect 0.0 0.5) (make-vect 1.0 0.5) (make-vect 0.0 1.0)))) (lambda (frame) (paint-top frame) (paint-bottom frame)))) }

2.2 Hierarchical Data and the Closure Property

2010-06-25T13:57:40+09:00

*Chapter 2.2 **[[Exercises 2.2.1]] **[[Exercises 2.2.2]] **[[Exercises 2.2.4]] **Note #pcomment()

Exercises 2.2.2

2010-05-26T04:33:59+09:00

* Chapter 2.2.2 ---- #pcomment(reply, コメント/2.2.2) ---- ** Exercise 2.24 #highlight(scheme){ (define ans (cons 1 (cons (cons 2 (cons (cons 3 (cons 4 '())) '())) '()))) } ---- ** Exercise 2.25 #highlight(scheme){ (define (pick x ls) (define (sub x ls) (if (null? ls) false (if (pair? ls) (pick x ls) (if (= x ls) true false)))) (if (not (sub x (car ls))) (sub x (cdr ls)) true)) } ---- ** Exercise 2.26 #highlight(scheme){ > (define x (list 1 2 3)) > (define y (list 4 5 6)) > (append x y) (1 2 3 4 5 6) > (cons x y) ((1 2 3) 4 5 6) > (list x y) ((1 2 3) (4 5 6)) } ---- ** Exercise 2.27 #highlight(scheme){ (define (rev ls) (define (it ls re) (if (null? ls) re (it (cdr ls) (cons (car ls) re)))) (it ls '())) (define (d-rev ls) (define (it ls re) (if (null? ls) re (if (pair? (car ls)) (it (cdr ls) (cons (d-rev (car ls)) re)) (it (cdr ls) (cons (car ls) re))))) (it ls '())) } ---- ** Exercise 2.28 #highlight(scheme){ (define (fringe ls) (if (null? ls) '() (if (pair? (car ls)) (fringe (append (car ls) (fringe (cdr ls)))) (cons (car ls) (fringe (cdr ls)))))) } ---- ** Exercise 2.29 ---- ** Exercise 2.30 #highlight(scheme){ (define (square-tree tree) (define (square x) (* x x)) (map (lambda (sub) (if (pair? sub) (square-tree sub) (square sub))) tree)) } ---- ** Exercise 2.31 #highlight(scheme){ (define (tree-map f tree) (map (lambda (x) (if (pair? x) (tree-map f x) (f x))) tree)) } ---- ** Exercise 2.32 #highlight(scheme){ (define (subsets s) (define (g x) (cons (car s) x)) (if (null? s) (list '()) (let ((rest (subsets (cdr s)))) (append rest (map g rest))))) }

Exercises 2.2.1

2010-04-03T16:29:35+09:00

* Chapter 2.2.1 ---- #pcomment(reply, コメント/2.2.1) ---- ** Exercise 2.17 #highlight(scheme){ (define (last-pair ls) (if (null? (cdr ls)) (car ls) (last-pair (cdr ls)))) } ---- ** Exercise 2.18 #highlight(scheme){ (define (rev ls) (define (iter ls re) (if (null? (cdr ls)) (cons (car ls) re) (iter (cdr ls) (cons (car ls) re)))) (iter (cdr ls) (cons (car ls) '()))) } ---- ** Exercise 2.19 #highlight(scheme){ (define us-coins (list 50 25 10 5 1)) (define uk-coins (list 100 50 20 10 5 2 1 0.5)) (define (cc amount coin-values) (define (first-denomination coin) (car coin)) (define (no-more? coin) (null? coin)) (define (except-first-denomination coin) (cdr coin)) (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))))) } ---- ** Exercise 2.20 #highlight(scheme){ ;排他的論理和を用いればもっと簡単に書ける (define (same-parity x . z) (define (same-odd ls) (if (null? ls) '() (if (odd? (car ls)) (cons (car ls) (same-odd (cdr ls))) (same-odd (cdr ls))))) (define (same-even ls) (if (null? ls) '() (if (even? (car ls)) (cons (car ls) (same-even (cdr ls))) (same-even (cdr ls))))) (if (odd? x) (cons x (same-odd z)) (cons x (same-even z)))) } ---- ** Exercise 2.21 #highlight(scheme){ (define (square x) (* x x)) (define (square-list1 items) (if (null? items) '() (cons (square (car items)) (square-list1 (cdr items))))) (define (square-list2 items) (map square items)) } ---- ** Exercise 2.22 ---- ** Exercise 2.23 #highlight(scheme){ (define (for-each1 proc items) (if (null? items) #t (begin (proc (car items)) (for-each proc (cdr items))))) } ----

コメント/2.2 Hierarchical Data and the Closure Property

2010-04-03T16:27:09+09:00

-問題数が多いので分割します - jout 2010-04-03 16:27:09

トップページ

2010-03-10T18:47:35+09:00

**お知らせ -&bold(){次回は2010/3/18?} -Chapter 2.2 **Chapter一覧 *** 1 Building Abstractions with Procedures -[[1.1 The Elements of Programming]] -[[1.2 Procedures and the Processes They Generate]] -[[1.3 Formulating Abstractions with Higher-Order Procedures]] *** 2 Building Abstractions with Data -[[2.1 Introduction to Data Abstraction]] -[[2.2 Hierarchical Data and the Closure Property]] -[[2.3 Symbolic Data]] -[[2.4 Multiple Representations for Abstract Data]] -[[2.5 Systems with Generic Operations]] *** 3 Modularity, Objects, and State //-[[3.1 Assignment and Local State]] //-[[3.2 The Environment Model of Evaluation]] //-[[3.3 Modeling with Mutable Data]] //-[[3.4 Concurrency: Time Is of the Essence]] //-[[3.5 Streams]] *** 4 Metalinguistic Abstraction //-[[4.1 The Metacircular Evaluator]] //-[[4.2 Variations on a Scheme -- Lazy Evaluation]] //-[[4.3 Variations on a Scheme -- Nondeterministic Computing]] //-[[4.4 Logic Programming]] *** 5 Computing with Register Machines //-[[5.1 Designing Register Machines]] //-[[5.2 A Register-Machine Simulator]] //-[[5.3 Storage Allocation and Garbage Collection]] //-[[5.4 The Explicit-Control Evaluator]] //-[[5.5 Compilation]] ---- #pcomment(reply)

Exercises 2.1

2010-03-09T16:37:24+09:00

* Chapter 2.1 ---- #pcomment(reply,コメント/2.1) ---- **Exercise 2.1 #highlight(scheme){ (define (make-rat n d) (define (cons-rat n d) (let ((g (gcd n d))) (cons (/ n g) (/ d g)))) (if (< (* n d) 0) (cons-rat (- (abs n)) (abs d)) (cons-rat (abs n) (abs d)))) } ---- **Exercise 2.2 #highlight(scheme){ (define (average x y) (/ (+ x y) 2)) (define (make-segment p q) (cons p q)) (define (start-segment seg) (car seg)) (define (end-segment seg) (cdr seg)) (define (make-point x y) (cons x y)) (define (x-point p) (car p)) (define (y-point p) (cdr p)) (define (midpoint-segment s) (let ((p (start-segment s)) (q (end-segment s))) (make-point (average (x-point p) (x-point q)) (average (y-point p) (y-point q))))) } ---- **Exercise 2.3 ---- **Exercise 2.4 #highlight(scheme){ ; cons,car,cdrを手続きで表現する (define (cons2 x y) (lambda (m) (m x y))) (define (car2 z) (z (lambda (a d) a))) (define (cdr2 z) (z (lambda (a d) d))) } ---- **Exercise 2.5 - 非負整数のペアを&math(150){2^a3^b}で表現する #highlight(scheme){ (define (count-factor factor num cnt) (if (= (remainder num factor) 0) (count-factor factor (/ num factor) (+ cnt 1)) cnt)) (define (cons3 a b) (if (and (> a 0) (> b 0)) (* (expt 2 a) (expt 3 b)) 0)) (define (car3 z) (count-factor 2 z 0)) (define (cdr3 z) (count-factor 3 z 0)) } ---- **Exercise 2.6 #highlight(scheme){ (define zero (lambda (f) (lambda (x) x))) (define (succ n) (lambda (f) (lambda (x) (f ((n f) x))))) ; (succ zero) ; (lambda (f) (lambda (x) (f ((zero f) x)))) ; (lambda (f) (lambda (x) (f ((lambda (x) x) x)))) (define one (lambda (f) (lambda (x) (f x)))) ; (succ one) ; (lambda (f) (lambda (x) (f ((one f) x)))) ; (lambda (f) (lambda (x) (f ((lambda (x) (f x)) x)))) (define two (lambda (f) (lambda (x) (f (f x))))) ; PLUS := λm n f x. m f (n f x) (define (plus m n) (lambda (f) (lambda (x) ((m f) ((n f) x))))) ; ついで, Church数から普通の整数に変換 (define (church-to-number n) (define (inc x) (+ x 1)) ((n inc) 0)) } - Church numeral -- [[ラムダ計算>http://ja.wikipedia.org/wiki/%E3%83%A9%E3%83%A0%E3%83%80%E8%A8%88%E7%AE%97]] -- 0 := λfx.x == λf.(λx.x) -- 1 := λfx.fx -- 2 := λfx.f(fx) -- succ := λnfx.f((n f) x) -- nとは, fを受け取ってfをn回適用する手続き ---- *Exercise 2.7 #highlight(scheme){ (define (l-b i) (min (car i) (cdr i))) (define (u-b i) (max (car i) (cdr i))) ;(car i)<(cdr i)の関係が保証されているとするなら (define (lower-bound i) (car i)) (define (upper-bound i) (cdr i)) } ---- *Exercise 2.8 #highlight(scheme){ (define (sub-interval x y) (add-interval x (make-interval (* -1 (upper-bound y)) (* -1 (lower-bound y))))) } ---- *Exercise 2.9 #highlight(scheme){ (define (width x) (/ (- (upper-bound x) (lower-bound x)) 2)) } **和差 - x1 := [l1,u1], x2 := [l2,u2] -- width(x1)+width(x2) = (u1-l1)/2 + (u2-l2)/2 - x1 + x2 = [l1+l2,u1+u2] -- width(x1+x2)={(u1+u2)-(l1+l2)}/2=(u1-l1)/2 + (u2-l2)/2 - x1 - x2 = [l1-u2,u1-l2] -- width(x1-x2)={(u1-l2)-(l1-u2)}/2=(u1-l1)/2 + (u2-l2)/2 **積商 - x1 := [6,8], x2 := [1,2] -- width(x1)=1, width(x2)=1/2 - x1 * x2 = [6,16] -- width(x1 * x2) = (16-6)/2 = 5 -- width(x1) * width(x2) = 1/2 - x1 / x2 = [3,8] -- width(x1 / x2) = (8-3)/2 = 5/2 -- width(x1) / width(x2) = 2 ---- *Exercise 2.10 #highlight(scheme){ (define (div-interval x y) (define span (and (<= (lower-bound y) 0) (<= 0 (upper-bound y)))) (if span (error "perhaps division by zero") (mul-interval x (make-interval (/ 1.0 (upper-bound y)) (/ 1.0 (lower-bound y)))))) } ---- *Exercise 2.11 ---- *Exercise 2.12 #highlight(scheme){ ; intervalをcenterと誤差(percent)で定義する ; (define (make-center-percent c per) (let ((err (/ (* c per) 100.0))) (make-interval (- c err) (+ c err)))) (define (center i) (/ (+ (upper-bound i) (lower-bound i)) 2)) (define (width i) (/ (- (upper-bound i) (lower-bound i)) 2)) (define (percent i) (/ (* 100.0 (width i)) (center i))) } ---- *Exercise 2.13 演算結果はそれぞれ次のものと同値 #highlight(scheme){ ;par1 (make-interval (/ (* (lower-bound r1) (lower-bound r2)) (+ (upper-bound r1) (upper-bound r2))) (/ (* (upper-bound r1) (upper-bound r2)) (+ (lower-bound r1) (lower-bound r2)))) ;par2 (make-interval (/ (* (lower-bound r1) (lower-bound r2)) (+ (lower-bound r1) (lower-bound r2))) (/ (* (upper-bound r1) (upper-bound r2)) (+ (upper-bound r1) (upper-bound r2)))) } ---- *Exercise 2.14

2.1 Introduction to Data Abstraction

2010-03-04T13:15:13+09:00

*Chapter 2.1 **[[Exercises 2.1]] **Note #pcomment()

Exercises 1.3

2010-03-01T17:37:49+09:00

* Chapter 1.3 ---- **Exercise 1.29 #highlight(,scheme){ (define (simpson f a b n) (if (and (> n 0) (even? n)) (simpson-in f a b (/ (- b a) n)) (simpson f a b (+ n 1)))) (define (simpson-in f a b h) (define (g x) (+ (f x) (* 2 (f (+ x h))))) (define (add-2h x) (+ x h h)) (/ (* h (+ (f a) (f b) (* 4 (f (+ a h))) (* 2 (sum g (add-2h a) add-2h (- b h))))) 3)) } - simpson手続きはnが2以上の偶数になるまで, +1し続ける - sum手続きの中身は, n≧2のとき下のΣの中身と同じ. n=2のときはf(a)+4f(a+h)+f(b)になる. - [[シンプソンの公式>http://ja.wikipedia.org/wiki/%E3%82%B7%E3%83%B3%E3%83%97%E3%82%BD%E3%83%B3%E3%81%AE%E5%85%AC%E5%BC%8F]] #math(100){{ \int_{a}^{b}f \approx \frac{h}{3} \left( f(a) + 4f(a+h) + 2\sum_{k=1}^{n/2-1} \left( f(a+2kh) + 2f\left( a+(2k+1)h \right) \right + f(b) \right) }} #pcomment(reply,コメント/1.29) ---- **Exercise 1.30 #highlight(,scheme){ (define (sum f a next b) (define (iter a result) (if (> a b) result (iter (next a) (+ result (f a))))) (iter a 0)) ; 評価の順序は違う ; 和が可換なので結果は同じ ; recursive ;(sum identity 1 inc 5) ;(+ 1 (+ 2 (+ 3 (+ 4 (+ 5 0))))) ;= 1+(2+(3+(4+(5+0)))) ; iterative ; result <-- (+ 0 1) ; result <-- (+ result 2) ; result <-- (+ result 3) ; result <-- (+ result 4) ; result <-- (+ result 5) ;=((((0+1)+2)+3)+4)+5 } - 結合法則が成り立つなら結果は同じ ---- **Exercise 1.31 #highlight(,scheme){ ;; recursive (define (product f a next b) (if (> a b) 1 (* (f a) (product f (next a) next b)))) ;; iterative (define (product-iter f a next b) (define (iter a result) (if (> a b) result (iter (next a) (* result (f a))))) (iter a 1)) ; Wallis Formula (define (pi-product n) (define (square x) (* x x)) (define (pi-term k) (/ (* 4.0 k (+ k 1)) (square (+ k k 1)))) (define (pi-next x) (+ x 1)) (* 4 (product pi-term 1 pi-next n))) } #math(150){{ \frac{\pi}{4} = \prod_{k=1}^{\infty} \frac{2k \left( 2k+1 \right) }{ \left( 2k+1 \right)^2 } }} - [[Wallisの公式>http://ja.wikipedia.org/wiki/%E3%82%A6%E3%82%A9%E3%83%AA%E3%82%B9%E3%81%AE%E5%85%AC%E5%BC%8F]] #math(120){{ \prod_{k=1}^{\infty} \frac{(2k)^2}{(2k-1)(2k+1)} = \lim_{n \to \infty} \frac{1}{2n+1} \prod_{k=1}^{n} \frac{(2k)^2}{(2k-1)^2} = \frac{\pi}{2} }} #math(120){{ \lim_{n \to \infty} \frac{n+1}{2n+1} = \frac{1}{2} }} どちらも収束するから #math(120){{ \lim_{n \to \infty} \frac{n+1}{(2n+1)^2} \prod_{k=1}^{n} \frac{(2k)^2}{(2k-1)^2} = \lim_{n \to \infty} \prod_{k=1}^{n} \frac{2k(2k+2)}{(2k+1)^2} = \frac{\pi}{4} }} ---- **Exercise 1.32 #highlight(,scheme){ ;; recursive (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)))) ;; iterative (define (accumu-iter combiner initial-value f a next b) (define (iter a result) (if (> a b) result (iter (next a) (combiner result (f a))))) (iter a initial-value)) (define (sum f a next b) (accumulate (lambda (x y) (+ x y)) 0 f a next b)) (define (product f a next b) (accumulate (lambda (x y) (* x y)) 1 f a next b)) } ---- **Exercise 1.33 - 長い... #highlight(scheme){ (define (filter-accumu filter combiner null-value term a next b) (if (> a b) null-value (let ((fx (term a))) (if (filter fx) (combiner fx (filter-accumu filter combiner null-value term (next a) next b)) (filter-accumu filter combiner null-value term (next a) next b))))) (define (product-rel-prime n) (filter-accumu (lambda (x) (= (gcd x n) 1)) (lambda (x y) (* x y)) 1 (lambda (x) x) 1 (lambda (x) (+ x 1)) n)) } ---- **Exercise 1.36 #highlight(scheme){ (define (fixed-point-print f guess) (define (print-line i x) (display i) (display ":") (display x) (newline)) (define (try cnt x) (let ((next (f x))) (if (close-enough? x next) next ((lambda () (print-line cnt x) (try (+ cnt 1) next)))))) (try 1 guess)) (define (average x y) (/ (+ x y) 2)) (define (average-dump f) (lambda (x) (/ (+ x (f x)) 2))) (define (ex136a) (fixed-point-print (lambda (x) (/ (* 3 (log 10)) (log x))) 2.0)) (define (ex136b) (fixed-point-print (average-dump (lambda (x) (/ (* 3 (log 10)) (log x)))) 2.0)) ;;(136a) ;;=> 33step 4.555532270803653 ;;(136b) ;;=> 8step 4.555537551999826 } ---- **Exercise 1.37 #highlight(scheme){ ; continued fraction ;; (cf n d k) = (/ n1 (+ d1 (/ n2 (+ d2 ... (/ nk (+ dk 0))...)))) ; (define (cf n d k) (define (cf-helper i) (if (> i k) 0 (/ (n i) (+ (d i) (cf-helper (+ i 1)))))) (cf-helper 1)) ;; iterative ;; (cf n d k) ;; result <-- (/ (n k) (+ (d k) 0)) ;; result <-- (/ (n (- k 1)) (+ (d (- k 1)) result)) ;; result <-- (/ (n (- k 2)) (+ (d (- k 2)) result)) ;; ... ;; result <-- (/ (n 1) (+ (d 1) result)) ;; accumulateでもよさそう? (define (cf-iter n d k) (define (iter i result) (if (< i 1) result (iter (- i 1) (/ (n i) (+ (d i) result))))) (iter k 0)) (define (inversed-golden-ratio k) (cf (lambda (i) 1.0) (lambda (i) 1.0) k)) ;;(inversed-golden-ratio 100) ;;=> 0.6180339887498948 } - [[Continued-Fractionのページ>http://mathworld.wolfram.com/ContinuedFraction.html]] ---- **Exercise 1.38,39 #highlight(scheme){ ;-- ex.1.38 ;; Euler's contnued-fraction expansion of e ; (define (euler-e k) (+ 2 (cf (lambda (i) 1.0) (lambda (i) (if (= (remainder i 3) 2) (* (+ (quotient i 3) 1) 2.0) 1.0)) k))) ;-- ex.1.39 ;; continued-fraction expansion of tan(x) ; by J.H.Lambert (1770) ; ;http://mathworld.wolfram.com/Tangent.html (define (tan-cf x k) (/ x (+ 1 (cf (lambda (i) (* x x -1)) (lambda (i) (+ i i 1)) k)))) } ---- ** Exercise 1.41 #highlight(scheme){ ; (double arg)はargを2回適用する手続きを返す ; (double double)はdoubleを2回適用する手続きを返す == argを4回適用する手続きを返す手続き ;; (define (quadruple arg) (lambda (x) (arg (arg (arg (arg x)))))) と同じ ; (double (double double)) は (double double)を2回適用する手続きを返す ; ;--訂正:2010-3-1 ;= (lamda (proc) (quadruple (quadruple proc)))と同じ ;= (lambda (proc) (lambda (x) (quadruple (proc (proc (proc (proc x)))))) ;= (lambda (proc) (lambda (x) (proc (proc (… (proc x) …))))) ;= procを16回適用する手続きを返す手続き ; ;**ここからウソついた. ので上に訂正 2010-3-1 ; (quadruple (quadruple (quadruple (quadruple arg)))) と同じ ;**ここまで. ; (((double (double double)) inc) 5) ;=> 5+16=21 } ---- ** Exercise 1.46 #highlight(scheme){ (define (iterative-improve good-enough? improve) (define (iter f guess) (if (good-enough? guess) guess (iter f (improve guess)))) ((lambda (x) x) iter)) (define (fixed-point-2 f guess) (define tolerance 0.00001) (define (close-enough? guess) (< (abs (- guess (f guess))) tolerance)) ((iterative-improve close-enough? f) f guess)) } ----