/*
	
	sudoku 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.

	abbreviations

	cnds 	- candidates
	lst	- list
	fwst	- fewest
	sqr	- square
	wt	- with
	updt	- update
	bd	- board
	h	- horizontal
	v	- vartical
	cur,c	- current
	n	- next
	p	- previous
*/

prepare_bd(Bd):-
	Bd = [ 
		[8,_,_,_,_,_,_,_,_],
		[_,_,3,6,_,_,_,_,_],
		[_,7,_,_,9,_,2,_,_],
		[_,5,_,_,_,7,_,_,_],
		[_,_,_,_,4,5,7,_,_],
		[_,_,_,1,_,_,_,3,_],
		[_,_,1,_,_,_,_,6,8],
		[_,_,8,5,_,_,_,1,_],
		[_,9,_,_,_,_,4,_,_]
	].

sudoku_main:-
	!,
	prepare_bd(Bd),
	print_bd(Bd),nl,
	make_bd_cnds(Bd,BdCnds),
	depth_search(Bd,BdCnds).

depth_search(Bd,_):-
	not(empty_sqr(Bd)),
	!,
	write('solved.'),nl,
	print_bd(Bd).
	
depth_search(Bd,BdCnds):-
	print_bd(Bd),nl,
	chk_cnds_exist(Bd,BdCnds),
	sqr_wt_fwst_cnds(BdCnds,X,Y,Cnds),
	select(Num,Cnds,_),
	bd_xy(Bd,X,Y,Num),	% set (X,Y) to Num
	update_candidates(BdCnds,X,Y,Num,NewBdCnds),
	depth_search(Bd,NewBdCnds).

empty_sqr(Bd):-
	flatten(Bd,Flat),
	has_var(Flat).

% if list has free variable, success.
has_var([]):-!,fail.
has_var([First|_]):-
	var(First),
	!,
	true.
has_var([_|Rest]):-
	!,
	has_var(Rest).

% find empty square(X,Y) having fewest candidates.
sqr_wt_fwst_cnds(BdCnds,X,Y,RetCnds):-
	!,
	FwstC = fewest(-1,-1,10),	% fewest(X,Y,CandidatesNum)
	Xc is 0,
	Yc is 0,	
	sqr_wt_fwst_cnds_sub(BdCnds,Xc,Yc,FwstC,fewest(X,Y,_)),
	bd_xy(BdCnds,X,Y,RetCnds). % get candidates of (X,Y)
	
sqr_wt_fwst_cnds_sub(_,_,9,FwstC,FwstC):-!. % y end
sqr_wt_fwst_cnds_sub([FirstLine|RestLines],X,Y,FwstC,Fwst2):-
	!,
	fwst_cnds_hline(FirstLine,X,Y,FwstC,Fwst1), %FwstC -> Fwst1
	Yn is Y+1,
	sqr_wt_fwst_cnds_sub(RestLines,X,Yn,Fwst1,Fwst2). %Fwst1->Fwst2
	
fwst_cnds_hline(_,9,_,CurFwst,CurFwst):-
	!.
fwst_cnds_hline([[]|Rest],Xc,Yc,CurFwst,NewFwst):-
	!,
	Xn is Xc + 1,
	fwst_cnds_hline(Rest,Xn,Yc,CurFwst,NewFwst).
fwst_cnds_hline([First|Rest],Xc,Y,fewest(_,_,CurMin),NewFwst):-
	length(First,Len),
	Len < CurMin,
	!,
	Xn is Xc + 1,
	fwst_cnds_hline(Rest,Xn,Y,fewest(Xc,Y,Len),NewFwst).
fwst_cnds_hline([_|Rest],Xc,Y,CurFwst,NewFwst):-
	Xn is Xc + 1,
	fwst_cnds_hline(Rest,Xn,Y,CurFwst,NewFwst).

% print board
print_bd([]):-!,nl.
print_bd([First|Rest]):-
	print_line(First),
	nl,
	print_bd(Rest).

print_line([]):-!.
print_line([First|Rest]):-
	var(First),!,
	write(' .'),
	print_line(Rest).
print_line([First|Rest]):-
	format(' ~d',[First]),
	print_line(Rest).

% bd_xy(Bd+,X?,Y?,Val?)  -   (X,Y) of Bd is Val
bd_xy(Bd,X,Y,Val):-
	((var(X);var(Y))->Searching = yes;Searching = no),
	nth0(Y,Bd,HLine),
	nth0(X,HLine,Wk),
	((Searching == yes,var(Wk))->fail;true),
	Val = Wk.	

% check number which has been already used  (VLine,HLine,3x3Area).
% ex. 
% If 1,5,7 is used,
%	Used is set to  [true,_,_,_,true,_,true,_,_] and
% 	NumList is set to (1,5,7)
make_cnds_lst(Bd,X,Y,NumLst):-
	Used=[_,_,_,_,_,_,_,_,_],
	used_chk_v(Bd,X,Used),
	used_chk_h(Bd,Y,Used),
	used_chk_3x3(Bd,X,Y,Used),
	chkLst2NumLst(Used,1,NumLst).

% convert checked list to Number List
% ex: [true,_,_,true,_,_,true,true,_] -> [1,4,7,8]
%
chkLst2NumLst([],_,[]):-!.
chkLst2NumLst([First|Rest],N,[N|NumRest]):-
	var(First),!,
	N1 is N + 1,
	chkLst2NumLst(Rest,N1,NumRest).
chkLst2NumLst([_|Rest],N,NumLst):-
	N1 is N + 1,
	chkLst2NumLst(Rest,N1,NumLst).

used_chk_3x3(Bd,X,Y,Used):-
	XLeft is ((X // 3) * 3),
	YTop is ((Y // 3) * 3),
	get_3x3(Bd,XLeft,YTop,List),
	flatten(List,List1),
	used_chk(Used,List1).

get_3x3(_,_,Y,[]):-
	Y=< -3,
	!.
get_3x3([FirstLine|RestLines],X,Y,[Out|OutRest]):-
	Y=<0,!,
	get_3(FirstLine,X,Out),
	Y1 is Y - 1,
	get_3x3(RestLines,X,Y1,OutRest).
get_3x3([_|Rest],X,Y,Out):-
	Y1 is Y -1,
	get_3x3(Rest,X,Y1,Out).

get_3(_,X,[]):-
	X =< -3,
	!.
get_3([First|Rest],X,[First|OutRest]):-
	X =< 0,
	X1 is X-1,
	!,
	get_3(Rest,X1,OutRest).
get_3([_|Rest],X,Out):-
	!,
	X1 is X-1,
	get_3(Rest,X1,Out).

% collect Nths of 2nd arg list (list of lists) and set them into 3rd arg list
nth0lst(_,[],[]):-!.
nth0lst(Nth,[FirstLst|RestLsts],[Val|OutRest]):-
	nth0(Nth,FirstLst,Val),
	nth0lst(Nth,RestLsts,OutRest).

% ex. 2nd arg : [2,4,5]
%      -> 1st arg:[_,true,_,true,true,_,_,_,_]
used_chk(_,[]):-!,true.
used_chk(Wk,[First|Rest]):-
	var(First),
	!,
	used_chk(Wk,Rest).
used_chk(Wk,[First|Rest]):-
	set_nth1(Wk,First),
	used_chk(Wk,Rest).

% set [2nd arg]th member of list (1st arg) to true.
set_nth1([First|_],1):-
	var(First),
	!,
	First = 'true'.
set_nth1([First|_],1):-		% already set
	nonvar(First),!.         
set_nth1([_|Rest],Xc):-
	Xn is Xc-1,
	set_nth1(Rest,Xn).
	
% make candidates list of all squares
% this function is called only once (initialization)
%
make_bd_cnds(Bd,BdCnds):-
	BdCnds = [
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_],
		[_,_,_,_,_,_,_,_,_]
	],

	make_cnds_sub(Bd,BdCnds,0).

make_cnds_sub(_,_,Yc):-
	Yc>=9,!.
make_cnds_sub(Bd,[FirstHLine|RestHLines],Yc):-
	Xc is 0,
	make_cnds_hline(Bd,FirstHLine,Xc,Yc),
	Yn is Yc+1,
	make_cnds_sub(Bd,RestHLines,Yn).

make_cnds_hline(_,[],Xc,_):-
	Xc >= 9, 
	!.
make_cnds_hline(Bd,[[]|RestCndsLsts],Xc,Yc):-
	bd_xy(Bd,Xc,Yc,Wk),
	nonvar(Wk),
	!,
	Xn is Xc + 1,
	make_cnds_hline(Bd,RestCndsLsts,Xn,Yc).
make_cnds_hline(Bd,[FirstCndsLst|RestCndsLsts],Xc,Yc):-
	!,
	make_cnds_lst(Bd,Xc,Yc,FirstCndsLst),
	Xn is Xc+1,
	make_cnds_hline(Bd,RestCndsLsts,Xn,Yc).

used_chk_h([HLine|_],0,Used):-
	!,
	used_chk(Used,HLine).
used_chk_h([_|Rest],Yc,Used):-
	Yn is Yc-1,
	used_chk_h(Rest,Yn,Used).

used_chk_v(Bd,Xc,Used):-
	nth0lst(Xc,Bd,VLine),
	used_chk(Used,VLine).

% update_candidates(+CndsOld,+X,+Y,+Val,-CndsNew)
%
% update candidates list.
%	1.remove Val from Y HLine candidates 
%	2.remove Val from X VLine candidates
%	3.remove Val from 3x3 Area candidates
% updated List returned as CndsNew
%
update_candidates(CndsOld,X,Y,Val,CndsNew):-
	% calc X,Y belonging 3x3 area 
	XLeft is (X//3)*3,
	YTop is (Y//3)*3,
	XRight is XLeft + 2,
	YBottom is YTop + 2,
	Yc is 0,
	updt_cnds_sub(CndsOld,Yc,X,Y,Val,
		(XLeft,XRight,YTop,YBottom),CndsNew).

updt_cnds_sub(_,Yc,_,_,_,_,[]):-
	Yc>=9,
	!.
updt_cnds_sub([First|Rest],Yc,FindX,FindY,Val,AreaInf,[NewFirst|NewRest]):-
	!,
	Xc is 0,
	updt_hline(First,Xc,Yc,FindX,FindY,Val,AreaInf,NewFirst),
	Yn is Yc + 1,
	updt_cnds_sub(Rest,Yn,FindX,FindY,Val,AreaInf,NewRest).

updt_hline(_,Xc,_,_,_,_,_,[]):-
	Xc>=9,!.

% remove All from (X,Y) candidates
updt_hline([_|Rest],Xc,Yc,Xc,Yc,Val,AreaInf,[[]|NewRest]):-
	!,	
	Xn is Xc + 1,	
	updt_hline(Rest,Xn,Yc,Xc,Yc,Val,AreaInf,NewRest).
	
% remove Val from VLine candidates
updt_hline([First|Rest],Xc,Yc,Xc,Y,Val,AreaInf,[NewFirst|NewRest]):-
	select(Val,First,NewFirst),  
		%remove Val from First and set it into NewFirst
	!,
	Xn is Xc + 1,
	updt_hline(Rest,Xn,Yc,Xc,Y,Val,AreaInf,NewRest).

% remove Val from HLine candidates 
updt_hline([First|Rest],Xc,Y,X,Y,Val,AreaInf,[NewFirst|NewRest]):-
	select(Val,First,NewFirst),
		%remove Val from First and set it into NewFirst
	!,
	Xn is Xc + 1,
	updt_hline(Rest,Xn,Y,X,Y,Val,AreaInf,NewRest).

% remove Val from 3x3 Area candidates
updt_hline([First|Rest],Xc,Yc,X,Y,Val,
		(XLeft,XRight,YTop,YBottom),[NewFirst|NewRest]):-
	XLeft =< Xc , Xc =< XRight,
	YTop =< Yc, Yc =< YBottom,
	select(Val,First,NewFirst),
	!,
	Xn is Xc + 1,
	updt_hline(Rest,Xn,Yc,X,Y,Val,(XLeft,XRight,YTop,YBottom),NewRest).

% if not matched above 3, just copy Candidates List.
updt_hline([First|Rest],Xc,Yc,X,Y,Val,AreaInf,[First|NewRest]):-
	!,
	Xn is Xc + 1,
	updt_hline(Rest,Xn,Yc,X,Y,Val,AreaInf,NewRest).

% check there is free square which has no candidates.
%
chk_cnds_exist([],_):-!.
chk_cnds_exist([BdFirst|BdRest],[CndsFirst|CndsRest]):-
	chk_cnds_exist_hline(BdFirst,CndsFirst),
	chk_cnds_exist(BdRest,CndsRest).

chk_cnds_exist_hline([],_):-!.
chk_cnds_exist_hline([BdFirst|_],[[]|_]):-
	var(BdFirst),
	!,
	fail.
chk_cnds_exist_hline([_|BdRest],[_|CndsRest]):-
	!,
	chk_cnds_exist_hline(BdRest,CndsRest).