Stable marriage problem: Difference between revisions
Content added Content deleted
m (→{{header|Phix}}: added syntax colouring the hard way) |
No edit summary |
||
Line 3,943: | Line 3,943: | ||
Stable: false |
Stable: false |
||
</pre> |
</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}}== |
=={{header|Nim}}== |