Scheme修行(9) 第18章 我変わる、ゆえに我同じなり！
cons、car、cdrをlambdaで書いてしまいます
(define kons
(lambda (kar kdr)
(lambda (selector)
(selector kar kdr))))
(define kar
(lambda (c)
(c (lambda (a d) a))))
(define kdr
(lambda (c)
(c (lambda (a d) d))))Schemeのコア中のコアと思っていたものが、実はlambdaで書けるという
楽しくなってまいりました（個人的趣味
konsの値は表示してくれません
> (kons 2 (kons 1 (quote ())))
#<procedure:...hemer/chap18.rkt:7:4>karやkdrで皮をめくっていけばアトムは表示されます
> (kar (kons 2 (kons 1 (quote ())))) ;(car '(2 1))
2
> (kar (kdr (kons 2 (kons 1 (quote ()))))) ;(car (cdr '(2 1)))
1
> (kdr (kdr (kons 2 (kons 1 (quote ()))))) ;(cdr (cdr '(2 1)))
'()konsにselectorという関数を渡しているのが目に新鮮です
やってることはそれほど難しくありません
konsがクロージャにkarとkdrの値を保存し、
karはkarを返す関数を、kdrはkdrを返す関数をkonsに渡してやっているだけです
(kons 1 (quote ()) はこんなクロージャを返し、
- kar → 1
- kdr → '()
- 仮引数 → (selector)
- 関数本体 → (selector car cdr)
(kons 2 (kons 1 (quote ()))はこんなクロージャを返す、というわけです
- kar → 2
- kdr → こんなクロージャ
- kar → 1
- kdr → '()
- 仮引数 → (selector)
- 関数本体 → (selector kar kdr)
- 仮引数 → (selector)
- 関数本体 → (selector kar kdr)
ポインタ的な実装と同じように動いてくれそうです
考えるときは箱と矢印を使った表現でよさそうです
そうじゃないと困りますし
konsはconsの影法師ですか。
そうです。
konsはconsと違っていますか。
確かに違いますが、6章(「Scheme手習い」)で「影法師に注意」と言ったことを
忘れないで下さい。
なぜ逆接でつながっているのかよくわかりませんが、忘れないようにしましょう
次に、kdrを書き換えられるようにします
karを書き換えられるようにしないのは紙面の都合ってやつでしょうか
書き換えられなくっていいということはなさそうですし
(define bons
(lambda (kar)
(let ((kdr (quote ())))
(lambda (selector)
(selector
(lambda (x) (set! kdr x))
kar
kdr)))))
(define kar
(lambda (c)
(c (lambda (s a d) a))))
(define kdr
(lambda (c)
(c (lambda (s a d) d))))
(define set-kdr
(lambda (c x) ((c (lambda (s a d) s)) x)))
(define kons
(lambda (a d)
(let ((c (bons a)))
(set-kdr c d)
c)))konsがどうなっているのか見えないのも不便ですので
konsを目に見えるようにする関数でも作りましょう
(define wride
(lambda (l)
(letrec ((W (lambda (l)
(cond ((null? l) (display "'()"))
((atom? l) (write l))
(else
(display "(kons ")
(W (kar l))
(display " ")
(W (kdr l))
(display ")"))))))
(W l)
(newline))))どれどれ
> (wride (kons 1 '()))
#<procedure:...hemer/chap18.rkt:8:6>ぶほ
・・・
konsはlambdaですがlambdaはatom?ですのでリストとは思ってもらえませんでした
まんまと影法師にしてやられています
考えてもkonsが作ったlambdaと他のlambdaを区別する方法が思いつかなかったので
lambdaはリストってことにしました
無茶ですが
(define adom?
(lambda (s)
(and (atom? s) (not (procedure? s)))))
(define wride
(lambda (l)
(letrec ((W (lambda (l)
(cond ((null? l) (display "'()"))
((adom? l) (write l))
(else
(display "(kons ")
(W (kar l))
(display " ")
(W (kdr l))
(display ")"))))))
(W l)
(newline))))konsのマネで子音を変えてみましたがどうもkonsみたいなしっくり感がないですね
センスの問題
動かしてみます
どうかな
> (wride (kons 1 (kons (kons 2 (kons 3 '())) '())))
(kons 1 (kons (kons 2 (kons 3 '())) '()))大丈夫そうです
これで新しいkonsとset-kdrのテストがしやすくなります
> (define l (kons 1 (kons 2 '())))
> (wride l)
(kons 1 (kons 2 '()))
> (set-kdr l (kons 2 (kons 3 '())))
> (wride l)
(kons 1 (kons 2 (kons 3 '())))
> (wride (kdr l))
(kons 2 (kons 3 '()))
> (wride (kar (kdr l)))
2おｋぽいです
しかしまだ結果が分かりづらいのでさらにもうちょっとそれっぽく表示してくれるようにします
(define wride
(lambda (l)
(letrec
((R (lambda (l)
(W (kar l))
(cond ((null? (kdr l)))
((adom? (kdr l))
(display " . ")
(write (kdr l)))
(else
(display " ")
(R (kdr l))))))
(W (lambda (l)
(cond ((adom? l) (write l))
((null? l) (write l))
(else
(display "(")
(R l)
(display ")"))))))
(W l)
(newline))))こうなります
> (wride (kons 1 (kons (kons 2 (kons 3 '())) '())))
(1 (2 3))
> (wride (kons (kons 1 (kons 2 '())) (kons 3 '())))
((1 2) 3)いちおうこういう表示にも対応したという自己満足
> (wride (kons (kons 'a 'b) 'c))
((a . b) . c)
> (wride (kons 'a (kons 'b 'c)))
(a b . c)ところでkonsを作るのになぜいったんbonsを作っているのでしょう
いきなりkonsだって作れそうですが
(define gons
(lambda (kar kdr)
(lambda (selector)
(selector
(lambda (x) (set! kdr x))
kar
kdr))))これでも普通に動くんですけどねえ
より小さい単位に分割したってことでしょうか
話を戻して
(define lots
(lambda (m)
(cond ((zero? m) (quote ()))
(else (kons (quote egg) (lots (sub1 m)))))))
(define add-at-end
(lambda (l)
(cond ((null? (kdr l))
(konsC (kar l) (kons (quote egg) (quote ()))))
(else
(konsC (kar l) (add-at-end (kdr l)))))))konsCはconsCと同じく、呼びだされた回数を覚えているkonsです
なぜ()とkonsするところはkonsCじゃないんでしょうね？
リストの長さと関係ないから？
> (wride (add-at-end (lots 3)))
(egg egg egg egg)
> (kounter)
3add-at-endではkonsCを3回実行していることがわかります
まるごとリストを作りなおしてますからね
最後のkons以外には新しいkonsをせず、末尾に卵を追加することはできますか。
set-kdrを使います
(define add-at-end-too
(lambda (l)
(letrec ((A (lambda (l)
(cond ((null? (kdr l))
(set-kdr l (kons (quote egg) (quote ()))))
(else
(A (kdr l)))))))
(A l)
l)))結果は同じです
> (set-kounter 0)
> (wride (add-at-end-too (lots 3)))
(egg egg egg egg)当然すぎるほど当然ですがkonsCは呼び出されていません
> (kounter)
0immutableな世界からmutableな世界に入りました
すると今までは起こらなかったようなことが起こります
konsの回数を数えてみます
（ここでは掲載のソースのkonsとkonsCを両方数えているようです）
(define dozen (lots 12)) ; 12回
(define bakers-dozen (add-at-end dozen)) ; 13回
(define bakers-dozen-too (add-at-end-too dozen)) ; 1回
(define bakers-dozen-again (add-at-end dozen)) ; 14回(!)2行目と4行目は同じことをしているはずですがkonsの回数が違っています
本では12+13+1が27になってますがご愛嬌 この本はけっこう誤植多いです
3行目のadd-at-end-tooで、大元のdozenにひとつeggがくっついてしまったからです
くわしく見てみます
(define dozen (lots 12))を実行すると卵が12個できます
dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()(define bakers-dozen (add-at-end dozen))はdozenのコピーを作ってから
卵をひとつ追加します
コピーなので元のdozenには影響は与えません
dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()
bakers-dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()(define bakers-dozen-too (add-at-end-too dozen))はdozenを末尾まで
たどってそこに卵を追加します
bakers-dozen-tooはもちろん13個の卵を指しますが、元のdozenまで13個の卵を
指すようになってしまいます
dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()
↑
bakers-dozen-too
bakers-dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()(define bakers-dozen-again (add-at-end dozen))は、13個になった
dozenをコピーしてから末尾に卵を追加するのでkonsCが14回呼ばれることになります
dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()
↑
bakers-dozen-too
bakers-dozen
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()
bakers-dozen-again
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->()さて
(set! ...)を導入すると、「同じこと」について新しい考え方ができます。
dozenとbakers-dozenはどちらも13個の卵を指しています
set!を使わないかぎり、dozenとbakers-dozenを区別する必要はありませんでした
2つのkonsは、片方を変えるともう片方も変わるなら、同じものです。
アドレスやポインタを前提にして話すのではないとするとこういう言い方になるんでしょうね
dozenとbakers-dozen-tooは全く同じものを指しています
bakers-dozen-tooを変えるとdozenも変わってしまいます
そのまま実装した「同じかどうか」判定器です
実用上の価値はほとんどないと思います
(define same?
(lambda (c1 c2)
(let ((t1 (kdr c1))
(t2 (kdr c2)))
(set-kdr c1 1)
(set-kdr c2 2)
(let ((v (= (kdr c1) (kdr c2))))
(set-kdr c1 t1)
(set-kdr c2 t2)
v))))本には(same? bakers-dozen bakers-dozen-too)が#tと書いてありますが
> (same? dozen bakers-dozen-too)
#t
> (same? bakers-dozen bakers-dozen-too)
#fそこは間違っちゃいかんとこじゃないのか・・・
それとも何か勘違いしてるかなあ？
正誤表ほしい・・・
最後のkonsを取り出すlast-konsです
(define last-kons
(lambda (ls)
(cond ((null? (kdr ls)) ls)
(else (last-kons (kdr ls))))))なんのへんてつもありません
> (define long (lots 12))
> (wride long)
(egg egg egg egg egg egg egg egg egg egg egg egg)
> (wride (last-kons long))
(egg)
> (lenkth long)
12longをいじってやります
> (set-kdr (last-kons long) long)
> (lenkth long)
このプログラムはメモリを使いきりました。
Interactions disabled
> (wride egg)
(egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg
egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg
egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg
egg egg egg egg egg ...longは最初こうでした
long
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->() (set-kdr (last-kons long) long)を実行した後はこうなってます
long
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg
↑ |
+------------------------------------------------------+ので、kdrを順番にたどっていくといつまでたっても終わりになりません
こうしても同じ
> (define long (lots 12))
> (set-kdr (last-kons long) (kdr (kdr long)))
> (lenkth long)
このプログラムはメモリを使いきりました。
Interactions disabled
> (wride egg)
(egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg
egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg
egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg egg
egg egg egg egg egg ...こんどはこういう絵になってます
long
↓
egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg->egg
↑ |
+--------------------------------------------+絵で書いてごまかしましたが本当はクロージャです
んーとどう書くといいかな・・・
(仮引数→(selector) 関数本体→(selector kar kdr) kar→egg kdr→
(仮引数→(selector) 関数本体→(selector kar kdr) kar→egg kdr→
あ→ (仮引数→(selector) 関数本体→(selector kar kdr) kar→egg kdr→
(仮引数→(selector) 関数本体→(selector kar kdr) kar→egg kdr→
...
(仮引数→(selector) 関数本体→(selector kar kdr) kar→egg kdr→あ))...)書けばよく分かるってものでもないかな
そんなリストだったら#fを返し、普通のリストだったら長さを返す関数finite-lenkthです
(define finite-lenkth
(lambda (p)
(let/cc infinite
(letrec ((C (lambda (p q)
(cond ((same? p q) (infinite #f))
((null? q) 0)
((null? (kdr q)) 1)
(else (+ (C (sl p) (qk q)) 2)))))
(qk (lambda (x) (kdr (kdr x))))
(sl (lambda (x) (kdr x))))
(cond ((null? p) 0)
(else (add1 (C p (kdr p)))))))))なんでしょうこれは？
本体はCで、Cを呼ぶたびにpはリスト内を１つ進み、qは2つ進む？
でpとqが同じだったら終わる？
ループができてる場合はどう動くのかな？
よくわからないので動かしてみます
まずは普通のリストから
1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> ()
0 p q +1
1 p q +2
2 p q +2
3 p q +2ここで(null? q)なのでCが0を返し、0+2+2+2+1で7になる、と
ああ、qの方だけ見るとちょっと変わったlenkth関数に見えますね
(define finite-lenkth1
(lambda (p)
(letrec ((C (lambda (q)
(cond ((null? q) 0)
((null? (kdr q)) 1)
(else (+ (C (qk q)) 2)))))
(qk (lambda (x) (kdr (kdr x)))))
(cond ((null? p) 0)
(else (add1 (C (kdr p))))))))さらに単純化すると
(define lenkth2
(lambda (q)
(cond ((null? q) 0)
((null? (kdr q)) 1)
(else (+ (lenkth2 (kdr (kdr q))) 2)))))普通のlenkthと見比べます
(define lenkth
(lambda (l)
(cond ((null? l) 0)
(else (add1 (lenkth (kdr l)))))))lenkth2のほうは２つずつ進めているので、
- 2ずつ足している
- qがnull?かどうかだけでなく、(kdr q)がnull?かどうかもチェックしている
という違いがあるだけですね
では、ループができている場合について確認します
+------------------------+
↓ |
1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7
0 p q
1 p q
2 p q
3 q p
4 q p
5 p,qで(same? p q)となって#fを返すというわけかー
qはとびとびに進んでいるのですれ違ったりしないかと思いましたが
pがひとつずつ、qがふたつずつ進んでいるので差がひとつずつ縮まっていくだけだから
心配いらなかったですね
うまいこと考えるもんだなあ
てっきりO(n^2)かと思ったけどO(n)で済むのかー
