１．四則演算
２．手続きと再帰
入門編です。
数値を使った再帰の例を増やしたいなとは思っています。
３．リストと再帰
普通はcar、cdr、consをやってからmapの説明に入りますが、
mapを使うのに慣れた方が有益と思うので、この配列に。
mapやapplyを使った再帰も扱います。
４．lambdaと再帰
lambdaの使いどころを書こうと思っていますが、全然できていません。
letもここでやるつもりです。
５．くり返しと再帰
末尾再帰の話です。
ここまでが初級編になります。
６．述語とandとor
条件式の書き方をやる予定です。
７．継続
継続の使い方までいかずに、継続の説明で終わりそうです。
８．複素数と三角関数
複素数に関する手続きと複素数の三角関数を説明する予定です。
+ が足し算、- が引き算、* が掛け算、/ が割り算です。 + などが前に来て、その後に足す数字がきます。 最初と最後を () で囲みます。> (+ 8 9) 17 > (- 99 77) 22 > (* 7999999 898998) 7191983101002 > (/ 70000 89) 786.5168539325842
数をふやしても大丈夫です。> (+ 8 9 10) 27 > (- 99 77 88) -66 > (* 7 89 34) 21182 > (/ 1 2 2) 0.25
入れ子にして複雑な式も計算できます。> (+ (* 7 9) (* 6 8)) 111
define で手続きを定義します。最初のかっこの中に手続き名と引数を書きます。 手続き名のあとに引数です。次に値を返すための式を書きます。 使う時は（手続き名 引数）です。手続きの中で同じ名前の手続きを使うことで再帰をします。> (define (func x) (+ x 1)) > (func 2) 3
再帰の書き方は、０以下のときの手続きの返す値を決め、それ以外のときの手続きの返す値を、引数を一減らした同じ手続きを利用して求めるのが基本です。> (define (factorial n) > (if (<= n 0) 1 > (* n (factorial (- n 1))))) > (factorial 5) 120
if は一番めの引数が #t なら二番目の引数を、#f なら三番目の引数を返します。 再帰の終端条件を記すのに使います。> (if #t 1 2) 1 > (if #f 1 2) 2
= は数が等しくなければ #f を、等しければ #t を返します。 ほかも条件に合致すれば #t を、そうでなければ #f を返します。 not は逆にします。 条件判定に使います。> (= 1 5) #f > (= (+ 3 4) 7) #t > (>= 0 3) #f > (<= 0 3) #t > (not #t) #f > (not #f) #t
かっこで囲まれたのをリストと呼びます。Schemeに評価されないようにするには ' をかっこの前につけます。> '(100 200) (100 200)
list でもリストをつくれます。計算したあとの値をリストにするのに使います。> (list (+ 8 9) (* 9 7) (/ 9 6)) (17 63 1.5)
map は第一引数に手続きを、第二引数以降にリストを受け取り、リストの要素一つ一つに手続きを適用した新しいリストを返します。> (define (henkan x) (/ 7500 x)) > (map henkan '(120 300 240)) (62.5 25 31.25)
append は引数にリストを受け取り、連結したリストを返します。> (append '(1) '(2) '(3 4 5 6) '(7 8 9)) (1 2 3 4 5 6 7 8 9)
list? はリストかどうかを判定します。> (list? '(1 2)) #t > (list? 8) #f
length はリストの要素数を返します。中にリストがあっても１要素扱いです。> (length '(7 (8 9) (7 9))) 3
reverse はリストを逆順にします。中にリストがあっても１要素扱いです。> (reverse '(7 (8 9) (7 9))) ((7 9) (8 9) 7)
要素のないリストを空リストといいます。> '() ()
リストの中の要素ひとつひとつに処理をしてリストとして返しています。car で要素を一つとって処理をし、cdr でのこりのリストが取れるので、同じ手続きに渡して処理して、cons でくっつけています。終了条件は空リストを受け取った時で、そのときは空リストを返します。> (define (henkan x) > (if (null? x) '() > (cons (/ 7500 (car x)) > (henkan (cdr x))))) > (henkan '(120 300 240)) (62.5 25 31.25)
car はリストの最初の要素を返します。> (car '(100 200 300)) 100
最初の要素がリストのときはそのリストを返します。> (car '((100 200) 300)) (100 200)
cdr は最初の要素をとったのこりをリストとして返します。> (cdr '(100 200 300)) (200 300)
もうなにもないときは空リスト () を返します。> (cdr '(300)) ()
cons は逆にくっつけてリストを作ります。 最初の引数が最初の要素になり、二番目の引数がのこりのリストです。> (cons 100 '(200 300)) (100 200 300)
car で cons の最初の引数が返ってくるし、cdr で cons の二番目の引数が返ってきます。> (car (cons 100 '(200 300))) 100 > (cdr (cons 100 '(200 300))) (200 300)
最初は空リストとくっつけていきます。> (cons 300 '()) (300)
null? は空リストの判定に使います。> (null? '()) #t
リストの中に入れ子になったリストを処理したいときにも map を使います。引数がリストだったときは map に自分自身をわたすようにして、引数がリストでなかったときの処理も書きます。リストだったときの処理とリストでなかったときの処理は対になります。> (define (flat x) > (if (list? x) (apply append (map flat x)) > (list x))) > (flat '(1 2 (3 (4 5) 6) ((7 8) 9))) (1 2 3 4 5 6 7 8 9)
apply は第一引数に手続きを、第二引数にリストを受け取り、リストの要素が全て手続きの引数となって処理されます。> (apply + '(1 2 3 4 5 6 7 8 9)) 45 > (apply append '((1) (2) (3 4 5 6) (7 8 9))) (1 2 3 4 5 6 7 8 9)
all-len はリストの中のリストまで要素を数えます。 こういう手続きを作るときは、(map all-len a) がどうなるかを考えます。 要素数を返すから、それを足しあわせればいい。 そのためにはリストでなかったときは１を返せばいいことになります。> (define (all-len a) > (if (list? a) (apply + (map all-len a)) > 1)) > (all-len '(7 (8 9) (7 9))) 5
all-rev はリストの中のリストも逆順にします。> (define (all-rev a) > (if (list? a) (reverse (map all-rev a)) > a)) > (all-rev '(7 (8 9) (7 9))) ((9 7) (9 8) 7)
lambdaで無名の手続きを作ることができます。 lambdaの次には引数がきて、 その後に続く本体でその引数を使うことができます。> ((lambda (x y) (+ (* x x) (* y y))) 1 2) 5
これはすべての部分集合を返す手続きです。 最初に(car a)と(powerset (cdr a))からこの手続きが定義できると考えます。> (define (powerset a) > (if (null? a) '(()) > ((lambda (x) (append (map (lambda (y) (cons (car x) y)) x) x)) > (powerset (cdr a))))) > (powerset '(a b c)) ((a b c) (a b) (a c) (a) (b c) (b) (c) ())
こんなのが浮かんできて、 あとは、最初の返り値'(())とlambdaの中身を考えればいい。 xが(car a)でyが(powerset (cdr a))だとすると、 yの要素一つ一つにxを加えたものとyとを足しあわせればいい。 つまり(append (map (lambda (z) (cons x z)) y) y)となります。(define (powerset a) (if (null? a) .... ((lambda (x y) ....) (car a) (powerset (cdr a)))))
(define (powerset a) (if (null? a) '(()) ((lambda (x y) (append (map (lambda (z) (cons x z)) y) y)) (car a) (powerset (cdr a)))))
ここまでするとダメです。(define (powerset a) (if (null? a) '(()) ((lambda (x y) ((lambda (a) (append a y)) ((lambda (f) (map f y)) (lambda (z) (cons x z))))) (car a) (powerset (cdr a)))))
(define (powerset a) (if (null? a) '(()) (let ((f (lambda (x) (cons (car a) x))) (x (powerset (cdr a)))) (append (map f x) x))))
(define (powerset a) (let iter ((a (reverse a)) (r '(()))) (if (null? a) r (iter (cdr a) (append (map (lambda (x) (cons (car a) x)) r) r)))))
中間の状態を引数にもつ手続きを使えば末尾再帰になります。> (define (fib n) > (define (fib-iter x y z) > (if (= x n) y > (fib-iter (+ x 1) (+ y z) y))) > (fib-iter 0 0 1)) > (fib 1000) 43466557686937456435688527675040625802564660517371780 40248172908953655541794905189040387984007925516929592 25930803226347752096896232398733224711616429964409065 33187938298969649928516003704476137795166849228875
製作中(define (fib n) (let iter ((x 0) (y 0) (z 1)) (if (= x n) y (iter (+ x 1) (+ y z) y)))) (define (fib n) (do ((x 0 (+ x 1)) (y 0 (+ y z)) (z 1 y)) ((= x n) y))) (define (fib n) (let iter ((a 1) (b 0) (p 0) (q 1) (n n)) (cond ((= n 0) b) ((even? n) (let ((p (+ (* p p) (* q q))) (q (+ (* 2 p q) (* q q)))) (iter a b p q (/ n 2)))) (else (let ((a (+ (* a (+ p q)) (* b q))) (b (+ (* b p) (* a q)))) (iter a b p q (- n 1)))))))
ごく普通の検索。手続きが真偽値を返すことで検索を制御している。(define (deepsearch a x) (if (not (pair? a)) (eqv? a x) (or (deepsearch (car a) x) (deepsearch (cdr a) x))))
積み重ねるタイプ。(define (deepsearch a x) (let iter ((a a) (stack '())) (cond ((pair? a) (iter (car a) (cons (cdr a) stack))) ((eqv? a x) #t) ((null? stack) #f) (else (iter stack '())))))
発見時に手続きを実行するタイプ。srchd には見つかった時に実行する手続きが、fsrch には見つからなかった時に実行する手続きが入る。(define (deepsearch a x srchd fsrch) (let iter ((a a) (stack '())) (cond ((pair? a) (iter (car a) (cons (cdr a) stack))) ((eqv? a x) (srchd)) ((null? stack) (fsrch)) (else (iter stack '())))))
srchd には見つかった時に実行する手続きが、fsrch には見つからなかった時に実行する手続きが入る。car を調べるごとに cdr を調べる手続きを fsrch に積み重ねる。(define (deepsearch a x srchd fsrch) (let iter ((a a) (fsrch fsrch)) (cond ((pair? a) (iter (car a) (lambda () (iter (cdr a) fsrch)))) ((eqv? a x) (srchd)) (else (fsrch)))))
次にreverseを使って繰り返しに。(define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y))))
reverseも同じように書けるから、一緒にして、(define (append x y) (let iter ((x (reverse x)) (y y)) (if (null? x) y (iter (cdr x) (cons (car x) y)))))
３つの変数で繰り返し。きれいには書けていない。(define (reverse x) (let iter ((x x) (y '())) (if (null? x) y (iter (cdr x) (cons (car x) y))))) (define (append x y) (define (iter x y) (if (null? x) y (iter (cdr x) (cons (car x) y)))) (iter (iter x '()) y))
処理が終わった後にする処理を受け取るようにする。(define (append x y) (let iter ((x x) (temp '()) (y y)) (cond ((and (null? x) (null? temp)) y) ((null? x) (iter x (cdr temp) (cons (car temp) y))) (else (iter (cdr x) (cons (car x) temp) y)))))
ここからcall-with-current-continuationを使ってみる。 (lambda (x) x)のかわりにcall-with-current-continuationで継続を渡す。(define (append x y) (define (iter x y f) (if (null? x) (f y) (iter (cdr x) (cons (car x) y) f))) (iter x '() (lambda (x) (iter x y (lambda (x) x)))))
ちょっと変更。継続を受け取る手続きを強調してみる。(define (append x y) (define (iter x y f) (if (null? x) (f y) (iter (cdr x) (cons (car x) y) f))) (call-with-current-continuation (lambda (cont) (iter x '() (lambda (x) (iter x y cont))))))
継続を受け取る手続きを返すようにiterを変更。(define (append x y) (define (iter x y f) (if (null? x) (f y) (iter (cdr x) (cons (car x) y) f))) (call-with-current-continuation (lambda (cont) ((lambda (cont) (iter x '() cont)) (lambda (x) ((lambda (cont) (iter x y cont)) cont))))))
call-with-current-continuationに渡す手続きをすっきりさせる。(define (append x y) (define (iter x y) (if (null? x) (lambda (cont) (cont y)) (iter (cdr x) (cons (car x) y))))) (call-with-current-continuation (lambda (cont) ((iter x '()) (lambda (x) ((iter x y) cont))))))
継続を受け取る手続き(iter x '())に継続を渡す。 渡す継続(lambda (x) (iter x y))は、継続を受け取る手続きを返し、 call-with-current-continuationが継続を渡す。(define (append x y) (define (iter x y) (if (null? x) (lambda (cont) (cont y)) (iter (cdr x) (cons (car x) y)))) (call-with-current-continuation ((iter x '()) (lambda (x) (iter x y)))))
connectは継続を受け取る手続きを返す。 fは継続を受け取る手続きで、contには継続のリストが入る。 contに入っている継続が返すのは継続を受け取る手続きである。(define (connect f . cont) (if (null? cont) f (apply connect (f (car cont)) (cdr cont))))
connectを使えばこう書ける。(define (append x y) (define (iter x y) (if (null? x) (lambda (cont) (cont y)) (iter (cdr x) (cons (car x) y)))) (call-with-current-continuation (connect (iter x '()) (lambda (x) (iter x y)))))
contは継続を返す手続きである。 (lambda (cont) (cont x))は受け取った継続にxを渡すだけである。 空リストにxを積み重ねていき、終わったらそれをyに積み重ねていく。(define (append x y) (define (cont y) (lambda (x) (let iter ((x x) (y y)) (if (null? x) (lambda (cont) (cont y)) (iter (cdr x) (cons (car x) y)))))) (call-with-current-continuation (connect (lambda (cont) (cont x)) (cont '()) (cont y))))
円周率が定義されています。(define $pi (* 4 ($atan 1))) (define pi $pi) (define (pi* z) (* $pi z)) (define (pi/ z) (/ $pi z)) > pi 3.141592653589793
自然底数を何乗かします。自然対数の逆関数です。(define (exp z) (if (real? z) ($exp z) (make-polar ($exp (real-part z)) (imag-part z)))) > (exp 1) 2.718281828459045
real? は実数の範囲内かどうか判定します。1.0+0.9iの形で複素数を表現します。> (real? 9.7) #t > (real? 1.0+0.9i) #f
それぞれ実数部と虚数部を返します。> (real-part 1.0+0.9i) 1.0 > (imag-part 1.0+0.9i) 0.9
角座標を複素平面に写します。第２引数のコサインを実数部に、サインを虚数部にして第１引数だけ掛けます。> (make-polar 1 pi) -1.0+1.2246063538223772e-16i > (make-polar 1 (/ pi 2)) 6.123031769111886e-17+1.0i > (make-polar 1 (/ pi 4)) 0.7071067811865476+0.7071067811865475i
自然対数を求めます。(define (log z) (if (and (real? z) (>= z 0)) ($log z) (make-rectangular ($log (magnitude z)) (angle z))))
複素数から角座標を求めることができます。> (magnitude (make-polar 1 pi)) 1.0 > (angle (make-polar 1 pi)) 3.141592653589793
複素数を作ります。> (make-rectangular 1 2) 1.0+2.0i
平方根を返します。(r*cos(x), r*sin(x)) の平方根は(sqrt(r)*cos(x/2), sqrt(r)*sin(x/2))になるようです。(define (sqrt z) (if (real? z) (if (negative? z) (make-rectangular 0 ($sqrt (- z))) ($sqrt z)) (make-polar ($sqrt (magnitude z)) (/ (angle z) 2))))
asin などはそれぞれの逆関数です。(define expt (let ((integer-expt integer-expt)) (lambda (z1 z2) (cond ((zero? z1) (if (zero? z2) 1 0)) ((exact? z2) (integer-expt z1 z2)) ((and (real? z2) (real? z1) (>= z1 0)) ($expt z1 z2)) (else (exp (* z2 (log z1)))))))) (define (sinh z) (if (real? z) ($sinh z) (let ((x (real-part z)) (y (imag-part z))) (make-rectangular (* ($sinh x) ($cos y)) (* ($cosh x) ($sin y)))))) (define (cosh z) (if (real? z) ($cosh z) (let ((x (real-part z)) (y (imag-part z))) (make-rectangular (* ($cosh x) ($cos y)) (* ($sinh x) ($sin y)))))) (define (tanh z) (if (real? z) ($tanh z) (let* ((x (* 2 (real-part z))) (y (* 2 (imag-part z))) (w (+ ($cosh x) ($cos y)))) (make-rectangular (/ ($sinh x) w) (/ ($sin y) w))))) (define (asinh z) (if (real? z) ($asinh z) (log (+ z (sqrt (+ (* z z) 1)))))) (define (acosh z) (if (and (real? z) (>= z 1)) ($acosh z) (log (+ z (sqrt (- (* z z) 1)))))) (define (atanh z) (if (and (real? z) (> z -1) (< z 1)) ($atanh z) (/ (log (/ (+ 1 z) (- 1 z))) 2))) (define (sin z) (if (real? z) ($sin z) (let ((x (real-part z)) (y (imag-part z))) (make-rectangular (* ($sin x) ($cosh y)) (* ($cos x) ($sinh y)))))) (define (cos z) (if (real? z) ($cos z) (let ((x (real-part z)) (y (imag-part z))) (make-rectangular (* ($cos x) ($cosh y)) (- (* ($sin x) ($sinh y))))))) (define (tan z) (if (real? z) ($tan z) (let* ((x (* 2 (real-part z))) (y (* 2 (imag-part z))) (w (+ ($cos x) ($cosh y)))) (make-rectangular (/ ($sin x) w) (/ ($sinh y) w))))) (define (asin z) (if (and (real? z) (>= z -1) (<= z 1)) ($asin z) (* -i (asinh (* +i z))))) (define (acos z) (if (and (real? z) (>= z -1) (<= z 1)) ($acos z) (+ (/ (angle -1) 2) (* +i (asinh (* +i z)))))) (define (atan z . y) (if (null? y) (if (real? z) ($atan z) (/ (log (/ (- +i z) (+ +i z))) +2i)) ($atan2 z (car y))))