Path: utzoo!attcan!uunet!lll-winken!lll-lcc!ames!mailrus!csd4.milw.wisc.edu!uxc!uxc.cso.uiuc.edu!m.cs.uiuc.edu!kale
From: kale@m.cs.uiuc.edu
Newsgroups: comp.lang.prolog
Subject: Re: Queens Again
Message-ID: <5500010@m.cs.uiuc.edu>
Date: 4 Jan 89 16:31:00 GMT
References: <5500009@m.cs.uiuc.edu>
Lines: 95
Nf-ID: #R:m.cs.uiuc.edu:5500009:m.cs.uiuc.edu:5500010:000:3743
Nf-From: m.cs.uiuc.edu!kale    Jan  4 10:31:00 1989


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