読者です 読者をやめる 読者になる 読者になる

kb84tkhrのブログ

何を書こうか考え中です

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

おkぽいです

しかしまだ結果が分かりづらいのでさらにもうちょっとそれっぽく表示してくれるようにします

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

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

immutableな世界から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)
12

longをいじってやります

> (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はリスト内を1つ進み、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つずつ進めているので、

  • 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)で済むのかー

Scheme修行(8) 第17章 我変わる、ゆえに我あり!

ふたたびdeepM
deepを内部に持つバージョンから始めます

(define deepM
  (let ((Rs (quote ()))
        (Ns (quote ())))
    (letrec ((D (lambda (m)
                  (if (zero? m)
                      (quote pizza)
                      (cons (D (sub1 m)) (quote ()))))))
      (lambda (n)
        (let ((exists (find n Ns Rs)))
          (if (atom? exists)
              (let ((result (D n)))
                (set! Rs (cons result Rs))
                (set! Ns (cons n Ns))
                result)
              exists))))))

これはメモ化が十分に働かない半バグバージョン
これを何度か修正して、以下のような形にします

(define deepM
  (let ((Rs (quote ()))
        (Ns (quote ())))
    (lambda (n)
      (let ((exists (find n Ns Rs)))
        (if (atom? exists)
            (let ((result
                   (if (zero? n)
                       (quote pizza)
                       (cons (deepM (sub1 n)) (quote ())))))
              (set! Rs (cons result Rs))
              (set! Ns (cons n Ns))
              result)
            exists)))))

この間にやったことは以下のとおり

  1. 正しくメモ化が動くようにする
    Dの呼び出しをdeepMに変えるだけ
  2. letrecをletに変更する
    自分自身を呼んでいないのでletでOK
  3. ふたつのletをひとつにまとめる
  4. 一度しか呼ばれていないDを、元のlambdaの形に置き換える
    せっかく関数の形に切り出したんですが元にも押します
  5. (lambda (m) (...) n)(let ((m n)) ...)に書き換える ふたつの式は同等ですから
  6. (let ((m n)) ...)からletを消す
    このletはただnをmに置き換えているだけですから

ここでは何を教えてくれているのでしょう?

  • 式の変形の練習みたいなもの?
  • リファクタリング
  • なにか計算機科学的な背景がある?
  • 次にやることの準備?

狙いがわかりませんでした

呼ばれた回数を数えるconsを作ります

(define counter #f)
(define set-counter #f)
(define consC
  (let ((N 0))
    (set! counter (lambda () N))
    (set! set-counter (lambda (x) (set! N x)))
    (lambda (x y)
      (set! N (add1 N))
      (cons x y))))

(set! counter (lambda () N))というのがちょっと不思議な書き方です
参照したいときは(counter)と関数を評価する形になります

こんなふうにNを直接見せてもやりたいことはやれるんですけれども

(define N 0)

(define consC
  (lambda (x y)
    (set! N (add1 N))
    (cons x y)))

直接見えるようにすると好き放題されてしまうので行儀がよろしくないということでしょうか
Javaで言うところのgetter、setterみたいな感じですね
外から勝手に使うことのできない状態をクロージャに持つことができました

なお(define counter #f)の#fには意味はありません
(define counter)でもいいしそれで通る処理系もあるようなのですが
Racketでは通らなかったのでとりあえず#fと書いてます

consCを呼ぶようにdeepを書き換えて

(define deep
  (lambda (m)
    (if (zero? m)
        (quote pizza)
        (consC (deep (sub1 m)) (quote ())))))

(deep 0)から(deep 1000)まで実行してやると

(define supercounter
  (lambda (f)
    (letrec
        ((S (lambda (n)
              (if (zero? n)
                  (f n)
                  (let ()
                    (f n)
                    (S (sub1 n)))))))
      (S 1000)
      (counter))))

(set-counter 0)
(supercounter deep)

500500回consを実行したことがわかります

ありがとう Carl F. Gauss (1777-1855)。

deepMのconsを数えてやると

(define deepM
  (let ((Rs (quote ()))
        (Ns (quote ())))
    (lambda (n)
      (let ((exists (find n Ns Rs)))
        (if (atom? exists)
            (let ((result
                   (if (zero? n)
                       (quote pizza)
                       (consC (deepM (sub1 n)) (quote ())))))
              (set! Rs (cons result Rs))
              (set! Ns (cons n Ns))
              result)
            exists)))))

(set-counter 0)
(supercounter deepM)

メモ化の効果で1000回で済んでいることがわかります
だから速くなったのかというとちょっとわかりませんが

14章のrember1*のconsを数えます
最初に作った版では、引数に取ったリストをそのまま返すだけでいい場合でも
1からリストを作っていたので余分なconsを行っていました
継続を使った版では、指定されたアトムがリスト内に存在しなければ
継続で即抜けて、指定されたリストをそのまま返しますので無駄なconsは実行されません

と言いたいだけなのか、もっと大事なことを言おうとしているのかわかりません
consの回数っていうのはけっこう気にされるようなのでそういう話なのかもしれません

Scheme修行(7) 第16章 位置について、セット、バン!

前回の代入では代入前の値は捨てられていましたが、今回は引数をため込んでいきます
こんな関数で

(define ingredients (quote ()))
(define sweet-toothR
  (lambda (food)
    (set! ingredients (cons food ingredients))
    (cons food
          (cons (quote cake)
                (quote ())))))

第16の戒律について忘れていませんか。

気になってました
set!letでくるむだけでは外から見えなくなってしまうし

時には、戒律を無視したほうが説明が簡単になるからです。
今度(set! ...)を使うときには、(let ...)でつけた名前を使いましょう。

お手並み拝見と行きましょう

pizzaをカッコでトッピングするdeep です

(define deep
  (lambda (m)
    (cond ((zero? m) (quote pizza))
          (else (cons (deep (sub1 m)) (quote ()))))))

引数と結果をため込んでいくようにします

(define Ns (quote ()))
(define Rs (quote ()))
(define deepR
  (lambda (n)
    (let ((result (deep n)))
    (set! Rs (cons result Rs))
    (set! Ns (cons n Ns))
    result)))

なんかさっきの約束が無視されてる気がしますが

せっかくため込んだので、引数が同じだったらため込んだ中から値を返します
メモ化ってやつでしょうか

(define find
  (lambda (n Ns Rs)
    (letrec
        ((A (lambda (ns rs)
              (cond ((= (car ns) n) (car rs))
                    (else (A (cdr ns) (cdr rs)))))))
      (A Ns Rs))))

(define deepM
  (lambda (n)
    (if (member? n Ns)
        (find n Ns Rs)
        (let ((result (deep n)))
          (set! Rs (cons result Rs))
          (set! Ns (cons n Ns))
          result))))

いったんmembernNsに含まれるかどうかを確認してからfindしているのが
もったいない感じですがメモ化のパターンみたいなものですかね
おかげでfindnull?を確認する必要はなくなってますが

deepの中での再帰(deep (sub1 m))から(deepM (sub1 m))に変更して、deepを手助けすべきでしょうか。

なるほど
さっきのだと(deep 3)を計算してから(deep 4)を計算するとき
すでに知ってるはずの(deep 3)の値を使わずに自前で計算してますね

(define deep
  (lambda (m)
    (cond ((zero? m) (quote pizza))
          (else (cons (deepM (sub1 m)) (quote ()))))))

(define deepM
  (lambda (n)
    (if (member? n Ns)
        (find n Ns Rs)
        (let ((result (deep n)))
          (set! Rs (cons result Rs))
          (set! Ns (cons n Ns))
          result))))

しかしこれ、いきなり(deepM 10000000)とかやっちゃったら大変なことになる気もします
メモ化というよりはテーブル作ってるのに近い感じ
呼び出され方次第でしょうか

deepMはまだ第16の戒律に反しています。

そうですね

(define deepM
  (let ((Ns (quote ()))
        (Rs (quote ())))
    (lambda (n)
      (if (member? n Ns)
          (find n Ns Rs)
          (let ((result (deep n)))
            (set! Rs (cons result Rs))
            (set! Ns (cons n Ns))
            result)))))

第16の戒律が出てから初めて、letで定義した値がまともに役に立ちました

実行結果はわかりますが
実行中にちゃんと想定通り動いてることを確認するには
デバッガで追いかけるしかないですかね
ですよね

見つからなかったら#fを返すようにfindを書き換えます

(define find
  (lambda (n Ns Rs)
    (letrec
        ((A (lambda (ns rs)
              (cond ((null? ns) #f)
                    ((= (car ns) n) (car rs))
                    (else (A (cdr ns) (cdr rs)))))))
      (A Ns Rs))))

もともとリストしか返さなかった関数なのでこれでOK
なんでも返す可能性があるんだったら、#fが見つかったのか何も見つからなかったのか
判別できないのでこのやりかたは使えません
このあたりがちょっと気持ち悪い
前も書きましたが

このfindを使うと、あらかじめmemberで値が含まれているのを確認してから
findを呼ぶ、という無駄を省くことができます
memberもfindもやってるのは似たようなことなのでぜひ消したいところ

(define deep
  (lambda (m)
    (cond ((zero? m) (quote pizza))
          (else (cons (deepM (sub1 m)) (quote ()))))))

(define deepM
  (let ((Ns (quote ()))
        (Rs (quote ())))
    (lambda (n)
      (let ((found (find n Ns Rs)))
        (if found
            found
            (let ((result (deep n)))
              (set! Rs (cons result Rs))
              (set! Ns (cons n Ns))
              result))))))

これで最終版

突然話題が変わります

lengthを覚えていますか。

さすがに見ないで書けるようになりました

次の値は何ですか。

(define length
  (lambda (l) 0))

(set! length
      (lambda (l)
        (cond ((null? l) 0)
              (else (add1 (length (cdr l)))))))

値は例によってありませんが、何かへんてこなことを始めました
このlengthでも動くことは動きます
次に第16の戒律に沿って書き換えます

(define length
  (let ((h (lambda (l) 0)))
    (set! h (lambda (l)
              (cond ((null? l) 0)
                    (else (add1 (h (cdr l)))))))
    h))

何でしょうかこれは
今までとは違うletの使い方が加わった模様

第17の戒律(最終版)

(let ((x ...)) ...)に対して(set! x ...)を用いる際には、
それらの間に少なくとも1つの(lambda ...を置くか、
xの新しい値がxを参照する関数のときのみにせよ。

(add1 (h (cdr l)))の方に出てくるhは、元のhを指してるのか
いま定義してる真っ最中のhを指してるのか
書いてあることからはわかりませんが
このlengthが普通のlengthと同じように動くためには
hが自分自身を参照している必要がありそうです

lengthっぽい部分を取り出してLとします

(define length
  (let ((h (lambda (l) 0)))
    (set! h (L (lambda (arg) (h arg))))
    h))

(define L
  (lambda (length)
    (lambda (l)
      (cond ((null? l) 0)
            (else (add1 (length (cdr l))))))))

(lambda (arg) (h arg))ってどこかで見たような
これはもしや・・・アレでしょうか

ここらへんで一度動きを確かめてみます

  (length '(a b))
= (h '(a b))
= ((L (lambda (arg) (h arg))) '(a b))
= ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (arg) (h arg)) (cdr l)))))) '(a b))
= (add1 ((lambda (arg) (h arg)) '(b)))
= (add1 (h '(b)))
= (add1 ((L (lambda (arg) (h arg))) '(b)))
= (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (arg) (h arg)) (cdr l)))))) '(b)))
= (add1 (add1 ((lambda (arg) (h arg)) '())))
= (add1 (add1 (h '())))
= (add1 (add1 ((L (lambda (arg) (h arg))) '())))
= (add1 (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (arg) (h arg)) (cdr l)))))) '())))
= (add1 (add1 0))
= (add1 1)
= 2

確かに動きます
代入が出てくるとこういうやりかたはうまくいかないそうですがまあなんとか

h のことをわざわざ(lambda (arg) (h arg))と書いているのは
そうしないとScheme手習いのアレでやったように無限ループになるからなんでしょうね

試しにそのままhと書いてみます

(define length
  (let ((h (lambda (l) 0)))
    (set! h (L h))
    h))

> (length '(a b c))
1

ええ?こうじゃないの?

  (length '(a b))
= (h '(a b))
= ((L h) '(a b))
= (((lambda (length) ...) (L h)) '(a b))
= (((lambda (length) ...) ((lambda (length) ...) (L h))) '(a b))
= (((lambda (length) ...) ((lambda (length) ...) ((lambda (length) ...) (L h)))) '(a b))

しかも1って何


そうか

  (length '(a b))
= (h '(a b))
= ((L h) '(a b))

ここでhが評価されて

= (((lambda (length) ...) (lambda (l) 0)) '(a b))

こうなるわけか
省略せずに続けると

= ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) 0) (cdr l)))))) '(a b))
= (add1 ((lambda (l) 0) '(b)))
= (add1 0)
= 1

了解です
パターンは違うけどやっぱりlambdaでくるんでないとダメということで

lengthがLの関数になるように、定義を書きなおしてください。
その新しい関数をY!とします。

やっぱりYのしわざか
関数はLを引数にするだけ

(define Y!
  (lambda (L)
    (let ((h (lambda (l) (quote ()))))
      (set! h (L (lambda (arg) (h arg))))
      h)))

(define length (Y! L))

こうも書けます

(define Y-bang
  (lambda (f)
    (letrec ((h (f (lambda (arg) (h arg)))))
      h)))

(define length (Y-bang L))

letrecはletとsetがあれば作れるということ

ここで見てきたことは、まさに「適用順手続き的Yコンビネータ」の導出です。

そういうわけでした

Scheme手習いでやった「適用順Yコンビネータ」はコード見ても何がなんだかさっぱりでした
こちらは細かい動きはともかくとして再帰させようとしてるんだということくらいはわかります

(Y f)の値は(Y! f)の値と同じ再帰関数だというのは正しいですか。
はい、関数Y!はこの形をしたすべてのfに対してYと同じ再帰関数を作り出します。

正しいそうですが同じって何でしょう
実質同じ働きをする関数という意味ではそのとおりだと思いますが
fとしてLやDを与えてみても字面まで同じになるわけではなさそうです

Yに食わせる関数とは異なる形のこんな関数で試します
bizはbizarreの略です

(define biz
  (let ((x 0))
    (lambda (f)
      (set! x (add1 x))
      (lambda (a) (if (= a x) 0 (f a))))))

字面的には、再帰するたびにxがひとつずつ増えていって5になったところで0を返しそうな雰囲気です
((Y biz) 5)は想定どおり0を返しますが、((Y! biz) 5)は無限ループになってしまいます
xが1のまま増えていってないようです
(set! x (add1 x))が1回しか評価されてないのか、毎回別のxが作られて0になっているのか、
そんなところでしょうか

細かく追ってみます
((Y! biz) 5)の評価ではxが1、fが(lambda (arg) (h arg))
関数本体が(lambda (a) (if (= a x) 0 (f a)))クロージャがhに結び付けられてから
5にhが適用されるぽいです
(set! x (add1 x))はすでに評価済みのため、その後xが加算されることはありません

いつもどおりに式を並べていく方式だと途中で破綻してしまったので
evalの気持ちになって考えてみました
こんな感じです

  1. (define biz ...)を評価します
  2. xが0、関数本体が (lambda (f) ...)クロージャにbizが結び付けられます
  3. ((Y! biz) 5)を評価します
  4. (Y! biz)を評価します
  5. Y!は(lambda (L) ...)に評価されます
  6. bizはxが0、関数本体が(lambda (f) ...)クロージャに評価されます
  7. bizにY!を適用します
  8. Lにxが0、関数本体が(lambda (f) ...)クロージャが結び付けられます
  9. Y!でhをいったん作ります
  10. Lに(lambda (arg) (h arg))を適用します
  11. fに(lambda (arg) (h arg))が結び付けられます
  12. xに1が加えられます
  13. xが1、fが(lambda (arg) (h arg))、関数本体が(lambda (a) (if (= a x) 0 (f a)))クロージャがhに結び付けられます
  14. 5にhを適用します

一方((Y biz) 5)ではbizのlambdaがそのままの形で再帰されるため
呼び出しのたびに(set! x (add1 x))が評価され、想定どおりにxが加算されていきます

帽子はまだ小さくなっていませんか。

Yコンビネータがわかっているならこれくらいでは小さくならないそうですが
けっこう小さくなりましたよ

ところでYはdefineがなくても再帰できる、という価値がありましたが
Y!の存在価値はなんでしょうか
defineはある前提だし
letrecの裏付けといったところでしょうか
わかりません

Scheme修行(6) 第15章 大人と子供の違い・・・・・・

代入です

set!defineされた変数に値を代入します
と書くと先生に怒られるかもしれません

「名前xはaを参照しています」という言い方はここが初めてかな?
こちらが正しい表現なんでしょう
さっきまでaを参照していたxに、今度はbを参照させるというのがset!
いうことになります

set!define

set!はすでにdefineされた名前についてのみ使用可能です
実際に、定義されてない名前をset!しようとするとエラーになります
逆に、define済みの名前でもう一度defineしようとするのもエラーかと思いきや成功

> (define x
    (cons (quote chicago)
          (cons (quote pizza)
                (quote ()))))
> x
'(chicago pizza)
> (set! x (quote gone))
> x
'gone
> (set! y (quote yet))
 set!: assignment disallowed;
 cannot set variable before its definition
  variable: y
> (define x (quote again))
> x
'again

しかしこういうファイルを作って...

(define x
  (cons (quote chicago)
        (cons (quote pizza)
              (quote ()))))
x

(set! x (quote gone))
x

(define x (quote again))
x

実行するとエラーになりました

module: duplicate definition for identifier in: x

REPL上では動作が違うってこと?
REPL上でdefineしなおすことができないと試行錯誤できないからそれでいいのかな
defineで値を変更できるようにすればset!はいらなくなりそうですが、
あえて好き勝手できないようになってるんでしょうね
未定義の変数にset!できないのも同様なんでしょう

(define ...)(set! ...)は値を持ちません
右側の欄がときどき空白になってて
初めはなんだろうこれと思いましたが、値がないということです

しつこいほど聞かれます
値がないということがそれほど重要なんでしょうか

definesetが、定義/代入された値を返すという仕様にするのもアリな気もしますが
値を返さないことにした、という選択が大事なんでしょうね
なぜでしょう
安全だから?

章の冒頭で

しかし、これからは時として定義式の値についても触れる必要があります。

と言ってますしね
触れても値はない、って繰り返すだけですが

何かが読み取れてない気がします

変わる

こう定義して

(define x (quote skins))

(define gourmet
  (lambda (food)
    (cons food
          (cons x (quote ())))))

(gourmet (quote onion))を評価すると当然(onion skins)ですが
(set! x (quote rings))した後もう一度(gourmet (quote onion))を評価すると
なんと!
(onion rings)になります

いやそれも当然っぽいんですけど

ただ、手習いのインタプリタで作ったクロージャだと
クロージャができた後は値の変わりようがない気がするので
当然ともいいきれないなあと

状態

現時点での変数の値(正確に言うと、「名前が参照する値」?)を覚えておかないといけないので
本が読みづらくなりました
やっぱり状態を持つのはよくないですね!(頭がメモリ不足

隠す

最後に食べたものを覚えておけるこんな関数を作ります

(define gourmand
  (lambda (food)
    (set! x food)
    (cons food
          (cons x (quote ())))))

もうひとつ作ります

(define dinerR
  (lambda (food)
    (set! x food)
    (cons (quote milkshake)
          (cons food (quote ())))))

両方でxという名前を使っているために他方の関数を呼ぶと
xの値が変更されてしまいます

他の関数からの影響を受けないようにするため、こんな風にしてxを隠します

(define omnivore
  (let ((x (quote minestrone)))
    (lambda (food)
      (set! x food)
      (cons food
            (cons x (quote ()))))))

(omnivore (quote (bouillabaisse))を評価しても
関数の外側で定義したxは影響を受けません
別の関数がxという名前を使っても影響を受けることはありません
staticなローカル変数といった感じです

しかし残念ながら、xが隠されてしまっているので最後に食べたものを
確認することはできなくなってしまいました
関数内部で前回の値を使うような例になっていればまだ役に立っているように見えるのですが
この辺りはきっと後で解決されるのでしょう

ominivoreの値は何ですか、という問が繰り返され、結局関数です、ということになります
lambdaなんだから関数なのはわかっているんですが
letの中に入ってても同じか、と聞いているのかなあ

詳しく言うと、lambdaで定義した関数とletで定義したxを含むクロージャ、と
なると思うんですがそう言わないということは?
手習いを読んでいればその説明で飲み込めないことはないと思うんですが

第16の戒律
(let ...)で定義された名前に対してのみ(set! ...)を使うべし。

letで定義するのはいいとして、minestroneみたいな捨てられるだけの値を書くのは
シャクに触るので書かずにすませたいところですが・・・

間違い

これはうまくいきません。

(define nibbler
  (lambda (food)
    (let ((x (quote donut)))
      (set! x food)
      (cons food
            (cons x (quote ()))))))

nibblerを評価するたびにxが新しく定義されるので
前回の値を覚えておく役にたっていません
といっても評価した値は変わらないので、x覚えてないよね、というのは
脳内で確かめるしかありませんが

第17の戒律(予備版)
(let ((x ...)) ...)に 対して(set! x)を用いる際には、それらの間に少なくとも1つの(lambda ...を置くべし。

自分的にはlambdaの外側にletを置け、の方がピンときますが気分的なものでしょう

swap

代入を使って値を入れ替える関数を作ります

(define chez-nous
  (lambda ()
    (set! food x)
    (set! x food)))

失敗です
わざとらしいですね
こうです

(define chez-nous2
  (lambda ()
    (let ((a food))
    (set! food x)
    (set! x a))))

第18の戒律
(set! x ...)xが参照する値がもはや必要ないときにのみ使うべし。

そりゃそうですね

まとめ

大人と子供の違いって?

Scheme修行(5) 第14章 名前をつけましょう(続き)

rember1*をいじっていきます
再掲

(define rember1*
  (lambda (a l)
    (letrec
        ((R (lambda (l)
              (cond
                ((null? l) (quote ()))
                ((atom? (car l))
                 (cond
                   ((eq? (car l) a) (cdr l))
                   (else (cons (car l) (R (cdr l))))))
                (else
                 (let ((av (R (car l))))
                   (cond
                     ((eqlist? av (car l))
                      (cons (car l) (R (cdr l))))
                     (else
                      (cons av (cdr l))))))))))
      (R l))))

今回の範囲はなんか順を追って丁寧に説明しているようで逆にわざと落とし穴を作っているような説明
ゆっくり見ていきます

letccを使うと

(R (car l))を求めてから(car l)と比較するってあたり、なんとなくもどかしさを感じます
(R (car l))を求めた時点で、その途中にaと等しいアトムがあったかどうかはわかっているはず
aと等しいアトムがなかったことを確かめるために(R (car l))(car l)を比較するのは無駄
リストが等しいことを確認しようとすると要素を全部たどらないといけないので

空リストを見つけたときに方位磁針を用いると、rember1*の役に立ちませんか。

null?だったとき、ということですね
空リストが見つかったということは、削除すべきアトムがなかったということなので
削除前のリストがそのまま答えになるはず
役に立たせることはできそうな気がします
ただ、carを見ている間に空リストになってしまった場合はまだcdrを見なきゃいけないとか
単純に終わってしまえばいいわけではないところがleftmostと異なるところです

補助関数から作り始めます
といってもこっちが本体のようなものです

リストlの最初に出てくるアトムaを取り除きます
上の定義のRでは外側の関数からlaを引き継いでいましたが
ここでは独立した関数として書いているので引数になっています

(define rm
  (lambda (a l oh)
    (cond
      ((null? l) (oh (quote no)))
      ((atom? (car l))
       (if (eq? (car l) a)
           (cdr l)
           (cons (car l) (rm a (cdr l) oh))))
      (else
       (if (atom? 
            (let/cc oh
              (rm a (car l) oh)))
           (cons (car l) (rm a (cdr l) oh))
           (cons (rm a (car l) 0) (cdr l)))))))

lが空リストの時

空リストを見つけると、継続ohを使って(quote no)を返します
空リストを見つけたということは、lをたどる途中でaに出会わなかったということですね

なぜ(quote no)なのかというと
失敗した時にリストを返してしまうと成功なのか失敗なのか判定できないからです
成功した時はリストを返し、失敗した時はアトムを返します
アトムであればnoだろうがyesだろうが問題ありません

leftmostでは失敗したとき(quote ())を返していました
失敗の値を何にするのか都度考えないといけないんでしょうか
リストもアトムも返すし失敗もする、っていう関数は作れないんでしょうか
ちょっと嫌ですね

ohで戻ったときにどうなるかはまだわかりません
気にしないで先へ進みます

lがアトムの時

(car l)がアトムの時の処理は普通です
ohはそのまま渡しているということは押さえておきます

lがリストの時

(car l)がアトムでなかった、つまりリストだった場合は(car l)rmを適用します

このとき、あらたに現時点の継続をohにセットしてからrmを評価しています
(car l)の中にaが含まれているかどうかをテストするのが目的なので
もらってきたそのままohを渡してどこかにすっとばされては困りますから

で、アトム(つまりno)が返ってきた場合
(car l)aが含まれなかったということなので
(rm a (car l) oh))で本来求めたかった値は(car l)ということになります
(car l)と、(cdr l)からaを取り除いたもの、
つまり(rm a (cdr l) oh))consします

cdr側にもaがなかったらどうなるんでしょうか
そうすると、値をnoとして(呼び出し元からもらった方の)ohに戻ります
たぶんそこでaが含まれてなかったぞ、と判定されてなんやらかんやら

そうでなければ、(car l)aが含まれているということなので
(rm a (car l) 0))の値に(cdr l)consします

って、(rm a (car l) 0))ってなんでしょうか?
0って?

rmがうまくアトムを取り除いてくれることがわかっていますから、方位磁針は必要ありません。

つまり (rm a (car l) 0)を使うことができるという意味ですか。

はい。どんな値でも大丈夫です。0は簡単な引数です。

なんでもいいなら()でもnoでもohでも渡していいってことですね
oh渡せば(rm a (car l) oh))になってletでまとめられそう

今回の継続は
空リストを見つけたとき、今までは素直に空リストを返してたところで
空リストではなく(ショートカットして)アトムを返すために使われている
ということになりますね

rmの動作

動作を追うとこんな感じ

  (let/cc Say (rm 'a '((b) c (b)) Say))
= (let/cc Say (if (atom? (let/cc oh (rm 'a '(b) oh))) ...))
= (let/cc Say (if (atom? (let/cc oh (cons 'b (rm 'a '() oh)))) ...))
= (let/cc Say (if (atom? (let/cc oh (cons 'a (oh 'no)))) ...))
= (let/cc Say (if (atom? 'no) ...))
= (let/cc Say (cons '(b) (rm 'a '(c (b)) Say)))
= (let/cc Say (cons '(b) (cons 'c (rm 'a '((b)) Say))))
= (let/cc Say (cons '(b) (cons 'c (if (atom? (let/cc oh (rm 'a '() oh))) ...))))
= (let/cc Say (cons '(b) (cons 'c (if (atom? 'no) ...))))
= (let/cc Say (cons '(b) (cons 'c (cons '(b) (rm 'a '() Say)))))
= (let/cc Say (cons '(b) (cons 'c (cons '(b) (Say 'no)))))
= 'no

本の例をもとにしたんですが、ふたつめのifのelse部分を通ってないので
カバー率が100%になってません
let/ccが入って、カバーすべきケースを思い浮かべるのが大変になってきた気がします
まじめにテスト項目あげようと思ったら頭痛くなるかも

バージョン1

呼び出し側を作ればいったんできあがりです

(define rember1*4
  (lambda (a l)
    (if (atom? (let/cc oh (rm a l oh)))
        l
        (rm a l (quote ())))))

こんどは使わない継続に(quote ())ですかやめれ
わざとなの?

バージョン2

letを使うとあら不思議・・・

(define rember1*5
  (lambda (a l)
    (let ((new-l (let/cc oh (rm5 a l oh))))
      (if (atom? new-l)
          l
          new-l))))
  
(define rm5
  (lambda (a l oh)
    (cond
      ((null? l) (oh (quote no)))
      ((atom? (car l))
       (if (eq? (car l) a)
           (cdr l)
           (cons (car l) (rm5 a (cdr l) oh))))
      (else
       (let ((new-car (let/cc oh (rm5 a (car l) oh))))
         (if (atom? new-car)
             (cons (car l) (rm5 a (cdr l) oh))
             (cons new-car (cdr l))))))))

(rm a (car l) 0)(rm a l (quote ()))が消えてしまいます

って、やっぱ2回評価される式にletで名前をつける、って言うんなら
同じ式じゃないとよくないんじゃないですかねえ
使われない引数だから何を渡しても結果は同じ
だからletでまとめてもやっぱり結果は同じなんでしょうけど

使われないことに意味がある?

失敗の時の値と同様、使われない値を何にするか考えるのはどうも気分がよろしくないです

失敗した時の値を()にしたりnoにしたり
使われない値を渡すときの値を0にしたり()にしたり
ここまで一貫して一貫性がないのはなにか言いたいことが隠されているに違いない
返されない値や使われない値として適切なものを都度探す必要があるのは面倒

なにかひとつ他には絶対に使われない値を用意しておいたほうがすっきりするでしょうか?

最終版

そしてこんな書き方が紹介されます。

(define rember1*6
  (lambda (a l)
    (try oh (rm5 a l oh) l)))

(define rm6
  (lambda (a l oh)
    (cond
      ((null? l) (oh (quote no)))
      ((atom? (car l))
       (if (eq? (car l) a)
           (cdr l)
           (cons (car l) (rm6 a (cdr l) oh))))
      (else
       (try oh2
            (cons (rm6 a (car l) oh2) (cdr l))
            (cons (car l) (rm6 a (cdr l) oh)))))))

使われない引数に0や()を渡している部分は消えてしまいました

(quote no)についても

この版のrember1*は、noがアトムでないと動きませんか。

いいえ。

と言い切っているのでアトムですらなくて良いということに
うーむ

tryって

注には以下のように書いてあります

`(and ...)、(try ...)などは省略形です。

(try x α β)
=
(letcc success
  (letcc x
    (success α))
  β)

名前successはαやβの中に現れてはいけません。

αを評価して、普通に評価できたら次にβを評価するはずのところを忘れて
αを評価した値をそのまま返し、
αを評価中に継続xが呼び出されたらαの評価は中断してβの値を返す

他の言語ではraiseとかthrowと書くところをxと書けばだいたい似た感じ

ということが落ち着いて読めばわかるんですが、
letccが入れ子で書いてあるとなんだかややこしく見えてしまいます
if ... then ... else ... をgotoで書いているような感じに近いかなあ
慣れですかねえ

andschemeに含まれているようにtryも含まれているのかと思いましたが
どうも含まれてない模様
例外の種類も渡せないし単純すぎて実用できないのかも
Racketには例外処理が最初からついてきますが、書き方が違うっぽいです
そこでマクロ定義方法をちょっと調べて作りました
上の定義をほとんどそのまま引き写し

(define-syntax-rule (try x a b)
  (let/cc success
    (let/cc x (success a))
    b))

これで上のコードも動いています
意外と簡単

何を教えてくれようとしたの?

結局のところ、失敗の時はtryを使え、それで万事うまくいく、っていう教えだったんでしょうか
それとも、tryみたいなやつはletccで作れるよ!って話?

どうも()を返したりnoを返したりしてるあたりがひっかかってて
読み取るべきことが読み取れたのか不安です

#成功した場合にあらゆる値を返せて、しかも失敗だったという情報もくっつけられて、
#でもいちいち失敗だったという情報をチェックしなくていい一貫性のある方法が・・・
#なんて言いはじめると違う言語の話になってしまうかな

Scheme修行(4) 第14章 名前をつけましょう

やっとletがでてきます
letをletrecよりletccより後でとりあげたのはどういうことなんでしょう?

leftmost

一番左のアトムを探すleftmostです

(define leftmost
  (lambda (l)
    (cond ((atom? (car l)) (car l))
          (else (leftmost (car l))))))

これは引数に空リストを含まないことが前提になっているので
空リストを含んでいてもよいようにしてやります

(define leftmost2
  (lambda (l)
    (cond ((null? l) (quote ()))
          ((atom? (car l)) (car l))
          (else (cond
                  ((atom? (leftmost2 (car l)))
                   (leftmost2 (car l)))
                  (else (leftmost2 (cdr l))))))))

ちょっと見慣れない形かと思いましたが
よくみると第4の戒律の、S式のリストを扱う形です
(car l)の一番左がアトムだったら(cdr l)を評価してやる必要は
ないのでcondが二重になってますがそこに惑わされました

(null? l)だったときに()を返しているのは
たとえば#fを返すようにすると一番左のアトムが#fだった場合と区別がつかないからです
ちょっと訳がわかりづらかった・・・

condの中の((atom? (leftmost2 (car l))) (leftmost2 (car l)))
(leftmost2 (car l))を2回評価しているのがもったいないですね

そのような望ましくない繰り返しを防ぐために、(letrec ...)を用いてみましょう。

はい。でも、(letrec ...)で好きなものに名前をつけるのですか?

代わりに(let ...)を使います。

こう

(define leftmost3
  (lambda (l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l)) (car l))
      (else
       (let ((a (leftmost3 (car l))))
         (cond
           ((atom? a) a)
           (else (leftmost3 (cdr l)))))))))

わからないのはこれ

(letrec ...)と見かけは同じですが、(let ...)は式の値に名前をつけるのです。

letrecだって式の値に名前をつけてるんじゃないかと思います先生!
違いは名前の見えてるスコープだけのような気がするんですが
どういうことでしょうか

次はS式から最初に見つかったアトムだけを削除するrember1*を作ります
これはまあ練習です
(eqlist? (R (car l)) (car l))という条件はなんだろうと思いましたが
言い換えると「carにaが含まれていなければ」という意味ですね

第15の戒律(仮)
繰り返される式の値に名づくるには(let ...)を用うべし。

depth*

リストの深さを求めるdepth*です

(define depth*
  (lambda (l)
    (cond ((null? l) 1)
          ((atom? (car l)) (depth* (cdr l)))
          (else (cond ((> (depth* (cdr l))
                          (add1 (depth* (car l))))
                       (depth* (cdr l)))
                      (else
                       (add1 (depth* (car l)))))))))

(depth* (cdr l))(add1 (depth* (car l)))が2回ずつ出てきます

letで書きます

(define depth*2
  (lambda (l)
    (cond
      ((null? l) 1)
      ((atom? (car l)) (depth*2 (cdr l)))
      (else
       (let ((a (add1 (depth*2 (car l))))
             (d (depth*2 (cdr l))))
         (cond ((> d a) d)
               (else a)))))))

よく見るとまだ(depth* (cdr l))が2回出てきてます
こうすべきでしょうか?

(define depth*3
  (lambda (l)
    (cond
      ((null? l) 1)
      (else
       (let ((d (depth*3 (cdr l))))
         (cond
           ((atom? (car l)) d)
           (else
            (let ((a (add1 (depth*3 (car l)))))
              (cond
                ((> d a) d)
                (else a))))))))))

こうすると確かに(depth* (cdr l))を繰り返し書かなくてすむようになりましたが
(depth* (cdr l))を評価する回数は実は変わっていません
そのわりに、コードの方はcondletの入れ子で読みづらくなっています
ちょっとこれはやり過ぎだったようです

第15の戒律(改訂版)
関数定義において繰り返される式は、当の関数を1回使用するときに2回評価される可能性があるなら、
それらの値を名付くるに(let ...)を用うべし。

コード上に何回出てくるかよりも、実際に評価される回数を重視しましょうってことみたいです
DRY原則とはバランスの問題になるのかな

あと今になってifを紹介したり

それは賢いですね。もっと前に知っておくべきでした。

何事にも、ふさわしい時と場所があるのです。

今がその時?
なんで?

さらに関数maxを導入すると

(define depth*6
  (lambda (l)
    (cond
      ((null? l) 1)
      ((atom? (car l)) (depth*6 (cdr l)))
      (else
       (max (add1 (depth*6 (car l)))
            (depth*6 (cdr l)))))))

letが消えてしまいました
letでローカル変数を導入する代わりに関数の引数でも同じ働きができるわけですね
もともとlambdaですもんね

ついでにifも消えてぐっと見通しが良くなりました
ぱっと見でS式の再帰の形に見えますし
リファクタリング終了、って気分です
○○なら関数にする、みたいな戒律があってもよさそうな気分

leftmost(再)

leftmostではletを使うことにより同じ式を2回評価するという無駄を減らしましたが
まだ無駄があります

簡単なケースとして(leftmost '(((s))))を評価する場合
再帰を繰り返して'sにたどり着いた後、それにaという名前をつけ
aつまり'sはアトムなので'sを返す、ということを繰り返して値が求まります

1ステップずつ追うとこうです
関数名はlmと略記しました

(lm '(((s))))
(let ((a (lm '((s))))) (cond ...))
(let ((a (let ((a (lm '(s)))) (cond ...)))) (cond ...))
(let ((a (let ((a 's)) (cond ...)))) (cond ...))
(let ((a 's)) (cond ...))
's

答えは'sだとわかっているのにひとつずつ戻っていくのは無駄ですね
そこで、答えが求まったらすぐに値を返すようにします
letccを使います

こっちがこの章の本題なのかな?
いやでも「名前をつけましょう」だしなあ

こうかな・・・

(define leftmost5
  (lambda (l)
    (let/cc skip
      (letrec
          ((lm (lambda (l)
                 (cond
                   ((null? l) (quote ()))
                   ((atom? (car l)) (skip (car l)))
                   (else
                    (let ((a (lm (car l))))
                      (cond
                        ((atom? a) a)
                        (else (lm (cdr l))))))))))
        (lm l)))))

追うとこんな感じ

(leftmost5 '(((s))))
(let/cc skip (lm '(((s)))))
(let/cc skip (let ((a (lm '((s))))) (cond ...)))
(let/cc skip (let ((a (let ((a (lm '(s)))) (cond ...)))) (cond ...)))
(let/cc skip (let ((a (let ((a (skip 's))) (cond ...)))) (cond ...)))
's

終わりが速くなりました

・・・と思ったら、正解は違ってました!
そもそもaと名前を付ける必要もありませんでした
確かに

(define leftmost7
  (lambda (l)
    (let/cc skip
      (letrec
          ((lm (lambda (l)
                 (cond ((null? l) (quote ()))
                       ((atom? (car l)) (skip (car l)))
                       (else (let ()
                               (lm (car l))
                               (lm (cdr l))))))))
        (lm l)))))

動き方は同じようなものですがすっきりしました

(leftmost7 '(((s))))
(let/cc skip (lm '(((s)))))
(let/cc skip (let () (lm '((s))) (lm '())))
(let/cc skip (let () (let () (lm '(s)) (lm '())) (lm '())))
(let/cc skip (let () (let () (skip 's) (lm '())) (lm '())))
's

ループを途中で打ち切るような感じです
あ、letccをCで言うところのbreakみたいに使ったということですね

ところでletの中に複数の式が出てきました
Scheme手習いでは初

純粋に関数型のプログラムなら、複数の式を順番に実行する機能は必要ない
そんな風に考えていた時期が俺にもありました

じゃなくてそうですよね?
副作用がないということは関数の値しか使えるものがないのに
それを捨ててしまうということですから

ところがletccを使うと順番に実行する機能の使いでが発生する
letccを使ったプログラムは(いわゆる)関数型の範疇を飛び出してるってことになるんでしょうか
それまでにやろうとしてたことを忘れてしまうというのは副作用といえばこの上ない副作用ですしね
letccで得た継続の値を持ち出さない限り影響が外に及ぶことはなさそうですが

でも、手習いで出てた式の継続ならすっかり関数型の範疇内なはず
どういうことになるのかな

さてテキストの注にはlet ()の代わりにbeginとも書けるよ、と書いてありますが
実はそれも不要で、これで動きます

                       (else 
                        (lm (car l))
                        (lm (cdr l)))))))

condの後ろにはひとつしか式が書けないということにしておきたいんでしょうか
こだわりポイントが何なのかちょっとわかりません
動き方を同じように書こうとするとこんな風になると思いますが、正しさに少々不安が

(leftmost8 '(((s))))
(let/cc skip (lm '(((s)))) (lm '()))
(let/cc skip (lm '((s))) (lm '()) (lm '()))
(let/cc skip (lm '(s)) (lm '()) (lm '()) (lm '()))
(let/cc skip (skip 's) (lm '()) (lm '()) (lm '())))
's

そういう不安を起こさないように、ということかもしれません

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章はここでおしまい