· 8 years ago · Apr 14, 2018, 01:50 AM
1
2:- use_module(library(clpfd)).
3:- use_module(library(lists)).
4
5/*
6Question 1
7
8(a)
9
10(1) v_94
11 =>row: {1, 3, 5} are removed
12 =>column: {1, 2, 3, 6, 7, 8} are removed
13 =>block: {1, 2, 3, 6, 9} are removed
14 =>Domain(v_94) is reduced to a singleton 4.
15
16(2) v_96
17 =>row: {1, 3, 4, 5} are removed
18 =>column: {2, 3, 5, 6, 8, 9} are removed
19 =>block: {1, 2, 3, 4, 6, 9} are removed
20 =>Domain(v_96) is reduced to a singleton 7.
21(3) v_14
22 =>row: {2, 3, 6} are removed
23 =>column: {1, 2, 3, 4, 6, 7, 8} are removed
24 =>block: {2, 3, 5, 6, 8} are removed
25 =>Domain(v_14) is reduced to a singleton 9.
26(4) v_54
27 =>column: {1, 2, 3, 4, 6, 7, 8, 9} are removed
28 =>Domain(v_54) is reduced to a singleton 5.
29(5) v_56
30 =>row: {5, 7, 8} are removed
31 =>column: {2, 3, 5, 6, 7, 8, 9} are removed
32 =>block: {1, 2, 5, 7, 8} are removed
33 => Domain(v_56) is reduced to a singleton 4.
34
35(6)example 2.
36 v_64
37 =>row: {7,3,9,8} are removed
38 =>column: {1,9,2} are removed
39 =>block: nothing are removed
40 =>Domain(v_64) is reduced to {4,5,6} no further reducable.
41
42(b)
43The set of ground atoms logic consequences of the program are:
44T1 = {edge(a,b), edge(b,c), edge(c,d), edge(b,e), edge(e,c), edge(d,e),
45 edge(e,f), edge(f,a)}
46T2 = T1 ∪ {path(a,b), path(b,c), path(c,d), path(b,e), path(e,c), path(d,e),
47 path(e,f), path(f,a)}
48T3 = T2 U { path(a,b), path(b,c), path(c,d), path(b,e), path(e,c), path(d,e),
49 path(e,f), path(f,a),path(a,c),path(b,d),path(b,f),path(d,f)}
50T4 = T3 ∪ {path(a,c), path(a,d), path(a,e), path(a,f), path(a,a), path(b,d),
51 path(b,f), path(b,a), path(b,b), path(c,e), path(c,f), path(c,a),
52 path(c,b), path(c,c), path(d,f), path(d,a), path(d,b), path(d,c),
53 path(d,d), path(e,a), path(e,b), path(e,d), path(e,e), path(f,b),
54 path(f,c), path(f,d), path(f,e), path(f,f)}
55At this point no more atoms can be obtained.
56Fix-point reached.
57*/
58
59/*
60Question 2 War and Peace
61test cases:
62p1(S) :- disarm([1,3,3,4,6,10,12],[3,4,7,9,16],S).
63 => S = [[[1, 3], [4]], [[3, 4], [7]], [[12], [3, 9]], [[6, 10], [16]]] .
64p2 :- disarm([],[],[]).
65 => true.
66p3(S) :- disarm([1,2,3,3,8,5,5],[3,6,4,4,10],S).
67 => S = [[[1, 2], [3]], [[3, 3], [6]], [[8], [4, 4]], [[5, 5], [10]]].
68p4(S) :- disarm([1,2,2,3,3,8,5],[3,2,6,4,4,10],S).
69 => false.
70p5(S) :- disarm([1,2,2,3,3,8,5,5,6,7],[3,2,6,4,4,10,1,5,2],S).
71 => false.
72p6(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).
73 => S = [[[1, 2], [3]], [[2, 2], [4]], [[5], [1, 4]], [[2, 3], [5]], [[6], [3, 3]], [[3, 8], [11]], [[6|...], [...]], [[...|...]|...], [...|...]] .
74*/
75disarm(Adivisions, Bdivisions, Solution) :-
76 insertSort(Adivisions, SortedADiv),
77 insertSort(Bdivisions, SortedBDiv),
78 disarm(SortedADiv, SortedBDiv, Solution, 0).
79disarm([], [], Solution, _) :-
80 Solution = [].
81
82
83
84
85/*
86Question 3 The seating problem
87
88The seating problem is to generate a sitting arrangement for a number of guests,
89with m tables and n chairs per table. Guests who like each other should sit at
90the same table; guests who dislike each other should not sit at the same table.
91
92To make the issue of symmetry go away, we assume that, by "guests A and B like
93each other", we mean either A likes B or B likes A; similarly, by "guests A and
94B dislike each other", we mean either A dislikes B or B dislikes A.
95
96The background information is represented by some facts. Given a specific number
97k, the following represents k tables.
98 table(1).
99 ...
100 table(k).
101The like and dislike relationships
102 like(A,B). % A likes B
103 dislike(A,C). % A dislikes C
104Given a listing of variables P representing persons, and a number N representing
105the number of chairs per table, the top predicate you need to define is:
106 seating(P,N) :- ......
107
108For a query, e.g.,
109 ?- seating([P1,P2,P3,P4,P5,P6],3).
110If solved, each Pi should be bound to a number representing a table. By typing
111";", all alternative answers should be generated.
112
113For example,
114 ?- seating([P1,P2,P3,P4,P5,P6],3).
115is a query of whether there is a sitting arrangement for 6 guests and 3 chairs
116per table.
117
118Test cases will be provided later.
119*/
120
121% Q3tests folder that is attached here, should be in the working directory.
122% Load the test cases, load the data before running.
123t0 :- ['Q3tests/t0'].
124t1 :- ['Q3tests/t1'].
125t2 :- ['Q3tests/t2'].
126t3 :- ['Q3tests/t3'].
127t4 :- ['Q3tests/t4'].
128t5 :- ['Q3tests/t5'].
129
130% tests
131q(P) :- seating(P,2).
132q1(P) :- seating(P,3).
133
134/*
135?- t0.
136true.
137?- q(P).
138false.
139?- q1(P).
140[1,[lily,ken,tony]]
141[2,[peter]];
142run time: 0.18 sec.
143...
144
145?- t1.
146true.
147No solution for either query: seating(P,2) or seating(P,3).
148[lily,ken,tony] must be at the same table;
149but peter and ann must sit at different tables.
150So, at least 3 tables are needed.
151
152?- t2.
153true.
154Same as the test case in t1, except having one more table.
155?- seating(P,2).
156no
157?- seating(P,3).
158[1,[lily,ken,tony]]
159[2,[peter]]
160[3,[ann]];
161...
162
163?- t3.
164true.
165?- seating(P,2). % No solution
166?- seating(P,3).
167[1,[lily,ken,ann]]
168[2,[tony,peter,cryst]]
169[3,[]]
170...
171Lots of other solutions
172
173?- t4.
174true.
175?- seating(P,2). % No solution (this starts taking some time to run).
176?- seating(P,3).
177[1,[lily,ken,ann]]
178[2,[tony,peter,jim]]
179[3,[cryst]]
180...
181Many other solutions
182
183?- t5.
184true.
185Same as test case in t1, except having one more table.
186?- seating(P,2).
187no
188?- seating(P,3).
189[1,[lily,ken,tony]]
190[2,[peter]]
191[3,[ann]];
192...
193*/
194
195seating(PeopleList, ChairNumPerTable) :-
196
197
198% ------------------------------------------------------------------------------
199/*
200Question 4 Subset Sum Problem (SSP)
201
202An important problem in cryptography is the so-called Subset Sum Problem.
203
204The predicate
205 subsetsum(+List, +Sum)
206where List is a list of integers (more formally, called a multiset - elements in
207it may be repeated) and Sum is an integer, determine whether there exists a subset
208Subset of List, such that the sum of the integers in Subset equals Sum.
209
210This solution was tested with example queries in the given tests-SSP.pl on a lab
211machine, ones can be solved within 2 minutes are: q1, q2, q3, q4, and q5. q6 took
212roughly 2 min 10 sec. q7 and q8 took much longer than 2 min.
213
214IMPORTANT: Note that sometimes it takes longer than usual. Thus for each test case,
215the result would be more reliable if you run it several times and compute the average
216run time.
217
218test cases:
219?- q1.
220[2,7,9]
221run time: 0.002 sec.
222true.
223
224?- q2.
225[524053838]
226run time: 0.001 sec.
227true.
228
229?- q3.
230[431825326,873310310]
231run time: 0.002 sec.
232true.
233
234?- q4.
235[816273326,4054437878,2579731950]
236run time: 0.012 sec.
237true.
238
239% Took around 15 sec
240?- q5.
241false.
242
243% Took around 2 min 10 sec
244?- q6.
245false.
246
247
248% Similar situation as TA's program: did not terminate in a reasonable time
249?- q7
250[1034291094,2096020902,469087294,2471297606,1369316398,2374890398,4173317310,2455720926,1939383126,950481070]
251run time: 542.258 sec.
252true.
253
254% Same as above. Didn't wait until it finished.
255?- q8.
256*/
257
258/*
259Redirect to subsetsum/3.
260- As only one solution is needed to determine the output to be true/false, once/1
261can be used to stop after first solution is found.
262- The found solution is also printed for testing purposes, which also conforms to
263the format of given test cases. Feel free to comment it out.
264- The given "comp_statistics†predicate is called at the end of the body to print
265out run time.
266*/
267subsetsum(List, Sum) :-
268 once(subsetsum(List, Sum, Subset)),
269 print(Subset),
270 comp_statistics.
271
272/*
273subsetsum(+List, +Sum, -Subset)
274- SubsetLen is the length of the subset, which ranges from 0 to ListLen (length
275of the list).
276- In order to get the shortest qualified subset (as TA's example shows), use the
277min variable selection strategy to try values starting with the lowest.
278- Build a list of SubsetLen variables corresponding to indices of elements from
279List. As these indices must be in ascending order, use chain/2 to create #</2
280constraints between any two consecutive indices.
281- Construct a list named Subset with elements from List Using these indices.
282Use nth1/3 wrapped in self-defined predicate xnth1/3 (so that maplist/3 can be
283used).
284- The sum of Subset must be equal to the Sum parameter.
285*/
286subsetsum(List, Sum, Subset) :-
287 length(List, ListLen),
288 SubsetLen in 0..ListLen,
289 labeling([min(SubsetLen)], [SubsetLen]),
290 length(Indices, SubsetLen),
291 Indices ins 1..ListLen,
292 chain(Indices, #<),
293 maplist(xnth1(List), Indices, Subset),
294 sum(Subset, #=, Sum).
295
296/*
297Wrapper predicate for nth1/3, for using maplist later.
298Is true when Elem is the Index'th element of List. Counting starts at 1.
299*/
300xnth1(List, Index, Elem):-
301 nth1(Index, List, Elem).
302
303/*
304The given "comp_statistics†predicate is called at the end of the subsetsum/2 body
305to print out run time.
306*/
307comp_statistics :-
308 statistics(runtime, [_, X]),
309 T is X/1000,
310 nl, % write to screen
311 write('run time: '),
312 write(T),
313 write(' sec.'),
314 nl.
315
316
317% ------------------------------------------------------------------------------
318/*
319Question 5 Graph Coloring
320
321The problem is: Given a graph in terms of nodes and arcs and a number of colors,
322determine whether there exists a coloring such that each node is colored with
323exactly one color and any two nodes that are adjacent to each other must be
324colored with different colors.
325
326We assume that nodes are named as 0,1,2,..., and arc/2 is a predicate for arcs,
327colors are given as red, blue, yellow, green, etc. The following is an input
328instance of the graph coloring problem. Note that nodes are implicitly given in
329arcs.
330 arc(0,1). arc(0,2). arc(0,3). arc(1,2). arc(1,3). arc(1,4).
331 arc(2,3). arc(2,4). arc(3,4).
332 color(red). color(blue). color(yellow).
333This graph coloring problem does not have a solution.
334
335Later, TA will provide some hints and possibly a sketch of a solution.
336*/
337
338% graphs folder has the test cases. It should be in the working directory.
339% load the test cases before running the program.
340t0 :- ['graphs/p5'].
341t1 :- ['graphs/p8'].
342t2 :- ['graphs/p10'].
343t3 :- ['graphs/p12'].
344t4 :- ['graphs/p13'].
345t5 :- ['graphs/p14'].
346t6 :- ['graphs/p15'].
347t7 :- ['graphs/p17'].
348t8 :- ['graphs/p20'].
349t9 :- ['graphs/p25'].
350t10 :- ['graphs/p30'].
351t11 :- ['graphs/p100'].
352t12 :- ['graphs/p150'].
353t13 :- ['graphs/p150_2'].
354t14 :- ['graphs/p300'].
355
356% tests
357/*
358IMPORTANT: when loading this prolog file a warning would show up, indicating
359"Singleton variables: [Colors]". This is not an issue, simply ignored it.
360*/
361c(I) :-
362 coloring(Colors, I).
363
364/*
365IMPORTANT: note that each time running a new test case (e.g., running t3 after t2),
366some warnings would should up, indicating something like "Redefined static procedure
367vertex/1", since they are already "Previously defined" in the previous test case
368file. This is not an issue, simply ignore it, or clear everything to re-run the
369program.
370
371?- t0.
372true.
373?- c(I).
374run time: 0.26 sec.
375I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow]] .
376
377?- t1.
378true.
379?- c(I).
380run time: 0.005 sec.
381I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...]] .
382
383?- t2.
384true.
385?- c(I).
386run time: 0.007 sec.
387I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
388
389?- t3.
390true.
391?- c(I).
392run time: 0.006 sec.
393I = [[0, red], [1, red], [2, blue], [3, blue], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
394
395?- t4.
396true.
397?- c(I).
398run time: 0.007 sec.
399I = [[0, red], [1, red], [2, blue], [3, blue], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
400
401?- t5.
402true.
403?- c(I).
404run time: 0.008 sec.
405I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
406
407?- t6.
408true.
409?- c(I).
410run time: 0.01 sec.
411I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
412
413?- t7.
414true.
415?- c(I).
416run time: 0.01 sec.
417I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, red], [6, yellow], [7|...], [...|...]|...] .
418
419?- t8.
420true.
421?- c(I).
422run time: 0.012 sec.
423I = [[0, red], [1, red], [2, blue], [3, blue], [4, yellow], [5, yellow], [6, black], [7|...], [...|...]|...] .
424
425?- t9.
426true.
427?- c(I).
428run time: 0.015 sec.
429I = [[0, red], [1, red], [2, blue], [3, red], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
430
431?- t10.
432true.
433?- c(I).
434run time: 0.017 sec.
435I = [[0, red], [1, red], [2, blue], [3, red], [4, blue], [5, red], [6, yellow], [7|...], [...|...]|...] .
436
437?- t11.
438true.
439?- c(I).
440run time: 0.054 sec.
441I = [[0, red], [1, red], [2, blue], [3, red], [4, blue], [5, red], [6, red], [7|...], [...|...]|...] .
442
443?- t12.
444true.
445?- c(I).
446run time: 0.026 sec.
447I = [[0, red], [1, red], [2, red], [3, red], [4, red], [5, red], [6, red], [7|...], [...|...]|...] .
448
449% Took ~10 sec
450?- t13.
451true.
452?- c(I).
453false.
454
455% Took > 2 min
456?- t14.
457true.
458?- c(I).
459*/
460
461/*
462The predicate
463 coloring(+Colors, ?VertexColors).
464does the following things in order:
465- Vertices: list of all vertices by collecting all V for which vertex(V) holds true.
466- Arcs: list of all arcs by collecting all A for which arc(A) holds true.
467- Colors: list of all colors by collecting all C for which color(C) holds true.
468- VertexNum: length of Vertices list, ie the number of vertices in Vertices
469- Map colors to integers, starting at 1. The list of [Color, Int] are saved in ColorInts.
470- ColorIntDomains: list of domains, each domain is integers corresponding to colors of one vertex.
471- MaxColorInt: length of Colors list, ie the max integer a color can map to.
472- Each domain in ColorIntDomains ranges from 1 to MaxColorInt (ie, all valid colors).
473 The index of a domain represents the vertex.
474- Apply the constraint that any two vertice that are adjacent to each other must
475 be colored with different colors.
476- Use labeling/2 to label solution.
477- Get VertexColors.
478- The given "comp_statistics†predicate is called at the end of the body to print
479out run time.
480*/
481coloring(Colors, VertexColors) :-
482 findall(Vert, vertex(Vert), Vertices),
483 findall([Vert1, Vert2], arc(Vert1, Vert2), Arcs),
484 findall(Color, color(Color), Colors),
485 length(Vertices, VertexNum),
486 colorToInt(Colors, 1, ColorInts),
487 length(ColorIntDomains, VertexNum),
488 length(Colors, MaxColorInt),
489 !,
490 ColorIntDomains ins 1..MaxColorInt,
491 adjVertConstraint(ColorIntDomains, Arcs),
492 labeling([], ColorIntDomains),
493 getVertColors(ColorIntDomains, VertexColors, 0, ColorInts),
494 comp_statistics.
495
496/*
497The predicate
498 adjVertConstraint(?ColorIntDomains, +Arcs)
499ensures the constraint that any two vertice that are adjacent to each other must
500be colored with different colors is satisfied. For each arc [Vert1, Vert2] in
501Arcs, the Vert1-th domain is not eual to Vert2-th domain in ColorIntDomains.
502
503Note that indices of domains in ColorIntDomains starts from 0. Hence nth0/3 instead
504of nth1/3 is used.
505*/
506adjVertConstraint(_, []).
507adjVertConstraint(ColorIntDomains, [[Vert1, Vert2]|ArcsTail]) :-
508 nth0(Vert1, ColorIntDomains, Domain1),
509 nth0(Vert2, ColorIntDomains, Domain2),
510 Domain1 #\= Domain2,
511 adjVertConstraint(ColorIntDomains, ArcsTail).
512
513/*
514The predicate
515 colorToInt(+Colors, +Int, -ColorInts)
516maps colors to integers, starting at specified Int. The resulting list of
517[Color, Int] list are saved in ColorInts.
518*/
519colorToInt([], _, []).
520colorToInt([Color|ColorsTail], Int, [[Color, Int]|ColorIntsTail]) :-
521 NextInt is Int + 1,
522 colorToInt(ColorsTail, NextInt, ColorIntsTail).
523
524/*
525The predicate
526 intToColor(-Color, +Int, +ColorInts)
527retrieve the corresponding color from ColorInts using the specified Int.
528*/
529intToColor(Color, Domain, [[Color, Domain]|_]).
530intToColor(Color, Domain, [[_, NextDomain]|ColorIntsTail]) :-
531 Domain \== NextDomain,
532 intToColor(Color, Domain, ColorIntsTail).
533
534/*
535The predicate
536 getVertColors(+ColorIntDomains, -VertexColors, +Vert, +ColorInts),
537gets a list of [Vert, Color] lists using the reduced ColorIntDomains and ColorInts,
538starting at specified Vert (normally 0).
539*/
540getVertColors([], [], _, _) :-
541 !.
542getVertColors([Domain|ColorIntDomainsTail], [[Vert, Color]|VertexColorsTail], Vert, ColorInts) :-
543 intToColor(Color, Domain, ColorInts),
544 NextVert is Vert + 1,
545 getVertColors(ColorIntDomainsTail, VertexColorsTail, NextVert, ColorInts).