SICP問題4.77

本当は4.77～4.79は飛ばすつもりだったんですが、4.76のところで判明したnotの問題に関連した話なのでやってみることにしました。

notの評価を遅らせて、frameに必要な変数がバインドされた頃合を見計らって実行しようという話。
なんとなく簡単そうに思えたんですが、実際には苦戦しました。

まず第一にわからなかったのが、それで本当にできるの？というもので、ようは

(and (not (job ?x (computer programmer)))
       (supervisor ?x ?y))

こういうのはもちろん、ちょっと無理やりだけど

(and (job  ?x (computer . ?y))
       (or (and (salary ?x ?amo)
                  (not (lisp-value <= ?amo 30000)))
           (not (supervisor ?x (Bitdiddle Ben)))))

とかで、notを後で実行するようにした場合に、orやandの性質は守られるのだろうかということだったんですが、よく考えてみると、orもandもありうるframeのパターン全部を返しているわけで、orの場合はnotが遅延されているframeとnotと関係ないframeが作られる、andの場合はnotが遅延されているframeがそうでないframeと混ぜ合わされるわけで、結局のところ、最終的にできたframeに対してフィルタをかけて、生き残ったもののみ表示してやれば結果は同じになるわけです。
と、あってるかどうかはともかく納得のいったところで実装に入ったわけですが、やり方自体は本に書いてあるとおり、frameに「約束」を混ぜ込んでおいて、最後の最後、出力する直前に遅らせておいたフィルタを実行するということにしました（フィルタリングはできるだけ早く実行したい、という要望は却下）。

できあがったものはこちら

ダウンロード

で、4.76でやったマージ版andで動くかなーっとやってみたところしっかりlives-nearとか実行してみたところうまい具合に動きました（andの実装バグってましたが）。
一応

    (rule (replace2 ?person-1 ?person-2)
          (and (job ?person-1 ?job-1)
               (job ?person-2 ?job-2)
               (or (same ?job-1 ?job-2)
                   (can-do-job ?job-1 ?job-2))
               (not (not (not (same ?person-1 ?person-2))))))

みたいなnotの入れ子もできるようになってます。
前にも書きましたが脳みそがついていっていないので、コードは汚いですが、何かのご参考に。

SICP問題4.76

すみません、バグってました。下のほうの追記読んでください。

いろいろ忙しくて1週間くらい考えてました。
こういう問題やっとくと、なんとなくわかっていたつもりだったのが、実はぜんぜんわかってないことに気づいたりするので、できる限りは手を出すようにしてます。

frameを引き継いでマッチをかけていく方式から、別々にマッチしたフレームを矛盾がなければ混ぜ合わせる方式にするという問題。

方針は結構最初の方から頭にあって
1.2つのフレームの片方にしかない変数は無条件でマージしてよい
2.両方のフレームにある変数について
　2-1.そのvalueが変数でない場合は単純に比較する
　　2-1-1.一致した場合はマージしてよい
　　2-1-2.一致しなかった場合はフレームは矛盾しており、マージはできないとみなす
　2-2.そのvalueがまた変数だった場合は、そのバインドを探してまた比較する
てな感じに考えていたんですが、いざこれを実装しようとすると、本文のようなシンプルかつ綺麗にいかず苦心しました。
以下ソース

; andその2
(define (conjoin2 conjuncts frame-stream)
  (if (empty-conjunction? conjuncts)
    frame-stream
    (let ((join1 (qeval (first-conjunct conjuncts)
                        frame-stream))
          (join2 (conjoin2 (rest-conjuncts conjuncts)
                          frame-stream)))
      (stream-flatmap (lambda (frame1)
                        (stream-flatmap (lambda (frame2)
                                          (let ((result (merge-frame frame1 frame2)))
                                            (if (eq? result 'false)
                                              the-empty-stream
                                              (singleton-stream result))))
                                    join2))
                      join1))))

(define (merge-frame frame1 frame2)
  (if (null? frame1)
    frame2
    (let ((binding (first-binding frame1)))
      (let ((var (binding-variable binding))
            (val (binding-value binding)))
        (let ((binding2 (binding-in-frame var frame2)))
          (if binding2
            (let ((match-result (merge-possible? val frame1
                                                 (binding-value binding2) frame2)))
              (if match-result
                (merge-frame (rest-bindings frame1) frame2)
                'false))
            (merge-frame (rest-bindings frame1)
                         (extend var val frame2))))))))

(define (merge-possible? val1 frame1 val2 frame2)
  (cond ((equal? val1 val2) true)
        ((var? val1)
         (let ((binding (binding-in-frame val1 frame1)))
           (if binding
             (merge-possible? (binding-value binding) frame1
                              val2 frame2)
             (merge-possible? (contract-question-mark val1) frame1
                              val2 frame2))))
        ((var? val2)
         (let ((binding (binding-in-frame val2 frame2)))
           (if binding
             (merge-possible? val1 frame1
                              (binding-value binding) frame2)
             (merge-possible? val1 frame1
                              (contract-question-mark val2) frame2))))
        ((and (pair? val1) (pair? val2))
         (and (merge-possible? (car val1) frame1
                               (car val2) frame2)
              (merge-possible? (cdr val1) frame1
                               (cdr val2) frame2)))
        (else
          false)))

(put 'and 'qeval conjoin2)

一応、簡単な質問

(and (address ?x ?y) (supervisor ?x ?z))

とか

(and (job ?p (computer programmer)) (salary ?p ?amo) (supervisor ?p ?sv))

みたいなのには答えられたのですが、悲しいかなruleが全然動きません。

(lives-near (Bitdiddle Ben) ?x)

ですら無理です。

    (rule (lives-near ?person-1 ?person-2)
          (and (address ?person-1 (?town . ?rest1))
               (address ?person-2 (?town . ?rest2))
               (not (same ?person-1 ?person-2))))

で、まあ上のを眺めていて気づいたんですが、よく考えたらnotを単独で処理したって結果返ってくるわけないんですよね。あと、

    (rule (reverse (?x . ?y) ?z)
          (and (reverse ?y ?u)
               (append-to-form ?u (?x) ?z)))

これも(reverse (1 2) ?x)に答えようとした場合、(append-to-form ?u (1) ?z)に答えないといけないわけで、これを単独で実行しても結果が返ってこないんですよね（私の環境ではそうでした）。
と、いうところで心が折れました。
まあ、一応簡単なのには答えられたからいいかなーっと思ってます。

続きを読む "SICP問題4.76"

SICP問題4.68

reverseのruleを作る問題。
ヒーコラいいながらも何とか動いたのでメモ。
最初の案

(rule (reverse (?x) (?x)))
(rule (reverse (?x . ?y) (?z . ?x))
      (reverse ?y ?z))

あきらかになにか勘違いしてます。

で、append-to-formを使うというヒントを頼りにウンウンうなってたわけですが、ふと所詮andもorもnotもフィルタだよなあ、とピンときて

    (rule (reverse (?x ?y) (?y ?x)))
    (rule (reverse (?x . ?y) ?z)
          (and (reverse ?y ?u)
               (append-to-form ?u (?x) ?z)))

こうなりました。まあこれでもほぼ動くんですが、よく考えてみると(reverse (1) ?x)が動かないことに気づいて、1個のときのルールを追加して

    (rule (reverse (?x) (?x)))
    (rule (reverse (?x ?y) (?y ?x)))
    (rule (reverse (?x . ?y) ?z)
          (and (reverse ?y ?u)
               (append-to-form ?u (?x) ?z)))

いやあよかったよかったと思ったら今度は答えが2重にでてくるという残念な問題が。
まあ、余計にあたることはよくあることだね、と自分に言い聞かせつつ風呂に入っていたわけですが、そこでようやく、ああ、この問題って、要は普通のschemeでやってることを別の形でやってるだけだなあと気づきまして、最終的に

    (rule (reverse (?x) (?x)))
    (rule (reverse (?x . ?y) ?z)
          (and (reverse ?y ?u)
               (append-to-form ?u (?x) ?z)))

これになりました。
よく考えたら2個のときのルールなんていらなかったというオチです。
いちおう(reverse (1 2 3) ?x)とか(reverse (1 (2 3) 4) ?x)とかでもそれなりにちゃんとした答えは返ってきている模様。
ちなみに(reverse ?x (1 2))はかえってきませんでした。なぜかは聞かないでください。

SICP-4.70

こういう問題はやってみるのに限る。
と、いうわけで

1.
(define THE-TEST the-empty-stream)
(define (a b) (set! THE-TEST (cons-stream b THE-TEST)))

2.
(define THE-TEST the-empty-stream)
(define (a b) (let ((c THE-TEST)) (set! THE-TEST (cons-stream b c))))

の2種類で、
(a 3) (a 2) (a 1) (define c (a 0))
とやったのち(stream-ref 0)・・・(stream-ref 3)とやってみた。
結果、1はずっと0、2は0,1,2,3となる。

なぜそうなるのか。
私に聞かないでください。
まあ、ヒントの時点で1のほうがonesのように最初のcarの連続になるのは想像ついていたんですが。
おそらくletのところのdefineすることで循環が防げているのだと思われます。