Exact Cover Problem
/* 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).
LPA Index
Home Page