/* Stable marriage problem in B-Prolog. Problem and OPL model from Pascal Van Hentenryck "The OPL Optimization Programming Language", page 43ff. Also, see http://www.comp.rgu.ac.uk/staff/ha/ZCSP/additional_problems/stable_marriage/stable_marriage.pdf This model is based on my SICStus Prolog version: http://hakank.org/sicstus/stable_marriage.pl Model created by Hakan Kjellerstrand, hakank@gmail.com See also my B-Prolog page: http://www.hakank.org/bprolog/ */ time2(Goal):- cputime(Start), statistics(backtracks, Backtracks1), call(Goal), statistics(backtracks, Backtracks2), cputime(End), T is (End-Start)/1000, Backtracks is Backtracks2 - Backtracks1, format('CPU time ~w seconds. Backtracks: ~d\n', [T, Backtracks]). go :- all_solutions(1), all_solutions(2), all_solutions(3), all_solutions(4), all_solutions(5), % one_solution(6), all_solutions(6). % one_solution(7). % one_solution(8). go2 :- % one_solution(7). all_solutions(7). go3 :- one_solution(8). all_solutions(Problem) :- format('\nProblem ~d:\n', [Problem]), findall([Husband,Wife], time2(stable_marriage(Problem,Husband,Wife)), L), foreach([H,W] in L, (format("Husband: ~w\n",[H]), format("Wife : ~w\n",[W]), nl) ). one_solution(Problem) :- format('\nProblem ~d:\n', [Problem]), time2(stable_marriage(Problem,Husband,Wife)), format("Husband: ~w\n",[Husband]), format("Wife : ~w\n",[Wife]), nl. stable_marriage(Problem,Husband,Wife) :- problem(Problem, RankWomen,RankMen), matrix(RankWomen,[NumWomen,NumMen]), matrix(RankMen,[NumMen,NumWomen]), length(Wife,NumMen), Wife :: 1..NumWomen, length(Husband,NumWomen), Husband :: 1..NumMen, % alldistinct(Wife), % alldistinct(Husband), alldifferent(Wife), alldifferent(Husband), assignment(Wife,Husband), foreach(M in 1..NumMen, % [WifeM,HusbandWifeM], ( %% Husband[Wife[M]] #= M % element(M,Wife,WifeM), % element(WifeM,Husband,HusbandWifeM), % HusbandWifeM #= M % This is faster element2(M,Wife,Husband) ) ), foreach(W in 1..NumWomen, % [HusbandW,WifeHusbandW], ( %% Wife[Husband[W]] #= W % element(W,Husband,HusbandW), % element(HusbandW,Wife,WifeHusbandW), % WifeHusbandW #= W element2(W,Husband,Wife) ) ), foreach(M in 1..NumMen,O in 1..NumWomen, [RankMenMO,WifeM,RankMenMWifeM,HusbandO, RankWomenOHusbandO,RankWomenOM], ( % (RankMen[M,O] #< RankMen[M, Wife[M]]) => % (RankWomen[O,Husband[O]] #< RankWomen[O,M]) matrix_element(RankMen,M,O,RankMenMO), element(M,Wife,WifeM), matrix_element(RankMen,M,WifeM,RankMenMWifeM), element(O,Husband,HusbandO), matrix_element(RankWomen,O,HusbandO,RankWomenOHusbandO), matrix_element(RankWomen,O,M,RankWomenOM), (RankMenMO #< RankMenMWifeM) #=> (RankWomenOHusbandO #< RankWomenOM) )), foreach(W in 1..NumWomen, O in 1..NumMen, [RankWomenWO,HusbandW,RankWomenWHusbandW,WifeO, RankMenOWifeO,RankMenOW], ( % (RankWomen[W,O] #< RankWomen[W,Husband[W]]) => % (RankMen[O,Wife[O]] #< RankMen[O,W]) matrix_element(RankWomen,W,O,RankWomenWO), element(W,Husband,HusbandW), matrix_element(RankWomen,W,HusbandW,RankWomenWHusbandW), element(O,Wife,WifeO), matrix_element(RankMen,O,WifeO,RankMenOWifeO), matrix_element(RankMen,O,W,RankMenOW), (RankWomenWO #< RankWomenWHusbandW) #=> (RankMenOWifeO #< RankMenOW) )), term_variables([Wife,Husband],Vars), writeln(searching), labeling([ffc,down],Vars). matrix_element(X, I, J, Val) :- element(I, X, Row), element(J, Row, Val). matrix(_, []) :- !. matrix(L, [Dim|Dims]) :- length(L, Dim), foreach(X in L, matrix(X, Dims)). % % handling % Husband[Wife[M]] #= M, % i.e. % Y[X[I]] #= I element2(I,X,Y) :- element(I,X,XI), element(XI,Y,XIY), XIY #= I. % From http://www.viridium.ro/2011/prolog-random-permutation/ random_permute([H|T], [H|R]) :- % change to B-Prolog's random R is random mod 2, R < 2, !, random_permute(T, R). random_permute([H|T], R) :- !, random_permute(T, Q), append(Q, [H], R). random_permute([], []). % % Original problem from van Hentenryck % problem(1, [[1, 2, 4, 3, 5], % rankWomen [3, 5, 1, 2, 4], [5, 4, 2, 1, 3], [1, 3, 5, 4, 2], [4, 2, 3, 5, 1]], [[5, 1, 2, 4, 3], % rankMen [4, 1, 3, 2, 5], [5, 3, 2, 4, 1], [1, 5, 4, 3, 2], [4, 3, 2, 1, 5]]). % Data from % http://mathworld.wolfram.com/StableMarriageProblem.html % """ % In the rankings illustrated above, the male-optimal stable % marriage is % 4, 2, 6, 5, 3, 1, 7, 9, 8, % and the female-optimal stable marriage is % 1, 2, 8, 9, 3, 4, 7, 6, 5. % A stable marriage can be found using StableMarriage[m, w] in the % Mathematica package Combinatorica` (which can be loaded with the % command <