/*
* Random greedy algorithm:
* At each iteration the variable that appears in the largest number of
* unsatisfied constraints is picked, ties being broken randomly. When all
* constraints are satisfied, redundant variables are discarded one at a
* time, the order being chosen randomly.
*/
/* greedy(+Constraints, -Cover) is true if Cover is an ordered subset of */
/* the set of variables contained in the Constraints such that each */
/* constraint (an ordered set) has at least one variable in common with */
/* Cover. Note that the obtained Cover may not be minimal, and several */
/* runs may be necessary to obtain a minimal cover. */
/* e.g. greedy([[2,3,5],[2,4,5,8,10],[2,5,10],[7,8],[3,5,10]], X) */
/* will give X=[5,7] or X=[5,8]. */
greedy(Constraints, Cover):-
variables(Constraints, [], Variables),
greedy_1(Constraints, Variables, [], Cover1),
findall(Dummy, redundant(Cover1, Constraints, Dummy), RedundantVariables),
remove_redundant(RedundantVariables, Constraints, Cover1, Cover).
greedy_1([], _, Cover, Cover):-!.
greedy_1(Constraints, Variables, Cover0, Cover):-
satisfactions(Variables, Constraints, 0, MaxN, Ns),
candidates(Variables, Ns, MaxN, Candidates),
rand_member(Candidates, Selected),
update(Constraints, Selected, Constraints1),
ord_insert(Cover0, Selected, Cover1),
remove(Selected, Variables, Variables1), !,
greedy_1(Constraints1, Variables1, Cover1, Cover).
variables([], Vs, Vs).
variables([Xs|Xss], Vs0, Vs):-
variables_1(Xs, Vs0, Vs1),
variables(Xss, Vs1, Vs).
variables_1([], Vs, Vs).
variables_1([X|Xs], Vs0, Vs):-
\+ ord_member(X, Vs0), !,
ord_insert(Vs0, X, Vs1),
variables_1(Xs, Vs1, Vs).
variables_1([_|Xs], Vs0, Vs):-
variables_1(Xs, Vs0, Vs).
/* update(Constraints0, Variable, Constraints) is true if Constraints is */
/* the result of removing from Constraints0 all constraints satisfied */
/* by the Variable. */
/* e.g. update([[0,1],[0,2],[1,2],[0,3],[1,3]], 0, [[1,2],[1,3]]). */
update([], _, []).
update([Constraint|Constraints0], Variable, [Constraint|Constraints]):-
\+ ord_member(Variable, Constraint), !,
update(Constraints0, Variable, Constraints).
update([_|Constraints0], Variable, Constraints):-
update(Constraints0, Variable, Constraints).
/* redundant(Cover, Constraints, Variable) is true if the Variable */
/* (contained in Cover) is a redundant variable with respect to the */
/* Constraints. On backtracking, all such variables will be found. */
redundant(Cover, Constraints, Variable):-
remove(Variable, Cover, Cover1),
is_cover(Constraints, Cover1).
/* remove_redundant(RedundantVariables, Constraints, Cover0, Cover) is */
/* true if Cover is the result of removing redundant variables from */
/* Cover0 with respect to the Constraints, where RedundantVariables is */
/* the initial list of redundant variables. */
remove_redundant([], _, Cover, Cover):-!.
remove_redundant(RedundantVariables, Constraints, Cover0, Cover):-
rand_member(RedundantVariables, RedundantVariable),
remove(RedundantVariable, Cover0, Cover1), !,
findall(Dummy,
redundant(Cover1, Constraints, Dummy),
RedundantVariables1),
remove_redundant(RedundantVariables1, Constraints, Cover1, Cover).
/*
* Random alternating greedy algorithm:
* At each iteration two steps are performed. First, the variable that
* appears in the largest number (N) of as yet unsatisfied constraints is
* added to the solution, ties being broken randomly. Then, any number of
* variables may be discarded from the solution, as long as the total number
* of constraints that become unsatisfied is less than N. In particular, any
* variable that becomes redundant after the addition of the variable is
* discarded. The variables to be discarded are chosen greedily, according to
* lexicographic order. Note that a variable may be discarded from the
* solution and then picked again in a later iteration. This algorithm solves
* some problems that the random greedy algorithm doesn't solve.
*/
/* alt_greedy(+Constraints, -Cover) is true if Cover is an ordered subset */
/* of the set of variables contained in the Constraints such that each */
/* constraint (an ordered set) has at least one variable in common with */
/* Cover. Note that the obtained Cover may not be minimal, and several */
/* runs may be necessary to obtain a minimal cover. */
/* e.g. alt_greedy([[2,3,5],[2,4,5,8,10],[2,5,10],[7,8],[3,5,10]], X) */
/* will give X=[5,7] or X=[5,8]. */
alt_greedy(Constraints, Cover):-
variables(Constraints, [], Variables),
alt_greedy_1(Constraints, [], Variables, [], Cover),
is_cover(Constraints, Cover). /* Debug - check the solution */
alt_greedy_1([], _, _, AssVars, AssVars):-!.
alt_greedy_1(Unsats, Sats, UnassVars, AssVars0, AssVars):-
satisfactions(UnassVars, Unsats, 0, MaxN, Ns),
candidates(UnassVars, Ns, MaxN, Candidates),
rand_member(Candidates, Selected),
ord_insert(AssVars0, Selected, AssVars1),
update_add(Unsats, Sats, Selected, Unsats1, Sats1),
discard(MaxN, AssVars1, Unsats1, Sats1, AssVars2, Unsats2, Sats2),
ord_diff(AssVars0, AssVars2, Vars),
remove(Selected, UnassVars, UnassVars1), !,
ord_union(Vars, UnassVars1, UnassVars2),
alt_greedy_1(Unsats2, Sats2, UnassVars2, AssVars2, AssVars).
/* satisfactions(Variables, Constraints, 0, Max, Satisfactions) is true if */
/* each element of Satisfactions is the number of Constraints which */
/* would be satisfied by the corresponding element of Variable (or */
/* 0 if the number is less than a previous element), and Max is the */
/* maximum element of Satisfactions. */
/* e.g. satisfactions([2,3,4], [[1,2],[2,3],[1,4]], 0, 2, [2,0,0]). */
satisfactions([], _, Max, Max, []).
satisfactions([Variable|Variables], Constraints, Max0, Max, [N|Ns]):-
covered(Constraints, Variable, 0, N),
N >= Max0, !,
satisfactions(Variables, Constraints, N, Max, Ns).
satisfactions([_|Variables], Constraints, Max0, Max, [0|Ns]):-
satisfactions(Variables, Constraints, Max0, Max, Ns).
/* candidates(Variables, Satisfactions, Value, Candidates) is true if */
/* Candidates is that subset of Variables such that the corresponding */
/* element of Satisfactions is equal to Value. */
/* e.g. candidates([2,3,4], [3,1,3], 3, [2,4]). */
candidates([], [], _, []).
candidates([Variable|Variables], [N|Ns], N, [Variable|Candidates]):-!,
candidates(Variables, Ns, N, Candidates).
candidates([_|Variables], [_|Ns], N, Candidates):-
candidates(Variables, Ns, N, Candidates).
/* covered(Xss, Y, 0, N) is true if N is the number of elements of Xss of */
/* which Y is a member. */
/* e.g. covered([[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]], 4, 0, 3). */
covered([], _, N, N).
covered([Xs|Xss], Y, N0, N):-
ord_member(Y, Xs), !,
N1 is N0 + 1,
covered(Xss, Y, N1, N).
covered([_|Xss], Y, N0, N):-
covered(Xss, Y, N0, N).
/* uncovered(Xss, Ys, 0, N) is true if N is the number of elements of Xss */
/* which have no elements in common with Ys. */
/* e.g. uncovered([[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]], [1,2], 0, 1). */
uncovered([], _, N, N).
uncovered([Xs|Xss], Ys, N0, N):-
\+ ord_joint(Ys, Xs), !, /* Faster than \+ ord_joint(Xs, Ys) */
N1 is N0 + 1,
uncovered(Xss, Ys, N1, N).
uncovered([_|Xss], Ys, N0, N):-
uncovered(Xss, Ys, N0, N).
/* update_add(Unsats0, Sats0, Variable, Unsats, Sats) is true if Unsats is */
/* the result of removing from Unsats0 all constraints satisfied by the */
/* Variable, and Sats is the result of adding to Sats0 all constraints */
/* satisfied by the Variable. */
/* e.g. update_add([[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]], [], 2, */
/* Unsats, Sats). */
update_add([], Sats, _, [], Sats).
update_add([Unsat|Unsats0], Sats0, Variable, [Unsat|Unsats], Sats):-
\+ ord_member(Variable, Unsat), !,
update_add(Unsats0, Sats0, Variable, Unsats, Sats).
update_add([Sat|Unsats0], Sats0, Variable, Unsats, Sats):-
update_add(Unsats0, [Sat|Sats0], Variable, Unsats, Sats).
/* update_discard(Sats0, Unsats0, Variables, Sats, Unsats) is true if Sats */
/* is the result of removing from Sats0 all constraints not satisfied by */
/* the Variables, and Unsats is the result of adding to Unsats0 all */
/* constraints satisfied by the Variables. */
/* e.g. update_discard([[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]], [], [2], */
/* Sats, Unsats). */
update_discard([], Unsats, _, [], Unsats).
update_discard([Unsat|Sats0], Unsats0, Variables, Sats, Unsats):-
\+ ord_joint(Variables, Unsat), !,
update_discard(Sats0, [Unsat|Unsats0], Variables, Sats, Unsats).
update_discard([Sat|Sats0], Unsats0, Variables, [Sat|Sats], Unsats):-
update_discard(Sats0, Unsats0, Variables, Sats, Unsats).
/* discard(N, Vs0, Unsats0, Sats0, Vs, Unsats, Sats) is true if N is the */
/* maximum number of constraints to become unsatisfied, Vs0 is the */
/* current list of assigned variables, Unsats0 is the current list of */
/* unsatisfied constraints, Sats0 is the current list of satisfied */
/* constraints, Vs is the new list of assigned variables after zero or */
/* more discards, Unsats is the list of constraints unsatisfied by Vs, */
/* and Sats is the list of constraints satisfied by Vs. */
/* e.g. discard(4, [1,2,3], [], [[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]], */
/* Vs, Unsats, Sats). */
discard(N, Vs0, Unsats0, Sats0, Vs, Unsats, Sats):-
N > 0,
best(Vs0, Vs0, Sats0, 32767, P, 0, Best),
P < N,
remove(Best, Vs0, Vs1), !,
update_discard(Sats0, Unsats0, Vs1, Sats1, Unsats1),
N2 is N - P,
discard(N2, Vs1, Unsats1, Sats1, Vs, Unsats, Sats).
discard(_, Vs, Unsats, Sats, Vs, Unsats, Sats).
/* best(Vs, Vs, Constrs, 32767, N, 0, Best) is true if Vs is the current */
/* list of assigned variables, Constrs is the list of constraints */
/* satisfied by Vs, and Best is that member of Vs which, if discarded, */
/* would cause the least number, N, of constraints in Constrs to become */
/* unsatisfied. */
/* e.g. best([1,2], [1,2], [[1,2],[1,3],[1,4],[2,3]], 32767, 1, 0, 2). */
best([], _, _, N, N, Best, Best).
best([V|Vs], Vs0, Constrs, N0, N, _, Best):-
remove(V, Vs0, Vs1),
uncovered(Constrs, Vs1, 0, N1),
N1 < N0, !,
best(Vs, Vs0, Constrs, N1, N, V, Best).
best([_|Vs], Vs0, Constrs, N0, N, Best0, Best):-
best(Vs, Vs0, Constrs, N0, N, Best0, Best).
/*
* Library procedures
*/
/* is_cover(Xss, Ys) is true if at least one element of Ys is contained in */
/* each element of Xss. */
/* e.g. is_cover([[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]], [1,2,3]). */
is_cover([], _).
is_cover([Xs|Xss], Ys):-
ord_joint(Xs, Ys),
is_cover(Xss, Ys).
/* ord_diff(Set1, Set2, Difference) is true if Set1 and Set2 are the */
/* ordered representations of two sets and Difference is unified with */
/* the ordered representation of their difference. Set1 and Set2 must */
/* be sufficiently instantiated and in standard order. */
ord_diff([], _, []).
ord_diff([X|Xs], [], [X|Xs]).
ord_diff([X|Xs], [X|Ys], Ds):-
!, ord_diff(Xs, Ys, Ds).
ord_diff([X|Xs], [Y|Ys], [X|Ds]):-
X < Y, !, ord_diff(Xs, [Y|Ys], Ds).
ord_diff([X|Xs], [_|Ys], Ds):-
ord_diff([X|Xs], Ys, Ds).
/* ord_insert(Xs, Y, Zs) is true if Zs is the ordered list resulting from */
/* inserting Y into the ordered list Xs, without duplicates. */
ord_insert([Y|Xs], Y, [Y|Xs]):-!.
ord_insert([X|Xs], Y, [X|Ws]):-X < Y, !, ord_insert(Xs, Y, Ws).
ord_insert(Xs, Y, [Y|Xs]).
/* ord_joint(Xs, Ys) is true if the ordered lists Xs and Ys have at least */
/* one common element. */
/* e.g. ord_joint([3,4], [1,2,3]). */
ord_joint([X|_], [X|_]):-!.
ord_joint([X|Xs], [Y|Ys]):-X < Y, !, ord_joint(Xs, [Y|Ys]).
ord_joint([X|Xs], [_|Ys]):-ord_joint([X|Xs], Ys).
/* ord_member(X, Ys) is true if X is a member of the ordered list Ys. */
/* e.g. ord_member(3, [2,3,4]). */
ord_member(X, [X|_]):-!.
ord_member(X, [Y|Xs]):-Y < X, ord_member(X, Xs).
/* ord_union(+Set1, +Set2, ?Union) is true if Set1 and Set2 are the */
/* ordered representations of two sets and Union is unified with the */
/* ordered representation of their union. Set1 and Set2 must be */
/* sufficiently instantiated and in standard order. */
ord_union([], Ys, Ys).
ord_union([X|Xs], [], [X|Xs]).
ord_union([X|Xs], [X|Ys], [X|Zs]):-!,
ord_union(Xs, Ys, Zs).
ord_union([X|Xs], [Y|Ys], [X|Zs]):-
X < Y, !, ord_union(Xs, [Y|Ys], Zs).
ord_union([X|Xs], [Y|Ys], [Y|Zs]):-
ord_union([X|Xs], Ys, Zs).
/* rand_int(I, J) is true if J is a pseudo-random non-negative integer */
/* less than I. */
rand_int(I, J):-I > 0, J is int(rand(I)).
/* rand_member(Xs, X) is true if X is a pseudo-randomly chosen member of */
/* the list Xs. */
rand_member(Xs, X):-
length(Xs, M),
rand_int(M, N),
rand_member_1(Xs, X, 0, N).
rand_member_1([X|_], X, N, N):-!.
rand_member_1([_|Xs], X, N0, N):-
N1 is N0 + 1,
rand_member_1(Xs, X, N1, N).
/*
* Sample application
*/
/* "Find a minimal subset of a set of words such that the words in the */
/* subset contain all the letters in the words in the set." */
/* Goal: solve([`january`,`february`,`march`,`april`,`may`,`june`,`july`, */
/* `august`,`september`,`october`,`november`,`december`], */
/* Cover). */
solve(Words, Cover):-
strings_chars(Words, Chars),
chars_used_letters(Chars, [], Letters),
data(Letters, Chars, Constraints),
% greedy(Constraints, Cover0),
alt_greedy(Constraints, Cover0),
indexes(Cover0, Words, Cover).
strings_chars([], []).
strings_chars([String|Strings], [Cs|Css]):-
string_chars(String, Cs),
strings_chars(Strings, Css).
chars_used_letters([], Letters, Letters).
chars_used_letters([Cs|Css], Letters0, Letters):-
chars_used_letters_1(Cs, Letters0, Letters1),
chars_used_letters(Css, Letters1, Letters).
chars_used_letters_1([], Letters, Letters).
chars_used_letters_1([Char|Chars], Letters0, Letters):-
ord_insert(Letters0, Char, Letters1),
chars_used_letters_1(Chars, Letters1, Letters).
data([], _, []).
data([Letter|Letters], Chars, [Constraint|Constraints]):-
data_1(Chars, Letter, 0, Constraint),
data(Letters, Chars, Constraints).
data_1([], _, _, []).
data_1([Cs|Css], Letter, I, [I|Constraint]):-
member(Letter, Cs), !,
I1 is I + 1,
data_1(Css, Letter, I1, Constraint).
data_1([_|Css], Letter, I, Constraint):-
I1 is I + 1,
data_1(Css, Letter, I1, Constraint).
indexes([], _, []).
indexes([X|Xs], Y, [Z|Zs]):-
nth(Y, X, Z),
indexes(Xs, Y, Zs).
/* nth(Xs, N, X) is true if X is the N-th (base 0) element of the list Xs. */
nth(Xs, N, X):-nth_1(Xs, X, 0, N).
nth_1([X|_], X, I, I):-!.
nth_1([_|Xs], X, I0, I):-
I1 is I0 + 1,
nth_1(Xs, X, I1, I).