[comp.lang.prolog] Queens Again

kale@m.cs.uiuc.edu (01/04/89)

Here is a simple program for solving the n non-attacking program.
Unlike the usual ones I have seen and written, this program uses an
array of logical variables to keep track of the status of each diagonal.

It does not exploit any symmetries except the reflection-symmetry.
It uses an ADT for a set of logical variables, which is defined
by the two predicates createSet and bind.
This ADT is implemented here simply using a flat term (so is valid upto
the maximum arity allowed on your system. It was 128 on SBProlog).

I ran this with sbprolog and quintus, and it runs much faster than the simple
programs which do not keep track of the diagonals.

No originality claimed here. I remember reading postings by Saraswat
and possibly by H. Stone that may have involved similar algorithms.

This program showed me once more the advantage of programming in Prolog.
It took me 30-40 minutes to write, debug, and execute this.
I wrote the program later in C, and it took me about 4-5 hours.
(Of course, I may be a bad C programmer, am certainly rusty).
It is just the routine details one gets caught up in, in the C program.

Some peculiarities in the program are for compatibility with our
parallel (pure) prolog interpreter.

safe(N, Queens) :-
/* Queens is a set of N co-ordinates for N non attacking queens on a
   NxN board */
	makeList(N,Cols),
	N2 is 2*N+1,
	createSet(N2, Diag1),	/* Creates an "array" of logical variables */
	createSet(N2, Diag2),
	delete(Col,Cols, RCols), Nhalf is (N+1)/2, Col =< Nhalf,
	diag1of(1,Col, N, D1),     bind(Diag1, D1, 1),
	diag2of(1,Col, N, D2),     bind(Diag2, D2, 1),
	ext(2,N,[q(1,Col)], Diag1, Diag2, RCols, Queens).

ext(Row, Max, Selected, Diag1, Diag2, Cols, Selected) :- Row > Max.

ext(Row, Max, Selected, Diag1, Diag2, Cols, Final) :-
	Row =< Max,
	delete(Col, Cols, RCols), 
	diag1of(Row,Col, Max, D1), bind(Diag1, D1, Row),
	diag2of(Row,Col, Max, D2), bind(Diag2, D2, Row),
	N1 is Row+1, 
	ext(N1, Max, [q(Row,Col)|Selected], Diag1, Diag2, RCols, Final).

diag1of(Row, Col, Max, M) :- M is Row+Col-1.
  /* diag1of returns the diagonal number of one passing thru (Row,Col) */
diag2of(Row, Col, Max, M) :- M is Row-Col+Max.
  /* diag2of returns the diagonal number of the counter-diagonal
	 passing thru (Row,Col) */

/* createSet and bind define an ADT for an array of logical variables */
/* This implementation works only for sets of size < 128. */
/* That is enough here. In general, would need a tree.    */

createSet(Size,T) :- Size < 128, functor(T,f,Size).
bind(T,Position,Value) :- arg(Position,T,Value). 

delete(X, [X|R] , R).
delete(X, [Y|R] , [Y|T]) :- delete(X,R,T).

makeList(0,[]).
makeList(N,[N|R]) :- N>0, N1 is N-1, makeList(N1,R).

kale@m.cs.uiuc.edu (01/05/89)

I posted a note with a simple N-queens programs earlier.
Here is a improved version that attempts to exploit the 8-fold symmetry.
It places 4 (or 3) queens in the rows and collumns at the borders.
It does not completely elliminate symmetries because of boundary conditions.
For example, for 8 queens, this returns 18 solutions instead of 12.
Notice that only the top level predicate (safe) was modified to
incorporate this. (But I am enclosing the rest for completeness).

safe(N,Queens) :-
	makeList(N,Cols),
	N2 is 2*N+1,
	createSet(N2, Diag1),
	createSet(N2, Diag2),
	delete(Col,Cols, RCols),
	Nhalf is (N+1)/2, Col =< Nhalf,		/* Reflection symmetry */
	diag1of(1,Col, N, D1), bind(Diag1, D1, 1),
	diag2of(1,Col, N, D2), bind(Diag2, D2, 1),

 /* Do the last row, for elliminating the 180 degree rotation symmetry */
	delete(ColLast,RCols, RCols2), ReflectCol is N-Col+1,
	ColLast > Col, ColLast =< ReflectCol,
	diag1of(N,ColLast, N, D1L), bind(Diag1, D1L, N),
	diag2of(N,ColLast, N, D2L), bind(Diag2, D2L, N),
	
/* Do First and Last Collumn, to deal with 90 and 270 degree symmetries */
        /* Last Collumn. There is Nothing there yet. */
	NCol is N - Col + 1,
	delete(N,RCols2, RCols3),
	N1 is N-1, between(2,N1, Row1),
	Row1 >= Col, /* 270 o symmetry! */
	Row1 =< NCol, /* Combined with reflection */
	diag1of(Row1,N, N, D1Right), bind(Diag1, D1Right, Row1),
	diag2of(Row1,N, N, D2Right), bind(Diag2, D2Right, Row1),
	
        /* First Collumn. There may be a queen there already. */
	Selected = [q(1,Col),q(N,ColLast), q(Row1,N) | QueenOrNil], 
		/* QueenOrNil will be bound to [] or [q(Row2,1)] by del2 */
		/* depending on whether it picks a new queen */
	del2(RCols3, RCols4, N1, Row2, QueenOrNil),
	Row2 =\= Row1,
	Row2 =< NCol, /* 90 degree symmetry! */
	Row2 >= Col, /* Combined with reflection */
	diag1of(Row2,1, N, D1Left), bind(Diag1, D1Left, Row2),
	diag2of(Row2,1, N, D2Left), bind(Diag2, D2Left, Row2),
	ext(2,N,Selected, Diag1, Diag2, RCols4, Queens, [Row1,Row2]).

/* del2 selects a row for the queen in 1st collumn, if its not
	already placed. Otherwise, it does not place any queen */
del2(RCols3, RCols4, N1, Row2, [q(Row2,1)]) :-
	delete(1, RCols3, RCols4),
	between(2,N1, Row2).
del2(RCols3, RCols3, N1, 1, []) :- /* Queen exists at (1,1) */
	notmember(1,RCols3).

ext(Row, Max, Selected, Diag1, Diag2, Cols, Selected,L) :- Row = Max.

ext(Row, Max, Selected, Diag1, Diag2, Cols, Final, [R1,R2]) :-
	Row =< Max, Row = R1, /* The row is already done */
	N1 is Row+1, 
	ext(N1, Max, Selected, Diag1, Diag2, Cols, Final, [R1,R2]).
ext(Row, Max, Selected, Diag1, Diag2, Cols, Final, [R1,R2]) :-
	Row =< Max, Row = R2, /* The row is already done */
	N1 is Row+1, 
	ext(N1, Max, Selected, Diag1, Diag2, Cols, Final, [R1,R2]).

ext(Row, Max, Selected, Diag1, Diag2, Cols, Final, [R1,R2]) :-
	Row =< Max,
	Row =\= R1, Row =\= R2,	
	delete(Col, Cols, RCols), 
	diag1of(Row,Col, Max, D1), bind(Diag1, D1, Row),
	diag2of(Row,Col, Max, D2), bind(Diag2, D2, Row),
	N1 is Row+1, 
	ext(N1, Max, [q(Row,Col)|Selected], Diag1, Diag2, RCols, Final, [R1,R2]).

diag1of(Row, Col, Max, M) :- M is Row+Col-1.
diag2of(Row, Col, Max, M) :- M is Row-Col+Max.

/* createSet and bind define an ADT for an array of logical variables */
/* This implementation works only for sets of size < 128. */
/* That is enough here. In general, would need a tree.    */
createSet(Size,T) :- Size < 128, functor(T,f,Size).
bind(T,Position,Value) :- arg(Position,T,Value). 

between(M,N, M) :- M =< N.
between(M,N,X) :- M<N, M1 is M+1, between(M1,N,X).

delete(X, [X|R] , R).
delete(X, [Y|R] , [Y|T]) :- delete(X,R,T).

makeList(0,[]).
makeList(N,[N|R]) :- N>0, N1 is N-1, makeList(N1,R).

notmember(X,[]).
notmember(X,[F|R]) :- X =\= F, notmember(X,R).