· 8 years ago · Apr 14, 2018, 12:32 AM
1/*
2Assignment 4
3Xutong Zhao
41430631
5*/
6
7:- use_module(library(clpfd)).
8:- use_module(library(lists)).
9
10% test-SSS.pl is attached and placed in the same directory of the main code.
11:- include("tests-SSP.pl").
12% ------------------------------------------------------------------------------
13/*
14Question 1
15
16(a)
17Notation used for this question:
18 v_ij - the cell (or tile) at i-th row and j-th colomn.
19 Domain(v_ij) - the domain of the cell v_ij.
20 B_ij - the 3x3 box at i-th "row" and j-th "colomn" in the 9x9 grid.
21 Note: i and j starts from 1.
22
23 1. 5 examples of the removal of domain values in Example 1.
24 Explanation:
25 Since this example puzzle can be solved by ruuning the AC-3 algorithm alone,
26 for each single cell, the domain of the corresponding variable is reduced
27 to a singleton. In other words, all other 8 domain values are removed.
28 Therefore, it is straighforward to verify removal of domain values for any cell.
29
30 Examples:
31 (1) v_94
32 By enforcing node consistency,
33 row: {1, 3, 5} are removed from Domain(v_94).
34 column: {1, 2, 3, 6, 7, 8} are removed from Domain(v_94).
35 B_32: {1, 2, 3, 6, 9} are removed from Domain(v_94).
36 => Domain(v_94) is reduced to a singleton 4.
37 This triggers a sequence of domain reductions by enforcing arc-consistency.
38 (2) v_96
39 row: {1, 3, 4, 5} are removed from Domain(v_96).
40 column: {2, 3, 5, 6, 8, 9} are removed from Domain(v_96).
41 B_32: {1, 2, 3, 4, 6, 9} are removed from Domain(v_96).
42 => Domain(v_96) is reduced to a singleton 7.
43 (3) v_14
44 row: {2, 3, 6} are removed from Domain(v_14).
45 column: {1, 2, 3, 4, 6, 7, 8} are removed from Domain(v_14).
46 B_12: {2, 3, 5, 6, 8} are removed from Domain(v_14).
47 => Domain(v_14) is reduced to a singleton 9.
48 (4) v_54
49 column: {1, 2, 3, 4, 6, 7, 8, 9} are removed from Domain(v_54).
50 => Domain(v_54) is reduced to a singleton 5.
51 (5) v_56
52 row: {5, 7, 8} are removed from Domain(v_56).
53 column: {2, 3, 5, 6, 7, 8, 9} are removed from Domain(v_56).
54 B_22: {1, 2, 5, 7, 8} are removed from Domain(v_56).
55 => Domain(v_56) is reduced to a singleton 4.
56
57 2. One example in Example 2 of domain values that cannot be removed by AC-3
58 Domain(v_11) can be reduced to {4, 9}, but neither one of them can be further
59 removed.
60 Explanation:
61 By enforcing node consistency.
62 row: {1, 2, 7} are removed from Domain(v_11).
63 column: {5, 6, 7, 8} are removed from Domain(v_11).
64 B_11: {1, 3} are removed from Domain(v_11).
65 => Domain(v_11) is reduced to {4, 9}.
66 This will trigger a sequence of other domain reductions by enforcing arc-
67 consistency, since the Domain(v_11) is not reduced to a singleton. The
68 AC-3 algorithm continues to run on other variables. As a result, no new
69 singleton domain is generated. Therefore, for v_11, all three constraints
70 (distinct values in row 1, column 1, and B_11) can be satisfied. In other
71 words, for v_11 to take either 4 or 9, there exists a way to organize
72 numbers. For example,
73 row1: [9, 5, 6, 1, 3, 8, 7, 4, 2] and [4, 5, 9, 1, 3, 6, 7, 8, 2]
74 column1: [9, 2, 4, 5, 1, 7, 8, 3, 6] and [4, 2, 9, 5, 1, 7, 8, 3, 6]
75 B_11: [9, 5, 6, 2, 3, 7, 4, 8, 1] and [4, 5, 6, 2, 3, 7, 9, 8, 1]
76 hence Domain(v_11) cannot be further reduced.
77
78(b)
79The set of ground atoms that are logic consequences of the program are:
80T₀ = ∅
81Tâ‚ = {edge(a,b), edge(b,c), edge(c,d), edge(b,e), edge(e,c), edge(d,e),
82 edge(e,f), edge(f,a)}
83T₂ = T₠∪ {path(a,b), path(b,c), path(c,d), path(b,e), path(e,c), path(d,e),
84 path(e,f), path(f,a)}
85T₃ = T₂ ∪ {path(a,c), path(a,d), path(a,e), path(a,f), path(a,a), path(b,d),
86 path(b,f), path(b,a), path(b,b), path(c,e), path(c,f), path(c,a),
87 path(c,b), path(c,c), path(d,f), path(d,a), path(d,b), path(d,c),
88 path(d,d), path(e,a), path(e,b), path(e,d), path(e,e), path(f,b),
89 path(f,c), path(f,d), path(f,e), path(f,f)}
90Stop. At this point a fixed-point is reached, no more atoms can be obtained.
91T₃ was obtained by using the second clause repeatedly, with atoms in T₂. One or
92more usage of the second clause are needed to obtain each new atom about path.
93*/
94% ------------------------------------------------------------------------------
95
96
97/*
98Question 2 War and Peace
99
100Two countries have signed a peace treaty and want to disarm over a period of
101months, but they still don't completely trust each other. Each month one of the
102countries can choose to dismantle one military division while the other can
103dismantle two. Each division has a certain strength, and both sides want to make
104sure that the total military strength remains equal at each point during the
105disarmament process.
106
107The predicate
108 disarm(+Adivisions, +Bdivisions,-Solution)
109Where Adivisions and Bdivisions are lists containing the strength of each
110country's divisions and Solution is a list describing the successive dismantle-
111ments.
112
113Each element of Solution represents one dismantlement, where a dismantlement is
114a list containing two elements: the first element is a list of country A's
115dismantlements and the second is a list of country B's dismantlements.
116
117Finally, the countries want to start with small dismantlements first in order to
118build confidence, so make sure that the total strength of one month's dismantle-
119ment is less than or equal to the total strength of next month's dismantlement.
120
121test cases:
122p1(S) :- disarm([1,3,3,4,6,10,12],[3,4,7,9,16],S).
123 => S = [[[1, 3], [4]], [[3, 4], [7]], [[12], [3, 9]], [[6, 10], [16]]] .
124p2 :- disarm([],[],[]).
125 => true.
126p3(S) :- disarm([1,2,3,3,8,5,5],[3,6,4,4,10],S).
127 => S = [[[1, 2], [3]], [[3, 3], [6]], [[8], [4, 4]], [[5, 5], [10]]].
128p4(S) :- disarm([1,2,2,3,3,8,5],[3,2,6,4,4,10],S).
129 => false.
130p5(S) :- disarm([1,2,2,3,3,8,5,5,6,7],[3,2,6,4,4,10,1,5,2],S).
131 => false.
132p6(S) :- disarm([1,2,2,116,3,3,5,2,5,8,5,6,6,8,32,2],[3,5,11,4,37,1,4,121,3,3,14],S).
133 => S = [[[1, 2], [3]], [[2, 2], [4]], [[5], [1, 4]], [[2, 3], [5]], [[6], [3, 3]], [[3, 8], [11]], [[6|...], [...]], [[...|...]|...], [...|...]] .
134p2T(S) :-
135 statistics(runtime,[T0|_]),
136 p6(S),
137 statistics(runtime, [T1|_]),
138 T is T1 - T0,
139 format('p6/1 takes ~3d sec.~n', [T]).
140 => p6/1 takes 14.761 sec.
141 S = [[[1, 2], [3]], [[2, 2], [4]], [[5], [1, 4]], [[2, 3], [5]], [[6], [3, 3]], [[3, 8], [11]], [[6|...], [...]], [[...|...]|...], [...|...]] .
142*/
143
144/*
145Sort the lists of divisions to be compatible with other disarm/4 predicates
146implementations. Call disarm/4 with sorted division lists. Since the total
147strength of one month's dismantlement is less than or equal to the that of next
148month's dismantlement, start with previous dismantlement of 0.
149*/
150disarm(Adivisions, Bdivisions, Solution) :-
151 insertSort(Adivisions, SortedADiv),
152 insertSort(Bdivisions, SortedBDiv),
153 disarm(SortedADiv, SortedBDiv, Solution, 0).
154
155/*
156If both division lists are empty, indicating the end of dismantlement, the
157Solution of this very call should also be am empty list. In this case, there is
158no need to worry about the previous dismantlement value.
159*/
160disarm([], [], Solution, _) :-
161 Solution = [].
162
163/*
164Case 1: Each month A dismantles 1 military division while B dismantles 2.
165Select Adivisions's 1st element (ADism), and Bdivisions' 1st and 2nd elements
166(BDism1 and BDism2). Ensure ADism is equal to BDism1+BDism2. Ensure ADism is greater
167than or equal to PrevDism so that the total strength of one month's dismantlement is
168less than or equal to that of next month's dismantlement. If all conditions are
169satisfied, append [[ADism], [BDism1, BDism2]] to Solution, and move on to the
170rest of Adivisions and Bdivisions.
171*/
172disarm(Adivisions, Bdivisions, Solution, PrevDism):-
173 Vars = [ADism, BDism1, BDism2],
174 select(ADism, Adivisions, NewADiv),
175 select(BDism1, Bdivisions, NextBDiv),
176 select(BDism2, NextBDiv, NewBDiv),
177 BDism1 #=< BDism2,
178 ADism #= BDism1 + BDism2,
179 PrevDism #=< ADism,
180 disarm(NewADiv, NewBDiv, TempSol, ADism),
181 append([[[ADism], [BDism1, BDism2]]], TempSol, Solution),
182 label(Vars).
183
184/*
185Case 2: Each month B dismantles 1 military division while A dismantles 2.
186Select Bdivisions's 1st element (BDism), and Adivisions' 1st and 2nd elements
187(ADism1 and ADism2). Ensure BDism is equal to ADism1+ADism2. Ensure BDism is greater
188than or equal to PrevDism so that the total strength of one month's dismantlement is
189less than or equal to that of next month's dismantlement. If all conditions are
190satisfied, append [[ADism1, ADism2], [BDism]] to Solution, and move on to the
191rest of Adivisions and Bdivisions.
192*/
193disarm(Adivisions, Bdivisions, Solution, PrevDism):-
194 Vars = [ADism1, ADism2, BDism],
195 select(BDism, Bdivisions, NewBDiv),
196 select(ADism1, Adivisions, NextADiv),
197 select(ADism2, NextADiv, NewADiv),
198 ADism1 #=< ADism2,
199 BDism #= ADism1 + ADism2,
200 PrevDism #=< BDism,
201 disarm(NewADiv, NewBDiv, TempSol, BDism),
202 append([[[ADism1, ADism2], [BDism]]], TempSol, Solution),
203 label(Vars).
204
205/*
206Sorting algorithm adopted from http://kti.ms.mff.cuni.cz/~bartak/prolog/sorting.html
207Without minor changes added to support usage of self-defined comparison predicate
208like Assignment 3.
209*/
210insertSort(List, Sorted) :-
211 i_sort(List, [], Sorted).
212
213i_sort([], Acc, Acc).
214i_sort([H|T], Acc, Sorted) :-
215 insert(H, Acc, NAcc),
216 i_sort(T, NAcc, Sorted).
217
218insert(X, [Y|T], [Y|NT]) :-
219 X > Y,
220 insert(X, T, NT).
221insert(X, [Y|T], [X,Y|T]) :-
222 X =< Y.
223insert(X, [], [X]).
224
225% ------------------------------------------------------------------------------
226/*
227Question 3 The seating problem
228
229The seating problem is to generate a sitting arrangement for a number of guests,
230with m tables and n chairs per table. Guests who like each other should sit at
231the same table; guests who dislike each other should not sit at the same table.
232
233To make the issue of symmetry go away, we assume that, by "guests A and B like
234each other", we mean either A likes B or B likes A; similarly, by "guests A and
235B dislike each other", we mean either A dislikes B or B dislikes A.
236
237The background information is represented by some facts. Given a specific number
238k, the following represents k tables.
239 table(1).
240 ...
241 table(k).
242The like and dislike relationships
243 like(A,B). % A likes B
244 dislike(A,C). % A dislikes C
245Given a listing of variables P representing persons, and a number N representing
246the number of chairs per table, the top predicate you need to define is:
247 seating(P,N) :- ......
248
249For a query, e.g.,
250 ?- seating([P1,P2,P3,P4,P5,P6],3).
251If solved, each Pi should be bound to a number representing a table. By typing
252";", all alternative answers should be generated.
253
254For example,
255 ?- seating([P1,P2,P3,P4,P5,P6],3).
256is a query of whether there is a sitting arrangement for 6 guests and 3 chairs
257per table.
258
259Test cases will be provided later.
260*/
261
262% Q3tests folder that is attached here, should be in the working directory.
263% Load the test cases, load the data before running.
264t0 :- ['Q3tests/t0'].
265t1 :- ['Q3tests/t1'].
266t2 :- ['Q3tests/t2'].
267t3 :- ['Q3tests/t3'].
268t4 :- ['Q3tests/t4'].
269t5 :- ['Q3tests/t5'].
270
271% tests
272q(P) :- seating(P,2).
273q1(P) :- seating(P,3).
274
275/*
276?- t0.
277true.
278?- q(P).
279false.
280?- q1(P).
281[1,[lily,ken,tony]]
282[2,[peter]];
283run time: 0.18 sec.
284...
285
286?- t1.
287true.
288No solution for either query: seating(P,2) or seating(P,3).
289[lily,ken,tony] must be at the same table;
290but peter and ann must sit at different tables.
291So, at least 3 tables are needed.
292
293?- t2.
294true.
295Same as the test case in t1, except having one more table.
296?- seating(P,2).
297no
298?- seating(P,3).
299[1,[lily,ken,tony]]
300[2,[peter]]
301[3,[ann]];
302...
303
304?- t3.
305true.
306?- seating(P,2). % No solution
307?- seating(P,3).
308[1,[lily,ken,ann]]
309[2,[tony,peter,cryst]]
310[3,[]]
311...
312Lots of other solutions
313
314?- t4.
315true.
316?- seating(P,2). % No solution (this starts taking some time to run).
317?- seating(P,3).
318[1,[lily,ken,ann]]
319[2,[tony,peter,jim]]
320[3,[cryst]]
321...
322Many other solutions
323
324?- t5.
325true.
326Same as test case in t1, except having one more table.
327?- seating(P,2).
328no
329?- seating(P,3).
330[1,[lily,ken,tony]]
331[2,[peter]]
332[3,[ann]];
333...
334*/
335
336seating(PeopleList, ChairNumPerTable) :-
337
338
339% ------------------------------------------------------------------------------
340/*
341Question 4 Subset Sum Problem (SSP)
342
343An important problem in cryptography is the so-called Subset Sum Problem.
344
345The predicate
346 subsetsum(+List, +Sum)
347where List is a list of integers (more formally, called a multiset - elements in
348it may be repeated) and Sum is an integer, determine whether there exists a subset
349Subset of List, such that the sum of the integers in Subset equals Sum.
350
351This solution was tested with example queries in the given tests-SSP.pl on a lab
352machine, ones can be solved within 2 minutes are: q1, q2, q3, q4, and q5. q6 took
353roughly 2 min 10 sec. q7 and q8 took much longer than 2 min.
354
355IMPORTANT: Note that sometimes it takes longer than usual. Thus for each test case,
356the result would be more reliable if you run it several times and compute the average
357run time.
358
359test cases:
360?- q1.
361[2,7,9]
362run time: 0.002 sec.
363true.
364
365?- q2.
366[524053838]
367run time: 0.001 sec.
368true.
369
370?- q3.
371[431825326,873310310]
372run time: 0.002 sec.
373true.
374
375?- q4.
376[816273326,4054437878,2579731950]
377run time: 0.012 sec.
378true.
379
380% Took around 15 sec
381?- q5.
382false.
383
384% Took around 2 min 10 sec
385?- q6.
386false.
387
388
389% Similar situation as TA's program: did not terminate in a reasonable time
390?- q7
391[1034291094,2096020902,469087294,2471297606,1369316398,2374890398,4173317310,2455720926,1939383126,950481070]
392run time: 542.258 sec.
393true.
394
395% Same as above. Didn't wait until it finished.
396?- q8.
397*/
398
399/*
400Redirect to subsetsum/3.
401- As only one solution is needed to determine the output to be true/false, once/1
402can be used to stop after first solution is found.
403- The found solution is also printed for testing purposes, which also conforms to
404the format of given test cases. Feel free to comment it out.
405- The given "comp_statistics†predicate is called at the end of the body to print
406out run time.
407*/
408subsetsum(List, Sum) :-
409 once(subsetsum(List, Sum, Subset)),
410 print(Subset),
411 comp_statistics.
412
413/*
414subsetsum(+List, +Sum, -Subset)
415- SubsetLen is the length of the subset, which ranges from 0 to ListLen (length
416of the list).
417- In order to get the shortest qualified subset (as TA's example shows), use the
418min variable selection strategy to try values starting with the lowest.
419- Build a list of SubsetLen variables corresponding to indices of elements from
420List. As these indices must be in ascending order, use chain/2 to create #</2
421constraints between any two consecutive indices.
422- Construct a list named Subset with elements from List Using these indices.
423Use nth1/3 wrapped in self-defined predicate xnth1/3 (so that maplist/3 can be
424used).
425- The sum of Subset must be equal to the Sum parameter.
426*/
427subsetsum(List, Sum, Subset) :-
428 length(List, ListLen),
429 SubsetLen in 0..ListLen,
430 labeling([min(SubsetLen)], [SubsetLen]),
431 length(Indices, SubsetLen),
432 Indices ins 1..ListLen,
433 chain(Indices, #<),
434 maplist(xnth1(List), Indices, Subset),
435 sum(Subset, #=, Sum).
436
437/*
438Wrapper predicate for nth1/3, for using maplist later.
439Is true when Elem is the Index'th element of List. Counting starts at 1.
440*/
441xnth1(List, Index, Elem):-
442 nth1(Index, List, Elem).
443
444/*
445The given "comp_statistics†predicate is called at the end of the subsetsum/2 body
446to print out run time.
447*/
448comp_statistics :-
449 statistics(runtime, [_, X]),
450 T is X/1000,
451 nl, % write to screen
452 write('run time: '),
453 write(T),
454 write(' sec.'),
455 nl.
456
457
458% ------------------------------------------------------------------------------
459/*
460Question 5 Graph Coloring
461
462The problem is: Given a graph in terms of nodes and arcs and a number of colors,
463determine whether there exists a coloring such that each node is colored with
464exactly one color and any two nodes that are adjacent to each other must be
465colored with different colors.
466
467We assume that nodes are named as 0,1,2,..., and arc/2 is a predicate for arcs,
468colors are given as red, blue, yellow, green, etc. The following is an input
469instance of the graph coloring problem. Note that nodes are implicitly given in
470arcs.
471 arc(0,1). arc(0,2). arc(0,3). arc(1,2). arc(1,3). arc(1,4).
472 arc(2,3). arc(2,4). arc(3,4).
473 color(red). color(blue). color(yellow).
474This graph coloring problem does not have a solution.
475
476Later, TA will provide some hints and possibly a sketch of a solution.
477*/
478
479% graphs folder has the test cases. It should be in the working directory.
480% load the test cases before running the program.
481t0 :- ['graphs/p5'].
482t1 :- ['graphs/p8'].
483t2 :- ['graphs/p10'].
484t3 :- ['graphs/p12'].
485t4 :- ['graphs/p13'].
486t5 :- ['graphs/p14'].
487t6 :- ['graphs/p15'].
488t7 :- ['graphs/p17'].
489t8 :- ['graphs/p20'].
490t9 :- ['graphs/p25'].
491t10 :- ['graphs/p30'].
492t11 :- ['graphs/p100'].
493t12 :- ['graphs/p150'].
494t13 :- ['graphs/p150_2'].
495t14 :- ['graphs/p300'].
496
497% tests
498/*
499IMPORTANT: when loading this prolog file a warning would show up, indicating
500"Singleton variables: [Colors]". This is not an issue, simply ignored it.
501*/
502c(I) :-
503 coloring(Colors, I).
504
505/*
506IMPORTANT: note that each time running a new test case (e.g., running t3 after t2),
507some warnings would should up, indicating something like "Redefined static procedure
508vertex/1", since they are already "Previously defined" in the previous test case
509file. This is not an issue, simply ignore it, or clear everything to re-run the
510program.
511
512?- t0.
513true.
514?- c(I).
515run time: 0.26 sec.
516I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow]] .
517
518?- t1.
519true.
520?- c(I).
521run time: 0.005 sec.
522I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...]] .
523
524?- t2.
525true.
526?- c(I).
527run time: 0.007 sec.
528I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
529
530?- t3.
531true.
532?- c(I).
533run time: 0.006 sec.
534I = [[0, red], [1, red], [2, blue], [3, blue], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
535
536?- t4.
537true.
538?- c(I).
539run time: 0.007 sec.
540I = [[0, red], [1, red], [2, blue], [3, blue], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
541
542?- t5.
543true.
544?- c(I).
545run time: 0.008 sec.
546I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
547
548?- t6.
549true.
550?- c(I).
551run time: 0.01 sec.
552I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
553
554?- t7.
555true.
556?- c(I).
557run time: 0.01 sec.
558I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
559
560?- t8.
561true.
562?- c(I).
563run time: 0.012 sec.
564I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, yellow], [6, black], [7|...], [...|...]|...] .
565
566?- t9.
567true.
568?- c(I).
569run time: 0.015 sec.
570I = [[0, red], [1, red], [2, blue], [3, red], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
571
572?- t10.
573true.
574?- c(I).
575run time: 0.017 sec.
576I = [[0, red], [1, red], [2, blue], [3, red], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
577
578?- t11.
579true.
580?- c(I).
581run time: 0.054 sec.
582I = [[0, red], [1, red], [2, blue], [3, red], [4, blue], [5, red], [6, red], [7|...], [...|...]|...] .
583
584?- t12.
585true.
586?- c(I).
587run time: 0.026 sec.
588I = [[0, red], [1, red], [2, red], [3, red], [4, red], [5, red], [6, red], [7|...], [...|...]|...] .
589
590% Took ~10 sec
591?- t13.
592true.
593?- c(I).
594false.
595
596% Took > 2 min
597?- t14.
598true.
599?- c(I).
600*/
601
602/*
603The predicate
604 coloring(+Colors, ?VertexColors).
605does the following things in order:
606- Vertices: list of all vertices by collecting all V for which vertex(V) holds true.
607- Arcs: list of all arcs by collecting all A for which arc(A) holds true.
608- Colors: list of all colors by collecting all C for which color(C) holds true.
609- VertexNum: length of Vertices list, ie the number of vertices in Vertices
610- Map colors to integers, starting at 1. The list of [Color, Int] are saved in ColorInts.
611- ColorIntDomains: list of domains, each domain is integers corresponding to colors of one vertex.
612- MaxColorInt: length of Colors list, ie the max integer a color can map to.
613- Each domain in ColorIntDomains ranges from 1 to MaxColorInt (ie, all valid colors).
614 The index of a domain represents the vertex.
615- Apply the constraint that any two vertice that are adjacent to each other must
616 be colored with different colors.
617- Use labeling/2 to label solution.
618- Get VertexColors.
619- The given "comp_statistics†predicate is called at the end of the body to print
620out run time.
621*/
622coloring(Colors, VertexColors) :-
623 findall(Vert, vertex(Vert), Vertices),
624 findall([Vert1, Vert2], arc(Vert1, Vert2), Arcs),
625 findall(Color, color(Color), Colors),
626 length(Vertices, VertexNum),
627 colorToInt(Colors, 1, ColorInts),
628 length(ColorIntDomains, VertexNum),
629 length(Colors, MaxColorInt),
630 !,
631 ColorIntDomains ins 1..MaxColorInt,
632 adjVertConstraint(ColorIntDomains, Arcs),
633 labeling([], ColorIntDomains),
634 getVertColors(ColorIntDomains, VertexColors, 0, ColorInts),
635 comp_statistics.
636
637/*
638The predicate
639 adjVertConstraint(?ColorIntDomains, +Arcs)
640ensures the constraint that any two vertice that are adjacent to each other must
641be colored with different colors is satisfied. For each arc [Vert1, Vert2] in
642Arcs, the Vert1-th domain is not eual to Vert2-th domain in ColorIntDomains.
643
644Note that indices of domains in ColorIntDomains starts from 0. Hence nth0/3 instead
645of nth1/3 is used.
646*/
647adjVertConstraint(_, []).
648adjVertConstraint(ColorIntDomains, [[Vert1, Vert2]|ArcsTail]) :-
649 nth0(Vert1, ColorIntDomains, Domain1),
650 nth0(Vert2, ColorIntDomains, Domain2),
651 Domain1 #\= Domain2,
652 adjVertConstraint(ColorIntDomains, ArcsTail).
653
654/*
655The predicate
656 colorToInt(+Colors, +Int, -ColorInts)
657maps colors to integers, starting at specified Int. The resulting list of
658[Color, Int] list are saved in ColorInts.
659*/
660colorToInt([], _, []).
661colorToInt([Color|ColorsTail], Int, [[Color, Int]|ColorIntsTail]) :-
662 NextInt is Int + 1,
663 colorToInt(ColorsTail, NextInt, ColorIntsTail).
664
665/*
666The predicate
667 intToColor(-Color, +Int, +ColorInts)
668retrieve the corresponding color from ColorInts using the specified Int.
669*/
670intToColor(Color, Domain, [[Color, Domain]|_]).
671intToColor(Color, Domain, [[_, NextDomain]|ColorIntsTail]) :-
672 Domain \== NextDomain,
673 intToColor(Color, Domain, ColorIntsTail).
674
675/*
676The predicate
677 getVertColors(+ColorIntDomains, -VertexColors, +Vert, +ColorInts),
678gets a list of [Vert, Color] lists using the reduced ColorIntDomains and ColorInts,
679starting at specified Vert (normally 0).
680*/
681getVertColors([], [], _, _) :-
682 !.
683getVertColors([Domain|ColorIntDomainsTail], [[Vert, Color]|VertexColorsTail], Vert, ColorInts) :-
684 intToColor(Color, Domain, ColorInts),
685 NextVert is Vert + 1,
686 getVertColors(ColorIntDomainsTail, VertexColorsTail, NextVert, ColorInts).