SICP::2003-06-03

酒井 政裕 <sakai at tom.sfc.keio.ac.jp>
総合政策学部3年

• 式はひとつ以上の可能な値を持ちえる
• 本節では、Schemeに自動探索のための機能を組み込むことで実現
• 自動探索はPrologでもやってるよね。

特殊形式amb

• (amb <e1> <e2> ... <en>) はn個の式<ei>のひとつの値を「曖昧に」返す
• 式をひとつももたないamb式は「失敗」を表す

(define (require p)
  (if (not p) (amb)))

• (require p)はpが真でなくてはならないことをあらわす。
• => 偽ならば「失敗」する

リストの要素

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

n以上の整数

(define (an-integer-starting-from n)
  (amb n (an-integer-starting-from (+ n 1))))

• amb式の評価は時を多くの分岐に分け、 各分岐では式の一つの可能な値が続くと考えられる。 ambは非決定的な選択点を表現する。
• 実現方法
  • すべての分岐を並列に実行
  • バックトラッキングにより逐次的に実行。
    • 評価機は各選択点で第一の道を選択する
    • 「失敗」したら、直前の選択点にもどり次の道を選択する

本節ではバックトラッキングを選択

• amb評価機は最初の成功した値しか表示しない

• 次の成功した値を表示するには、記号try-againでバックトラック

  > (prime-sum-pair '(19 27 30) '(11 36 58))
  (3 20)
  > try-again
  (3 110)
  ...

• 単純な論理パズル
• 自然言語の構文解析

を例としてとりあげる。

非決定プログラムラムの長所

• 探索の仕方の細部を押し隠す事ができる
• => より高い抽象レベルで表現できる

• いわゆる バックトラッキング・パーサー
• 再起降下法

• (define nouns '(noun student professor cat class))
• (define verbs '(verb studies lectures eats sleeps))
• 先頭が品詞名
• 残りがその品詞の語

「The cat eats」

(sentense (naun-phrase (article the) (naun cat))
          (verb eats))

句構造文法の生成規則を、そのまま関数呼び出しに対応させる。

;; S -> NP V
(define (parse-sentence)
  (list 'sentence
         (parse-noun-phrase)
         (parse-word verbs)))

;; NP -> A N
(define (parse-noun-phrase)
  (list 'noun-phrase
        (parse-word articles)
        (parse-word nouns)))

• 最終的にはparse-wordによって語を扱う
• *unparsed* : 文のまだ読んでいない部分を入れておく

• *unparsed*の先頭が与えられた品詞であるかをチェックして読み進める

  (define (parse-word word-list)
    (require (not (null? *unparsed*)))
    (require (memq (car *unparsed*) (cdr word-list)))
    (let ((found-word (car *unparsed*)))
      (set! *unparsed* (cdr *unparsed*))
      (list (car word-list) found-word)))

値を評価したとき

• 通常のScheme
  1. 値が返る
  2. 停止しない
  3. エラーになる

非決定性Schemeではこれに加えて、「袋小路」の可能性がある。

継続 = その後に行われるべき計算の全体

• [[x]]ρ = λk.(k (ρx) )
• [[λx.M]]ρ = λk.k(λv.λk'.([[M]](ρ[x|->v]) k') )
• [[E1 E2]]ρ = λk.[[E1]]ρ(λf.[[E2]]ρ(λa.f a k) )

でのkが継続。

• 評価機の実行手続きは3つの引数をとる
  1. 環境
  2. 成功継続
  3. 失敗継続
• 成功継続 = 値(と失敗継続)を受け取り計算を続行する手続き
• 失敗継続 = 非決定プロセスの別の道を試みる手続き

• amb式 - 選択が袋小路に至ったときに別の選択をするため
• トップレベルの駆動ループ - 選択を使い切った時、失敗を報告する機構を用意するため
• 代入 - 失敗を横取りし、バックトラック中に代入を元に戻すため

• 構文手続き, データ表現手続き, analyze は、amb特殊形式を扱うコード以外は、これまでとほぼ同様

(define (ambeval exp env succeed fail)
  ((analyze exp) env succeed fail))

実行形式の一般形は

(lambda (env succeed fail)
   ;; succeed は (lambda (value fail) ...)
   ;; fail は (lambda () ...)
   ...)

• 複雑さの殆んどは実行手続きが互いに呼び出すときの、 継続を引き渡す機構に由来する。

• 継続を管理すること以外は、これまでとほぼ同じ

(define (analyze-self-evaluating exp)
  (lambda (env succeed fail)
    (succeed exp fail)))

(define (analyze-quoted exp)
  (let ((qval (text-of-quotation exp)))
    (lambda (env succeed fail)
	(succeed qval fail))))

(define (analyze-variable exp)
  (lambda (env succeed fail)
    (succeed (lookup-variable-value exp env)
	       fail)))

(define (analyze-lambda exp)
  (let ((vars (lambda-parameters exp))
	  (bproc (analyze-sequence (lambda-body exp))))
    (lambda (env succeed fail)
	(succeed (make-procedure vars bproc env)
		 fail))))

• これも継続をたらいまわしにするだけ

(define (analyze-if exp)
  (let ((pproc (analyze (if-predicate exp)))
	  (cproc (analyze (if-consequent exp)))
	  (aproc (analyze (if-alternative exp))))
    (lambda (env succeed fail)
	(pproc env
	       ;; success continuation for evaluating the predicate
	       ;; to obtain pred-value
	       (lambda (pred-value fail2)
		 (if (true? pred-value)
		     (cproc env succeed fail2)
		     (aproc env succeed fail2)))
	       ;; failure continuation for evaluating the predicate
	       fail))))

(define (analyze-sequence exps)
  (define (sequentially a b)
    (lambda (env succeed fail)
	(a env
	   ;; success continuation for calling a
	   (lambda (a-value fail2)
	     (b env succeed fail2))
	   ;; failure continuation for calling a
	   fail)))
  (define (loop first-proc rest-procs)
    (if (null? rest-procs)
	  first-proc
	  (loop (sequentially first-proc (car rest-procs))
		(cdr rest-procs))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
	  (error "Empty sequence -- ANALYZE"))
    (loop (car procs) (cdr procs))))

• 代入は、継続をたらい回しにするのではなく、実際に使う初めての場所
• => 失敗を横取りして、代入を戻す

(define (analyze-definition exp)
  (let ((var (definition-variable exp))
	  (vproc (analyze (definition-value exp))))
    (lambda (env succeed fail)
	(vproc env                        
	       (lambda (val fail2)
		 (define-variable! var val env)
		 (succeed 'ok fail2))
	       fail))))

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

(define (analyze-application exp)
  (let ((fproc (analyze (operator exp)))
	  (aprocs (map analyze (operands exp))))
    (lambda (env succeed fail)
	(fproc env
	       (lambda (proc fail2)
		 (get-args aprocs
			   env
			   (lambda (args fail3)
			     (execute-application
			      proc args succeed fail3))
			   fail2))
	       fail))))

(define (get-args aprocs env succeed fail)
  (if (null? aprocs)
	(succeed '() fail)
	((car aprocs) env
		      ;; success continuation for this aproc
		      (lambda (arg fail2)
			(get-args (cdr aprocs)
				  env
				  ;; success continuation for recursive
				  ;; call to get-args
				  (lambda (args fail3)
				    (succeed (cons arg args)
					     fail3))
				  fail2))
		      fail)))

(define (execute-application proc args succeed fail)
  (cond ((primitive-procedure? proc)
	   (succeed (apply-primitive-procedure proc args)
		    fail))
	  ((compound-procedure? proc)
	   ((procedure-body proc)
	    (extend-environment (procedure-parameters proc)
				args
				(procedure-environment proc))
	    succeed
	    fail))
	  (else
	   (error
	    "Unknown procedure type -- EXECUTE-APPLICATION"
	    proc))))

(define (analyze-amb exp)
  (let ((cprocs (map analyze (amb-choices exp))))
    (lambda (env succeed fail)
	(define (try-next choices)
	  (if (null? choices)
	      (fail)
	      ((car choices) env
			     succeed
			     (lambda ()
			       (try-next (cdr choices))))))
	(try-next cprocs))))

(define input-prompt ";;; Amb-Eval input:")
(define output-prompt ";;; Amb-Eval value:")

(define (driver-loop)
  (define (internal-loop try-again)
    (prompt-for-input input-prompt)
    (let ((input (read)))
	(if (eq? input 'try-again)
	    (try-again)
	    (begin
	      (newline)
	      (display ";;; Starting a new problem ")
	      (ambeval input
		       the-global-environment
		       ;; ambeval success
		       (lambda (val next-alternative)
			 (announce-output output-prompt)
			 (user-print val)
			 (internal-loop next-alternative))
		       ;; ambeval failure
		       (lambda ()
			 (announce-output
			  ";;; There are no more values of")
			 (user-print input)
			 (driver-loop)))))))
  (internal-loop
   (lambda ()
     (newline)
     (display ";;; There is no current problem")
     (driver-loop))))

さぁ、練習問題を解こう(^^;