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

Valid HTML 4.0!