:- set_prolog_flag(verbose,silent).
:- prompt(_, '').
:- use_module(library(readutil)).

goal_check([[],_]).
goal_check([[X,X,X,X],_]).

move_check([],_,_):-!,false.
move_check([X,X,X,Y],[X,X,X],[Y]):-X\=Y.
move_check([X,X,Y,Y2],[X,X],[Y,Y2]):-X\=Y.
move_check([X,Y,Y2,Y3],[X],[Y,Y2,Y3]):-X\=Y.
move_check([X,X,X],[X,X,X],[]).
move_check([X,X,Y],[X,X],[Y]):-X\=Y.
move_check([X,Y,Y2],[X],[Y,Y2]):-X\=Y.
move_check([X,X],[X,X],[]).
move_check([X,Y],[X],[Y]):-X\=Y.
move_check([X],[X],[]).

move_ok(_,[]).
move_ok([X|_],[X|_]).

head([Xs,_],Xs).
get2([_,Xs],Xs).

swap([X,Y],[Y,X]).

cleaning_route(Data,[Next1,Now2]):-bagof(Now1,member([Next1,Now1],Data),Nows),[Now2|_]=Nows.

move(Xs1,Res):-select(X1,Xs1,Xs2),
				[E1,No1]=X1,
				move_check(E1,E1Move,E1Next),
				select(X2,Xs2,Xs),
				[E2,No2]=X2,
				move_ok(E1Move,E2),
				append(E1Move,E2,E2Next),
				length(E2Next,Len),
				Len<5,
				msort([[E1Next,No1],[E2Next,No2]|Xs],Res).
search_all_move(Data1,[Next,Now1]):-member([Now1,_],Data1),move(Now1,Next).

my_equal(E1,E2):-maplist(head,E1,E1A),
				maplist(head,E2,E2A),
				sort([E1A,E2A],[E1A]).
 
my_more(E1,E2):-maplist(head,E1,E1A),
				maplist(head,E2,E2A),
				sort([E1A,E2A],[E1A,E2A]).

deduplication([],Data,Data):-!.
deduplication(_,[],[]):-!.
deduplication([Commit1|Data1],[[Next2,_]|Data2],Res):-my_equal(Commit1,Next2),!,deduplication([Commit1|Data1],Data2,Res).
deduplication([Commit1|Data1],[[Next2,Now2]|Data2],Res):-my_more(Commit1,Next2),!,
								deduplication(Data1,[[Next2,Now2]|Data2],Res).
deduplication([E1|Data1],[E2|Data2],[E2|Res]):-!,
								deduplication([E1|Data1],Data2,Res).
format_ans(Data):-member([Now1,_],Data),
			maplist(swap,Now1,Now2),
			msort(Now2,Now3),
			maplist(get2,Now3,Now4),
			maplist(writeln,Now4),nl,false.
format_ans(_).
get_next(Data,Res):-member([Res,_],Data).

bfs(_,_,[],_):-!,read(_),fail.
bfs(60,_,_,_):-!,read(_),fail.
bfs(_,_,Data,[[Ans,Old1]]):-member([Ans,Old1],Data),maplist(goal_check,Ans),!.
bfs(N,AllData1,Data1,[[NowRes,OldRes]|Res]):-N2 is N+1,
			setof(E1,search_all_move(Data1,E1),Data2),
			findall(E3,cleaning_route(Data2,E3),Data3),
			sort(Data3,Data4),
			deduplication(AllData1,Data4,Data5),
			findall(E5,get_next(Data5,E5),DataNext),
			append(AllData1,DataNext,AllData2),
			sort(AllData2,AllData3),
			length(AllData3,Len3),
			length(Data5,Len5),
			/*writeln([Len5,Len3,N]),*/
			!,
			bfs(N2,AllData3,Data5,Res),
			[[NextRes,NowRes]|_]=Res,
			member([NowRes,OldRes],Data1),
			!.
		
main:-
	process,halt.
 
process:-
	/*
	深さ4、ビーカー数可変のウォーターソートパズルを解くコード、答えの出力は手抜き状態、堀江 伸一
	テキストファイルに出力するコードに変えないとな。
	処理が重たくメモリも食うので、ビーカー数の少ない問題しか解けません。
	一応手元で問題を１問正しく解いたのは確認済みです。
	*/
	msort([[[1,2,1,2],1],[[3,4,1,3],2],[[2,4,4,3],3],[[4,1,2,3],4],[[],5],[[],6]],Test2),
	bfs(0,[],[[Test2,[]]],Ans),
	format_ans(Ans),
	read(X),
	true.
:-main.