The Non-Dominating Queens Problem

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

LPA Index     Home Page

Valid HTML 4.0!