The problem is to place N queens on an NxN chessboard so as to maximize the number of unattacked cells.
% Lower Bounds for the Non-Dominating Queens Problem.
%
% Finds the positions, Qs, of N contiguous queens grouped in the top-left
% corner of an NxN chessboard maximizing the number M of unattacked
% cells, Fs.
% Note that better solutions may exist with the queens not being grouped in
% the top-left corner, so M gives a lower bound to the solution. However,
% the solutions obtained here are equal to the best known solutions for
% N=12,14,18,19,24,27,29,30,31, and presumably also for many bigger numbers.
% e.g. lb(12, Qs, M, _) gives Qs=[1,2,13,14,15,25,26,27,28,38,39,40], M=36
% and outputs:
% QQ++++++++++
% QQQ+++++++++
% QQQQ++++++++
% +QQQ++++++++
% ++++++FFFFFF
% +++++++FFFFF
% ++++++++FFFF
% ++++F++++FFF
% ++++FF++++FF
% ++++FFF++++F
% ++++FFFF++++
% ++++FFFFF+++
% where Q is a cell occupied by a queen, and F is a free (unattacked) cell.
lb(N, Qs, M, Fs):-
findall(Xs, block(N, Xs), Xss), % All configurations of the queens
P0=p(0,0,0,0,0,[]),
lb_1(Xss, N, P0, p(A,B,C,D,M,Rs)), % Best configuration of the queens
Rs=[_|_], % A solution exists
queen_cells(Rs, 1, N, 0, [], Qs), % Cells containing queens
right_free(N, A, C, Fs1),
left_free(N, B, D, Fs2),
ord_union(Fs1, Fs2, Fs), % Unattacked (free) cells
incr(Qs, -1, Qs0),
incr(Fs, -1, Fs0),
show(N, Qs0, Fs0).
lb_1([], _, P, P).
lb_1([Rs|Rss], N, p(_,_,_,_,M0,_), p(A1,B1,C1,D1,M,Ss)):-
Rs=[A|_], % The number of queens in the first row
nth_member(Rs, B, 0), % The number of queens in the first column
length_1(Rs, -1, C), % The number of rows containing queens
Bm1 is B - 1,
Bp1 is B + 1,
nth_member(Rs, Bm1, X),
nth_member(Rs, Bp1, Y),
Y1 is Y + 1,
maximum(X, Y1, D), % The number of columns containing queens
NAC is N - A - C,
NBD is N - B - D,
M1 is (NAC*(NAC+1) // 2) + (NBD*(NBD+1) // 2), % Number of unattacked cells
M1 > M0, !,
lb_1(Rss, N, p(A,B,C,D,M1,Rs), p(A1,B1,C1,D1,M,Ss)).
lb_1([_|Rss], N, P0, P):-
lb_1(Rss, N, P0, P).
% Finds a concise representation of the positions of the N queens.
% e.g. findall(Rs, block(14,Rs), Rss) gives
% Rss=[[2,3,4,0,3,2],[3,4,0,4,3],[3,4,4,0,3]]
block(N, Rs):-block_1(1, N, Rs).
block_1(R, N, [R|Rs]):- % Start with R
R < N,
R1 is R + 1,
block_2(up, R1, N, R, Rs).
block_1(R, N, Rs):- % Start with R+1
R < N,
R1 is R + 1,
block_1(R1, N, Rs).
block_2(down, R, N, Sum, [R]):- % A solution has been found
Sum + R =:= N.
block_2(up, R, N, Sum, [R|Rs]):- % Keep going up
Sum + R < N,
R1 is R + 1,
Sum1 is Sum + R,
block_2(up, R1, N, Sum1, Rs).
block_2(up, R, N, Sum, [R,R,0|Rs]):- % Repeated number followed by indent
Sum + R + R < N,
R1 is R - 1,
Sum1 is Sum + R + R,
block_2(down, R1, N, Sum1, Rs).
block_2(up, R, N, Sum, [R,0,R|Rs]):- % Repeated number with indent between them
Sum + R + R < N,
R1 is R - 1,
Sum1 is Sum + R + R,
block_2(down, R1, N, Sum1, Rs).
block_2(up, R, N, Sum, [R,0|Rs]):- % Start going down
Sum + R < N,
R1 is R - 1,
Sum1 is Sum + R,
block_2(down, R1, N, Sum1, Rs).
block_2(down, R, N, Sum, [R|Rs]):- % Keep going down
Sum + R < N,
R > 1,
R1 is R - 1,
Sum1 is Sum + R,
block_2(down, R1, N, Sum1, Rs).
% Converts a concise representation of the positions of the queens into an
% ordered list of the cells occupied by queens.
% e.g. queen_cells([2,3,4,0,3,2], 1, 14, 0, [], Qs) gives
% Qs=[1,2,15,16,17,29,30,31,32,44,45,46,59,60]
queen_cells([], _, _, _, Qs, Qs).
queen_cells([R|Rs], J, N, Indent, Qs0, Qs):-
R > 0,
Indent =:= 0, !, % The queens in this row start at the first column
cells(R, J, Qs1),
append(Qs0, Qs1, Qs2),
J1 is J + N,
queen_cells(Rs, J1, N, Indent, Qs2, Qs).
queen_cells([R|Rs], J, N, Indent, Qs0, Qs):-
R > 0, !, % The queens in this row are indented w.r.t. the previous row
J2 is J + Indent,
cells(R, J2, Qs1),
append(Qs0, Qs1, Qs2),
J1 is J + N,
Indent1 is Indent + 1,
queen_cells(Rs, J1, N, Indent1, Qs2, Qs).
queen_cells([0|Rs], J, N, _, Qs0, Qs):-
queen_cells(Rs, J, N, 1, Qs0, Qs).
% Returns R consecutive integers beginning at Q.
% e.g. cells(3, 15, [], Qs) gives Qs=[15,16,17]
cells(0, _, []):-!.
cells(R, Q, [Q|Qs]):-
R1 is R - 1,
Q1 is Q + 1,
cells(R1, Q1, Qs).
% Finds the the upper-right block of free cells.
% e.g. right_free(14, 2, 5, X) gives
% X=[78,79,80,81,82,83,84,93,94,95,96,97,98,108,109,110,111,112,123,124,125,
% 126,138,139,140,153,154,168]
right_free(N, A, C, Fs):-
F is C * N + A + C + 1,
I is N - A - C,
right_free_1(I, F, N, [], Fs).
right_free_1(0, _, _, Fs, Fs):-!.
right_free_1(I, F, N, Fs0, Fs):-
cells(I, F, Fs1),
append(Fs0, Fs1, Fs2),
I1 is I - 1,
F1 is F + N + 1,
right_free_1(I1, F1, N, Fs2, Fs).
% Finds the the lower-left block of free cells.
% e.g. left_free(14, 3, 4, X) gives
% X=[103,117,118,131,132,133,145,146,147,148,159,160,161,162,163,173,174,175,
% 176,177,178,187,188,189,190,191,192,193]
left_free(N, B, D, Fs):-
F is (B + D) * N + D + 1,
J is N - B - D,
left_free_1(1, J, F, N, [], Fs).
left_free_1(I, J, _, _, Fs, Fs):-
I > J, !.
left_free_1(I, J, F, N, Fs0, Fs):-
cells(I, F, Fs1),
append(Fs0, Fs1, Fs2),
I1 is I + 1,
F1 is F + N,
left_free_1(I1, J, F1, N, Fs2, Fs).
% Adds I to each element of a list.
incr([], _, []).
incr([X|Xs], I, [Y|Ys]):-
Y is X + I,
incr(Xs, I, Ys).
% Displays the board
show(N, Qs, Fs):-
N1 is N - 1,
N2 is N * N - 1,
show_1(0, N1, N2, Qs, Fs).
show_1(I, _, N2, _, _):-
I > N2, !,
nl.
show_1(I, N1, N2, [I|Qs], Fs):-!,
write('Q'),
I1 is I + 1,
show_2(I1, N1),
show_1(I1, N1, N2, Qs, Fs).
show_1(I, N1, N2, Qs, [I|Fs]):-!,
write('F'),
I1 is I + 1,
show_2(I1, N1),
show_1(I1, N1, N2, Qs, Fs).
show_1(I, N1, N2, Qs, Fs):-
write('+'),
I1 is I + 1,
show_2(I1, N1),
show_1(I1, N1, N2, Qs, Fs).
show_2(I, N):-
I mod (N+1) =:= 0, !,
nl.
show_2(_, _).
% e.g. intersection([[1,2,3,4,5],[2,4,6,8,10],[1,2,4]], X) gives
% X=[2,4]
intersection([Xs|Xss], Ys):-
intersection_1(Xss, Xs, Ys).
intersection_1([], Ys, Ys).
intersection_1([Xs|Xss], Ys0, Ys):-
ord_inter(Ys0, Xs, Ys1),
intersection_1(Xss, Ys1, Ys).
/* difference(Xs, Ys, Zs) is true if Zs is the list of those elements of */
/* the list Xs which are not elements of the list Ys. */
difference([], _, []).
difference([X|Xs], Ys, Zs):-member(X, Ys), !, difference(Xs, Ys, Zs).
difference([X|Xs], Ys, [X|Zs]):-difference(Xs, Ys, Zs).
/* nth_member(+Xs, ?N, ?X) is true if X is the N-th (base 0) element of */
/* the list Xs. */
nth_member(Xs, N, X):-nth_member_1(Xs, X, 0, N).
nth_member_1([X|_], X, I, I).
nth_member_1([_|Xs], X, I0, I):-
I1 is I0 + 1,
nth_member_1(Xs, X, I1, I).
/* ord_inter(+Set1, +Set2, ?Intersection) is true if Set1 and Set2 are the */
/* ordered representations of two sets, and Intersection is unified with */
/* the ordered representation of their intersection. */
ord_inter([], _, []).
ord_inter([_|_], [], []).
ord_inter([X|Xs], [X|Ys], [X|Zs]):-!, ord_inter(Xs, Ys, Zs).
ord_inter([X|Xs], [Y|Ys], Zs):-X < Y, !, ord_inter(Xs, [Y|Ys], Zs).
ord_inter([X|Xs], [_|Ys], Zs):-ord_inter([X|Xs], Ys, Zs).
/* ord_union(+Set1, +Set2, ?Union) is true if Set1 and Set2 are the */
/* ordered representations of two sets and Union is unified with the */
/* ordered representation of their union. */
ord_union([], Ys, Ys).
ord_union([X|Xs], [], [X|Xs]).
ord_union([X|Xs], [X|Ys], [X|Zs]):-!, ord_union(Xs, Ys, Zs).
ord_union([X|Xs], [Y|Ys], [X|Zs]):-X < Y, !, ord_union(Xs, [Y|Ys], Zs).
ord_union([X|Xs], [Y|Ys], [Y|Zs]):-ord_union([X|Xs], Ys, Zs).
/* append(Xs, Ys, Zs) is true if Zs is the result of appending the list Xs */
/* to the list Ys. */
%append([], Ys, Ys).
%append([X|Xs], Ys, [X|Zs]):-append(Xs, Ys, Zs).
/* length(Xs, L) is true if L is the number of elements in the list Xs. */
%length(Xs, L):-length_1(Xs, 0, L).
/* length_1(Xs, L0, L) is true if L is equal to L0 plus the number of */
/* elements in the list Xs. */
length_1([], L, L).
length_1([_|Xs], L0, L):-L1 is L0 + 1, length_1(Xs, L1, L).
/* maximum(X, Y, Z) is true if Z is the maximum of the numbers X and Y. */
maximum(X, Y, Z):-X >= Y, !, Z=X.
maximum(_, Y, Y).