非決定性計算ならPrologで

Prolog

問題とRubyおよびHaskellのプログラム

何かを探していて偶然面白い問題を見つけた．

Baker, Cooper, Fletcher, MillerとSmithは五階建てアパートの異なる階に住んでいる。Bakerは最上階に住むのではない。Cooperは最下階に住むのではない。Fletcherは最上階にも最下階にも住むのではない。MillerはCooperより上の階に住んでいる。SmithはFletcherの隣の階に住むのではない。FletcherはCooperの隣の階に住むのではない。それぞれはどの階に住んでいるか。

そういえばSICPで見かけた気もするけど，あまり気にしていなかった．

このRubyプログラム，継続で非決定性計算を実現しているのはともかく，それをRubyでやっているのが新鮮だった．Rubyにファーストクラス継続が導入されているなんて知らなかったから．

Haskell版はよくわからないが（Haskell勉強しなくちゃ…），非決定性計算ならPrologでしょ，ということで，Prologで書いてみた．使用処理系はSWI Prolog．

Prologに翻訳

baker(N) :- between(1,5,N).
cooper(N) :- between(1,5,N).
fletcher(N) :- between(1,5,N).
miller(N) :- between(1,5,N).
smith(N) :- between(1,5,N).

solve(Baker,Cooper,Fletcher,Miller,Smith) :-
        baker(Baker),cooper(Cooper),fletcher(Fletcher),miller(Miller),smith(Smith),
        sort([Baker,Cooper,Fletcher,Miller,Smith],[1,2,3,4,5]),
        Baker =\= 5,
        Cooper =\=1,
        Fletcher =\=1, Fletcher =\= 5,
        Miller > Cooper,
        abs(Smith - Fletcher) =\= 1,
        abs(Fletcher - Cooper) =\= 1.

実行結果は次のとおり．

?-time(solve(Baker,Cooper,Fletcher,Miller,Smith)).
% 2,475 inferences, 0.00 CPU in 0.06 seconds (0% CPU, Infinite Lips)

Baker = 3,
Cooper = 2,
Fletcher = 4,
Miller = 5,
Smith = 1 

Yes

枝刈り

しかし，SICPにも書かれているとおり，このプログラムにはあまりに無駄が多いのが気になる．生成＆検査アルゴリズムでは，できるだけ生成の深いところで無駄な枝を刈るべし，というのがセオリーなので，solve/5を書き直してみた．住人の住む階をまとめて決めずに，1つずつ決めながら制約を満たしているか確かめていくのがポイント．

baker(N) :- between(1,5,N).
cooper(N) :- between(1,5,N).
fletcher(N) :- between(1,5,N).
miller(N) :- between(1,5,N).
smith(N) :- between(1,5,N).

solve(Baker,Cooper,Fletcher,Miller,Smith) :-
        baker(Baker),
        Baker =\= 5,
        cooper(Cooper),
        Cooper =\=1,
        fletcher(Fletcher),
        Fletcher =\=1, Fletcher =\= 5,
        abs(Fletcher - Cooper) =\= 1,
        miller(Miller),
        Miller > Cooper,
        smith(Smith),
        abs(Smith - Fletcher) =\= 1,
        sort([Baker,Cooper,Fletcher,Miller,Smith],[1,2,3,4,5]).

% 568 inferences, 0.00 CPU in 0.03 seconds (0% CPU, Infinite Lips)

さらなる枝刈り

推論回数が4分の1以下に落ちているので，かなりの無駄が省けていることがわかる．毒を食らわば皿をまでと，もう少しがんばったのが以下のコード．between/3の段階で不要な枝を刈り，制約条件の順番も変えてみた．

baker(N) :- between(1,4,N).
cooper(N) :- between(2,4,N).
fletcher(N) :- between(2,4,N).
miller(N) :- between(2,5,N).
smith(N) :- between(1,5,N).

solve(Baker,Cooper,Fletcher,Miller,Smith) :-
        cooper(Cooper),
        fletcher(Fletcher),
        abs(Fletcher - Cooper) =\= 1,
        smith(Smith),
        abs(Smith - Fletcher) =\= 1,
        miller(Miller),
        Miller > Cooper,
        baker(Baker),
        sort([Baker,Cooper,Fletcher,Miller,Smith],[1,2,3,4,5]).

% 117 inferences, 0.00 CPU in 0.02 seconds (0% CPU, Infinite Lips)

かなり推論回数は減ったが，こうなってくると宣言的プログラミングという感じがあまりしなくなってくるのが悲しい．

順列を使う

やっぱり，「異なる階に住んでいる」というところで最初に枝刈りしちゃうのが筋なんじゃないの，と思い直して書いたのが以下のプログラム．

solve(Baker,Cooper,Fletcher,Miller,Smith) :-
        permutation([1,2,3,4,5],[Baker,Cooper,Fletcher,Miller,Smith]),
        Baker =\= 5,
        Cooper =\=1,
        Fletcher =\=1, Fletcher =\= 5,
        Miller > Cooper,
        abs(Smith - Fletcher) =\= 1,
        abs(Fletcher - Cooper) =\= 1.

% 73 inferences, 0.00 CPU in 0.00 seconds (?% CPU, Infinite Lips)

ゴールの順序を変えると推論回数はまだ減らせるけど，それはもうしたくない．

だけど，よく考えると順列を使っちゃうところが宣言的ではないかも．Howを書いてしまっているかな，やっぱり…．

それはともかく，これをSchemeに翻訳しようとしてはまってしまったのだが，その話はまた日を改めて書く．