/*     The Prolog Latin Squares Program 

       Once upon a time in a since long forgotten land there lived a king
       with a very peculiar sense of order.  On day the ruler of said kingdom
       pronounced:

       - Let it hence be known that we in our role as head of our armed
       forces will set a limit upon its size.  Each year shall a great
       festival be held in the fields outside our castle.  There shall
       officers from all regiments gather.  From each regiment there shall be
       one officer of each rank.  The number of ranks shall be the same as the
       number of regiments.  We then say that there shall be no more
       regiments in this land then the side of a square consisting of those
       officers.  To ensure that the number of regiments is held low we
       decide that there shall not be officers of same regiment and rank in
       neither row nor column.

       At those ancient times they knew nothing of computers and
       absolutely nil about prolog programming so their war machine stayed
       quite small.  A rumour says that they managed to have five regiments
       but that they never got their sixth.  Today things have changed though.
       This program would have gived the land means of a fantastic military
       expansion.  Be glad this country is no more.
       
       
       ======================================================================

       This problem is known as two orthogonal latin squares.

       The regiments (with name X) are called 1, 2, ...
       The ranks     (with name Y) are called 1, 2, ...
       The columns   (with name C) are called 1, 2, ...
       The rows      (with name R) are called 1, 2, ...

       Solutions are divided in:

       * Odd.
       * 2^n (n > 1).
       *	4+3k where 1+k has solution (k >= 0).
       * Factorizeable in above.
       * Rest (2+4n that is not one of above).

       For all but last group this program have deterministic algorithms.
       In the last group you can, in reasonable time, show that 2 and 6 have
       no solutions.  Some 2+4n are unknown.  Those are 14, 18, 26 ...
       The non deterministic search algorithm have so far neither found any
       solution for those nor shown that there are no solution.  If you know
       of solutions you are very welcome to tell me.  (To get a complete
       list of numbers that I do not know of any solution try the query
       write_all_solutions.  Numbers that are unknown are marked as unknown.)

       PS. I have been told that all sizes except 2 and 6 has
       solutions. I shall not let this stop me to get another answer.

       - roland                                                            */


/*    Usage:
	regof(N)		Gives a solution for NxN square.
	regof_naive(N   	Tries the naive algorithm.
	regof_odd(N)    	Tries the odd algorithm.
	regof_pow2(N)   	Tries the odd algorithm.
	regof_factor(N,L)	N is factorizeable acc. to list L.
	regof_unknown(N)	Do not know any algorithm.
	dotest(X)		Test solutions (yes or no).
	get_factors(N,L)	Get factors of N in list L.
	write_all_factors	Write factors for numbers from 1 to 255.
	write_all_factors_proper Same as above but more complete.

% --  Top queries.  --
% Also a chooser for algorithm.


regof(N) :- regof(N, _), !.
regof_naive(N) :- regof_naive(N, _), !.
regof_pow2(N) :- regof_pow2(N, _), !.
regof_odd(N) :- regof_odd(N, _), !.
regof_unknown(N) :- regof_unknown(N, _), !.
regof_factor(N, List) :- regof_factor(N, _, List), !.
'regof_4+3k'(N, [Na,Nb]) :- 'regof_4+3k'(N, _, Na, Nb), !.

regof(N, _) :-		var(N), !,
    write('Variable size?'), nl, fail.
regof(N, _) :-		\+integer(N), !,
    write('Non integer size?'), nl, fail.
regof(N, _) :-		N > 255, !,
    write('Square can not be bigger than 255 by 255.'), nl, fail.
regof(N, _) :-		N < 0, !,
    write('Negative numbers of columns and rows?'), nl, fail.
regof(1, b(r(m(1,1)))) :- !,
    write('A one by one square is not very interresting.'), nl.
regof(N, Board) :-	is_factor(odd, N, _, first), !,
    write('Odd numbers are very simple!'), nl,
    regof_odd(N, Board).
regof(_,_) :- write('Not odd.'), nl, fail.
regof(N, Board) :-	is_factor(pow2, N, _, first), !,
    write('Simple! This type is 2^n.'), nl,
    regof_pow2(N, Board).
regof(_,_) :- write('Not 2^n.'), nl, fail.
regof(N, Board) :-	is_factor('4+3k',N, [Na,Nb], first), !,
    write('Easy. This type is 4 + 3k.'), nl,
    'regof_4+3k'(N, Board, Na, Nb).
regof(_,_) :- write('Not 4 + 3k.'), nl, fail.
regof(N, Board) :- is_factor(factor, N, ListOfN, first),
    ListOfN = [_,_|_], !,
    write('Can be factorized.'), nl,
    regof_factor(N, Board, ListOfN).
regof(_,_) :- write('Not factorizeable.'), nl, fail.
regof(N, Board) :-
    write('I will do it the hard way. Not knowing anything.'), nl,
    regof_unknown(N, Board).

write_all_factors :-
    get_number(1, 255, 1, N),
    (get_factors(N, Fs) ->
     findall(X, get_factors(N,_,X), T), sort(T, Types),
     write(N), write(': '), write([Fs|Types]), nl, fail
     ; write(N), write(': '), write(unknown), nl, fail).

write_all_factors_proper :-
    get_number(1, 255, 1, N),
    findall([T,F], get_factors(N,F,T), B), sort(B,SB),
    write(N=SB), nl, fail.


% --  Odd.  --
% Very simple. (OBS! Zero numbering and non negative modulo.)
% X is (C + R)%N.
% Y is (C - R)%N. (or (C + 2*R)%n)

is_factor(odd, N, _, _) :- (N mod 2) =\= 0, N > 1.

regof_odd(N, Board) :-
    initialize(Men, _, _, N, Board),
    make_odd(N, N, Board),
    test_this_solution(Men, N, Board).

make_odd(0, _, _).				  % For all rows ..
make_odd(R, N, B) :- R > 0, NextR is R - 1,
    make2_odd(N, R, N, B),
    make_odd(NextR, N, B).

make2_odd(0, _, _, _).				  % .. and columns ..
make2_odd(C, R, N, B) :- C > 0, NextC is C - 1,
    X is ((N + (R-1) + (C-1)) mod N) + 1,
    Y is ((N - (R-1) + (C-1)) mod N) + 1,
    position(C, R, B, m(X,Y)),			  % .. set value.
    make2_odd(NextC, R, N, B).


% --  2^N.  --
% Almost as simple. (OBS! Se odd above.)
% X is (C + ((-1)^(C+R))*R)%N.
% Y is (C + ((-1)^(C+(R+1)//2))*(R*(R+1)//2))%N.

is_factor(pow2, 4, _, _).
is_factor(pow2, N1, _, _) :- N1 > 1, N2 is N1//2, N1 is N2*2,
    is_factor(pow2, N2, _, recursive).

regof_pow2(N, Board) :-
    initialize(Men, _, _, N, Board),
    make_pow2(N, N, Board),
    test_this_solution(Men, N, Board).

make_pow2(0, _, _).				  % For all rows ..
make_pow2(R, N, B) :- R > 0, NextR is R - 1,
    make2_pow2(N, R, N, B),
    make_pow2(NextR, N, B).

make2_pow2(0, _, _, _).				  % .. and columns ..
make2_pow2(C, R, N, B) :- C > 0, NextC is C - 1,
    ((((C-1+R-1) mod 2) =:= 0) -> SX = 1 ; SX = -1),
    ((((C-1+(R//2)) mod 2) =:= 0) -> SY = 1 ; SY = -1),
    X is 1 + ( (N + (C-1) - SX*(R-1)) mod N),
    Y is 1 + ( (N*N + (C-1) + SY*(((R-1)*R)//2)) mod N),
    position(C, R, B, m(X,Y)),			  % .. set value.
    make2_pow2(NextC, R, N, B).


% 4+3k where 1+k has a solution.
% This is the algorithm (10 as an example):

/*
       Make a 3x3 and a 7x7 square.
       1,1 2,2 3,3 _,_ _,_ _,_ _,_ _,_ _,_ _,_ 
       2,3 3,1 1,2 _,_ _,_ _,_ _,_ _,_ _,_ _,_ 
       3,2 1,3 2,1 _,_ _,_ _,_ _,_ _,_ _,_ _,_ 
       _,_ _,_ _,_ 4,4 5,5 6,6 7,7 8,8 9,9 a,a 
       _,_ _,_ _,_ 5,a 6,4 7,5 8,6 9,7 a,8 4,9 
       _,_ _,_ _,_ 6,9 7,a 8,4 9,5 a,6 4,7 5,8 
       _,_ _,_ _,_ 7,8 8,9 9,a a,4 4,5 5,6 6,7 
       _,_ _,_ _,_ 8,7 9,8 a,9 4,a 5,4 6,5 7,6 
       _,_ _,_ _,_ 9,6 a,7 4,8 5,9 6,a 7,4 8,5 
       _,_ _,_ _,_ a,5 4,6 5,7 6,8 7,9 8,a 9,4 

       Rearrange the 7x7 square.
       1,1 2,2 3,3 4,4 5,5 6,6 7,7 8,8 9,9 a,a 
       2,3 3,1 1,2 5,a 6,4 7,5 8,6 9,7 a,8 4,9 
       3,2 1,3 2,1 6,9 7,a 8,4 9,5 a,6 4,7 5,8 
       a,5 9,6 8,7 7,8 _,_ _,_ _,_ _,_ _,_ _,_ 
       4,6 a,7 9,8 _,_ 8,9 _,_ _,_ _,_ _,_ _,_ 
       5,7 4,8 a,9 _,_ _,_ 9,a _,_ _,_ _,_ _,_ 
       6,8 5,9 4,a _,_ _,_ _,_ a,4 _,_ _,_ _,_ 
       7,9 6,a 5,4 _,_ _,_ _,_ _,_ 4,5 _,_ _,_ 
       8,a 7,4 6,5 _,_ _,_ _,_ _,_ _,_ 5,6 _,_ 
       9,4 8,5 7,6 _,_ _,_ _,_ _,_ _,_ _,_ 6,7 

       Fill in diagonals from {1,2,3}.
       1,1 2,2 3,3 4,4 5,5 6,6 7,7 8,8 9,9 a,a 
       2,3 3,1 1,2 5,a 6,4 7,5 8,6 9,7 a,8 4,9 
       3,2 1,3 2,1 6,9 7,a 8,4 9,5 a,6 4,7 5,8 
       a,5 9,6 8,7 7,8 _,3 3,_ _,2 2,_ _,1 1,_ 
       4,6 a,7 9,8 1,_ 8,9 _,3 3,_ _,2 2,_ _,1 
       5,7 4,8 a,9 _,1 1,_ 9,a _,3 3,_ _,2 2,_ 
       6,8 5,9 4,a 2,_ _,1 1,_ a,4 _,3 3,_ _,2 
       7,9 6,a 5,4 _,2 2,_ _,1 1,_ 4,5 _,3 3,_ 
       8,a 7,4 6,5 3,_ _,2 2,_ _,1 1,_ 5,6 _,3 
       9,4 8,5 7,6 _,3 3,_ _,2 2,_ _,1 1,_ 6,7 

       Fill in diagonals from {4,5,6,7,8,9,a}.
       1,1 2,2 3,3 4,4 5,5 6,6 7,7 8,8 9,9 a,a 
       2,3 3,1 1,2 5,a 6,4 7,5 8,6 9,7 a,8 4,9 
       3,2 1,3 2,1 6,9 7,a 8,4 9,5 a,6 4,7 5,8 
       a,5 9,6 8,7 7,8 4,3 3,9 5,2 2,a 6,1 1,4 
       4,6 a,7 9,8 1,5 8,9 5,3 3,a 6,2 2,4 7,1 
       5,7 4,8 a,9 8,1 1,6 9,a 6,3 3,4 7,2 2,5 
       6,8 5,9 4,a 2,6 9,1 1,7 a,4 7,3 3,5 8,2 
       7,9 6,a 5,4 9,2 2,7 a,1 1,8 4,5 8,3 3,6 
       8,a 7,4 6,5 3,7 a,2 2,8 4,1 1,9 5,6 9,3 
       9,4 8,5 7,6 a,3 3,8 4,2 2,9 5,1 1,a 6,7 

       */


is_factor('4+3k', N, [Na,Nb], _) :-
    Na is (N-1)//3, N is 3*Na + 1, (is_factor(_, Na, _, first) ; Na == 1),
    Nb is 2*Na+1.

'regof_4+3k'(N, B, Na, Nb) :-
    write(('Divided in two squares: ' = [Na,Nb])), nl,
    write(Na), write(': '), regof(Na, Ba),	  % Make square a.
    write(Nb), write(': '), regof(Nb, Bb),	  % Make square b.
    initialize(M, _, _, N, B),
    'move_a_4+3k'(Na, Na, Na, Ba, B),		  % Move square a to board.
    'move_b_4+3k'(Nb, Nb, Nb, Na, Bb, B),	  % Move square b to board.
    'diagonals_a_4+3k'(Na, N, Na, Nb, N, B),	  % Fill diagonals from set a.
    'diagonals_b_4+3k'(N, Na, Nb, B),		  % Fill diagonals from set b.
    test_this_solution(M, N, B),
    true.

'move_a_4+3k'(0, _, _, _, _) :- !.
'move_a_4+3k'(C, 0, Na, Ba, B) :- !, NextC is C - 1,
    'move_a_4+3k'(NextC, Na, Na, Ba, B).
'move_a_4+3k'(C, R, Na, Ba, B) :- !, NextR is R - 1,
    position(C, R, Ba, P), position(C, R, B , P),
    'move_a_4+3k'(C, NextR, Na, Ba, B).

'move_b_4+3k'(0, _, _, _, _, _) :- !.
'move_b_4+3k'(Cb, 0, Nb, Na, Bb, B) :- !, NextCb is Cb - 1,
   'move_b_4+3k'(NextCb, Nb, Nb, Na, Bb, B).
'move_b_4+3k'(Cb, Rb, Nb, Na, Bb, B) :- !, NextRb is Rb - 1,
    position(Cb, Rb, Bb, m(Xb,Yb)),
    'convert_cr_4+3k'(Cb, Rb, Na, C, R), X is Xb+Na, Y is Yb+Na,
    position(C, R, B, m(X,Y)),
    'move_b_4+3k'(Cb, NextRb, Nb, Na, Bb, B).

'convert_cr_4+3k'(Cb, Rb, Na, C, R) :- Rb <   Na+1,
    C is Cb + Na, R is Rb.
'convert_cr_4+3k'(Cb, Rb, Na, C, R) :- Rb =:= Na+1,
    C is Cb + Na, R is C.
'convert_cr_4+3k'(Cb, Rb, Na, C, R) :- Rb >   Na+1,
    C is (2*Na+1) - (Rb-1), R is Cb + Na.

'diagonals_a_4+3k'(0, _, _, _, _, _) :- !.
'diagonals_a_4+3k'(XY, C, Na, Nb, N, B) :- C =< Na, !, NextXY is XY - 1,
    'diagonals_a_4+3k'(NextXY, N, Na, Nb, N, B).
'diagonals_a_4+3k'(XY, C, Na, Nb, N, B) :- !, NextC is C - 1,
    Rx is Na + 1 + ((Nb + 2*(XY-1) + (C-1) - Na + 1) mod Nb),
    Ry is Na + 1 + ((Nb + 2*(XY-1) + (C-1) - Na + 2) mod Nb),
    position(C, Rx, B, m(XY,_)), position(C, Ry, B, m(_,XY)),
    'diagonals_a_4+3k'(XY, NextC, Na, Nb, N, B).

'diagonals_b_4+3k'(CR, Na, _, _) :- CR =< Na, !.
'diagonals_b_4+3k'(CR, Na, Nb, B) :- NextCR is CR - 1,
    position(CR, CR, B, m(X,Y)),
    'short_diagonals_b_4+3k'(Na, CR, X, Y, Na, Nb, B),
    'diagonals_b_4+3k'(NextCR, Na, Nb, B).

'short_diagonals_b_4+3k'(0, _, _, _, _, _, _) :- !.
'short_diagonals_b_4+3k'(D, CR, X, Y, Na, Nb, B) :- NextD is D - 1,
    Cx is Na + 1 + ((Nb + (CR-D) - (Na+1)) mod Nb), Ry is Cx,
    Rx is Na + 1 + ((Nb + (CR+D) - (Na+1)) mod Nb), Cy is Rx,
    position(Cx, Rx, B, m(X,_)), position(Cy, Ry, B, m(_,Y)),
    'short_diagonals_b_4+3k'(NextD, CR, X, Y, Na, Nb, B).


% --  Factorizeable.  --
% If you can factorize the size in known solutions then you can
% use the solutions recursively to get an answer.

is_factor(factor, 1, Fs, _) :- !, Fs = [].
is_factor(factor, N, [F|Fs], first) :- N > 1, 
    get_number(N, 2, -1, F), NextN is N // F, N is NextN * F, F > 1,
    ((N == F) -> T = recursive ; T = first),
    is_factor(_, F, _, T),
    is_factor(factor, NextN, Fs, first).

get_factors(N, Fs) :- is_factor(factor, N, Fs, first).
get_factors(N, R, Type) :-
    is_factor(Type, N, Fs, first),
    ((Type == factor) -> Fs = [_,_|_], sorted(Fs), R = Fs ; R = [N]).

regof_factor(N, B, [N1|Ns]) :-
    write('Factors are: '), write([N1|Ns]), nl,
    regof_for_each_factor([N1|Ns], [B1|Bs]),	  % Solve for all factors ..
    combine_all(Ns, Bs, N1, B1, B),		  % .. and combine them.
    initialize(Men, _, _, N, _),
    test_this_solution(Men, N, B).

regof_for_each_factor([], []).
regof_for_each_factor([N|Ns], [B|Bs]) :-
    write(N), write(': '),
    regof(N, B),
    regof_for_each_factor(Ns, Bs).

combine_all([], _, _, B, B).
combine_all([N|Ns], [B|Bs], Nin, Bin, Ball) :-
    Nout is N * Nin, functor(Bout, b, Nout), make_board(Nout, Nout, Bout),
    combine_two(N, N, N, Nin, Nin, Nin, Nout, B, Bin, Bout),
    combine_all(Ns, Bs, Nout, Bout, Ball).

combine_two(0, _, _, _, _, _, _, _, _, _) :- !.
combine_two(C, 0, N, Cin, Rin, Nin, Nout, B, Bin, Bout) :- !, NextC is C - 1,
    combine_two(NextC, N, N, Cin, Rin, Nin, Nout, B, Bin, Bout).
combine_two(C, R, N, 0, Rin, Nin, Nout, B, Bin, Bout) :- !, NextR is R - 1,
    combine_two(C, NextR, N, Nin, Rin, Nin, Nout, B, Bin, Bout).
combine_two(C, R, N, Cin, 0, Nin, Nout, B, Bin, Bout) :- !, NextCin is Cin - 1,
    combine_two(C, R, N, NextCin, Nin, Nin, Nout, B, Bin, Bout).
combine_two(C, R, N, Cin, Rin, Nin, Nout, B, Bin, Bout) :- NextRin is Rin - 1,
    position(C, R, B, m(X,Y)),
    position(Cin, Rin, Bin, m(Xin,Yin)),
    Rout is N*(Rin-1) + R, Cout is N*(Cin-1) + C,
    Xout is N*(Xin-1) + X, Yout is N*(Yin-1) + Y,
    position(Cout, Rout, Bout, m(Xout,Yout)),
    combine_two(C, R, N, Cin, NextRin, Nin, Nout, B, Bin, Bout).
    


% --  Unknown (Currently some 2*odd).  --

/*    As naming is arbitrary you can start with first row as:
       1/1, 2/2, 3/3, 4/4, 5/5, 6/6.

       As the order of rows is of no moment you can start with the first
       column as:
       1/1,
       2/_,
       3,_,
       4/_,
       5/_,
       6/_.

       As you always can swap columns/rows and rename types you can start with:
       1/1, 2/2, 3/3, 4/4, 5/5, 6/6
       2/6, _/_, _/_, _/_, _/_, _/_
       3/5, _/_, _/_, _/_, _/_, _/_
       4/_, _/_, _/_, _/_, _/_, _/_
       5/_, _/_, _/_, _/_, _/_, _/_
       6/_, _/_, _/_, _/_, _/_, _/_
       proof: You can choose 2/6 because /3 -> /6 are interchangeable.
       .      Then you can choose 3/5 because /4 -> /5 are interchangeable. */

regof_unknown(N, Board) :-
    initialize(Men, Xs, Ys, N, Board),
    first_row(Men, Xs, Ys, N, N, Board, M2),
    Split is N//2 + 1,
    first_col_det(M2, Xs, Ys, N, 2, Split, Board, M3),
    !,
    first_col_nondet(M3, Xs, Ys, N, Split, Board, M4),
    search(M4, Xs, Ys, Board),
    write_nice(1, 1, N, Board).

first_row(M1, Xs, Ys, N, C, B, M2) :- C > 0, NextC is C - 1,
    M = m(C,C),					  % (C is nonvar)
    delete(M, M1, M3),				  % Fetch one man (C,C) ..
    put_one_man(M, Xs, Ys, B, p(C,1)),		  % .. and put him at (C,1).
    first_row(M3, Xs, Ys, N, NextC, B, M2).
first_row(M, _, _, _, 0, _, M).

first_col_det(M1, Xs, Ys, N, R, S, B, M2) :- R < S, NextR is R + 1,
    Y is N - R + 2,
    M = m(R,Y),					  % (R and Y is nonvar)
    delete(M, M1, M3),				  % Fetch one man (R,Y) ..
    put_one_man(M, Xs, Ys, B, p(1,R)),		  % .. and put him at (1,R).
    first_col_det(M3, Xs, Ys, N, NextR, S, B, M2).
first_col_det(M, _, _, _, R, S, _, M) :- R > S - 1.

first_col_nondet(M1, Xs, Ys, N, R, B, M2) :- R =< N, NextR is R + 1,
    M = m(R,_),					  % (R is nonvar, Y is var)
    deleteP(M, M1, M3),				  % Fetch one man (R,Y) ..
    put_one_man(M, Xs, Ys, B, p(1,R)),		  % .. and put him at (1,R).
    first_col_nondet(M3, Xs, Ys, N, NextR, B, M2).
first_col_nondet(M, _, _, N, R, _, M) :- R > N.


% --  Naive algorithm, initialization and standard search routine.  --

regof_naive(N, Board) :-
    initialize(Men, Xs, Ys, N, Board),
    search(Men, Xs, Ys, Board),
    write_nice(1, 1, N, Board).

initialize(Men, Xs, Ys, N, Board) :-
    functor(Board, b, N),			  % Make columns and ..
    make_board(N, N, Board),			  % .. rows of board.
    men(N, N, N, Men),				  % Make a list of all men.
    functor(Xs, x, N), set_up(N, N, Xs),		  % Make lists of free ..
    functor(Ys, y, N), set_up(N, N, Ys),		  % .. cols and rows.
    ! /* To cut down at environment size */.

make_board(0, _, _).
make_board(C, N, Board) :- C > 0, NextC is C - 1,
    arg(C, Board, RR), functor(RR, r, N),
    make_board(NextC, N, Board).

men(_,  0,  _,  []) :- !.
men(0, Y, N, Ms) :- !, NextY is Y - 1,
    men(N, NextY, N, Ms).
men(X, Y, N, [m(X,Y)|Ms]) :- NextX is X - 1,
    men(NextX, Y, N, Ms).

set_up(XY, N, F) :-  XY > 0, NextXY is XY - 1,
    arg(XY, F, free(C,R)),
    empty_list(N, C), empty_list(N, R),
    set_up(NextXY, N, F).
set_up(0, _, _).

search([], _, _, _).				  % Until last man ..
search([M|Ms], Xs, Ys, B) :-			  % .. try to put him on board.
    put_one_man(M, Xs, Ys, B, p(_,_)),
    search(Ms, Xs, Ys, B).

put_one_man(m(X,Y), Xs, Ys, B, p(C,R)) :-
    arg(X, Xs, free(XC, XR)),			  % Fetch list of free rows ..
    arg(Y, Ys, free(YC, YR)),			  % .. and cols for this man.
    pair_member(m(X,Y), XC, YC, 1, C),		  % Fetch a col.
    pair_member(m(X,Y), XR, YR, 1, R),		  % Fetch a row.
    position(C, R, B, m(X,Y)).			  % Can I put him here?

position(C, R, B, P) :- arg(R, B, RR), arg(C, RR, P).


% --  Testing of solutions  --

test_this_solution(Men, N, Board) :-
    write_nice(1, 1, N, Board),
    (i_shall_test -> test(Men, N, Board)		  % Test only on demand!
     ; write('Do not test'), nl).

test(Ms, N, B) :-
    write('testing ...'), nl,
    sort(Ms, SortedMs),
    test_men(SortedMs, N, B, Flag),		  % Test if all men on board.
    numbered_list(N, L), sort(L, SortedL),
    test_cols(N, N, N, B, SortedL, [], [], Flag),  % Test if columns and ..
    test_rows(N, N, N, B, SortedL, [], [], Flag),  % .. rows are right.
    var(Flag), !, write('OK'), nl.
test(_, _, _) :-
    write('... found not OK, what a mistake!'), nl, fail.

test_men(Ms, N, B, Flag) :-
    which_is_on_board(N, N, N, B, W),
    test_lists(Ms, W, men, Flag).

test_lists(SortedOld, New, Com, Flag) :-
    sort(New, SortedNew),
    ((SortedOld == SortedNew) -> true
     ; write(Com), write(' is wrong.'), nl, Flag = nonvar).

which_is_on_board(0, _, _, _, []) :- !.
which_is_on_board(C, 0, N, B, W) :- !, NextC is C - 1,
    which_is_on_board(NextC, N, N, B, W).
which_is_on_board(C, R, N, B, W) :- NextR is R - 1,
    position(C, R, B, m(X,Y)),
    ((var(X) ; var(Y)) -> NextW = W ; [m(X,Y)|NextW] = W),
    which_is_on_board(C, NextR, N, B, NextW).

test_cols(0, _, _, _, _, _, _, _) :- !.
test_cols(C, 0, N, B, L, Xs, Ys, Flag) :- !, NextC is C - 1,
    test_lists(L, Xs, xcol(C), Flag),
    test_lists(L, Ys, ycol(C), Flag),
    test_cols(NextC, N, N, B, L, [], [], Flag).
test_cols(C, R, N, B, L, Xs, Ys, Flag) :- !, NextR is R - 1,
    position(C, R, B, m(X,Y)),
    test_cols(C, NextR, N, B, L, [X|Xs], [Y|Ys], Flag).

test_rows(0, _, _, _, _, _, _, _) :- !.
test_rows(R, 0, N, B, L, Xs, Ys, Flag) :- !, NextR is R - 1,
    test_lists(L, Xs, xrow(R), Flag),
    test_lists(L, Ys, yrow(R), Flag),
    test_rows(NextR, N, N, B, L, [], [], Flag).
test_rows(R, C, N, B, L, Xs, Ys, Flag) :- !, NextC is C - 1,
    position(C, R, B, m(X,Y)),
    test_rows(R, NextC, N, B, L, [X|Xs], [Y|Ys], Flag).


% --  Member and other help stuff.  --

get_number(Cnt, _, _, Cnt).
get_number(Cnt, Stop, Incr, Num) :- Cnt \== Stop, NextCnt is Cnt + Incr,
    get_number(NextCnt, Stop, Incr, Num).

pair_member(X, L1, L2, N1, N2) :- var(N2), !,	  % Parallel or sequential?
    pair_memberP(X, L1, L2, N1, N2).
pair_member(X, L1, L2, N1, N2) :-
    pair_memberS(X, L1, L2, N1, N2).
    
pair_memberP(X, [X|_], [X|_], N ,N).
pair_memberP(X, [_|T1], [_|T2], Cnt, N) :- NextCnt is Cnt + 1,
    pair_memberP(X, T1, T2, NextCnt, N).

pair_memberS(X, [X|_], [X|_], N ,N).
pair_memberS(X, [_|T1], [_|T2], Cnt, N) :- NextCnt is Cnt + 1,
    pair_memberS(X, T1, T2, NextCnt, N).

delete(m(X,Y), L1, L2) :- (var(X) ; var(Y)), !,	  % Parallel or sequential?
    deleteP(m(X,Y), L1, L2).
delete(M, L1, L2) :-
    deleteS(M, L1, L2).

deleteP(X, [X|T], T).
deleteP(X, [H|T1], [H|T2]) :- deleteP(X, T1, T2).

deleteS(X, [X|T], T).
deleteS(X, [H|T1], [H|T2]) :- deleteS(X, T1, T2).

empty_list(N, [_|T]) :- N > 0, NextN is N - 1, empty_list(NextN, T).
empty_list(0, []).

numbered_list(N, [N|T]) :- N > 0, NextN is N - 1, numbered_list(NextN, T).
numbered_list(0, []).

sorted(L) :- sort(L, L).

write_nice(C, R, N, B) :-			  % Locking if parallel!
    (predicate_property(bc_lock(_), _) -> bc_lock(5) ; true),
    write_nice2(C, R, N, B),
    (predicate_property(bc_lock(_), _) -> bc_unlock(5) ; true).

write_nice2(_, R, N, _) :- R > N, !, nl.
write_nice2(C, R, N, B) :- C > N, !, nl, NextR is R + 1,
    write_nice2(1, NextR, N, B).
write_nice2(C, R, N, B) :- NextC is C + 1,
    position(C, R, B, m(X,Y)), write_nice4(X, Y),
    write_nice2(NextC, R, N, B).

write_nice3(N) :- var(N), !, write('_').
write_nice3(N) :- (N > 9, N < 36), !,
    C is 0'a + N - 10, name(A, [C]), write(A).
write_nice3(N) :- (N > 35, N < 62), !,
    C is 0'A + N - 36, name(A, [C]), write(A).
write_nice3(N) :- write(N).
    
write_nice4(X, Y) :- write_nice3(X), write(','), write_nice3(Y), write(' ').
