@uents blog

Code wins arguments.

SICP 読書ノート#59 - 4.3 非決定性計算 - call/ccによるambオペレータの実装 (pp.245)

SICP Scheme

前回で継続やcall/ccの振る舞いはつかめたので、今回はambオペレータをcall/ccで実装します。

ソースコードは以下に置いています。

amb評価器を動作させる

まずは動かしてみないとambが何者かすらわからないので動かしてみる。

1. SICP本家からサンプルコードをダウンロード

% curl -O https://mitpress.mit.edu/sicp/code/ch4-ambeval.scm
% curl -O https://mitpress.mit.edu/sicp/code/ch4-mceval.scm

2. Racket処理系で解釈できるようにいくつか修正

§4.2の遅延評価器の時とほぼ同じことをやればよい。

ch4-ambeval.scm

  • ファイルの先頭に#lang racketのシェバンを追加
  • ch4-mceval.scmのロード処理をloadからincludeに変更
(require racket/include)
(include "ch4-mceval.scm")
  • ファイルの終端に以下を追加
(define the-global-environment (setup-environment))
(driver-loop)

ch4-mceval.scm

  • ファイルの先頭に(require r5rs)を追加
  • Racket処理系やch4-ambeval.scmと重複している定義をコメントアウト
    • eval
    • apply
    • primitive-procedures
    • input-prompt
    • output-prompt
    • driver-loop

3. amb評価器を起動

ch4-ambeval.scmをロードすると遅延評価器のREPLが起きて入力プロンプトが表示される。

racket@> ,enter "ch4-ambeval.scm"
'METACIRCULAR-EVALUATOR-LOADED
'AMB-EVALUATOR-LOADED

;;; Amb-Eval input:

amb評価器の仕様

amb評価器のインターフェース

amb評価器のREPL(driver-loop)で、(amb 1 2 3)とした場合、1,2,3の選択肢の集合が評価器にセットされ、どれかひとつが返される。すでに選択肢がセットされていた場合、これまでのものは捨てられ、与えられた選択肢がセットされる。

;;; Amb-Eval input:
(amb 1 2 3)

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

さらに'try-againとすると、残りの選択肢からひとつ返される

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
2

さらに'try-againを続けていき、選択肢がなくなった場合、There are no more values of ...とprintされる

;;; Amb-Eval input:
try-again

;;; There are no more values of
(amb 1 2 3)

また、REPLではなくコード上で(amb <choices> ...)を呼ぶ場合、

  • <choices>がある場合、新たな選択肢の集合が追加される
  • <choices>がない場合、残りの選択肢からひとつ返される ('try-againと同じ)

となる。

選択肢のうちどれが選択されるか本質的にはわからない。このような処理を非決定性計算（または非決定性オートマトン）と呼ぶらしい。

ambの選択肢の探索

例えば、以下のようなコードをamb評価器のREPLに与えると、

;;; Amb-Eval input:
(let ((x (amb 1 2 3))
      (y (amb 'a 'b)))
  (list x y))

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

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(1 b)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(2 a)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(2 b)

;;; Amb-Eval input:
try-again

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

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(3 b)

;;; Amb-Eval input:
try-again

;;; There are no more values of
(let ((x (amb 1 2 3)) (y (amb (quote a) (quote b)))) (list x y))

;;; Amb-Eval input:
try-again

;;; There is no current problem

集合 '(1 2 3) と '(a b) の内積を逐次返すコードとなる。

これをみても分かるように'try-againとすると、以前の選択点に戻って別の選択肢を返していることがわかる。このように以前の選択点へ戻る処理を「バックトラック」と呼ぶ。

call/ccによるambオペレータの実装

ここからが本題。

SICPテキストのamb評価器を使うと、Racketの豊富な組み込みライブラリの恩恵が受けられないので、この先この評価器を使って問題を解いていくのは辛そう。

そこでambオペレータをcall/ccを使って実装する。まぁ、On Lispのコードを少し改変しただけですが。。

まず、与えられた選択肢からひとつを選び、残りの選択肢をキュー（コード上の*alternatives*）にpushする手続きchooseを実装する。

(define *alternatives* '())

(define (choose choices)
  (if (null? choices)
      (try-again)
      (call/cc
       (lambda (cc)
         (set! *alternatives*
               (cons
                (lambda ()
                  (cc (choose (cdr choices))))
                *alternatives*))
         (car choices)))))

残りの選択肢をキューにpushする際に(lambda () (cc (choose (cdr choices))))とccを付けるのがポイント。ccを呼ぶことで、残りの選択肢から選ぶ度に(amb <choices> ...)を実行したコンテキストへジャンプすることができる。

次に、残りの選択肢*alternatives*から選び直す手続きtry-againを実装する。これは*alternatives*から手続きをpopし実行するだけなので、わかりやすい。

この時のnextは上記の(lambda () (cc (choose (cdr choices))))に相当。つまりnextを作用させることでバックトラックを引き起こす。

(define try-again false)
    
(call/cc
 (lambda (cc)
   (set! try-again
         (lambda ()
           (if (null? *alternatives*)
               (cc '(there are no more values))
               (let ((next (car *alternatives*)))
                 (set! *alternatives* (cdr *alternatives*))
                 (next)))))))

あとは、chooseのラッパーとしてambを定義。

(define (amb . choices)
  (choose choices))

上記をamb.scmというファイルで保存し、Racket REPLで動かしてみる。

racket@> (require "amb.scm")
racket@> (let ((x (amb 1 2 3))
               (y (amb 'a 'b)))
           (list x y))
'(1 a)
racket@> (try-again)
'(1 b)
racket@> (try-again)
'(2 a)
racket@> (try-again)
'(2 b)
racket@> (try-again)
'(3 a)
racket@> (try-again)
'(3 b)
racket@> (try-again)
'(there are no more values)

できた！

このときの動作は以下のようになる。

  1. (let ...)で
    • (choose '(2 3))が*alternatives*にpushされ、xに1が束縛される
    • (choose '(b))が*alternatives*にpushされ、yに'aが束縛される
    • '(1 a)が返る
  2. (try-again)で
    • (choose '(b))がバックトラックされ
      • xには1が束縛されたまま
      • (choose '())が*alternatives*にpushされ、yに'bが束縛される
      • '(1 b)が返る
  3. (try-again)で
    • (choose '())がバックトラックされると、(try-again)が実行される
    • (choose '(2 3))がバックトラックされ
      • (choose '(3))が*alternatives*にpushされ、xに2が束縛される
      • (choose '(b))が*alternatives*にpushされ、yに'aが束縛される
      • '(2 a)が返る

後の(try-again)もこれの繰り返しです。

ambオペレータの基本手続き

まずはrequireだが、Racket組み込みのrequireを奪われるとさすがに辛いので、reqという名前で定義する。また、Racketはif構文でaltenative節がないのを許さないので、適当にfalseを返すようにしておく。

(define (req p)
  (if (not p) (amb) false))

次にan-element-of。SICPの通りの実装では、

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

実行時にamb手続きの引数が先に評価されてしまうので、an-element-ofの評価の無限ループに嵌まり返ってこなくなる。

そこで引数を遅延オブジェクト化する。

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

反対にambオペレータの実装となるchooseではforceさせる。

(define (choose choices)
  (if (null? choices)
      (try-again)
      (call/cc
       (lambda (cc)
         (define try-next
           (lambda () (cc (choose (cdr choices)))))
         (set! *alternatives*
               (cons try-next *alternatives*))
         (force (car choices)))))) ;; ここでforce

これでan-element-ofが動くようになった。

racket@> (an-element-of '(1 3 5))
1
racket@> (try-again)
3
racket@> (try-again)
5
racket@> (try-again)
'(there are no more values)

これでprime-sum-pairも問題なく動く。

racket@> (require math/number-theory) ;; prime?のためにロード

racket@> (define (prime-sum-pair list1 list2)
           (let ((a (an-element-of list1))
                 (b (an-element-of list2)))
             (req (prime? (+ a b)))
             (list a b)))

racket@> (prime-sum-pair '(1 3 5 8) '(20 35 110))
'(3 20)
racket@> (try-again)
'(3 110)
racket@> (try-again)
'(8 35)
racket@> (try-again)
'(there are no more values)

ただし、上記のan-element-ofは(try-agian)の度に(choose '())が*alternatives*にpushされるし、毎回delay/forceが絡むので効率はいまいち。

このambオペレータは特殊形式ではなく手続きなので、単純にapplyで実装する方がよいかもしれない。

(define (an-element-of items)
  (apply amb items))

次は§4.3の練習問題を解いていきます。

※「SICP読書ノート」の目次はこちら