:- module(_,_). % -- UNM CS 550, Fall 2006, with Prof. Hermenegildo % -- Aaron Clauset (aaron@cs.unm.edu) % -- Class Project % -- Presented (Thursday) November 30th % -- Submitted (Sunday) December 10th % -- Finite Domain / Constraint Programming version :- use_module(library(lists)). :- use_package(fd). % -------------------------------------------------------------- % Main function call for the constraint version. sudoku(P) :- get_n(P,N), constrain_values(N,P), check_rows(N,P), check_cols(N,P), check_blks(N,P), labeling(P), nl, _B = round(sqrt(N)), print_pretty(N,_B,_B,N,_B,P). sudoku_noprint(P) :- get_n(P,N), constrain_values(N,P), check_rows(N,P), check_cols(N,P), check_blks(N,P), labeling(P). print_pretty(_,_,_,_,_,[]) :- nl. print_pretty(C,_,A,N,SqrtN,R) :- C =:= 0, A > 1, A1 = A - 1, C1 = N, nl, print_pretty(C1,SqrtN,A1,N,SqrtN,R). print_pretty(C,_,A,N,SqrtN,R) :- C =:= 0, A =:= 1, C1 = N, nl, nl, print_pretty(C1,SqrtN,SqrtN,N,SqrtN,R). print_pretty(C,B,A,N,SqrtN,[H|T]) :- C > 0, B =:= 1, C1 = C - 1, write(H), write(' '), print_pretty(C1,SqrtN,A,N,SqrtN,T). print_pretty(C,B,A,N,SqrtN,[H|T]) :- C > 0, B > 1, C1 = C - 1, B1 = B - 1, write(H), write(' '), print_pretty(C1,B1,A,N,SqrtN,T). % Using the same examples as in the prolog version, % % 1 _ _ _ % _ _ _ 1 % _ _ 1 _ % _ 1 _ _ % % ?- findall(X,sudoku([1,_X,_,_,_,_,_,1,_,_,1,_,_,1,_,_]),_L),length(_L,N). % N = 18 ? ; % % no % % a 9x9 puzzle from activityvillage.co.uk with 36 specified values % ("easy" class) % % _ 7 _ _ 6 _ _ 2 _ % _ _ 3 2 9 7 5 _ _ % _ _ 6 5 _ 4 3 _ _ % % _ 6 8 _ _ _ 7 1 _ % 1 _ 7 _ _ _ 9 _ 5 % _ 9 5 _ _ _ 2 8 _ % % _ _ 4 8 _ 2 1 _ _ % _ _ 1 3 5 6 4 _ _ % _ 5 _ _ 1 _ _ 3 _ % % ?- sudoku([_,7,_,_,6,_,_,2,_,_,_,3,2,9,7,5,_,_,_,_,6,5,_,4,3,_,_,_,6,8,_,_,_,7,1,_,1,_,7,_,_,_,9,_,5,_,9,5,_,_,_,2,8,_,_,_,4,8,_,2,1,_,_,_,_,1,3,5,6,4,_,_,_,5,_,_,1,_,_,3,_]). % % 5 7 9 1 6 3 8 2 4 % 8 4 3 2 9 7 5 6 1 % 2 1 6 5 8 4 3 9 7 % % 4 6 8 9 2 5 7 1 3 % 1 2 7 6 3 8 9 4 5 % 3 9 5 7 4 1 2 8 6 % % 6 3 4 8 7 2 1 5 9 % 9 8 1 3 5 6 4 7 2 % 7 5 2 4 1 9 6 3 8 % % yes % % How many solutions to this puzzle? % % ?- findall(X,sudoku([_X,7,_,_,6,_,_,2,_,_,_,3,2,9,7,5,_,_,_,_,6,5,_,4,3,_,_,_,6,8,_,_,_,7,1,_,1,_,7,_,_,_,9,_,5,_,9,5,_,_,_,2,8,_,_,_,4,8,_,2,1,_,_,_,_,1,3,5,6,4,_,_,_,5,_,_,1,_,_,3,_]),_L),length(_L,N). % % N = 1 ? ; % % no % Here's a "very hard" puzzle from saidwhat.co.uk (25 givens) % % ?- sudoku([_,6,_,_,5,_,_,2,_,_,_,_,3,_,_,_,9,_,7,_,_,6,_,_,_,1,_,_,_,6,_,3,_,4,_,_,_,_,4,_,7,_,1,_,_,_,_,5,_,9,_,8,_,_,_,4,_,_,_,1,_,_,6,_,3,_,_,_,8,_,_,_,_,2,_,_,4,_,_,5,_]). % % 8 6 1 4 5 9 7 2 3 % 4 5 2 3 1 7 6 9 8 % 7 9 3 6 8 2 5 1 4 % % 2 1 6 8 3 5 4 7 9 % 9 8 4 2 7 6 1 3 5 % 3 7 5 1 9 4 8 6 2 % % 5 4 7 9 2 1 3 8 6 % 1 3 9 5 6 8 2 4 7 % 6 2 8 7 4 3 9 5 1 % % yes % % How many solutions to this puzzle? % % ?- findall(X,sudoku([_X,6,_,_,5,_,_,2,_,_,_,_,3,_,_,_,9,_,7,_,_,6,_,_,_,1,_,_,_,6,_,3,_,4,_,_,_,_,4,_,7,_,1,_,_,_,_,5,_,9,_,8,_,_,_,4,_,_,_,1,_,_,6,_,3,_,_,_,8,_,_,_,_,2,_,_,4,_,_,5,_]),_L),length(_L,N). % % 8 6 1 4 5 9 7 2 3 % 4 5 2 3 1 7 6 9 8 % 7 9 3 6 8 2 5 1 4 % % 2 1 6 8 3 5 4 7 9 % 9 8 4 2 7 6 1 3 5 % 3 7 5 1 9 4 8 6 2 % % 5 4 7 9 2 1 3 8 6 % 1 3 9 5 6 8 2 4 7 % 6 2 8 7 4 3 9 5 1 % % N = 2 ? ; % % no % Here's an "easy" 16x16 from colinj.co.uk that takes a while... % % ?- sudoku([10,16,_,_,_,_,_,_,_,_,12,1,_,_,_,2,_,_,_,5,_,4,_,_,11,2,13,_,6,_,10,_,_,14,11,_,2,3,12,_,10,_,_,_,_,1,_,7,_,_,6,_,9,_,13,15,7,_,_,8,_,12,_,_,7,11,10,2,_,_,_,_,_,_,_,6,_,_,12,4,1,_,16,_,_,_,_,12,2,11,5,_,_,_,_,14,_,_,_,_,_,_,1,_,_,8,_,_,_,_,9,_,_,9,_,_,_,_,14,_,1,4,10,_,_,11,7,_,_,3,5,_,_,1,11,8,_,13,_,_,_,_,14,_,_,10,_,_,_,_,16,_,_,14,_,_,_,_,_,_,11,_,_,_,_,14,4,9,8,_,_,_,_,13,_,6,13,1,_,_,3,_,_,_,_,_,_,_,12,5,8,11,_,_,1,_,14,_,_,16,13,9,_,4,_,6,_,_,9,_,12,_,_,_,_,5,_,6,1,11,_,7,4,_,_,6,_,14,_,15,9,3,_,_,2,_,10,_,_,_,16,_,_,_,8,12,_,_,_,_,_,_,_,_,2,1]). % % 10 16 9 13 11 7 5 14 6 15 12 1 8 4 3 2 % 12 7 3 5 16 4 8 1 11 2 13 9 6 14 10 15 % 15 14 11 8 2 3 12 6 10 5 4 16 9 1 13 7 % 2 4 6 1 9 10 13 15 7 3 14 8 11 12 5 16 % % 7 11 10 2 15 5 3 13 14 16 9 6 1 8 12 4 % 1 8 16 4 7 9 10 12 2 11 5 3 13 15 6 14 % 14 5 13 6 4 16 1 11 15 8 7 12 2 10 9 3 % 3 9 15 12 6 8 14 2 1 4 10 13 16 11 7 5 % % 4 3 5 16 12 1 11 8 9 13 6 15 7 2 14 10 % 6 10 8 15 13 2 16 7 12 14 11 5 4 3 1 9 % 11 12 2 7 5 14 4 9 8 1 3 10 15 13 16 6 % 13 1 14 9 3 6 15 10 4 7 16 2 12 5 8 11 % % 5 2 1 10 14 11 7 16 13 9 8 4 3 6 15 12 % 9 15 12 3 10 13 2 5 16 6 1 11 14 7 4 8 % 8 6 4 14 1 15 9 3 5 12 2 7 10 16 11 13 % 16 13 7 11 8 12 6 4 3 10 15 14 5 9 2 1 % % yes % -------------------------------------------------------------- constrain_values(_,[]). constrain_values(N,[H|T]) :- N > 0, H in 1..N, constrain_values(N,T). check_rows(_,[]). check_rows(N,S) :- grab_rows(N,N,S). % grab_rows/3 takes the sudoku instance (a list), extracts each % row and then checks to see if it is a permutation of the symbol % list V. grab_cols/4 and grab_blks/4 work similarly. grab_rows(N,_,[]) :- N =:= 0. grab_rows(N,Len,S) :- N > 0, build_row(Len,S,Srest,Row), all_different(Row), N1 = N - 1, grab_rows(N1,Len,Srest). build_row(Len,T,T,[]) :- Len =:= 0. build_row(Len,[H|T],Srest,[H|R]) :- Len > 0, Len1 = Len - 1, build_row(Len1,T,Srest,R). % Trivial examples of build_row/4 working as desired. % % ?- build_row(4,[1,2,3,4,2,3,4,1,3,4,1,2,4,1,2,3],Srest,Row). % % Row = [1,2,3,4], % Srest = [2,3,4,1,3,4,1,2,4,1,2,3] ? ; % % no % ?- build_row(4,[4,1,2,3],Srest,Row). % % Row = [4,1,2,3], % Srest = [] ? ; % % no check_cols(_,[]). check_cols(N,S) :- grab_cols(N,N,S). grab_cols(N,_,_) :- N =:= 0. grab_cols(N,Len,S) :- N > 0, build_col(N,Len,Len,S,Col), all_different(Col), N1 = N - 1, grab_cols(N1,Len,S). build_col(Oset,Spcr,Len,[_|T],R) :- Oset > 1, Oset1 = Oset - 1, build_col(Oset1,Spcr,Len,T,R). build_col(Oset,Spcr,Len,[H|T],[H|R]) :- Oset =:= 1, Len1 = Len - 1, Oset1 = Spcr, build_col(Oset1,Spcr,Len1,T,R). build_col(Oset,_,Len,_,[]) :- Oset =:= 1, Len =:= 0, !. build_col(_,_,_,[],[]). % grab_cols/3 can certainly complete partially solved constraints % % ?- grab_cols(4,4,[X,Y,3,4,2,Z,4,W,3,4,1,2,4,1,2,3]). % check_blks(_,[]). check_blks(N,S) :- grab_blks(N,N,S). grab_blks(N,_,_) :- N =:= 0. grab_blks(N,Len,S) :- N > 0, _B is round(sqrt(Len)), _K is _B*(N - floor((N-1)/_B)*_B - 1) + 1 + _B*Len*floor((N-1)/_B), build_blk(_K,_B,Len,_B,Len,S,Blk), all_different(Blk), N1 = N - 1, grab_blks(N1,Len,S). build_blk(Oset,Tset,Len,SqrtN,N,[_|T],B) :- Oset > 1, Oset1 = Oset - 1, build_blk(Oset1,Tset,Len,SqrtN,N,T,B). build_blk(Oset,Tset,Len,SqrtN,N,[H|T],[H|B]) :- Oset =:= 1, Tset > 0, Tset1 = Tset - 1, Len1 = Len - 1, build_blk(Oset,Tset1,Len1,SqrtN,N,T,B), !. build_blk(Oset,Tset,Len,SqrtN,N,[_|T],B) :- Oset =:= 1, Tset =:= 0, Oset1 = N - (SqrtN), Tset1 = SqrtN, build_blk(Oset1,Tset1,Len,SqrtN,N,T,B). build_blk(Oset,_,Len,_,_,_,[]) :- Oset =:= 1, Len =:= 0, !. % check_blks/2 works as desired % test1 % 1 4 3 2 % 2 3 4 1 % % 3 2 1 4 % 4 1 2 3 % % ?- check_blks([1,2,3,4],[1,4,3,2,2,3,4,1,3,2,1,4,4,1,3,2]). % % % test 2 % 1 2 3 4 % 2 3 4 1 % % 3 4 1 2 % 4 1 2 3 % ?- check_blks([1,2,3,4],[1,2,3,4,2,3,4,1,3,4,1,2,4,1,2,3]). % % % test 3 % 1 W 3 2 % 2 3 X 1 % % 3 2 1 Y % X 1 2 3 % % ?- check_blks([1,2,3,4],[1,W,3,2,2,3,X,1,3,2,1,Y,Z,1,2,3]). % % % test 4 : fix the 1s, but let the others vary % 1 Z1 Y1 X1 % X2 Y2 Z2 1 % % Y3 X3 1 Z3 % Z4 1 X4 Y4 % % How many boards are there with this arrangement of 1s? % % ?- findall(X1,check_blks([1,2,3,4],[1,Z1,Y1,X1,X2,Y2,Z2,1,Y3,X3,1,Z3,Z4,1,X4,Y4]),_L),length(_L,N). % % % Cool. % -------------------------------------------------------------- % These predicates derive the set of symbols that must appear in % each row / col / blk. get_n(S,N) :- length(S,N2), int_sqrt(N,N2). int_sqrt(A,B) :- A is round(sqrt(B)). % -------------------------------------------------------------- %% Local Variables: %% mode: CIAO %% update-version-comments: "off" %% End: