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