/* Stable marriage in SWI 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 Model created by Hakan Kjellerstrand, hakank@gmail.com See also my SWI Prolog page: http://www.hakank.org/swi_prolog/ */ :- use_module(library(clpfd)). :- use_module(hakank_utils). go :- all_solutions(1), % 3 solutions, 0.13s all_solutions(2), % 6 solutions, 0.86s all_solutions(3), % 2 solutions, 0.06s all_solutions(4), % 3 solutions, 0.2s all_solutions(5), % 1 solution, 0.09s %% one_solution(6), % 1 solution, 11.7s all_solutions(6), % 8 solutions, 11,7s %% one_solution(7), % Stack limit (1.0Gb) exceeded after 38s %% all_solutions(7), % too hard %% one_solution(8), % too hard nl. all_solutions(Problem) :- format("\nProblem ~d:\n", [Problem]), time(findall([Husband,Wife], stable_marriage(Problem,Husband,Wife),L)), writeln(L), maplist(print_solution,L), length(L,Len), format("Num solutions: ~d~n", [Len]), nl. print_solution([H,W]) :- format("Husband: ~w~n", [H]), format("Wife: ~w~n", [W]), nl. one_solution(Problem) :- format("\nProblem ~d:\n", [Problem]), time(once(stable_marriage(Problem,Husband,Wife))), print_solution([Husband,Wife]). %% %% Stable marriage problem. %% stable_marriage(Problem,Husband,Wife) :- problem(Problem, RankWomen,RankMen), length(RankWomen,NumMen), length(RankMen,NumWomen), N #= NumMen, length(Wife, NumMen), Wife ins 1..NumWomen, length(Husband, NumWomen), Husband ins 1..NumMen, %% If a wife is married to some husband then %% this husband must - of course - be married to that wife as well. inverse(Wife,Husband), %% all_distinct(Wife), %% all_distinct(Husband), all_different(Wife), %% this is faster all_different(Husband), %% The indices findall([I,J],(between(1,N,I),between(1,N,J)),IJs), %% The two big loops: husband -> wife and wife -> husband check1(IJs,RankMen,RankWomen,Wife,Husband), check2(IJs,RankWomen,RankMen,Husband,Wife), %% search flatten(Wife,WifeFlatten), flatten(Husband,HusbandFlatten), append([WifeFlatten,HusbandFlatten],Vars), labeling([ffc,bisect],Vars). check1([],_RankMen,_RankWomen,_Wife,_Husband). check1([[M,O]|IJs],RankMen,RankWomen,Wife,Husband) :- %% This is (approximately) how the constraint is stated %% in Van Hentenryck's OPL model. % (RankMen[M,O] #< RankMen[M, Wife[M]]) #=> % (RankWomen[O,Husband[O]] #< RankWomen[O,M]) matrix_element2(RankMen,M,O,RankMenMO), element(M,Wife,WifeM), matrix_element2(RankMen,M,WifeM,RankMenMWifeM), element(O,Husband,HusbandO), matrix_element2(RankWomen,O,HusbandO,RankWomenOHusbandO), matrix_element2(RankWomen,O,M,RankWomenOM), (RankMenMO #< RankMenMWifeM) #==> (RankWomenOHusbandO #< RankWomenOM), check1(IJs,RankMen,RankWomen,Wife,Husband). check2([],_RankWomen,_RankMen,_Husband,_Wife). check2([[W,O]|IJs],RankWomen,RankMen,Husband,Wife) :- %% This is (approximately) how the constraint is stated %% in Van Hentenryck's OPL model. % (RankWomen[W,O] #< RankWomen[W,Husband[W]]) #=> % (RankMen[O,Wife[O]] #< RankMen[O,W]) matrix_element2(RankWomen,W,O,RankWomenWO), element(W,Husband,HusbandW), matrix_element2(RankWomen,W,HusbandW,RankWomenWHusbandW), element(O,Wife,WifeO), matrix_element2(RankMen,O,WifeO,RankMenOWifeO), matrix_element2(RankMen,O,W,RankMenOW), (RankWomenWO #< RankWomenWHusbandW) #==> (RankMenOWifeO #< RankMenOW), check2(IJs,RankWomen,RankMen,Husband,Wife). % % Original problem from Van Hentenryck % problem(1, W, M) :- W = [[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]], M = [[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 <