Prolog で油売り算（幅優先探索）

Prolog で幅優先探索をする方法を覚えたので [1] の油売り算を幅優先探索で解いてみた。（1年遅れですが）

Prolog で素直に組むと深さ優先探索を行うことになるけど、アジェンダをリストとして明示的に持って findall で次の状態のリストを得て後ろに追加してやれば幅優先探索を行うことができる。アジェンダを作る分だけコードはめんどくさい。

abura(Ac,Bc,Cc,Path) :-
  move(Ac,Bc,Cc,[[[Ac,0,0]]],Trail),
  reverse(Trail,Path).

amount(Src,Dest,Cap,Amt) :- Src > 0, Dest < Cap, Src < Cap - Dest, !, Amt = Src.
amount(Src,Dest,Cap,Amt) :- Src > 0, Dest < Cap, Amt is Cap - Dest.

successor(Ac,Bc,Cc,[A,B,C],[A1,B1,C]) :- amount(A,B,Bc,Amt), A1 is A-Amt, B1 is B+Amt.
successor(Ac,Bc,Cc,[A,B,C],[A1,B,C1]) :- amount(A,C,Cc,Amt), A1 is A-Amt, C1 is C+Amt.
successor(Ac,Bc,Cc,[A,B,C],[A1,B1,C]) :- amount(B,A,Ac,Amt), B1 is B-Amt, A1 is A+Amt.
successor(Ac,Bc,Cc,[A,B,C],[A,B1,C1]) :- amount(B,C,Cc,Amt), B1 is B-Amt, C1 is C+Amt.
successor(Ac,Bc,Cc,[A,B,C],[A1,B,C1]) :- amount(C,A,Ac,Amt), C1 is C-Amt, A1 is A+Amt.
successor(Ac,Bc,Cc,[A,B,C],[A,B1,C1]) :- amount(C,B,Bc,Amt), C1 is C-Amt, B1 is B+Amt.

is_goal([Half,Half,0]).
is_goal([Half,0,Half]).
is_goal([0,Half,Half]).

move(_,_,_,Agenda,Trail) :-
  Agenda = [FirstPath|RestPaths],
  FirstPath = [State|_],
  is_goal(State),
  Trail = FirstPath.
move(Ac,Bc,Cc,Agenda,Trail) :-
  Agenda = [FirstPath|RestPaths],
  FirstPath = [State|Past],
  findall([Succ,State|Past],
    (successor(Ac,Bc,Cc,State,Succ),\+member(Succ,Past)),
    SuccPaths),
  /*append(SuccPaths,RestPaths,NewAgenda),*/ /* depth-first */
  append(RestPaths,SuccPaths,NewAgenda), /* breadth-first */
  move(Ac,Bc,Cc,NewAgenda,Trail).

move の中の単一化は述語の引数のところでパターンマッチさせればもっと簡潔になるはずだけど、頭がついていかないので冗長な書き方にした。あと Prolog には @ とか as にあたるものは無いんだろうか。

実行結果。幅優先なので短い順に答えが出る。SWI-Prolog では解の表示が省略されたときは w を押すと全部表示してくれる。

?- abura(10,7,3,Answer).

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0|...], [2|...], [...|...]|...] [write]

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [0, 7, 3], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [0, 7, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [0, 7, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [0, 7, 3], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [0, 7, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [0, 7, 3], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [0, 7, 3], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [0, 7, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [0, 7, 3], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [5, 5, 0]] ;

Answer = [[10, 0, 0], [7, 0, 3], [7, 3, 0], [4, 3, 3], [4, 6, 0], [1, 6, 3], [1, 7, 2], [8, 0, 2], [8, 2, 0], [5, 2, 3], [0, 7, 3], [3, 7, 0], [3, 4, 3], [6, 4, 0], [6, 1, 3], [9, 1, 0], [9, 0, 1], [2, 7, 1], [2, 5, 3], [5, 5, 0]] ;

No

[1] http://karetta.jp/article/blog/ll-spirit/033840