Article View: comp.lang.prolog
Article #3846Re: Queens Again
From: kale
Date: Wed, 04 Jan 1989 16:31
Date: Wed, 04 Jan 1989 16:31
95 lines
4271 bytes
4271 bytes
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).
Technical Details
Message-ID:
<5500010@m.cs.uiuc.edu>Path:
arc1-ca.pugleaf.net!utzoo!attcan!uunet!lll-winken!lll-lcc!ames!mailrus!csd4.milw.wisc.edu!uxc!uxc.cso.uiuc.edu!m.cs.uiuc.edu!kaleReferences:
<5500009@m.cs.uiuc.edu>Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!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