1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21%
22% END LICENSE BLOCK
23%
24% System:	ECLiPSe Constraint Logic Programming System
25% Version:	$Id: queens.pl,v 1.1 2008/06/30 17:43:48 jschimpf Exp $
26% ----------------------------------------------------------------------
27
28/*
29
30  SEPIA DEMO PROGRAM
31
32  IDENTIFICATION:	queens.pl
33
34  AUTHOR:		Micha Meier
35
36  CONTENTS:		go_queens/0		runs the demo
37
38  DESCRIPTION:
39
40 	This program shows the difference of various constraint
41 	solving approaches. Using the graphics interface it is possible
42	to solve the N-queens problem for any N, using four different
43	strategies:
44		- naive: generate and test
45		- constraints: using finite domains, queens are labelled
46			strictly left to right
47		- first fail: finite domains, the most constrained queen
48			is selected for the labeling
49		- heuristics: finite domains, start from the centre of
50			the board rather than from the left bottom corner,
51			us the first fail principle.
52	It can be seen that for small N the difference is not very big,
53	however for greater N the strategy becomes significant.
54 */
55
56
57:- module(queens).
58:- use_module(library(fd)).
59:- lib(util).
60:- global
61	close_queens/0,
62	go_queens/0.
63
64:- dynamic
65	stop/0.
66
67:-
68   make_local_array(mode),
69   setval(mode, naive).
70
71:-      make_local_array(flags),
72	get_flag(debug_compile, DC),
73	get_flag(variable_names, VN),
74	setval(flags, flags(DC, VN)),
75	nodbgcomp,
76	true.
77
78window_data(0, 0, 500, 500).
79
80go_queens :-
81	(open_pce -> true; true),
82	global(window_data/4),
83	(open_2d(0,0,5000,5000) -> true; clear_view_surface(0)),
84	interior_style(1,0),
85	line_color(1),
86	Nb is fix(5000/8),
87	board(8, 0, Nb),
88	make_dialog.
89
90close_queens :-
91	(close_2d -> true; true),
92	object(@map_dialog),
93	send(@map_dialog, destroy),
94	call(get_flag(window_data/4, definition_module, queens), kegi),
95	local(window_data/4),
96	!.
97close_queens.
98
99place_queens :-
100	get(@queens_number, string, Text),
101	integer_atom(N, Text),
102	getval(mode, Mode),
103	queens(N, yes, Mode).
104
105queens(N, Mode) :-
106	queens(N, yes, Mode).
107
108queens(N, Gr, Mode) :-
109	make_list(N, List),
110	(Gr == yes ->
111	    send(@queen_setting, selection, '        '),
112	    send(@queen_solving, selection, '        '),
113	    clear_view_surface(0),
114	    interior_style(1,0),
115	    line_color(1),
116	    Nb is fix(5000/N),
117	    board(N, 0, Nb),
118	    drawlp(List, 1, Nb)
119	;
120	    true
121	),
122	cputime(T0),
123	(Mode \== naive ->
124	    List :: 1..N, 		% Domain of Xi's
125	    queens(List),
126	    alldistinct(List)
127	;
128	    true
129	),
130	cputime(T1),
131	T is round((T1 - T0) * 100)/100,
132	(Gr == yes ->
133	    term_string(T, String),
134	    send(@queen_setting, selection, String)
135	;
136	    printf("%d queens:\n\tSetting up constraints %.2f sec.\n%b", [N, T])
137	),
138	labeling(List, N, Mode),
139	Te is round((cputime - T1) * 100)/100,
140	(Gr == yes ->
141	    term_string(Te, Se),
142	    send(@queen_solving, selection, Se)
143	;
144	    printf("\tSolving                %.2f sec.\n%b", [Te])
145	).
146
147queens([]).
148queens([X|Y]) :-
149   safe(X,Y,1),
150   queens(Y).
151
152safe(_,[],_).
153safe(X,[F|T],Nb) :-
154   noattack(X,F,Nb),
155   Newnb is Nb + 1,
156   safe(X,T,Newnb).
157
158noattack(X,Y,Nb) :-
159   Y + Nb ## X,
160   X + Nb ## Y.
161
162safe_naive(_,[],_).
163safe_naive(X,[F|T],Nb) :-
164   X + Nb =\= F,
165   F + Nb =\= X,
166   X \== F,
167   Newnb is Nb + 1,
168   safe_naive(X,T,Newnb).
169
170make_list(0, []) :- !.
171make_list(N, [_|Rest]) :-
172	N1 is N - 1,
173	make_list(N1, Rest).
174
175labeling(L, _, ff) :-
176	labeling(L).
177labeling(L, N, ffh) :-
178	Nh is N // 2,
179	labeling_h(L, Nh).
180labeling(L, _, noff) :-
181	labeling_noff(L).
182labeling(L, N, naive) :-
183	generate(L, N).
184
185labeling([]).
186labeling([X|Y]) :-
187   deleteffc(Var,[X|Y], Reste),			% Var has least domain
188   indomain(Var),				% generates values in domain
189   (stop -> exit_block(abort) ; labeling(Reste)).
190
191labeling_h([], _).
192labeling_h([X|Y], Nh) :-
193   deleteffh(Var,[X|Y],Nh, Reste),			% Var has least domain
194   indomainq(Var),				% generates values in domain
195   (stop -> exit_block(abort) ; labeling_h(Reste, Nh)).
196
197labeling_noff([]).
198labeling_noff([H|T]) :-
199	indomain(H),
200	(stop -> exit_block(abort) ; labeling_noff(T)).
201
202generate(List, N) :-
203	generate(List, N, []).
204
205generate([], _, _).
206generate([Var|Vars], N, Alloc) :-
207	between(1, N, Var),
208	safe_naive(Var, Alloc, 1),
209	(stop -> exit_block(abort); generate(Vars, N, [Var|Alloc])).
210
211% Specific predicates, some of them actually copied from domain.pl
212deleteffh(Var, [H|T], Nh, Rest) :-
213    get_var_domain(H, _, Card),
214    Dist is Nh - 1,
215    find_least_domain(T, H, Card, 2, Nh, Dist, Chosen, Rest),
216    Var = Chosen.
217
218find_least_domain([], Chosen, _, _, _, _, Chosen, []) :- !.
219find_least_domain([Var|L], OldVar, OldCard, I, Nh, OldDist, Chosen, [V|Rest]) :-
220    get_var_domain(Var, _, NewCard),
221    (NewCard == 1 ->
222            Chosen = Var,
223            Rest = L,
224            V = OldVar
225    ;
226            D is abs(Nh - I),
227            ((NewCard > OldCard ; NewCard == OldCard, D > OldDist) ->
228                    V = Var, Next = OldVar, Max = OldCard, Dist = OldDist
229            ;
230                    V = OldVar, Next = Var, Max = NewCard, Dist = D
231            ),
232            I1 is I + 1,
233            find_least_domain(L, Next, Max, I1, Nh, Dist, Chosen, Rest)
234    ).
235
236make_queen_domain(Var, Size, NewDomain) :-
237	Half is Size // 2,
238	dom(Var, List),
239	halve(Half, List, [], L1, L2),
240	merge(L1, L2, NewDomain).
241
242halve(0, L2, L1, L1, L2) :- !.
243halve(N, [H|R], Li, L1, L2) :-
244	N1 is N - 1,
245	halve(N1, R, [H|Li], L1, L2).
246
247merge([], L, L) :- !.
248merge(L, [], L) :- !.
249merge([H1|L1], [H2|L2], [H1, H2|R]) :-
250	merge(L1, L2, R).
251
252get_var_domain(Var, Domain, Size) :-
253    dvar_domain(Var, Domain),
254    dom_size(Domain, Size).
255
256indomainq(Var) :-
257	get_var_domain(Var, Domain, Size),
258        make_queen_domain(Var, Size, NewDomain),
259        member(Var, NewDomain).
260
261%% Graphic stuff
262drawlp([], _, _).
263drawlp([H|T],N,Size):-
264	draw(H,N,Size),
265	N1 is N+1,
266	drawlp(T,N1,Size).
267
268delay draw(L,_,_) if var(L).
269draw(L,K,Size):-
270	X is K*Size,
271	Y is L*Size,
272	X1 is X-Size,
273	Y1 is Y-Size,
274	fill_color(1),
275	rectangle(X,Y,X1,Y1).
276draw(L,K,Size):-
277	X is K*Size,
278	Y is L*Size,
279	X1 is X-Size,
280	Y1 is Y-Size,
281	fill_color(0),
282	rectangle(X,Y,X1,Y1),
283	line(X,Y,X,Y1),
284	line(X,Y1,X1,Y1),
285	line(X1,Y1,X1,Y),
286	line(X1,Y,X,Y),
287	fail.
288
289board(N,N,Size):-
290	!,
291	X is N*Size,
292	line(0,X,X,X),
293	line(X,0,X,X).
294board(Nmax,N,Size):-
295	X is N*Size,
296	Xmax is Nmax*Size,
297	line(0,X,Xmax,X),
298	line(X,0,X,Xmax),
299	N1 is N+1,
300	board(Nmax,N1,Size).
301
302%-------------------------------------------------------
303% dialog window
304%-------------------------------------------------------
305
306:- make_callback(queen_dialog_pressed/2).
307:- make_callback(queen_constraints_selected/2).
308:- make_callback(queen_text_item/2).
309
310make_dialog :-
311	new_dialog(@map_dialog, 'Queens Set Up', dialog_panel),
312	send(@map_dialog, open, point(600, 0)).
313
314dialog_panel(@queen_run, button('Run', queen_dialog_pressed), append, []).
315dialog_panel(@queen_stop, button('Abort', queen_dialog_pressed), right, []).
316dialog_panel(@queen_quit, button('Quit', queen_dialog_pressed), right, []).
317dialog_panel(_, label(none, 'Setting: '), point(180, 10), []).
318dialog_panel(@queen_setting, label(none, '       '), point(240, 10), []).
319dialog_panel(_, label(none, 'Solving: '), point(180, 30), []).
320dialog_panel(@queen_solving, label(none, '       '), point(240, 30), []).
321dialog_panel(_, menu('Solving mode', cycle, cascade(0, queen_constraints_selected, 0),
322	[naive, constraints, 'first fail', 'heuristics']), below, []).
323%dialog_panel(_, label(none, 'Number of queens'), below, []).
324dialog_panel(@queens_number, text_item('Number of queens:', 8, queen_text_item), below, []).
325
326queen_constraints_selected(_, naive) :-
327	setval(mode, naive).
328queen_constraints_selected(_, constraints) :-
329	setval(mode, noff).
330queen_constraints_selected(_, 'first fail') :-
331	setval(mode, ff).
332queen_constraints_selected(_, heuristics) :-
333	setval(mode, ffh).
334
335queen_text_item(D, _) :-
336	queen_dialog_pressed(D, 'Run').
337
338queen_dialog_pressed(_, 'Run') :-
339	retract_all(stop),
340	send(@pce, async, 0),
341	send(@queen_stop, [greyed:off, active:on]),
342	send(@queen_run, [greyed:on, active:off]),
343	send(@queen_quit, [greyed:on, active:off]),
344	block(place_queens, stopped, true),
345	send(@queen_quit, [greyed:off, active:on]),
346	send(@queen_run, [greyed:off, active:on]),
347	send(@queen_stop, [greyed:on, active:off]).
348queen_dialog_pressed(_, 'Abort') :-
349	send(@queen_run, [greyed:off, active:on]),
350	send(@queen_quit, [greyed:off, active:on]),
351	send(@queen_stop, [greyed:on, active:off]),
352	assert(stop).
353queen_dialog_pressed(_, 'Quit') :-
354	close_queens,
355	abort.
356
357:-      getval(flags, flags(DC, VN)),
358	set_flag(debug_compile, DC),
359	set_flag(variable_names, VN),
360	erase_array(flags).
361