/* excov(Set, Subsets, Cover) is true if Set is a set of integers; Subsets */ /* is a list of ordered sets of integers; Cover is a sublist of Subsets */ /* which contains each of the integers in Set exactly once, and integers */ /* not in Set at most once. On backtracking, all solutions will be found. */ /* Examples: */ /* excov([1,2,3,4,5,6,7], [[3,5,6],[1,4,7],[2,3,6],[1,4],[2,7],[4,5,7]], X) */ /* gives X=[[1,4],[3,5,6],[2,7]] */ /* excov([1,2,3,4,5], [[1,3,4],[2],[3],[1,4,5],[2,5,6]], X) */ /* gives X=[[1,3,4],[2,5,6]] and X=[[1,4,5],[2],[3]] */ excov(Set, Subsets, Cover):- initial_counts(Set, Subsets, Counts), excov_1(Counts, Subsets, Cover). excov_1([], _, []):-!. excov_1(Counts, Subsets, [Subset|Cover]):- selected_integer(Counts, X), % X is the first integer in Counts having the smallest non-zero count remove_subset(Subsets, X, Subset, Subsets1), % Subset is an element of Subsets containing X, and Subsets1 contains the % other elements of Subsets split(Subsets1, Subset, Joint, Disjoint), % Joint and Disjoint are the subsets joint and disjoint with Subset delete_counts(Counts, Subset, Counts1), % Counts have been deleted for the selected Subset update_counts(Counts1, Joint, Counts2), % Counts have been updated for the joint subsets excov_1(Counts2, Disjoint, Cover). /* initial_counts(Set, Subsets, Counts) is true if Counts is a list of */ /* c(X,C) where X is an element of Set and C is the number of occurrences */ /* of X in Subsets. */ /* e.g. initial_counts([1,2,3,4,5,6,7], */ /* [[3,5,6],[1,4,7],[2,3,6],[1,4],[2,7],[4,5,7]], Cs) */ /* gives Cs=[c(1,2),c(2,2),c(3,2),c(4,3),c(5,2),c(6,2),c(7,3)] */ initial_counts([], _, []). initial_counts([X|Set], Subsets, [c(X,C)|Counts]):- initial_count(Subsets, X, 0, C), initial_counts(Set, Subsets, Counts). /* initial_count(Subsets, X, C0, C) is true if C is the result of */ /* incrementing C0 by the number of occurrences of X in Subsets. */ /* e.g. initial_count([[3,5,6],[1,4,7],[2,3,6],[1,4],[4,5,7]], 4, 0, C) */ /* gives C=3 */ initial_count([], _, C, C). initial_count([Ys|Subsets], X, C0, C):- ord_member(X, Ys), !, C1 is C0 + 1, initial_count(Subsets, X, C1, C). initial_count([_|Subsets], X, C0, C):- initial_count(Subsets, X, C0, C). /* selected_integer(Counts, X) is true if c(X,C) is the first element of */ /* Counts having the smallest value of C, and C > 0. */ /* e.g. selected_integer([c(1,2),c(2,2),c(3,2),c(4,3),c(5,2),c(6,2)], X) */ /* gives X=1 */ selected_integer([Count|Counts], X):-selected_integer_1(Counts, Count, X). selected_integer_1([], c(X,C), X):- C > 0. selected_integer_1([Count|Counts], c(_,C), X):- Count=c(_,C0), C0 < C, !, selected_integer_1(Counts, Count, X). selected_integer_1([_|Counts], C, X):- selected_integer_1(Counts, C, X). /* remove_subset(Subsets, X, Subset, Subsets1) is true if Subset is an */ /* element of Subsets containing X, and Subsets1 contains all the other */ /* elements of Subsets. On backtracking, all solutions will be found. */ /* e.g. remove_subset([[3,5,6],[1,4,7],[2,3,6],[1,4],[2,7],[4,5,7]],1,A,B) */ /* gives A=[1,4,7], B=[[3,5,6],[2,3,6],[1,4],[2,7],[4,5,7]] */ /* and A=[1,4], B=[[3,5,6],[1,4,7],[2,3,6],[2,7],[4,5,7]] */ remove_subset([Subset|Subsets], X, Subset, Subsets):- ord_member(X, Subset). remove_subset([Ys|Subsets], X, Subset, [Ys|Subsets1]):- remove_subset(Subsets, X, Subset, Subsets1). /* split(Subsets, Subset, Joint, Disjoint) is true if Joint is a list of all */ /* elements of Subsets containing at least one element of Subset, and */ /* Disjoint is a list of all elements of Subsets containing no elements of */ /* Subset. */ /* e.g. split([[3,5,6],[2,3,6],[1,4],[2,7],[4,5,7]], [1,4,7], Js, Ds) */ /* gives Js=[[1,4],[2,7],[4,5,7]], Ds=[[3,5,6],[2,3,6]] */ split([], _, [], []). split([Ys|Subsets], Subset, Joint, [Ys|Disjoint]):- ord_disjoint(Subset, Ys), !, split(Subsets, Subset, Joint, Disjoint). split([Ys|Subsets], Subset, [Ys|Joint], Disjoint):- split(Subsets, Subset, Joint, Disjoint). /* delete_counts(Counts, Subset, Counts1) is true if Counts1 is the result */ /* of deleting from Counts all elements c(X,C) where X is a member of */ /* Subset. */ /* e.g. delete_counts([c(1,2),c(2,2),c(3,2),c(4,3),c(5,2)], [1,4,7], Cs) */ /* gives Cs=[c(2,2),c(3,2),c(5,2)] */ delete_counts([], _, []). delete_counts([c(X,_)|Counts], Subset, Counts1):- ord_member(X, Subset), !, delete_counts(Counts, Subset, Counts1). delete_counts([C|Counts], Subset, [C|Counts1]):- delete_counts(Counts, Subset, Counts1). /* update_counts(Counts, Joint, Counts1) is true if Counts1 is the result of */ /* decrementing C in each element c(X,C) of Counts by the number of */ /* occurrences of X in Joint. */ /* e.g. update_counts([c(2,1),c(3,2),c(5,1),c(6,2)], [[2,7],[4,5,7]], Cs) */ /* gives Cs=[c(2,0),c(3,2),c(5,0),c(6,2)] */ update_counts([], _, []). update_counts([c(X,C0)|Counts], Joint, [c(X,C)|Counts1]):- update_count(Joint, X, C0, C), update_counts(Counts, Joint, Counts1). /* update_count(Joint, X, C0, C) is true if C is the result of decrementing */ /* C0 by the number of occurrences of X in Joint. */ /* e.g. update_count([[1,4],[2,7],[4,5,7]], 4, 7, C) */ /* gives C=5 */ update_count([], _, C, C). update_count([Subset|Joint], X, C0, C):- ord_member(X, Subset), !, C1 is C0 - 1, update_count(Joint, X, C1, C). update_count([_|Joint], X, C0, C):- update_count(Joint, X, C0, C). /* ord_disjoint(Xs, Ys) is true if the ordered sets Xs and Ys have no */ /* common element. */ ord_disjoint([], _). ord_disjoint([X|Xs], Ys):-ord_disjoint_1(Ys, X, Xs). ord_disjoint_1([], _, _). ord_disjoint_1([Y|Ys], X, Xs):-X < Y, !, ord_disjoint_1(Xs, Y, Ys). ord_disjoint_1([Y|Ys], X, Xs):-X > Y, !, ord_disjoint_1(Ys, X, Xs). /* ord_member(+X, +Set) is true if X is a member of the ordered set Set. */ /* e.g. ord_member(3, [2,3,4]). */ ord_member(X, [X|_]):-!. ord_member(X, [Y|Ys]):-Y < X, ord_member(X, Ys). /* * Sample application - The N queens problem */ /* queens(N, Rows) is true if Rows is a solution to the N queens problem. */ /* On backtracking, all solutions will be found. */ /* e.g. queens(4, Rows). gives Rows=[2,4,1,3] and Rows=[3,1,4,2] */ /* e.g. queens(24, Rows),!. gives */ /* Rows=[1,3,5,20,11,4,16,7,12,21,23,17,6,24,2,10,8,22,9,15,18,14,19,13] */ queens(N, Rows):- N1 is 2*N - 1, findall(X, for(0, N1, X), Xs), % 0..2n-1 findall(Ys, queens_2(N, Ys), Yss), excov(Xs, Yss, Zss0), sort(Zss0, Zss), % Sorted by columns queens_1(Zss, N, Rows). % Makes the output more user-understandable % e.g. queens_1([[0,5,9,19],[1,7,12,20],[2,4,10,16],[3,6,13,17]], 4, Rows) % gives Rows=[2,4,1,3] queens_1([], _, []). queens_1([[_,R,_,_]|Zss], N, [Row|Rows]):- Row is R - N + 1, queens_1(Zss, N, Rows). % r=0..n-1; c=n..2n-1; a=2n..4n-2; b=4n-1..6n-3 % e.g. findall(X, queens_2(2, X), Xs) % gives Xs=[[0,2,4,8],[0,3,5,9],[1,2,5,7],[1,3,6,8]] queens_2(N, [C,R,A,B]):- % [Column, Row, Diagonal, ReverseDiagonal] N1 is N - 1, for(0, N1, C), for(0, N1, K), R is N + K, A is N + C + R, B is 4*N - 2 + R - C. /* for(I, J, K) is true if K is an integer between I and J inclusive. */ for(I, J, I):-I =< J. for(I, J, K):-I < J, I1 is I + 1, for(I1, J, K).