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