Stable marriage problem: Difference between revisions
no edit summary
m (→{{header|Phix}}: added syntax colouring the hard way) |
No edit summary |
||
Line 3,943:
Stable: false
</pre>
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<lang Mathematica>(*<<Combinatorica`;*)
ClearAll[CheckStability]
CheckStabilityHelp[male_, female_, ml_List, fl_List, pairing_List] := Module[{prefs, currentmale},
prefs = fl[[female]];
currentmale = Sort[Reverse /@ pairing][[female, 2]];
FirstPosition[prefs, currentmale][[1]] < FirstPosition[prefs, male][[1]]
]
CheckStabilityHelp[male_, ml_List, fl_List, pairing_List] := Module[{prefs, m, f, p, otherf, reversepair, pos, othermen},
prefs = ml[[male]];
{m, f} = pairing[[male]];
p = FirstPosition[prefs, f][[1]];
otherf = Take[prefs, p - 1];
AllTrue[otherf, CheckStabilityHelp[male, #, ml, fl, pairing] &]
]
CheckStability[ml_List, fl_List, pairing_List] := AllTrue[pairing[[All, 1]], CheckStabilityHelp[#, ml, fl, pairing] &]
males = {"abe", "bob", "col", "dan", "ed", "fred", "gav", "hal",
"ian", "jon"};
females = {"abi", "bea", "cath", "dee", "eve", "fay", "gay", "hope",
"ivy", "jan"};
ml = {{"abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea",
"hope", "gay"}, {"cath", "hope", "abi", "dee", "eve", "fay",
"bea", "jan", "ivy", "gay"}, {"hope", "eve", "abi", "dee", "bea",
"fay", "ivy", "gay", "cath", "jan"}, {"ivy", "fay", "dee", "gay",
"hope", "eve", "jan", "bea", "cath", "abi"}, {"jan", "dee", "bea",
"cath", "fay", "eve", "abi", "ivy", "hope", "gay"}, {"bea",
"abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope",
"fay"}, {"gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope",
"jan", "fay"}, {"abi", "eve", "hope", "fay", "ivy", "cath",
"jan", "bea", "gay", "dee"}, {"hope", "cath", "dee", "gay", "bea",
"abi", "fay", "ivy", "jan", "eve"}, {"abi", "fay", "jan", "gay",
"eve", "bea", "dee", "cath", "ivy", "hope"}};
fl = {{"bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col",
"hal"}, {"bob", "abe", "col", "fred", "gav", "dan", "ian", "ed",
"jon", "hal"}, {"fred", "bob", "ed", "gav", "hal", "col", "ian",
"abe", "dan", "jon"}, {"fred", "jon", "col", "abe", "ian", "hal",
"gav", "dan", "bob", "ed"}, {"jon", "hal", "fred", "dan", "abe",
"gav", "col", "ed", "ian", "bob"}, {"bob", "abe", "ed", "ian",
"jon", "dan", "fred", "gav", "col", "hal"}, {"jon", "gav", "hal",
"fred", "bob", "abe", "col", "ed", "dan", "ian"}, {"gav", "jon",
"bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"}, {"ian",
"col", "hal", "gav", "fred", "bob", "abe", "ed", "jon",
"dan"}, {"ed", "hal", "gav", "abe", "bob", "jon", "col", "ian",
"fred", "dan"}};
ml = ml /. Thread[females -> Range[Length[males]]];
fl = fl /. Thread[males -> Range[Length[females]]];
pairing = StableMarriage[ml, fl];
pairing = {Range[Length[pairing]], pairing} // Transpose;
pairing
CheckStability[ml, fl, pairing]
pairing[[{2, 7}, 2]] //= Reverse;
pairing
CheckStability[ml, fl, pairing]</lang>
{{out}}
<pre>{{1,9},{2,3},{3,4},{4,6},{5,10},{6,2},{7,7},{8,5},{9,8},{10,1}}
True
{{1,9},{2,7},{3,4},{4,6},{5,10},{6,2},{7,3},{8,5},{9,8},{10,1}}
False</pre>
=={{header|Nim}}==
| |||