/* -*-prolog-*- */

/* ブロックワールドのプラン探索プログラム

   ブロックワールドとは、初期状態と目標状態が与えられて、初期状態から初めて
   ブロックを動かして目標状態に到達する手順を求めるパズル。

   ブロックワールドには「場所」と「ブロック」があり、
   このプログラムでは「場所」がp,q,rの3箇所、ブロックはa,b,cの3つで、
   このことは下の「テスト用データ」に与えられている。
   また、「初期状態」や「目標状態」は複数与えることができ、それぞれに名前を
   つけることができる。
   このプログラムでは初期状態として「場所pにブロックb、その上にブロックa、
   場所rにブロックcが積まれている」というものが1つ与えられており、これには
   test_iという名前がついている。

     初期状態
          ┌─┐
          │a │
          ├─┤        ┌─┐
          │b │        │c │
        ─┴─┴────┴─┴─
            p      q      r

   また、目標状態として「場所rにブロックc、その上にブロックb、さらにその
   上にブロックcが積まれている」というものが1つ与えられており、これには
   test_fという名前がついている。初期状態と目標状態のどちらも「テスト
   データ」に与えられている。

     目標状態
                        ┌─┐
                        │a │
                        ├─┤
                        │b │
                        ├─┤
                        │c │
        ────────┴─┴─
            p      q      r

   ブロックを1度につき1つだけ動かして、初期状態から目標状態に
   1度に2つのブロックを動かすことはできない。また、ブロックは他のブロックの
   上か、あるいはブロックの積まれていない場所にしか動かせない。

   ?- test. で解が求まるようになっている。解は
   [to_place(a,b,q),to_block(b,p,a),…]
   (ブロックaをbの上から場所qへ動かし、次にブロックbを場所qからaの上へ
   動かし…)
   のように、「どのブロックをどこからどこへ動かすか」という作業のリスト
   として出力される。

   解はいくつもあるが、手数の短い順に求まるようにはなっていない。
   実際、この問題の最短解は「aをqに、bをcの上に、aをbの上に動かす」という
   3手だが、このプログラムで最初に求まるのは11手の解である */

/* テスト用データ */
initial_state(test_i, [on(a, b), on(b, p), on(c, r)]). /* 初期状態 */
final_state(test_f, [on(a, b), on(b, c), on(c, r)]).   /* 最終状態 */
block(a).	block(b). 	block(c).
place(p).	place(q).	place(r).

/* 第1引数にデータの名前(この場合はtest)を与え、そのデータで与えられる
   初期状態から最終状態へのプランを作り出す述語 */
test_plan(IniStateName, FinStateName, Plan) :-
	initial_state(IniStateName, I),
	final_state(FinStateName, F),
	transform(I, F, Plan).

/* ?- test. とすれば、test_planを名前testで呼び出して解を得て出力 */
test :- test_plan(test_i, test_f, Plan), write(Plan).

/* transform(+State1, +State2, -Plan) :-
	Planは状態State1から状態State2へ行くアクションの列。*/
transform(State1, State2, Plan) :-
	/* 5引数のtransformを呼ぶ。第4引数はブロックの名前として存在
	   しないもの(none)を指定する */
	transform(State1, State2, [State1], none, Plan).

/* transform(+State1, +State2, +Visited, +NoFirst, -Plan) :-
	Visitedは状態のリスト。Planは状態State1から状態State2へ、
	Visitedに入っている状態を通らずに行くアクションの列。
	ただし、Planの最初の手はブロックNoFirstを動かすものではない。*/
transform(State, State, _, _, []).
transform(State1, State2, Visited, NoFirst, [Action|Actions]) :-
	/* State1で可能なアクションを1つ選ぶ */
	legal_action(Action, State1),
	\+ action_target(Action, NoFirst),
	/* State1でActionを行ったときに行ける状態Stateを求める */
	update(Action, State1, State),
	/* StateがVisitedの中に入っていないことが条件 */
	\+ member(State, Visited),
	/* StateからState2へ行くアクションの列Actionsを求める */
	action_target(Action, NoFirst1),
	transform(State, State2, [State|Visited], NoFirst1, Actions).
	/* Actionsの先頭にActionを付けたものが求めるアクションの列 */

/* action_target(+Action, -Block) :-
	ActionはBlockを動かすアクションである。*/
action_target(to_place(Block, _, _), Block).
action_target(to_block(Block, _, _), Block).

/* legal_action(?Action, +State) :-
	Actionは状態Stateで可能なアクションである。*/
legal_action(to_place(Block, Y, Place), State) :-
	on(Block, Y, State), clear(Block, State),
	place(Place), clear(Place, State).
legal_action(to_block(Block1, Y, Block2), State) :-
	on(Block1, Y, State), clear(Block1, State), block(Block2),
	Block1 \= Block2, clear(Block2, State).

/* clear(+X, +State) :- 状態Stateで、場所またはブロックXの上には何もない。*/
clear(X, State) :- \+ member(on(_, X), State).

/* on(+X, +Y, +State) :-
	状態Stateで、ブロックXはブロックYの上または場所Yの上にある。*/
on(X, Y, State) :- member(on(X, Y), State).

/* update(+Action, +State, -State1) :-
	アクションActionによって、状態StateからState1に遷移する。*/
update(to_block(X, Y, Z), State, State1) :-
	substitute(on(X, Y), on(X, Z), State, State1).
update(to_place(X, Y, Z), State, State1) :-
	substitute(on(X, Y), on(X, Z), State, State1).

/* substitiute(+X, +Y, +List1, -List2) :-
	リストList1の中にある要素Xを全てYに置き換えると、リストList2を得る */
substitute(_, _, [], []).
substitute(X, Y, [X|Xs], [Y|Ys]) :-
	substitute(X, Y, Xs, Ys).
substitute(X, Y, [Z|Xs], [Z|Ys]) :-
	X \= Z, substitute(X, Y, Xs, Ys).