1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8% 
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License. 
13% 
14% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
15% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
16% Portions created by the Initial Developer are
17% Copyright (C) 2006 Cisco Systems, Inc.  All Rights Reserved.
18% 
19% Contributor(s): 
20% 
21% END LICENSE BLOCK
22
23/********************************************************************
24 *                                                                  *
25 *                          mapcolour.ecl                           *
26 *   ECLiPSe side code for map colouring example:                   *
27 *                                                                  *
28 ********************************************************************/
29
30
31% fd/ic_search library is used to provide the different variable choice and value
32% selection strategies
33:- lib(fd_search).
34
35:- lib(ic_search).
36
37:- ensure_loaded(library(ic)).
38
39% init_map(++File, -MaxSize)
40% called from the external interface. It compiles in the map data file OsFile
41% and returns the number of countries this map specifies (MaxSize). This
42% is the maximum number of countries this map can be used for.
43init_map(OsFile, MaxSize) :-
44	% OsFile's name may be in an OS dependent format
45	os_file_name(File, OsFile),
46	compile(File),
47        % the rest is just used to find the last country
48	findall(Index, country(_,Index,_,_,_,_), Cs),
49	sort(0, >, Cs, [MaxSize|_]).
50
51% get_map_data(++Size)
52% call from external side to cause the data for Size number of countries
53% to be sent over. At the end of sending the data, the term end is sent.
54get_map_data(Size) :-
55	country(_, N, X1,Y1, X2,Y2),
56	N =< Size,
57	write_exdr(setup_map, c(N,X1,Y1,X2,Y2)),
58	fail.
59get_map_data(_) :-
60	write_exdr(setup_map, end),
61	flush(setup_map).
62
63% colouring(++Type, ++Select, ++Choice, ++N, -Backtracks, -Time)
64%
65% This is the main predicate that does the map colouring, and is called from 
66% the external side. Type is the solver/method used (prolog, delay or fd),
67% Select is the strategy used for variable selection, which corresponds to the
68% those of fd_search's search/6; Choice is the strategy used for value choice,
69% again corresponding to those available in search/6, plus rotate, the map
70% colouring specific strategy whereby the choice of the next colour is a
71% rotation of the choice for the previous country. N is the number of countries
72% to colour for this particular call, Backtracks is the number of
73% backtracks performed in the search, and Time returns the total cputime
74% used.
75colouring(Type, Select, Choice, N, Backtracks, Time) :-
76	cputime(T0),
77	colouring1(Type, Select, Choice, N, Backtracks),
78	Time is cputime - T0.
79
80colouring1(Type, Select, Choice0, N, Backtracks) :-
81	% setup the demons to inform external side of colour changes
82        % (1 demon per country)
83	functor(Countries, countries, N),
84	Countries =.. [countries|CountryList],
85	setup_demons(N, Countries),
86
87        % get the colour (numbers used so that both fd and ic solvers
88        % can be used (no symbolic domain in ic)
89	findall(X, number_colour(X,_), ColourList),
90
91	% collect the relevant neighbours information  
92	findall(C1-C2, (neighbour(C1,C2), C1=<N,C2=<N), Neighbours),
93        % make the countries both fd and ic variables. 
94	[fd,ic]: (CountryList:: ColourList),
95        % setting up the rotate value choice function for search/6
96	add_choicearg(Choice0, Choice, ColourList),
97
98        % colouring both set up the constraints and perform the search.
99        % this is to allow both the Prolog and constraint approaches
100	do_colouring(Type, Select, Choice, Neighbours, Countries,
101                     CountryList, Backtracks), 
102	% ask external side if another solution is required
103	read_exdr(continue, Continue),
104	Continue == no, !. /* otherwise fail back and get next solution */
105colouring1(_, _, _, _, _). 
106
107        
108do_colouring(prolog, Select, Choice, Neighbours, Countries, CountryList,
109             BTs) :-
110% Prolog generate and test: first generate without any constraints, and then
111% test
112	fd_search: search(CountryList, 0, Select, Choice, complete,
113                          [backtrack(BTs)]),
114        % just use #\= as values are ground so same effect as \=
115	add_fd_constraints(fd, Neighbours, Countries). 
116do_colouring(delay, Select, Choice, Neighbours, Countries, CountryList, BTs) :-
117% a \= constraint is woken when both arguments are ground
118	add_delay_constraints(Neighbours, Countries),
119	fd_search: search(CountryList, 0, Select, Choice, complete,
120                          [backtrack(BTs)]).
121do_colouring(fd, Select, Choice, Neighbours, Countries, CountryList, BTs) :-
122% finite domain #\= (using lib(fd))
123
124	add_fd_constraints(fd, Neighbours, Countries),
125	fd_search: search(CountryList, 0, Select, Choice, complete, 
126                          [backtrack(BTs)]).
127do_colouring(ic, Select, Choice, Neighbours, Countries, CountryList, BTs) :-
128% finite domain #\= (using lib(ic))
129	add_fd_constraints(ic, Neighbours, Countries),
130	ic_search: search(CountryList, 0, Select, Choice, complete, 
131                          [backtrack(BTs)]).
132
133
134
135add_fd_constraints(Solver, Neighbours, Countries) :-
136	(foreach(Pair, Neighbours), param(Countries,Solver) do
137	    not_same_colour(Solver, Pair, Countries)
138	).
139
140add_delay_constraints(Neighbours, Countries) :-
141	(foreach(Pair, Neighbours), param(Countries) do
142	    delay_not_same_colour(Pair, Countries)
143	).
144
145rotate_assign(Country, ColourList0, ColourList1) :-
146	rotate(ColourList0, ColourList1),
147	member(Country, ColourList0).
148
149
150rotate([E|Es], R) :-
151	append(Es, [E], R).
152
153
154not_same_colour(Solver, C1-C2, Countries) :-
155      % get the colours for the countries C1 and C2
156      arg(C1, Countries, Colour1),
157      arg(C2, Countries, Colour2),
158      % send constraint to either the fd or ic solver
159      Solver: (Colour1 #\= Colour2).
160
161
162delay_not_same_colour(C1-C2, Countries) :-
163      arg(C1, Countries, Colour1),
164      arg(C2, Countries, Colour2),
165      suspend(delay_not_same(Colour1, Colour2), 3, [Colour2->inst]).
166
167delay_not_same(C1, C2) :-
168	(var(C1) ->
169	    suspend(C1\=C2, 3, [C1->inst])
170	; C1 \= C2
171        ).
172
173add_choicearg(rotate,  ChoiceFunc, Values) ?- !,
174	ChoiceFunc =.. [rotate_assign,Values,_].
175add_choicearg(Choice, Choice, _Values).
176
177
178setup_demons(0, _) ?- !.
179setup_demons(N, Cs) :-
180	arg(N, Cs, C),
181	suspend(inform_colour(N,C), 3, [C->inst]),
182	N1 is N - 1,
183	setup_demons(N1, Cs).
184
185
186% inform_colour is a suspended goal (one per country) that is woken when the
187% country's colour is set. A choice-point is created so that the colour can
188% be `undone' by the external display when it is backtracked over. 
189inform_colour(N, C0) :-
190        % convert number back into a colour
191	number_colour(C0, C),
192	write_exdr(update_map,colour(N,C)),
193	flush(update_map).
194inform_colour(N, _) :-
195        % undo on backtrack and set colour to the neutral darkgray
196	write_exdr(update_map,colour(N,darkgray)),
197	flush(update_map), fail.
198
199
200% the numbers should be in order to ensure same ordering in the finite
201% domain solvers as in Prolog/delay solvers
202number_colour(1,green).
203number_colour(2,purple).
204number_colour(3,red).
205number_colour(4,yellow).
206
207
208
209
210
211