exerise 4.50-54

むーん。ということで再掲その3。RSSとかでこの記事確認してる方に色々混乱させてしまい申し訳ないです。(といってもここのRSS見てる人殆どいない気もするが)

exercise 4.50

ambの選択をランダムに行うrambを作る。
ついでに4.49をrambを使ってもう一回だとか。

言われたとおりにrambを作ったのが以下。

(use srfi-27)

(define (ramb? exp) (tagged-list? exp 'ramb))
(define (ramb-choices exp) (cdr exp))

(define (analyze exp)
  (cond ((self-evaluating? exp) 
         (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((let? exp) (analyze (let->combination exp))) ;**
        ((amb? exp) (analyze-amb exp))                ;**
        ((ramb? exp) (analyze-ramb exp))              ;;追加。
        ((application? exp) (analyze-application exp))
        (else
         (error "Unknown expression type -- ANALYZE" exp))))

(define (analyze-ramb exp)
  (let ((cprocs (map analyze (ramb-choices exp))))
    (define (delete x seq)
      (cond ((null? seq) '())
            ((equal? x (car seq)) (cdr seq))
            (else (cons (car seq) (delete x (cdr seq))))))
    (lambda (env succeed fail)
      (define (try-next choices)
        (if (null? choices)
            (fail)
            (let ((ret (list-ref choices (random-integer (length choices)))))
              (ret
               env
               succeed
               (lambda ()
                 (try-next (delete ret choices)))))))
      (try-next cprocs))))

analyze-rambの中のdeleteは要素一つの削除。srfi-1のdeleteはマッチする要素を全て削除なので微妙に違う・・・。
以下にテストした例。

(define (require p)
  (if (not p) (ramb)))

(define (an-element-of items)
  (require (not (null? items)))
  (ramb (car items) (an-element-of (cdr items))))

そして実行。

;;; Amb-Eval input:
(an-element-of '(1 2 3))

;;; Starting a new problem 
;;; Amb-Eval value:
3

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
2

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
1

;;; Amb-Eval input:
try-again

;;; There are no more values of
(an-element-of '(1 2 3))

できてると信じて4.49の問題へ戻る
前回の記事で書いたが、ambを用いると再帰でひたすら深くもぐっていって変な文章しかできない。というわけでrambを使ってみると・・・。

;;; Amb-Eval input:
(generate-sentence)

;;; Starting a new problem 
;;; Amb-Eval value:
(sentence (noun-phrase (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun cat)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun cat)))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun cat)))))) (prep-phrase (prep to) (simple-noun-phrase (article a) (noun professor)))) (verb lectures))

try-againしたら深く深く再帰して凄いことになったので省略。載せられんがな。

exercise 4.51

バックトレースの影響を受けないparmanent-set!を作る問題。

もともとのanalyze-assignmentの失敗継続で、set!の巻き戻しをしてる部分を取り除けば良い。

(define (parmanent-assignment? exp) (tagged-list? exp 'parmanent-set!))

(define (analyze exp)
  (cond ((self-evaluating? exp) 
         (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((parmanent-assignment? exp) (analyze-parmanent-assignment exp)) ;;追加
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((let? exp) (analyze (let->combination exp))) ;**
        ((amb? exp) (analyze-amb exp))                ;**
        ((application? exp) (analyze-application exp))
        (else
         (error "Unknown expression type -- ANALYZE" exp))))

(define (analyze-parmanent-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)
               (let ((old-value
                      (lookup-variable-value var env))) 
                 (set-variable-value! var val env)
                 (succeed 'ok
                          fail2)))
             fail))))

以下文中の実行例。

;;; Starting a new problem 
;;; Amb-Eval value:
(a b 2)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(a c 3)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(b a 4)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(b c 6)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(c a 7)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(c b 8)

;;; Amb-Eval input:
try-again

;;; There are no more values of
(let ((x (an-element-of '(a b c))) (y (an-element-of '(a b c)))) (parmanent-set! count (+ count 1)) (require (not (eq? x y))) (list x y count))

;;; Amb-Eval input:
count

;;; Starting a new problem 
;;; Amb-Eval value:
9

3要素が2つだったので探索は9回行われているはず
これがcountと一致してるので多分できてるでしょう。
ちなみにparmanent-set!の代わりにset!使えばcountは0のまま。

exercise 4.52

if-failを作れ ってな問題。
第一引数(special-formだけどこの呼び方でいいのかな)が失敗した場合、二つ目の引数を返すようにすればいいらしい。

以下に実装。

(define (if-fail? exp) (tagged-list? exp 'if-fail))

(define (analyze exp)
  (cond ((self-evaluating? exp) 
         (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((parmanent-assignment? exp) (analyze-parmanent-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((if-fail? exp) (analyze-if-fail exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((let? exp) (analyze (let->combination exp))) ;**
        ((amb? exp) (analyze-amb exp))                ;**
        ((application? exp) (analyze-application exp))
        (else
         (error "Unknown expression type -- ANALYZE" exp))))

(define (analyze-if-fail exp)
  (let ((proc1 (analyze (cadr exp)))
        (proc2 (analyze (caddr exp))))
    (lambda (env succeed fail)
      (proc1 env
             succeed
             (lambda () (proc2 env succeed fail))))))

proc1とかproc2の名前の適当さはどうしたもんか。
あとセレクタに名前付けた方が格好がついたかな、if-fail-first-expとか。

実行例は本のまんまなのでパス。それに次の問題でも動かすし。

exercise 4.53

以下のコードはどうなるか って問題。
問題のコードは以下。(prime-sum-pairは自分で定義。前にあったはず)

(let ((pairs '()))
  (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
             (parmanent-set! pairs (cons p pairs))
             (amb))
           pairs))

parmanent-set!を使ってpairsにprime-sum-pairの結果を格納していってるので、結果は prime-sum-pairのリストになるはず。
以下に実行例。

;;; Amb-Eval input:
(let ((pairs '()))
  (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
             (parmanent-set! pairs (cons p pairs))
             (amb))
           pairs))


;;; Starting a new problem 
;;; Amb-Eval value:
((8 35) (3 110) (3 20))

確かに予想通り。こういう使い方はおもしろいな。
でもこれってambでできる気がする。実際、

;;; Amb-Eval input:
(let ((pairs '()))
  (amb (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
             (parmanent-set! pairs (cons p pairs))
             (amb))
           pairs))

;;; Starting a new problem 
;;; Amb-Eval value:
((8 35) (3 110) (3 20))

な訳だし。まぁif-failってのを定義して使った方が何してるのか分かり易いのかな。

exercise 4.54

requireをspecial-formに。
2行空白を埋めるだけなので簡単かな。

(define (require? exp) (tagged-list? exp 'require))
(define (require-predicate exp) (cadr exp))

(define (analyze-require exp)
  (let ((pproc (analyze (require-predicate exp))))
    (lambda (env succeed fail)
      (pproc env
             (lambda (pred-value fail2)
               (if (not pred-value)
                   (fail2)
                   (succeed 'ok fail2)))
             fail))))

動作はan-element-ofとかで適当に試した。動いたし書くの省略。書いても面白くもないし。
という訳で4.3の演習終了。やっと読書会に追いついた。