kb84tkhrのブログ

何を書こうか考え中です あ、あと組織とは関係ないってやつです 個人的なやつ

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)))))))

このバージョンは、lsetnull?でないという前提がありました
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)と似ていますよね。

はい、そうです。名前xyは、Mが何であろうと、Mの内部でのみ有効です。そして

(letrec ((x F) (y G)) M)

では、名前xyは、FGMが何であろうと、FGMの内部でのみ有効です。

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をネタにします

remberletrecを使って書き換えます
次に、最初に見つけたアトムだけでなく、それ以降のアトムをすべて削除する、
rember-beyond-firstを作ります
これはremberを1行書き換えるだけで、letccは使わずに書くことができます
わざわざ取り上げることもなかったような気がしますが何か裏があるのでしょうか
5回読めばわかると思うので今は気にせずに進みます

my-rember-upto-last

こんどは最後に見つかるアトムとそれ以降のアトムのみを残す
rember-upto-lastを作ります
まずは自分で作ってみます
これはぱっと考えてもremberrember-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 hophopが「継続」のはず
手習いで出てきた「継続」(収集子とも言ってましたが)との関係が気になります
同じもののことを言ってるんでしょうか?

手習い風の継続を使って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章はここでおしまい