:- 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
% -- Prolog version

:- use_module(library(lists)).

% --------------------------------------------------------------

% Main function calls. sudoku1/1 returns the first solution it finds,
% while the more general sudoku/1 returns all solutions.
%
% The function works by first deriving the set of symbols that each
% row / col / blk must satisfy and then searches for a solution
% that satisfies each set of constraints. The search space is
% exponentially large, so for puzzles with a large (>25) number of
% variables, the running time can be quite long.

sudoku1(P) :-	get_vars(P,V),
		check_rows(V,P),
		check_cols(V,P),
		check_blks(V,P),
		nl,
		length(V,N), _B = round(sqrt(N)),
		print_pretty(N,_B,_B,N,_B,P).

sudoku(P) :-	get_vars(P,V),
		check_rows(V,P),
		check_cols(V,P),
		check_blks(V,P),
		nl,
		length(V,N), _B = round(sqrt(N)),
		print_pretty(N,_B,_B,N,_B,P),
		fail.

sudoku_noprint(P) :-	get_vars(P,V),
		check_rows(V,P),
		check_cols(V,P),
		check_blks(V,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).
% Here's a highly under constrained 4x4 puzzle
%
% 1 _   _ _
% _ _   _ 1
%
% _ _   1 _
% _ 1   _ _
%
% ?- sudoku([1,_A,_B,_C,_D,_E,_F,1,_G,_H,1,_J,_K,1,_L,_M]).
% 1 2   3 4
% 3 4   2 1
% 
% 4 3   1 2
% 2 1   4 3
%
% We can use the noprint version to ask how many unique
% puzzles satisfy our given constraints. Using the above 
% example again, we have:
% 
% ?- findall(X,sudoku_noprint([1,_X,_,_,_,_,_,1,_,_,1,_,_,1,_,_]),_L),length(_L,N).
% 
% N = 18 ? ;
% 
% no

% Here is a partially completed 9x9 puzzles (modified from the 
% DailyLobo on Nov 20th), where only the first and fifth blocks
% are unspecified.
% 
% ?- sudoku([_,_,_,5,3,1,9,7,2,_,_,_,6,7,2,1,8,4,_,_,_,8,9,4,6,3,5,2,7,3,_,_,_,5,1,6,8,5,9,_,_,_,2,4,3,4,6,1,_,_,_,7,9,8,1,8,6,7,5,3,4,2,9,3,2,4,9,1,6,8,5,7,5,9,7,2,4,8,3,6,1]).
% 
% 6 4 8   5 3 1   9 7 2   
% 9 3 5   6 7 2   1 8 4   
% 7 1 2   8 9 4   6 3 5   
% 
% 2 7 3   4 8 9   5 1 6   
% 8 5 9   1 6 7   2 4 3   
% 4 6 1   3 2 5   7 9 8   
% 
% 1 8 6   7 5 3   4 2 9   
% 3 2 4   9 1 6   8 5 7   
% 5 9 7   2 4 8   3 6 1   
% 
% no
%
% This one is from the DailyLobo on Nov 21st. The first and 
% second columns are unspecified, so there should be at least
% two solutions. Solver finds four.
% 
% ?- sudoku([_,_,4,9,6,8,5,7,2,_,_,6,4,5,7,1,3,8,_,_,7,3,1,2,6,4,9,_,_,9,8,3,6,4,2,1,_,_,1,5,2,9,7,8,6,_,_,8,7,4,1,3,9,5,_,_,5,2,9,4,8,1,3,_,_,2,6,8,3,9,5,7,_,_,3,1,7,5,2,6,4]).
% 
% 1 3 4   9 6 8   5 7 2   
% 2 9 6   4 5 7   1 3 8   
% 8 5 7   3 1 2   6 4 9   
% 
% 5 7 9   8 3 6   4 2 1   
% 3 4 1   5 2 9   7 8 6   
% 6 2 8   7 4 1   3 9 5   
% 
% 7 6 5   2 9 4   8 1 3   
% 4 1 2   6 8 3   9 5 7   
% 9 8 3   1 7 5   2 6 4   
% 
% 
% 1 3 4   9 6 8   5 7 2   
% 9 2 6   4 5 7   1 3 8   
% 5 8 7   3 1 2   6 4 9   
% 
% 7 5 9   8 3 6   4 2 1   
% 3 4 1   5 2 9   7 8 6   
% 2 6 8   7 4 1   3 9 5   
% 
% 6 7 5   2 9 4   8 1 3   
% 4 1 2   6 8 3   9 5 7   
% 8 9 3   1 7 5   2 6 4   
% 
% 
% 3 1 4   9 6 8   5 7 2   
% 2 9 6   4 5 7   1 3 8   
% 8 5 7   3 1 2   6 4 9   
% 
% 5 7 9   8 3 6   4 2 1   
% 4 3 1   5 2 9   7 8 6   
% 6 2 8   7 4 1   3 9 5   
% 
% 7 6 5   2 9 4   8 1 3   
% 1 4 2   6 8 3   9 5 7   
% 9 8 3   1 7 5   2 6 4   
% 
% 
% 3 1 4   9 6 8   5 7 2   
% 9 2 6   4 5 7   1 3 8   
% 5 8 7   3 1 2   6 4 9   
% 
% 7 5 9   8 3 6   4 2 1   
% 4 3 1   5 2 9   7 8 6   
% 2 6 8   7 4 1   3 9 5   
% 
% 6 7 5   2 9 4   8 1 3   
% 1 4 2   6 8 3   9 5 7   
% 8 9 3   1 7 5   2 6 4   
% 
% no
% 
% If we remove the first column of each block, how many
% unique solutions are there? (This takes too long...)
% 
% ?- findall(X,sudoku_noprint([_X,3,4,_,6,8,_,7,2,_,2,6,_,5,7,_,3,8,_,8,7,_,1,2,_,4,9,_,5,9,_,3,6,_,2,1,_,4,1,_,2,9,_,8,6,_,6,8,_,4,1,_,9,5,_,7,5,_,9,4,_,1,3,_,1,2,_,8,3,_,5,7,_,9,3,_,7,5,_,6,4]),_L),length(_L,N).
% 
%
% For the 9x9 puzzles, it seems to be able to handle up to 
% about 25 unknowns before it takes longer than my patience
% allows. I tried running it on one with 45 unknowns, but after
% more than 12 hours of running, I stopped it. The 4x4 puzzles,
% with <25 unknowns in all situations, always run quite quickly.

% Here's an "easy" 16x16 puzzle from online.
% 
% 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
% 
% If we delete just the first block, the solver is quite slow
% on this, i.e., doesn't finish in reasonable amount of time.
%
% ?- sudoku([_,_,_,_,11,7,5,14,6,15,12,1,8,4,3,2,_,_,_,_,16,4,8,1,11,2,13,9,6,14,10,15,_,_,_,_,2,3,12,6,10,5,4,16,9,1,13,7,_,_,_,_,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]).
% 


% --------------------------------------------------------------

check_rows(_,[]).
check_rows(V,S) :- length(V,N), grab_rows(V,N,N,S).

% grab_rows/4 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(V,N,Len,S) :-	N > 0, build_row(Len,S,Srest,Row),
			permutation(V,Row), N1 = N - 1,
			grab_rows(V,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

% If grab_rows/4 works correctly, then the following command would
% return N = (4!)! = 6.204484017e+23 . So, it's not surprising that
% ciao falls over at this request.
% 
% ?- findall(X,grab_rows([1,2,3,4],4,4,X),_L),length(_L,N).
% % realloc: Undefined error: 0
% {ERROR: Memory allocation failed}
% { Execution aborted }
%
% But, here are the first few of these results, which are clearly
% the permutations of the rows of the 4x4 puzzle, as desired.
% 
% ?- grab_rows([1,2,3,4],4,4,X).
% 
% X = [1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4] ? ;
% 
% X = [1,2,3,4,1,2,3,4,1,2,3,4,1,2,4,3] ? ;
% 
% X = [1,2,3,4,1,2,3,4,1,2,3,4,1,3,2,4] ? ;
% 
% X = [1,2,3,4,1,2,3,4,1,2,3,4,1,3,4,2] ? ;
% 
% X = [1,2,3,4,1,2,3,4,1,2,3,4,1,4,2,3] ? ;
% 
% X = [1,2,3,4,1,2,3,4,1,2,3,4,1,4,3,2] ? 
% 
% yes

check_cols(_,[]).
check_cols(V,S) :- length(V,N), grab_cols(V,N,N,S).

grab_cols(_,N,_,_)  :- N =:= 0.
grab_cols(V,N,Len,S) :-	N > 0, build_col(N,Len,Len,S,Col),
			permutation(V,Col), N1 = N - 1,
			grab_cols(V,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/4 can certainly complete partially solved constraints
% 
% ?- grab_cols([1,2,3,4],4,4,[X,Y,3,4,2,Z,4,W,3,4,1,2,4,1,2,3]).
% 
% W = 1,
% X = 1,
% Y = 2,
% Z = 3 ? ;
% 
% W = 1,
% X = 1,
% Y = 3,
% Z = 2 ? ;
% 
% no

check_blks(_,[]).
check_blks(V,S) :- length(V,N), grab_blks(V,N,N,S).

grab_blks(_,N,_,_)  :- N =:= 0.
grab_blks(V,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),
			permutation(V,Blk), N1 = N - 1,
			grab_blks(V,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]).
% 
% yes
% 
% 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]).
% 
% no
% 
% 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]).
% 
% W = 4,
% X = 4,
% Y = 4,
% Z = 4 ? ;
% 
% no
%
% 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).
% 
% N = 1296 ? ;
% 
% no
% 
% Cool.

% --------------------------------------------------------------

% These predicates derive the set of symbols that must appear in 
% each row / col / blk.

get_vars(S,V) :- length(S,N2), int_sqrt(N,N2),
		 make_vars(N,L1), qsort(L1,V).

int_sqrt(A,B) :- A is round(sqrt(B)).

make_vars(1,[1]).
make_vars(N,[N|T]) :- N > 0, N1 is N-1, make_vars(N1,T).

% Here's a trivial example on a 4x4 board:
% 
% ?- get_vars([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],V).
% 
% V = [1,2,3,4] ? ;
% 
% no

% --------------------------------------------------------------

% The main engine of a sudoku solver is the permutation/2 predicate,
% which tests whether a candidate list L1 is a permutation of the
% source list T. The sudoku solver functions by searching for 
% permutations L1 that simultaneously satisfy the sudoku constraints,
% i.e., the row, column and block occurrences. It suffices to use 
% the permutation function given in 3examples.pl.

permutation([], []).
permutation([H|T], [H1|T1]) :- select_el(H1, [H|T], R), permutation(R, T1). 

select_el(H, [H|T], T).
select_el(H1, [H|T], [H|T1]) :- select_el(H1, T, T1).


% --------------------------------------------------------------
% Quicksort (from 3examples.pl)

qsort([],[]).
qsort([X|L],R) :-
	partition(L,X,L1,L2), qsort(L2,R2), qsort(L1,R1), append(R1,[X|R2],R).

partition([],_B,[],[]).
partition([E|R],C,[E|Left1],Right):- E <  C, partition(R,C,Left1,Right).
partition([E|R],C,Left,[E|Right1]):- E >= C, partition(R,C,Left,Right1).


% --------------------------------------------------------------