This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/Logtalk/examples/miscellaneous/queens.lgt
2001-06-06 19:40:57 +00:00

217 lines
6.9 KiB
Plaintext

% example adopted form:
% File : Queens.Pl
% Author : Richard A O'Keefe
% Updated: 8 Feb 84
% Purpose: Solve the N queens problem in Prolog.
:- object(queens).
:- uses(list).
:- public(queens/1).
:- mode(queens(+integer), one).
:- private(forbidden/4).
:- mode(forbidden(+integer, +integer, +integer, +integer), zero_or_one).
:- private(least_room_to_move/4).
:- mode(least_room_to_move(+list, -integer, -integer, -list), zero_or_more).
:- private(lr2m/6).
:- mode(lr2m(+list, +integer, +integer, -integer, -integer, -list), zero_or_more).
:- private(make_initial_table/2).
:- mode(make_initial_table(+integer, -list), zero_or_one).
:- private(make_initial_table/3).
:- mode(make_initial_table(+integer, +list, -list), zero_or_one).
:- private(number_list/2).
:- mode(number_list(+integer, -list), one).
:- private(place/2).
:- mode(place(+list, -list), zero_or_more).
:- private(prune/4).
:- mode(prune(+list, +integer, +integer, -list), zero_or_more).
:- private(prune/5).
:- mode(prune(+list, +integer, +integer, +integer, -list), zero_or_more).
:- private(shorter/2).
:- mode(shorter(+list, +list), zero_or_one).
/* The N-queens problem is to place N queens on an NxN chessboard so
that no two queens attack each other. Suppose we have a queen in
(Row1,Col1) and a queen in (Row2,Col2). They attack each other if
1. Same rank: Row1 = Row2.
2. Same file: Col1 = Col2.
3. Same NW-SE diagonal Row2 - Row1 = Col2 - Col1.
4. Same SW-NE diagonal Row2 - Row1 = Col1 - Col2.
We can express 3 and 4 another way:
3. Row2 - Col2 = Row1 - Col1.
4. Row2 + Col2 = Row1 + Col1.
So each of the N queens has four numbers associated with it,
(Row,Col,Dif,Sum), and any two queens must have different numbers
in all these positions. The possible values are
Row : 1 .. N
Col : 1 .. N
Sum : 1 .. 2N
Dif : 1-N .. N-1
The first question is, how shall we represent the board?
It is sufficient to have a table indexed by rows, whose elements
are the columns in which the corresponding queen is placed. For
example, with rows horizontal and columns vertical
1 2 3 4 -column / row
+---+---+---+---+
| | Q | | | 1
+---+---+---+---+
| | | | Q | 2
+---+---+---+---+
| Q | | | | 3
+---+---+---+---+
| | | Q | | 4
+---+---+---+---+
could be represented by board(2,4,1,3).
How are we going to place the queens? The first idea that springs
to mind is to place them one after another, but we can do better than
that. Let us maintain a table of (QueenRow/PossibleColumns), and at
each step pick the queen with the fewest possible columns, place it,
and prune the remaining sets.
Let's start by writing a predicate to generate this table. For N=4
it will look like [1/[1,2,3,4], 2/[1,2,3,4], 3/[1,2,3,4], 4/[1,2,3,4]].
*/
make_initial_table(N, Table) :-
number_list(N, PossibleColumns), % set of all possible columns
make_initial_table(N, PossibleColumns, Table).
make_initial_table(0, _, []) :- !.
make_initial_table(N, PossibleColumns, [N/PossibleColumns|Table]) :-
M is N-1,
% in C-Prolog we could write succ(M, N) which would eliminate
% the need for the cut in the previous clause
make_initial_table(M, PossibleColumns, Table).
number_list(0, []) :- !.
number_list(N, [N| List]) :-
M is N-1, % see previous comment
number_list(M, List).
/* This actually generates the reverse of what I said, so we'd get
[4/[4,3,2,1], 3/[4,3,2,1], 2/[4,3,2,1], 1/[4,3,2,1]],
but since it was to be a set of number/set pairs, that's ok.
We shall only be operating on these sets an element at a time,
so it the order doesn't matter.
Now the problem is solved if there are no queens left to place.
Otherwise, we pick the queen with the fewest possible columns,
backtrack over those possible columns, prune the possible columns
sets of the remaining queens, and recur.
We are given a set of Row/PossCols pairs for the unplaced queens,
and we are to return a set of Row-Col pairs saying where we put
the queens.
*/
place([], []).
place(UnplacedQueens, [Queen-Col|Placement]) :-
least_room_to_move(UnplacedQueens, Queen, Columns, OtherQueens),
list::member(Col, Columns), % backtrack over possible places
prune(OtherQueens, Queen, Col, RemainingQueens),
place(RemainingQueens, Placement).
/* If you haven't done this sort of thing before, least_room_to_move
can be quite tricky. The idea is the we wander down the list of
pairs, keeping the current best pair apart, and when we find that
there is a better pair we have to put the current pair back in the list.
But because these are sets, it doesn't matter *where* the pairs go in
the list. Note that we don't need a cut in the first clause of place/2
because least_room_to_move will fail on an empty list.
*/
least_room_to_move([Q/C|Table], Qbest, Cbest, Rest) :-
lr2m(Table, Q, C, Qbest, Cbest, Rest).
/* This uses accumulator passing. I really have to explain this program
to you in person.
*/
lr2m([], Q, C, Q, C, []).
lr2m([NewQ/NewC|Table], OldQ, OldC, MinQ, MinC, [OldQ/OldC|Rest]) :-
shorter(NewC, OldC),
!,
lr2m(Table, NewQ, NewC, MinQ, MinC, Rest).
lr2m([Pair|Table], OldQ, OldC, MinQ, MinC, [Pair|Rest]) :-
lr2m(Table, OldQ, OldC, MinQ, MinC, Rest).
/* shorter(L1, L2) is true when the list L1 is strictly shorter than
the list L2
*/
shorter([], [_|_]).
shorter([_|L1], [_|L2]) :-
shorter(L1, L2).
/* Now we have to code prune. To prune all the queens, we prune each
queen in turn.
*/
prune([], _, _, []).
prune([Queen/Columns|Queens], Row, Col, [Queen/Pruned|RestPruned]) :-
prune(Columns, Queen, Row, Col, Pruned),
prune(Queens, Row, Col, RestPruned).
/* To prune a single queen, we have to eliminate all the positions
forbidden by the queen wee have just placed.
*/
prune([], _, _, _, []).
prune([Col2|Cols], Row2, Row1, Col1, Permitted) :-
forbidden(Row1, Col1, Row2, Col2),
!,
prune(Cols, Row2, Row1, Col1, Permitted).
prune([Col2|Cols], Row2, Row1, Col1, [Col2|Permitted]) :-
prune(Cols, Row2, Row1, Col1, Permitted).
/* Finally, since we have ensured that two queens are automatically in
different rows, we have only to check rules 2, 3, and 4.
*/
forbidden(_, Col, _, Col).
forbidden(Row1, Col1, Row2, Col2) :-
Row2 - Col2 =:= Row1 - Col1.
forbidden(Row1, Col1, Row2, Col2) :-
Row2 + Col2 =:= Row1 + Col1.
/* The last thing left for us to do is to write the top level predicate
that ties all the pieces together. Because the 'place' predicate
may place the queens in any order, we keysort the list to make it more
readable. I'm afraid I had that in mind when I decided that it would
be a list of Row-Col pairs. I seem to recommend sorting for everything.
Well, it IS a panacea.
*/
queens(N) :-
make_initial_table(N, Table),
place(Table, Placement),
list::keysort(Placement, DisplayForm),
write(DisplayForm), nl.
:- end_object.