Instantly share code, notes, and snippets.

# kariyayo/_SICPの問題等を解いていく_1-3章.md

Last active April 3, 2021 04:18
Show Gist options
• Save kariyayo/5adccfcf642b18af104b1291b2125e5f to your computer and use it in GitHub Desktop.

# SICPの問題等を解いていく

• Guileを使う
• rlwrapも使う
• `\$ rlwrap -r -c guile` こんな感じで使う
• `> ,q` で終了する
• `> (load "foo.scm")` でソースコード読み込む
• `> ,trace (f 3)` で関数の適用をトレースする

4章はこちら

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (f n) (cond ((< n 3) n) (else (+ (f (- n 1)) (* 2 (f (- n 2))) (* 3 (f (- n 3))))))) ;; ,trace (f 5) ;; trace: | (f 5) ;; trace: | | (f 4) ;; trace: | | | (f 3) ;; trace: | | | | (f 2) ;; trace: | | | | 2 ;; trace: | | | | (f 1) ;; trace: | | | | 1 ;; trace: | | | | (f 0) ;; trace: | | | | 0 ;; trace: | | | 4 ;; trace: | | | (f 2) ;; trace: | | | 2 ;; trace: | | | (f 1) ;; trace: | | | 1 ;; trace: | | 11 ;; trace: | | (f 3) ;; trace: | | | (f 2) ;; trace: | | | 2 ;; trace: | | | (f 1) ;; trace: | | | 1 ;; trace: | | | (f 0) ;; trace: | | | 0 ;; trace: | | 4 ;; trace: | | (f 2) ;; trace: | | 2 ;; trace: | 25 (define (f-iter n a b c) (cond ((= n 0) a) ((= n 1) b) (else (f-iter (- n 1) (+ a (* 2 b) (* 3 c)) a b)))) ;; ,trace (f-iter 5 2 1 0) ;; trace: | (f-iter 5 2 1 0) ;; trace: | (f-iter 4 4 2 1) ;; trace: | (f-iter 3 11 4 2) ;; trace: | (f-iter 2 25 11 4) ;; trace: | 25
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (pascal n k) (cond ((= n 0) 1) ((= k 0) 1) ((= n k) 1) (else (+ (pascal (- n 1) (- k 1)) (pascal (- n 1) k))))) ;; scheme@(guile-user)> (pascal 2 0) ;; \$4 = 1 ;; scheme@(guile-user)> (pascal 3 1) ;; \$5 = 3 ;; scheme@(guile-user)> (pascal 4 1) ;; \$6 = 4 ;; scheme@(guile-user)> (pascal 4 2) ;; \$7 = 6
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 ;;; 指数計算 (define (expr b n) (if (= n 0) 1 (* b (expr b (- n 1))))) (define (expr-iter b n acc) (if (= n 0) acc (expr-iter b (- n 1) (* acc b)))) ;;; 指数が偶数のとき、 b^n = (b^(n/2))^2 を使うとO(logn)にできる ;;; e.g. b^8 = b^4 * b^4, b^4 = b^2 * b^2, b^2 = b * b (define (square x) (* x x)) (define (fast-expr b n) (cond ((= n 0) b) ((= n 1) b) ((even? n) (square (fast-expr b (/ n 2)))) (else (* b (fast-expr b (- n 1)))) )) ;; scheme@(guile-user)> ,trace (fast-expr 2 6) ;; trace: | (fast-expr 2 6) ;; trace: | | (even? 6) ;; trace: | | #t ;; trace: | | (fast-expr 2 3) ;; trace: | | | (even? 3) ;; trace: | | | #f ;; trace: | | | (fast-expr 2 2) ;; trace: | | | | (even? 2) ;; trace: | | | | #t ;; trace: | | | | (fast-expr 2 1) ;; trace: | | | | 2 ;; trace: | | | (square 2) ;; trace: | | | 4 ;; trace: | | 8 ;; trace: | (square 8) ;; trace: | 64 (define (fast-expr-iter b n acc) (cond ((= n 0) acc) ((even? n) (fast-expr-iter (square b) (/ n 2) acc)) (else (fast-expr-iter b (- n 1) (* b acc))) )) ;; trace: | (fast-expr-iter 2 6 1) ;; trace: | | (even? 6) ;; trace: | | #t ;; trace: | | (square 2) ;; trace: | | 4 ;; trace: | (fast-expr-iter 4 3 1) ;; trace: | | (even? 3) ;; trace: | | #f ;; trace: | (fast-expr-iter 4 2 4) ;; trace: | | (even? 2) ;; trace: | | #t ;; trace: | | (square 4) ;; trace: | | 16 ;; trace: | (fast-expr-iter 16 1 4) ;; trace: | | (even? 1) ;; trace: | | #f ;; trace: | (fast-expr-iter 16 0 64) ;; trace: | 64
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (prod a b) (if (= b 0) 0 (+ a (prod a (- b 1))))) ;; scheme@(guile-user)> ,trace (prod 2 20) ;; trace: | (prod 2 20) ;; trace: | | (prod 2 19) ;; trace: | | | (prod 2 18) ;; trace: | | | | (prod 2 17) ;; trace: | | | | | (prod 2 16) ;; trace: | | | | | | (prod 2 15) ;; trace: | | | | | | | (prod 2 14) ;; trace: | | | | | | | | (prod 2 13) ;; trace: | | | | | | | | | (prod 2 12) ;; trace: | | | | | | | | | | (prod 2 11) ;; trace: | | | | | | | | | | 11> (prod 2 10) ;; trace: | | | | | | | | | | 12> (prod 2 9) ;; trace: | | | | | | | | | | 13> (prod 2 8) ;; trace: | | | | | | | | | | 14> (prod 2 7) ;; trace: | | | | | | | | | | 15> (prod 2 6) ;; trace: | | | | | | | | | | 16> (prod 2 5) ;; trace: | | | | | | | | | | 17> (prod 2 4) ;; trace: | | | | | | | | | | 18> (prod 2 3) ;; trace: | | | | | | | | | | 19> (prod 2 2) ;; trace: | | | | | | | | | | 20> (prod 2 1) ;; trace: | | | | | | | | | | 21> (prod 2 0) ;; trace: | | | | | | | | | | 21< 0 ;; trace: | | | | | | | | | | 20< 2 ;; trace: | | | | | | | | | | 19< 4 ;; trace: | | | | | | | | | | 18< 6 ;; trace: | | | | | | | | | | 17< 8 ;; trace: | | | | | | | | | | 16< 10 ;; trace: | | | | | | | | | | 15< 12 ;; trace: | | | | | | | | | | 14< 14 ;; trace: | | | | | | | | | | 13< 16 ;; trace: | | | | | | | | | | 12< 18 ;; trace: | | | | | | | | | | 11< 20 ;; trace: | | | | | | | | | | 22 ;; trace: | | | | | | | | | 24 ;; trace: | | | | | | | | 26 ;; trace: | | | | | | | 28 ;; trace: | | | | | | 30 ;; trace: | | | | | 32 ;; trace: | | | | 34 ;; trace: | | | 36 ;; trace: | | 38 ;; trace: | 40 (define (double x) (+ x x)) (define (halve x) (/ x 2)) (define (fast-prod a b) (cond ((= b 0) 0) ((= b 1) a) ((even? b) (double (fast-prod a (halve b)))) (else (+ a (fast-prod a (- b 1)))) )) ;; scheme@(guile-user)> ,trace (fast-prod 2 20) ;; trace: | (fast-prod 2 20) ;; trace: | | (even? 20) ;; trace: | | #t ;; trace: | | (halve 20) ;; trace: | | 10 ;; trace: | | (fast-prod 2 10) ;; trace: | | | (even? 10) ;; trace: | | | #t ;; trace: | | | (halve 10) ;; trace: | | | 5 ;; trace: | | | (fast-prod 2 5) ;; trace: | | | | (even? 5) ;; trace: | | | | #f ;; trace: | | | | (fast-prod 2 4) ;; trace: | | | | | (even? 4) ;; trace: | | | | | #t ;; trace: | | | | | (halve 4) ;; trace: | | | | | 2 ;; trace: | | | | | (fast-prod 2 2) ;; trace: | | | | | | (even? 2) ;; trace: | | | | | | #t ;; trace: | | | | | | (halve 2) ;; trace: | | | | | | 1 ;; trace: | | | | | | (fast-prod 2 1) ;; trace: | | | | | | 2 ;; trace: | | | | | (double 2) ;; trace: | | | | | 4 ;; trace: | | | | (double 4) ;; trace: | | | | 8 ;; trace: | | | 10 ;; trace: | | (double 10) ;; trace: | | 20 ;; trace: | (double 20) ;; trace: | 40
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (double x) (+ x x)) (define (halve x) (/ x 2)) (define (fast-prod-iter a b acc) (cond ((= b 0) acc) ((even? b) (fast-prod-iter (double a) (halve b) acc)) (else (fast-prod-iter a (+ b -1) (+ a acc))) )) ;; scheme@(guile-user)> ,trace (fast-prod-iter 2 20 0) ;; trace: | (fast-prod-iter 2 20 0) ;; trace: | | (even? 20) ;; trace: | | #t ;; trace: | | (double 2) ;; trace: | | 4 ;; trace: | | (halve 20) ;; trace: | | 10 ;; trace: | (fast-prod-iter 4 10 0) ;; trace: | | (even? 10) ;; trace: | | #t ;; trace: | | (double 4) ;; trace: | | 8 ;; trace: | | (halve 10) ;; trace: | | 5 ;; trace: | (fast-prod-iter 8 5 0) ;; trace: | | (even? 5) ;; trace: | | #f ;; trace: | (fast-prod-iter 8 4 8) ;; trace: | | (even? 4) ;; trace: | | #t ;; trace: | | (double 8) ;; trace: | | 16 ;; trace: | | (halve 4) ;; trace: | | 2 ;; trace: | (fast-prod-iter 16 2 8) ;; trace: | | (even? 2) ;; trace: | | #t ;; trace: | | (double 16) ;; trace: | | 32 ;; trace: | | (halve 2) ;; trace: | | 1 ;; trace: | (fast-prod-iter 32 1 8) ;; trace: | | (even? 1) ;; trace: | | #f ;; trace: | (fast-prod-iter 32 0 40) ;; trace: | 40
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (inc n) (+ n 1)) (define (identity x) x) (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) (define (sum-integers a b) (sum identity a inc b)) ;; scheme@(guile-user)> ,trace (sum-integers 1 10) ;; trace: | (sum-integers 1 10) ;; trace: | (sum # 1 # 10) ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | | (sum # 2 # 10) ;; trace: | | | (identity 2) ;; trace: | | | 2 ;; trace: | | | (inc 2) ;; trace: | | | 3 ;; trace: | | | (sum # 3 # …) ;; trace: | | | | (identity 3) ;; trace: | | | | 3 ;; trace: | | | | (inc 3) ;; trace: | | | | 4 ;; trace: | | | | (sum # 4 # …) ;; trace: | | | | | (identity 4) ;; trace: | | | | | 4 ;; trace: | | | | | (inc 4) ;; trace: | | | | | 5 ;; trace: | | | | | (sum # 5 # …) ;; trace: | | | | | | (identity 5) ;; trace: | | | | | | 5 ;; trace: | | | | | | (inc 5) ;; trace: | | | | | | 6 ;; trace: | | | | | | (sum # 6 # …) ;; trace: | | | | | | | (identity 6) ;; trace: | | | | | | | 6 ;; trace: | | | | | | | (inc 6) ;; trace: | | | | | | | 7 ;; trace: | | | | | | | (sum # 7 # …) ;; trace: | | | | | | | | (identity 7) ;; trace: | | | | | | | | 7 ;; trace: | | | | | | | | (inc 7) ;; trace: | | | | | | | | 8 ;; trace: | | | | | | | | (sum # 8 # …) ;; trace: | | | | | | | | | (identity 8) ;; trace: | | | | | | | | | 8 ;; trace: | | | | | | | | | (inc 8) ;; trace: | | | | | | | | | 9 ;; trace: | | | | | | | | | | (inc 9) ;; trace: | | | | | | | | | | 10 ;; trace: | | | | | | | | | | (sum # # …) ;; trace: | | | | | | | | | | 11> (identity 10) ;; trace: | | | | | | | | | | 11< 10 ;; trace: | | | | | | | | | | 11> (inc 10) ;; trace: | | | | | | | | | | 11< 11 ;; trace: | | | | | | | | | | 11> (sum # …) ;; trace: | | | | | | | | | | 11< 0 ;; trace: | | | | | | | | | | 10 ;; trace: | | | | | | | | | 19 ;; trace: | | | | | | | | 27 ;; trace: | | | | | | | 34 ;; trace: | | | | | | 40 ;; trace: | | | | | 45 ;; trace: | | | | 49 ;; trace: | | | 52 ;; trace: | | 54 ;; trace: | 55 (define (sum-iter term a next b acc) (if (> a b) acc (sum-iter term (next a) next b (+ acc (term a))))) (define (sum-integers-iter a b) (sum-iter identity a inc b 0)) ;; scheme@(guile-user)> ,trace (sum-integers-iter 1 10) ;; trace: | (sum-integers-iter 1 10) ;; trace: | (sum-iter # 1 # …) ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | (sum-iter # 2 # …) ;; trace: | | (inc 2) ;; trace: | | 3 ;; trace: | | (identity 2) ;; trace: | | 2 ;; trace: | (sum-iter # 3 # …) ;; trace: | | (inc 3) ;; trace: | | 4 ;; trace: | | (identity 3) ;; trace: | | 3 ;; trace: | (sum-iter # 4 # …) ;; trace: | | (inc 4) ;; trace: | | 5 ;; trace: | | (identity 4) ;; trace: | | 4 ;; trace: | (sum-iter # 5 # …) ;; trace: | | (inc 5) ;; trace: | | 6 ;; trace: | | (identity 5) ;; trace: | | 5 ;; trace: | (sum-iter # 6 # …) ;; trace: | | (inc 6) ;; trace: | | 7 ;; trace: | | (identity 6) ;; trace: | | 6 ;; trace: | (sum-iter # 7 # …) ;; trace: | | (inc 7) ;; trace: | | 8 ;; trace: | | (identity 7) ;; trace: | | 7 ;; trace: | (sum-iter # 8 # …) ;; trace: | | (inc 8) ;; trace: | | 9 ;; trace: | | (identity 8) ;; trace: | | 8 ;; trace: | (sum-iter # 9 # …) ;; trace: | | (inc 9) ;; trace: | | 10 ;; trace: | | (identity 9) ;; trace: | | 9 ;; trace: | (sum-iter # 10 # …) ;; trace: | | (inc 10) ;; trace: | | 11 ;; trace: | | (identity 10) ;; trace: | | 10 ;; trace: | (sum-iter # 11 # …) ;; trace: | 55
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (inc n) (+ n 1)) (define (identity x) x) (define (product term a next b) (if (> a b) 1 (* (term a) (product term (next a) next b)))) (define (factorial n) (product identity 1 inc n)) ;; scheme@(guile-user) [1]> ,trace (factorial 5) ;; trace: | (factorial 5) ;; trace: | (product # 1 # 5) ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | | (product # 2 # …) ;; trace: | | | (identity 2) ;; trace: | | | 2 ;; trace: | | | (inc 2) ;; trace: | | | 3 ;; trace: | | | (product # 3 # …) ;; trace: | | | | (identity 3) ;; trace: | | | | 3 ;; trace: | | | | (inc 3) ;; trace: | | | | 4 ;; trace: | | | | (product # 4 # …) ;; trace: | | | | | (identity 4) ;; trace: | | | | | 4 ;; trace: | | | | | (inc 4) ;; trace: | | | | | 5 ;; trace: | | | | | (product # 5 # …) ;; trace: | | | | | | (identity 5) ;; trace: | | | | | | 5 ;; trace: | | | | | | (inc 5) ;; trace: | | | | | | 6 ;; trace: | | | | | | (product # 6 # …) ;; trace: | | | | | | 1 ;; trace: | | | | | 5 ;; trace: | | | | 20 ;; trace: | | | 60 ;; trace: | | 120 ;; trace: | 120 (define (pi-product n) (define (pi-term x) (/ (* x x) (* (- x 1) (- x 1)))) (define (pi-next x) (+ x 2)) (* 2.0 (/ (product pi-term 4 pi-next n) n))) ;; scheme@(guile-user) [1]> (* 4 (pi-product 10)) ;; \$40 = 3.3023935500125976 ;; scheme@(guile-user) [1]> (* 4 (pi-product 100)) ;; \$41 = 3.157339689217565 ;; scheme@(guile-user) [1]> (* 4 (pi-product 1000)) ;; \$42 = 3.143163842419198 ;; 最初こうやって書いたけど、割る前の数値が大きくなりすぎてダメ (define (pi-product-overflow n) (define (pi-term x) (* x x)) (define (pi-next x) (+ x 2)) (/ (* 2.0 (product pi-term 4 pi-next n)) (product pi-term 3 pi-next n)) ) ;; scheme@(guile-user) [1]> (* 4 (pi-product-overflow 200)) ;; \$43 = +nan.0
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (inc n) (+ n 1)) (define (identity x) x) ;; 再帰プロセス版 (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 (sum term a next b) (accumulate + 0 term a next b)) (define (sum-integers a b) (sum identity a inc b)) (define (product term a next b) (accumulate * 1 term a next b)) (define (factorial n) (product identity 1 inc n)) ;; scheme@(guile-user) > (sum-integers 1 10) ;; \$47 = 55 ;; scheme@(guile-user) > ,trace (sum-integers 1 3) ;; trace: | (sum-integers 1 3) ;; trace: | (sum # 1 # 3) ;; trace: | (accumulate # 0 # …) ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | | (accumulate # 0 # …) ;; trace: | | | (identity 2) ;; trace: | | | 2 ;; trace: | | | (inc 2) ;; trace: | | | 3 ;; trace: | | | (accumulate # 0 # 3 …) ;; trace: | | | | (identity 3) ;; trace: | | | | 3 ;; trace: | | | | (inc 3) ;; trace: | | | | 4 ;; trace: | | | | (accumulate # 0 …) ;; trace: | | | | 0 ;; trace: | | | (+ 3 0) ;; trace: | | | 3 ;; trace: | | (+ 2 3) ;; trace: | | 5 ;; trace: | (+ 1 5) ;; trace: | 6 ;; scheme@(guile-user) > (factorial 5) ;; \$48 = 120 ;; scheme@(guile-user) > ,trace (factorial 3) ;; trace: | (factorial 3) ;; trace: | (product # 1 # 3) ;; trace: | (accumulate # 1 # …) ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | | (accumulate # 1 # …) ;; trace: | | | (identity 2) ;; trace: | | | 2 ;; trace: | | | (inc 2) ;; trace: | | | 3 ;; trace: | | | (accumulate # 1 # 3 …) ;; trace: | | | | (identity 3) ;; trace: | | | | 3 ;; trace: | | | | (inc 3) ;; trace: | | | | 4 ;; trace: | | | | (accumulate # 1 …) ;; trace: | | | | 1 ;; trace: | | | (* 3 1) ;; trace: | | | 3 ;; trace: | | (* 2 3) ;; trace: | | 6 ;; trace: | (* 1 6) ;; trace: | 6 ;; 線形プロセス版 (define (accumulate-iter combiner acc term a next b) (if (> a b) acc (accumulate-iter combiner (combiner acc (term a)) term (next a) next b))) (define (sum-iter term a next b acc) (accumulate-iter + 0 term a next b)) (define (sum-integers-iter a b) (sum-iter identity a inc b 0)) (define (product-iter term a next b) (accumulate-iter * 1 term a next b)) (define (factorial-iter n) (product-iter identity 1 inc n)) ;; scheme@(guile-user) > (sum-integers-iter 1 10) ;; \$49 = 55 ;; scheme@(guile-user) > ,trace (sum-integers-iter 1 3) ;; trace: | (sum-integers-iter 1 3) ;; trace: | (sum-iter # 1 # …) ;; trace: | (accumulate-iter # 0 #<…> …) ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | | (+ 0 1) ;; trace: | | 1 ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | (accumulate-iter # 1 #<…> …) ;; trace: | | (identity 2) ;; trace: | | 2 ;; trace: | | (+ 1 2) ;; trace: | | 3 ;; trace: | | (inc 2) ;; trace: | | 3 ;; trace: | (accumulate-iter # 3 #<…> …) ;; trace: | | (identity 3) ;; trace: | | 3 ;; trace: | | (+ 3 3) ;; trace: | | 6 ;; trace: | | (inc 3) ;; trace: | | 4 ;; trace: | (accumulate-iter # 6 #<…> …) ;; trace: | 6 ;; scheme@(guile-user) > (factorial-iter 5) ;; \$50 = 120 ;; scheme@(guile-user) > ,trace (factorial-iter 3) ;; trace: | (factorial-iter 3) ;; trace: | (product-iter # 1 # …) ;; trace: | (accumulate-iter # 1 #<…> …) ;; trace: | | (identity 1) ;; trace: | | 1 ;; trace: | | (* 1 1) ;; trace: | | 1 ;; trace: | | (inc 1) ;; trace: | | 2 ;; trace: | (accumulate-iter # 1 #<…> …) ;; trace: | | (identity 2) ;; trace: | | 2 ;; trace: | | (* 1 2) ;; trace: | | 2 ;; trace: | | (inc 2) ;; trace: | | 3 ;; trace: | (accumulate-iter # 2 #<…> …) ;; trace: | | (identity 3) ;; trace: | | 3 ;; trace: | | (* 2 3) ;; trace: | | 6 ;; trace: | | (inc 3) ;; trace: | | 4 ;; trace: | (accumulate-iter # 6 #<…> …) ;; trace: | 6
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (inc n) (+ n 1)) (define (square x) (* x x)) (define (double f) (lambda (x) (f (f x)))) ;; scheme@(guile-user) > ((double inc) 2) ;; \$1 = 4 ;; scheme@(guile-user) > ((double inc) 1) ;; \$2 = 3 ;; scheme@(guile-user) > (((double (double double)) inc) 5) ;; \$3 = 21 (define (compose f g) (lambda (x) (f (g x)))) ;; scheme@(guile-user)> ((compose square inc) 6) ;; \$4 = 49 (define (repeated f n) (define (iter n ff) (if (= n 0) ff (iter (- n 1) (compose f ff)))) (lambda (x) ((iter (- n 1) f) x))) ;; scheme@(guile-user)> ((repeated square 2) 5) ;; \$5 = 625
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define nil `()) (define (filter predicate sequence) (cond ((null? sequence) `()) ((predicate (car sequence)) (cons (car sequence) (filter predicate (cdr sequence)))) (else (filter predicate (cdr sequence))) )) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))) )) ; (define (map proc items) ; (if (null? items) ; `() ; (cons (proc (car items)) ; (map proc (cdr items))))) (define (map p sequence) (accumulate (lambda (x y) (cons (p x) y)) `() sequence)) (define (flatmap proc seq) (accumulate append nil (map proc seq))) (define (fold-right op initial sequence) (accumulate op initial sequence)) (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 (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1))) ) ; (define (length items) ; (define (length-iter as acc) ; (if (null? as) ; acc ; (length-iter (cdr as) (+ acc 1)))) ; (length-iter items 0)) (define (length sequence) (accumulate (lambda (x y) (+ y 1)) 0 sequence)) ; (define (append list1 list2) ; (if (null? list1) ; list2 ; (cons (car list1) (append (cdr list1) list2)))) (define (append seq1 seq2) (accumulate cons seq2 seq1)) (define (last-pair list) (cond ((null? list) `()) ((= (length list) 1) (car list)) (else (last-pair (cdr list))))) (define (reverse xs) (cond ((= (length xs) 0) xs) ((= (length xs) 1) xs) (else (append (reverse (cdr xs)) (list (car xs)))) )) (define (deep-reverse x) (cond ((null? x) x) ((not (pair? x)) x) (else (append (deep-reverse (cdr x)) (list (deep-reverse (car x))))) )) (define (fringe x) (cond ((null? x) `()) ((not (pair? x)) (list x)) ((append (fringe (car x)) (fringe (cdr x)))))) (define (enumerate-interval low hight) (if (> low hight) nil (cons low (enumerate-interval (+ low 1) hight))))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (equal-rat? x y) (= (* (numer x) (denom y) (* (numer y) (denom x))))) (define (print-rat x) (display (numer x)) (display "/") (display (denom x)) (newline)) (define (make-rat n d) (let ((g (abs (gcd n d))) (nn (if (or (and (>= n 0) (>= d 0)) (and (< n 0) (< d 0))) (abs n) (- (abs n))))) (cons (/ nn g) (/ (abs d) g)))) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (gcd a b) (if (= b 0) a (gcd b (remainder a b))))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 ;;; 二分木としての集合 (define (entry tree) (car tree)) (define (left-branch tree) (cadr tree)) (define (right-branch tree) (caddr tree)) (define (make-tree entry left right) (list entry left right)) (define (element-of-set? x set) (cond ((null? set) #f) ((= x (entry set)) #t) ((< x (entry set)) (element-of-set? x (left-branch set))) ((> x (entry set)) (element-of-set? x (right-branch set))) )) (define (adjoin-set x set) (cond ((null? set) (make-tree x `() `())) ((= x (entry set)) set) ((< x (entry set)) (make-tree (entry set) (adjoin-set x (left-branch set)) (right-branch set))) ((> x (entry set)) (make-tree (entry set) (left-branch set) (adjoin-set x (right-branch set)))) )) (define (tree->list-1 tree) (if (null? tree) `() (append (tree->list-1 (left-branch tree)) (cons (entry tree) (tree->list-1 (right-branch tree)))))) (define (tree->list-2 tree) (define (copy-to-list tree result-list) (if (null? tree) result-list (copy-to-list (left-branch tree) (cons (entry tree) (copy-to-list (right-branch tree) result-list))))) (copy-to-list tree `())) (define tree->list tree->list-1) (define (list->tree elements) (car (partial-tree elements (length elements)))) (define (partial-tree elts n) (if (= n 0) (cons `() elts) (let ((left-size (quotient ( - n 1) 2))) (let ((left-result (partial-tree elts left-size))) (let ((left-tree (car left-result)) (non-left-elts (cdr left-result)) (right-size (- n (+ left-size 1)))) (let ((this-entry (car non-left-elts)) (right-result (partial-tree (cdr non-left-elts) right-size))) (let ((right-tree (car right-result)) (remaining-elts (cdr right-result))) (cons (make-tree this-entry left-tree right-tree) remaining-elts)))))))) (define (union-set set1 set2) (list->tree (union-set-ordered (tree->list set1) (tree->list set2)))) (define (union-set-ordered set1 set2) (cond ((null? set1) set2) ((null? set2) set1) (else (let ((x1 (car set1)) (x2 (car set2))) (cond ((= x1 x2) (cons x1 (union-set-ordered (cdr set1) (cdr set2)))) ((< x1 x2) (cons x1 (union-set-ordered (cdr set1) set2))) ((< x2 x1) (cons x2 (union-set-ordered set1 (cdr set2)))) ))))) (define (intersection-set set1 set2) (list->tree (intersection-set-ordered (tree->list set1) (tree->list set2)))) (define (intersection-set-ordered set1 set2) (cond ((or (null? set1) (null? set2)) `()) ((element-of-set-ordered? (car set1) set2) (cons (car set1) (intersection-set-ordered (cdr set1) set2))) (else (intersection-set-ordered (cdr set1) set2)))) (define (element-of-set-ordered? x set) (cond ((null? set) #f) ((= x (car set)) #t) ((< x (car set)) #f) (else (element-of-set-ordered? x (cdr set)))))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 ;;; 順序なしリストとしての集合 (define (element-of-set? x set) (cond ((null? set) #f) ((equal? x (car set)) #t) (else (element-of-set? x (cdr set))))) (define (adjoin-set x set) (if (element-of-set? x set) set (cons x set))) (define (intersection-set set1 set2) (cond ((or (null? set1) (null? set2)) `()) ((element-of-set? (car set1) set2) (cons (car set1) (intersection-set (cdr set1) set2))) (else (intersection-set (cdr set1) set2)))) (define (union-set set1 set2) (cond ((null? set1) set2) ((element-of-set? (car set1) set2) (union-set (cdr set1) set2)) (else (cons (car set1) (union-set (cdr set1) set2)))))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 ;;; 順序ありリストバージョン (define (element-of-set? x set) (cond ((null? set) #f) ((= x (car set)) #t) ((< x (car set)) #f) (else (element-of-set? x (cdr set))))) (define (adjoin-set x set) (cond ((null? set) (cons x `())) ((= x (car set)) set) ((< x (car set)) (cons x set)) ((> x (car set)) (cons (car set) (adjoin-set x (cdr set)))) )) (define (intersection-set set1 set2) (if (or (null? set1) (null? set2)) `() (let ((x1 (car set1)) (x2 (car set2))) (cond ((= x1 x2) (cons x1 (intersection-set (cdr set1) (cdr set2)))) ((< x1 x2) (intersection-set (cdr set1) set2)) ((< x2 x1) (intersection-set set1 (cdr set2))) )))) (define (union-set set1 set2) (cond ((null? set1) set2) ((null? set2) set1) (else (let ((x1 (car set1)) (x2 (car set2))) (cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2)))) ((< x1 x2) (cons x1 (union-set (cdr set1) set2))) ((< x2 x1) (cons x2 (union-set set1 (cdr set2)))) )))))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (same-parity x . ys) (define (odd? n) (= (remainder n 2) 0)) (define (f parity zs) (cond ((null? zs) zs) ((or (and parity (odd? (car zs))) (and (not parity) (not (odd? (car zs))))) (cons (car zs) (f parity (cdr zs)))) (else (f parity (cdr zs))))) (cons x (f (odd? x) ys))) ;; scheme@(guile-user)> (same-parity 1 2 3 4 5 6 7) ;; \$8 = (1 3 5 7) ;; scheme@(guile-user)> (same-parity 2 3 4 5 6 7) ;; \$9 = (2 4 6)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (map proc items) (if (null? items) `() (cons (proc (car items)) (map proc (cdr items))))) (define (square-list1 items) (if (null? items) `() (cons (* (car items) (car items)) (square-list1 (cdr items))))) (define (square-list2 items) (map (lambda (x) (* x x)) items))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 ;; scheme@(guile-user)> (define xs (list 1 3 (list 5 7) 9)) ;; scheme@(guile-user)> xs ;; \$56 = (1 3 (5 7) 9) ;; scheme@(guile-user) > (car (cdr (car (cdr (cdr xs))))) ;; \$59 = 7 ;; scheme@(guile-user) > (define xs (list (list 7))) ;; scheme@(guile-user) > xs ;; \$60 = ((7)) ;; scheme@(guile-user) > (car (car xs)) ;; \$61 = 7 ;; scheme@(guile-user)> (define xs (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7))))))) ;; scheme@(guile-user)> xs ;; \$74 = (1 (2 (3 (4 (5 (6 7)))))) ;; scheme@(guile-user) > (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr xs)))))))))))) ;; \$75 = 7 ;; scheme@(guile-user)> (define x (list 1 2 3)) ;; scheme@(guile-user)> (define y (list 4 5 6)) ;; scheme@(guile-user)> (append x y) ;; \$76 = (1 2 3 4 5 6) ;; scheme@(guile-user)> (cons x y) ;; \$77 = ((1 2 3) 4 5 6) ;; scheme@(guile-user)> (list x y) ;; \$78 = ((1 2 3) (4 5 6))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (square-tree1 tree) (cond ((null? tree) `()) ((not (pair? tree)) (* tree tree)) (else (cons (square-tree1 (car tree)) (square-tree1 (cdr tree))))) ) (define (square-tree2 tree) (map (lambda (sub-tree) (if (pair? sub-tree) (square-tree2 sub-tree) (* sub-tree sub-tree))) tree)) (define (tree-map proc tree) (map (lambda (sub-tree) (if (pair? sub-tree) (tree-map proc sub-tree) (proc sub-tree))) tree)) (define (square x) (* x x)) (define (square-tree tree) (tree-map square tree)) ;; scheme@(guile-user)> (define tree (list 1 ;; (list 2 (list 3 4) 5) ;; (list 6 7))) ;; scheme@(guile-user)> tree ;; \$24 = (1 (2 (3 4) 5) (6 7)) ;; scheme@(guile-user)> (square-tree1 tree) ;; \$25 = (1 (4 (9 16) 25) (36 49)) ;; scheme@(guile-user)> (square-tree2 tree) ;; \$26 = (1 (4 (9 16) 25) (36 49)) ;; scheme@(guile-user)> (square-tree tree) ;; \$27 = (1 (4 (9 16) 25) (36 49))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define nil `()) (define (filter predicate sequence) (cond ((null? sequence) `()) ((predicate (car sequence)) (cons (car sequence) (filter predicate (cdr sequence)))) (else (filter predicate (cdr sequence))) )) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))) )) (define (map p sequence) (accumulate (lambda (x y) (cons (p x) y)) `() sequence)) (define (flatmap proc seq) (accumulate append nil (map proc seq))) (define (enumerate-interval low hight) (if (> low hight) nil (cons low (enumerate-interval (+ low 1) hight)))) ;; 8-Queen (define (queens board-size) (define empty-board nil) (define (queen-cols k) (if (= k 0) (list empty-board) ; []nil (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) ; map((int) -> []pair), []int) -> []pair ; ↑をqueen-colsの各要素に適用するので [][]pair ; 結果は [[ (1,k):rest-of-queens, (2,k):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)) (define (adjoin-position row col rest-queens) (cons (cons row col) rest-queens)) (define (safe? k positions) (define (out? p1 p2) (cond ((= (car p1) (car p2)) #t) ; 行方向の利き筋 ((= (abs (- (car p1) (car p2))) (abs (- (cdr p1) (cdr p2)))) #t) ; 対角方向の利き筋 (else #f))) (let ((newpos (car positions))) ; 先頭がk列にセットされた候補 (null? (filter (lambda (queen) (out? newpos queen)) (cdr positions))))) ;; scheme@(guile-user)> (queens 1) ;; \$76 = (((1 . 1))) ;; scheme@(guile-user)> (queens 2) ;; \$77 = () ;; scheme@(guile-user)> (queens 3) ;; \$78 = () ;; scheme@(guile-user)> (queens 4) ;; \$79 = (((3 . 4) (1 . 3) (4 . 2) (2 . 1)) ((2 . 4) (4 . 3) (1 . 2) (3 . 1)))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (make-table same-key?) (let ((local-table (list `*table*))) (define (lookup key-1 key-2) (let ((subtable (assoc key-1 (cdr local-table) equal?))) (if subtable (let ((record (assoc key-2 (cdr subtable) same-key?))) (if record (cdr record) #f)) #f))) (define (insert! key-1 key-2 value) (let ((subtable (assoc key-1 (cdr local-table) equal?))) (if subtable (let ((record (assoc key-2 (cdr subtable) same-key?))) (if record (set-cdr! record value) (set-cdr! subtable (cons (cons key-2 value) (cdr subtable))))) (set-cdr! local-table (cons (list key-1 (cons key-2 value)) (cdr local-table))))) `ok) (define (dispatch m) (cond ((eq? m `lookup-proc) lookup) ((eq? m `insert-proc!) insert!) (else (error "Unknown operation: TABLE" m)))) dispatch)) (define (assoc key records same-key?) (cond ((null? records) #f) ((same-key? key (caar records)) (car records)) (else (assoc key (cdr records) same-key?)))) ;; scheme@(guile-user)> (define t (make-table equal?)) ;; scheme@(guile-user) [2]> t ;; \$1 = # ;; scheme@(guile-user) [2]> ((t `insert-proc!) `letters `a 97) ;; \$2 = ok ;; scheme@(guile-user) [2]> ((t `lookup-proc) `letters `a) ;; \$3 = 97 ;; ;; scheme@(guile-user)> (define t2 (make-table (lambda (key x) (> 0 key)))) ;; scheme@(guile-user)> t2 ;; \$15 = # ;; scheme@(guile-user)> ((t2 `insert-proc!) `key -10 `negative) ;; \$16 = ok ;; scheme@(guile-user)> ((t2 `lookup-proc) `key -2) ;; \$17 = negative ;; scheme@(guile-user)> ((t2 `lookup-proc) `key 5) ;; \$18 = #f
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (make-table same-key?) (define (lookup-iter keys table) (cond ((not (pair? keys)) #f) ((null? (cdr keys)) (let ((record (assoc (car keys) (cdr table) same-key?))) (if record (cdr record) #f))) (else (let ((subtable (assoc (car keys) (cdr table) equal?))) (if subtable (lookup-iter (cdr keys) subtable) #f))))) (define (insert-iter! keys value table) (cond ((not (pair? keys)) #f) ((null? (cdr keys)) (let ((record (assoc (car keys) (cdr table) same-key?))) (if record (set-cdr! record value) (set-cdr! table (cons (cons (car keys) value) (cdr table))))) `ok) (else (let ((subtable (assoc (car keys) (cdr table) equal?))) (if subtable (insert-iter! (cdr keys) value subtable) (set-cdr! table (cons (list (car keys) (cons (cadr keys) value)) (cdr table))))) `ok))) (let ((local-table (list `*table*))) (define (lookup keys) (lookup-iter keys local-table)) (define (insert! keys value) (insert-iter! keys value local-table)) (define (dispatch m) (cond ((eq? m `lookup-proc) lookup) ((eq? m `insert-proc!) insert!) (else (error "Unknown operation: TABLE" m)))) dispatch)) (define (assoc key records same-key?) (cond ((null? records) #f) ((same-key? key (caar records)) (car records)) (else (assoc key (cdr records) same-key?)))) ;; scheme@(guile-user)> (define t (make-table equal?)) ;; scheme@(guile-user)> ((t `insert-proc!) (list `letters `a) 97) ;; \$53 = ok ;; scheme@(guile-user)> ((t `lookup-proc) (list `letters `a)) ;; \$54 = 97 ;; ;; scheme@(guile-user)> (define t2 (make-table (lambda (key x) (> 0 key)))) ;; scheme@(guile-user)> t2 ;; \$55 = # ;; scheme@(guile-user)> ((t2 `insert-proc!) (list `key -10) `negative) ;; \$56 = ok ;; scheme@(guile-user)> ((t2 `lookup-proc) (list `key -2)) ;; \$57 = negative ;; scheme@(guile-user)> ((t2 `lookup-proc) (list `key 5)) ;; \$58 = #f
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (define (make-accumulator sum) (lambda (x) (begin (set! sum (+ sum x)) sum))) ;; scheme@(guile-user)> (define A (make-accumulator 5)) ;; scheme@(guile-user)> (A 10) ;; \$17 = 15 ;; scheme@(guile-user)> (A 10) ;; \$18 = 25 (define (make-monitored f) (let ((cnt 0)) (define (dispatch arg) (cond ((eq? arg `how-many-calls?) cnt) (else (begin (set! cnt (+ cnt 1)) (f arg) )))) dispatch)) ;; scheme@(guile-user)> (define s (make-monitored sqrt)) ;; scheme@(guile-user)> (s 100) ;; \$19 = 10 ;; scheme@(guile-user)> (s `how-many-calls?) ;; \$20 = 1
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters