kb84tkhrのブログ

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

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の裏付けといったところでしょうか
わかりません