Scheme修行(3) 第13章
第13章 ホップ、スキップ、ジャンプ
継続が出てきます
intersectall
題材はintersectall
です
まずはintersect
から
(define intersect
(lambda (set1 set2)
(cond ((null? set1) (quote ()))
((member? (car set1) set2)
(cons (car set1) (intersect (cdr set1) set2)))
(else (intersect (cdr set1) set2)))))
第12の戒律を使って書き換えます
(define intersect
(lambda (set1 set2)
(letrec
((I (lambda (set)
(cond ((null? set) (quote ()))
((member? (car set) set2)
(cons (car set) (I (cdr set))))
(else (I (cdr set)))))))
(I set1))))
以前に書いたintersectallです
(define intersectall
(lambda (lset)
(cond ((null? (cdr lset)) (car lset))
(else (intersect (car lset)
(intersectall (cdr lset)))))))
このバージョンは、lset
がnull?
でないという前提がありました
null?
でもよいように書き換えます
(define intersectall
(lambda (lset)
(letrec
((A (lambda (lset)
(cond ((null? (cdr lset)) (car lset))
(else (intersect (car lset)
(A (cdr lset))))))))
(cond ((null? lset) (quote ()))
(else (A lset))))))
大したことをしたわけじゃないんですがね
lambdaとletrecの違い
これ(
letrec
のこと)は(lambda (x y) M)
と似ていますよね。はい、そうです。名前
x
とy
は、M
が何であろうと、M
の内部でのみ有効です。そして
(letrec ((x F) (y G)) M)
では、名前x
とy
は、F
とG
とM
が何であろうと、F
とG
とM
の内部でのみ有効です。
FとかGの中でxやyが呼べるってのが大事なわけですから
lambdaやletではできません
letcc
(inersectall '((3 mangoes and) () (3 diet hamburgers))
の値は
()
になります
()
との共通部分を取っているので当然ですが、intersectall
は正直に全部を
intersect
し続けます
()
と出会ったらすぐ、今までやってきたことを放棄して()
を返すようにします
というところでletcc
の登場です
ただし、Racketではletcc
ではなくlet/cc
になっています
(define intersectall
(lambda (lset)
(let/cc hop
(letrec
((A (lambda (lset)
(cond ((null? (car lset))
(hop (quote ())))
((null? (cdr lset)) (car lset))
(else (intersect (car lset)
(A (cdr lset))))))))
(cond ((null? lset) (quote()))
(else (A lset)))))))
A
の中で(null? (car lset))
だった場合に(hop (quote ())
を評価します
このとき何が起こるかというと
(letcc hop
を通り過ぎた後、(hop M)
に遭遇する前にすべきだったことを忘れなさい。そして、M
が何であっても、まるで(letcc hop M)
の値を求めたかのようにふるまいなさい。
ということだそうです
この文章がいまひとつ飲み込めてなかったりします
(hop M)
のM
と(letcc hop M)
のM
は同じなの?
コードと対応付けてみると(hop M)
のM
は(quote ())
で
(letcc hop M)
のM
は(letrec ...)
に見えます
そうじゃないとすれば両方(quote ())
ってことなんでしょうけど(letcc hop M)
の値を求めたかのようにふるまいなさいと言われても?
値は何なんですか?
M
なんでしょうけど
それなら「まるで(letcc hop M)
の値はM
であるかのように」と書けば
よさそうなものですが・・・
引っ掛かりはするものの、(letcc hop M)
の値はM
という理解で進みます
この評価が、実際に関数と同じ仕組みで行われているかはわかりませんが
同じように考えても問題はなさそうです
ひさしぶりに1ステップずつ評価を追ってみます
上の規則を踏まえるとこんな感じでしょうか
(intersectall-c '((a b c) () (b e c)))
= (let/cc hop (A '((a b c) () (b e c))))
= (let/cc hop (intersect '(a b c) (A '(() (b e c)))))
= (let/cc hop (intersect '(a b c) (hop (quote ()))))
= (let/cc hop (quote ()))
= (quote ())
すぐに終わりました
Alonzo Church (1903-1995) ならこう書いたでしょう。
: (call-with-current-continuation (lambda (hop) :
だそうですが
Churchさんはコンピュータもない時代に継続まで考えてたってことでしょうか?
どういう思考回路?と思いましたが
さらっと検索した感じだと別にChurchが継続を発明したというわけではなさそうです
とすると何が言いたかったのか?
第14の戒律
(letcc ...)
を用いて、値を直ちに、すばやく返すべし。
ふむ
lset
に()
が含まれていなくても、intersect
した結果が()
であれば
intersectall
の結果も()
になります
その場合もすぐに結果を返すようにしたいものです
intersect
を内部関数にしてhop
を共有できるようにし
intersect
の処理から直接intersectall
の結果を返すようにします
(define intersectall
(lambda (lset)
(let/cc hop
(letrec
((A (lambda (lset)
(cond ((null? (car lset))
(hop (quote ())))
((null? (cdr lset)) (car lset))
(else (I (car lset) (A (cdr lset)))))))
(I (lambda (set1 set2)
(letrec
((J (lambda (set1)
(cond ((null? set1) (quote ()))
((member? (car set1) set2)
(cons (car set1) (J (cdr set1))))
(else (J (cdr set1)))))))
(cond ((null? set2) (hop (quote ())))
(else (J set1)))))))
(cond ((null? lset) (quote()))
(else (A lset)))))))
実行の様子
(intersectall '((a b) (c d) (e f) (g h)))
= (let/cc hop (A '((a b) (c d) (e f) (g h))))
= (let/cc hop (I '(a b) (A '((c d) (e f) (g h)))))
= (let/cc hop (I '(a b) (I '(c d) (A '((e f) (g h))))))
= (let/cc hop (I '(a b) (I '(c d) (I '(e f) (A '((g h)))))))
= (let/cc hop (I '(a b) (I '(c d) (I '(e f) '(g h)))))
= (let/cc hop (I '(a b) (I '(c d) '())))
= (let/cc hop (I '(a b) (hop (quote ()))))
= (let/cc hop (quote ()))
= (quote ())
こういうのが思ったとおりに動いているかどうかは、こういうテストではわかりませんね
(check-equal? (intersectall '((a b) (c d) (e f) (g h))) '())
なにかいい方法はあるんでしょうか
ファーストクラスの継続、と言うくらいですから内部関数にする代わりに
hop
を渡すようにしても動くでしょうか?
(define intersect2
(lambda (set1 set2 hop)
(letrec
((I (lambda (set)
(cond ((null? set) (quote ()))
((member? (car set) set2)
(cons (car set) (I (cdr set))))
(else (I (cdr set)))))))
(cond ((null? set2) (hop (quote ())))
(else (I set1))))))
(define intersectall2
(lambda (lset)
(let/cc hop
(letrec
((A (lambda (lset)
(cond ((null? (car lset))
(hop (quote ())))
((null? (cdr lset)) (car lset))
(else (intersect2 (car lset) (A (cdr lset)) hop))))))
(cond ((null? lset) (quote()))
(else (A lset)))))))
動きました
rember-beyond-first
つぎはrember
をネタにします
rember
をletrec
を使って書き換えます
次に、最初に見つけたアトムだけでなく、それ以降のアトムをすべて削除する、
rember-beyond-first
を作ります
これはrember
を1行書き換えるだけで、letccは使わずに書くことができます
わざわざ取り上げることもなかったような気がしますが何か裏があるのでしょうか
5回読めばわかると思うので今は気にせずに進みます
my-rember-upto-last
こんどは最後に見つかるアトムとそれ以降のアトムのみを残す
rember-upto-last
を作ります
まずは自分で作ってみます
これはぱっと考えてもrember
やrember-beyond-first
よりも
複雑なやり方が必要そうです
普通に作るなら後ろから見ていくんでしょうかね
配列ならいいんですけどリストは後ろからたどるのってちょっと苦手なんですよね
ひっくり返して前から見ますか
(define reverse
(letrec
((R (lambda (lat rev)
(cond ((null? lat) rev)
(else (R (cdr lat) (cons (car lat) rev)))))))
(lambda (lat) (R lat (quote ())))))
(define my-rember-upto-last
(lambda (a lat)
(letrec
((R (lambda (rlat result)
(cond ((null? rlat) result)
((eq? (car rlat) a) result)
(else (R (cdr rlat) (cons (car rlat) result)))))))
(R (reverse lat) (quote ())))))
そういえばこのシリーズではこうやって結果を変数に蓄積していくやり方って出てきませんね
なにか邪道っぽいことなんでしょうか
この技なしでひっくり返そうとするとけっこうめんどくさそうなんですが
remember-upto-last
こんどはletcc
を使います
使うんだろうなあと思いつつも自力ではどう使うのかわかりませんでした
新しい版では、アトム
a
を見つけると、lat
の要素をみるのは止めませんが、そこまでに見たすべてのものを捨ててしまいます。
忘れるためにletcc
を使うんだろうということはわかるんですが
探し続けるけれども、結果に
cons
しようと舞っているアトムを無視するにはどうすればよいですか。
そうそう、アトムを見つけても「あとでcons
する」が残ってると
multirember
になってしまうんですよねえ
というわけで答えです
(define rember-upto-last
(lambda (a lat)
(let/cc skip
(letrec
((R (lambda (lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) a) (skip (R (cdr lat))))
(else (cons (car lat) (R (cdr lat))))))))
(R lat)))))
なるほど
そうか脱出するだけじゃないんだ
追ってみます
(rember-upto-last 'a '(b a c a d))
= (let/cc skip (R '(b a c a d)))
= (let/cc skip (cons 'b (R '(a c a d))))
= (let/cc skip (cons 'b (skip (R '(c a d)))))
= (let/cc skip (cons 'b (skip (cons 'c (R '(a d))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip (R '(d)))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip (cons 'd (R '())))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip (cons 'd '()))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip '(d))))))
= (let/cc skip '(d))
= '(d)
見事に忘れていますね
手習いで出てきた継続との関係
そういえばこの本では訳者まえがき以降「継続」っていう言葉は出てきてない気がしますが
(letcc hop
のhop
が「継続」のはず
手習いで出てきた「継続」(収集子とも言ってましたが)との関係が気になります
同じもののことを言ってるんでしょうか?
手習い風の継続を使ってrember-upto-last
を書いてみます
(define rember-upto-last&co
(lambda (a lat)
(letrec
((R (lambda (lat col)
(cond
((null? lat) (col (quote ())))
((eq? (car lat) a)
(R (cdr lat) (lambda (x) x)))
(else
(R (cdr lat) (lambda (x) (col (cons (car lat) x)))))))))
(R lat (lambda (x) x)))))
ぴったり同じかというと微妙ですが、全体としては同じ構造で書けました
お前の仕事が終わったらこれやっとけよ、というのをcol
に貯めていくわけですが
a
が見つかった時、それまでに貯めたcol
を一度忘れて
(lambda (x) x)
にリセットしてしまうというのが(skip ...)
に対応しています
今はそれだけですが、きっと先まで読めばわかるんじゃないでしょうか
13章はここでおしまい