/*
	rushhour solver
	for SWI-PROLOG version 6.4.1
	2013/10/04
	written by Taku Koyahata
	mail:koyahata*koyahatataku.com(change * to @)
	This program is NOT a public domain software.
	But you can edit and redistribute this program on your own responsibility.
*/


que_push(Item,[Qhead , [Item | Qtail]],[Qhead,Qtail]).
que_pop(Item,[[Item|Qhead],Qtail],[Qhead,Qtail]).
que_empty([X,Y]):-X==Y.
append_dl([X,Y],[Y,Z],[X,Z]).

:- dynamic
	gvar/2.

gvar(mem,0).
gvar(que,0).

gvar(initial_pos,[[h,2,2,2],[h,3,0,0],[v,2,3,0],[v,3,4,0],[v,3,5,0],[v,2,0,1],[h,2,1,1],[h,2,0,3],[v,2,2,3],[v,2,1,4],[h,2,4,4],[h,2,2,5],[h,2,4,5]]).
/*gvar(initial_pos,[[h,2,1,2],[h,2,0,0],[v,3,0,1],[v,3,3,1],[v,3,5,0],[v,2,0,4],[h,3,2,5],[h,2,4,4]]).*/
/*gvar(initial_pos,[[h,2,3,2],[v,3,2,0],[h,2,3,0],[v,3,5,0],[v,2,0,4],[h,2,1,4],[v,3,3,3],[h,2,4,3],[h,2,4,5]]).*/

search_main :-
	% Entry initial Car Position into Que and Phase Database.
	gvar(initial_pos,Cars),
	cars2oct(Cars,Oct),
	que_push(Oct,[Q,Q],NewQ),
	term_hash(Oct,Hash),
	recorda(Hash,[0,Oct]),
	breadth_search(NewQ),
	!.

out_mem_max(Que):-
	gvar(mem,MaxMem),
	statistics(memory,[CurrentMem,_]),
	CurrentMem>MaxMem->(set_gvar(mem,CurrentMem),write(CurrentMem),nl,true);true,
	gvar(que,QueCount),
	que_count(Que,NewQueCount),
	NewQueCount>QueCount->(set_gvar(que,NewQueCount),write('que:'),write(NewQueCount),nl,true);true.
	
que_count([A,A],0):-!.
que_count([[First|Que],QueTail],Cnt):-
	que_count([Que,QueTail],Cnt1),
	Cnt is Cnt1 + 1.
	

breadth_search(Que):-
out_mem_max(Que),

	not(que_empty(Que)),
	que_pop(CurrentPhaseOct,Que,Que1),
	oct2cars(CurrentPhaseOct,CurrentPhase),
	not(isSolved(CurrentPhaseOct,CurrentPhase)),
	% find all available phases and push it into Que.
	findall(
		NextPhaseOct,
		get_next_phase(	CurrentPhaseOct,
				CurrentPhase,
				NextPhaseOct),
		Head,
		Tail),
	append_dl(Que1,[Head,Tail],Que2), 
	breadth_search(Que2).

% get_next_phase(CurrentPhaseOct+, CurrentPhase+, NextPhaseOct-)
% 1.choose one car ,
% 2.choose an available move, 
% 3.make new cars list,
% 4.check generated phase exists in Phase Database,
% 5.if not , Entry it (as key and current Phase as data)
%
get_next_phase(CurrentPhaseOct,CurrentPhase,NewPhaseOct):-
	select(PickUpCar,CurrentPhase,RestCars), % choose one car
	move(PickUpCar,RestCars,DestCar), % choose an available move
	% make cars list
	replaceOne(CurrentPhase,PickUpCar,DestCar,NewCars), 
	cars2oct(NewCars,NewPhaseOct), % phase -> oct (hash)
	% if generated phase already exists, it fails.
	term_hash(NewPhaseOct,Hash),
	not(recorded(Hash,[_,NewPhaseOct])), 
	% or entry it into phase database.
	recorda(Hash,[CurrentPhaseOct,NewPhaseOct]). 
	
set_gvar(Name,X):-
	nonvar(Name),retract(gvar(Name,_)),!,asserta(gvar(Name,X)).
set_gvar(Name,X):-
	nonvar(Name),asserta(gvar(Name,X)).

% oct to decimal list
% oct2decLst(Oct+,OctAryLength+,List-)
% ex. 83(decimal)=123(oct) -> [3,2,1]
%
oct2decLst(_,0,[]):-!.
oct2decLst(OldNum,Len,[First|Rest]):-
	First is OldNum /\ 7,
	Num1 is OldNum>>3,
	Len1 is Len - 1,
	oct2decLst(Num1,Len1,Rest).

% oct to cars list
% oct2cars(Oct+,Cars-)
%
oct2cars(Oct,Cars):-
	gvar(initial_pos,InitialCars),
	length(InitialCars,Len),
	oct2decLst(Oct,Len,DecLst),
	maplist(setCarXorY,InitialCars,DecLst,Cars).

% Make Integer from Cars Positions (Phase -> HashValue)
% carNumLst2Int(CarList+ , Integer-)
% CarList: cars list (ex.[[h,2,3,3],[v,3,2,2]])
cars2oct(Cars,Num):-
	cars2decLst(Cars,DecLst),
	decLst2oct(DecLst,Num).

% decimal list to oct
% ex.[4,2,1,0,4] => result of (((( 4 * 8  + 0 ) * 8 + 1) * 8 + 2 ) * 8 + 4 )
decLst2oct([],0).
decLst2oct([FirstDigit|Rest],Num):-
	decLst2oct(Rest,Num1),
	Num is (Num1<<3) + FirstDigit.

% CarsList to NumerList
cars2decLst(Cars,Lst):-
	maplist(getCarXorY,Cars,Lst).

% get a horizontal car's x or a vertical car's y
% getCarXorY(CarPos+,Val-)
%
getCarXorY([h,_,X,_],X):-!.
getCarXorY([v,_,_,Y],Y).

% set a horizontal car'x or a vertical car's y
% setCarXorY(InitCarPos+,Val+,NewCarPos-) 
%
setCarXorY([h,Len,_,Y],Val,[h,Len,Val,Y]):-!.
setCarXorY([v,Len,X,_],Val,[v,Len,X,Val]).

hit_cars(_,[]):-
	!,fail.
hit_cars(Pos,[Car|RestCars]):-
	hit_car(Pos,Car),hit_cars(Pos,RestCars),!.

hit_cars(_,[]):-
        !,fail.
hit_cars(Pos,[Car|RestCars]):-
        hit_car(Pos,Car),!;hit_cars(Pos,RestCars).

hit_car([PosX|PosY],[h,Length,ChkCarX,ChkCarY]):-
        PosY =:= ChkCarY ,
        ChkCarX =< PosX , PosX < ChkCarX + Length,
        !.
hit_car([PosX|PosY],[v,Length,ChkCarX,ChkCarY]):-
        PosX =:= ChkCarX ,
        ChkCarY =< PosY , PosY < ChkCarY + Length,
        !.

moveLeft([h,_,X,_],_,_):-
        X1 is X-1,
        X1<0,!,fail.
moveLeft([h,_,X,Y],OtherCars,_):-
        X1 is X-1,
        hit_cars([X1,Y],OtherCars),!,fail.
moveLeft([h,Length,X,Y],OtherCars,[h,Length,X1,Y]):-
        X1 is X-1,
        not(hit_cars([X1,Y],OtherCars)).
moveLeft([h,Length,X,Y],OtherCars,[h,Length,Xdst,Y]):-
        X1 is X-1,
        moveLeft([h,Length,X1,Y],OtherCars,[h,Length,Xdst,Y]).

moveRight([h,Length,X,_],_,_):-
        X1 is X+1,
        X1+Length-1>5,!,fail.
moveRight([h,Length,X,Y],OtherCars,_):-
        X1 is X + 1,
        Right is X1 + Length - 1,
        hit_cars([Right,Y],OtherCars),!,fail.
moveRight([h,Length,X,Y],OtherCars,[h,Length,X1,Y]):-
        X1 is X + 1,
        Right is X1 + Length - 1,
        not(hit_cars([Right,Y],OtherCars)).
moveRight([h,Length,X,Y],OtherCars,[h,Length,Xdst,Y]):-
        X1 is X + 1,
        moveRight([h,Length,X1,Y],OtherCars,[h,Length,Xdst,Y]).

moveUp([v,_,_,Y],_,_):-
        Y1 is Y-1,
        Y1<0,!,fail.
moveUp([v,_,X,Y],OtherCars,_):-
        Y1 is Y-1,
        hit_cars([X,Y1],OtherCars),!,fail.
moveUp([v,Length,X,Y],OtherCars,[v,Length,X,Y1]):-
        Y1 is Y-1,
        not(hit_cars([X,Y1],OtherCars)).
moveUp([v,Length,X,Y],OtherCars,[v,Length,X,Ydst]):-
        Y1 is Y-1,
        moveUp([v,Length,X,Y1],OtherCars,[v,Length,X,Ydst]).

moveDown([v,Length,_,Y],_,_):-
        Y1 is Y+1,
        Y1+Length-1 > 5,
	!,fail.
moveDown([v,Length,X,Y],OtherCars,_):-
        Y1 is Y + 1,
        Bottom is Y1 + Length - 1,
        hit_cars([X,Bottom],OtherCars),
	!,fail.
moveDown([v,Length,X,Y],OtherCars,[v,Length,X,Y1]):-
        Y1 is Y + 1,
        Bottom is Y1 + Length - 1,
        not(hit_cars([X,Bottom],OtherCars)).
moveDown([v,Length,X,Y],OtherCars,[v,Length,X,Ydst]):-
        Y1 is Y + 1,
        moveDown([v,Length,X,Y1],OtherCars,[v,Length,X,Ydst]).

move(Car,RestCars,Dst):-moveLeft(Car,RestCars,Dst).
move(Car,RestCars,Dst):-moveRight(Car,RestCars,Dst).
move(Car,RestCars,Dst):-moveUp(Car,RestCars,Dst).
move(Car,RestCars,Dst):-moveDown(Car,RestCars,Dst).

isSolved(CurrentPhaseOct,[[h,2,X,Y] | OtherCars]):-
	isRightDirectionEmpty(X,Y,OtherCars),
	output_solution(CurrentPhaseOct).
	
isRightDirectionEmpty(X,_,_):-
	X1 is X+1,
	X1>5,!,true.	
isRightDirectionEmpty(X,Y,OtherCars):-
	X1 is X+1,
	X1=<5,
	not(hit_cars([X1,Y],OtherCars)),
	isRightDirectionEmpty(X1,Y,OtherCars).

replaceOne([Search | Rest],Search,To,[To | Rest]):-!.
replaceOne([First | Rest],Search,To,[First | Y]):-
	replaceOne(Rest,Search,To,Y).

output_solution(Oct):-
	make_solution_list(Oct,[_|List]),
	reverse(List,List1),
	write_lists_nl(List1).

write_lists_nl([]):-!,true.
write_lists_nl([First|Rest]):-
	write(First),nl,
	write_lists_nl(Rest).

get_prev_oct(Hash,CurrentPhaseOct,PrevPhaseOct):-
	recorded(Hash,[PrevPhaseOct,CurrentPhaseOct]).

make_solution_list(0,_):-!,true.
make_solution_list(Oct,[First|Rest]):-
	oct2cars(Oct,Cars),
	term_hash(Oct,Hash),
	get_prev_oct(Hash,Oct,PrevOct),
	oct2cars(PrevOct,PrevCars),
	get_diff_cars(PrevCars,Cars,First),
	make_solution_list(PrevOct,Rest).

get_diff_cars([],[],_):-!,false.
get_diff_cars([PrevFirst|PrevRest],[PrevFirst|CurrentRest],Diff):-
	get_diff_cars(PrevRest,CurrentRest,Diff).
get_diff_cars([PrevFirst|_],[CurrentFirst|_],[PrevFirst,CurrentFirst]):-
	PrevFirst\=CurrentFirst,!,true.