一个有趣的问题(GS婚姻匹配算法)的R语言求教

superdesolator

搬砖:

问题

给定一组男人和一组女人，每个人在心目中都对所有的异性有一个倾慕度排序，从最喜欢到最不喜欢依次排序1、2、3。现在给出问题，如何对这些男女进行配对使得在分配好后不出现偷情的现象。

算法

可以有男人优先和女人优先两种算法。以男人优先为例，为代码如下：

[plain] view plaincopyprint?

01.while 存在男人m是自由的且还没对每个女人都求过婚

02. 选择这个男人m

03. 令w是m的优先表中还没求过婚的最高排名的女人

04. if w是自由的

05. （m，w）变成约会状态

06. else w当前与m1约会

07. if w更偏爱m1而不爱m

08. m保持自由

09. else w更偏爱m而不爱m1

10. （m，w）变成约会状态

11. m1变成自由

12. endif

13. endif

14.endwhile

while 存在男人m是自由的且还没对每个女人都求过婚

选择这个男人m

令w是m的优先表中还没求过婚的最高排名的女人

if w是自由的

（m，w）变成约会状态

else w当前与m1约会

if w更偏爱m1而不爱m

m保持自由

else w更偏爱m而不爱m1

（m，w）变成约会状态

m1变成自由

endif

endif

endwhile

需要特别注意的是！虽然从第9、10行来看，女人能够选择更好的伴侣。但从第3行来看，男人能够优先选择排名最高的女人。实际上，第9、10行只是为了保证婚姻的稳定性。

哪位大牛可以用R实现上面的算法呢？

nan.xiao

这问题没什么意思，更有意思的问题是，如何对这些男女进行配对使得在分配好后出现最多偷情的现象

superdesolator

回复第2楼的肖楠：我看网上有python,c/c++版的，就是没有R版的。。。。奈何天啊。。。

corelion

2012年经济学奖的那个？

Robert_Hoo

<br />
rm(list = ls())<br />
set.seed(666)<br />
MW <- data.frame(matrix(replicate(10, sample(10)),10, byrow = T),partner=0, partner.score=0)  ## M evaluate W, The higher score the better<br />
WM <- data.frame(matrix(replicate(10, sample(10)),10, byrow = T),partner=0, partner.score=0)  ## W evaluate M, The higher score the better</p>
<p>while(any(MW$partner==0)) {<br />
  M <- as.integer(sample(rownames(MW[MW$partner == 0, ]),1))<br />
  W <- which.max(MW[M,1:nrow(MW)])<br />
  if (WM[W,'partner'] == 0) {<br />
    MW$partner[M] = W<br />
    WM$partner[W] = M<br />
    MW$partner.score[M] = MW[M,W]<br />
    WM$partner.score[W] = WM[W,M]<br />
  } else if (WM[W,M] > WM[W,'partner.score']) {<br />
    MW$partner[WM$partner[W]] = 0<br />
    MW$partner.score[WM$partner[W]] = 0<br />
    MW$partner[M] = W<br />
    MW$partner.score[M] = MW[M,W]<br />
    WM$partner[W] = M<br />
    WM$partner.score[W] = WM[W,M]<br />
  }<br />
  MW[M,W] <- NA<br />
  WM[W,M] <- NA<br />
}</p>
<p>colnames(MW) <- c(paste0("W",1:nrow(MW)), "partner", "partner.score")<br />
rownames(MW) <- paste0("M", 1:nrow(MW))</p>
<p>colnames(WM) <- c(paste0("M",1:nrow(MW)), "partner", "partner.score")<br />
rownames(WM) <- paste0("W", 1:nrow(MW))</p>
<p> MW<br />
    W1 W2 W3 W4 W5 W6 W7 W8 W9 W10 partner partner.score<br />
M1  NA  2 NA NA  3  4  5 NA  1   6       8             7<br />
M2  NA  1 NA NA  2  5 NA  3  4   6       7             7<br />
M3  NA  6  1  8  5  2  7  9  3   4       1            10<br />
M4   5  4 NA NA NA  3  2 NA  6   1       3             7<br />
M5   3  5  1  7  6  4  2  9 NA   8       9            10<br />
M6   1 NA  2  6 NA  4  7  3  5   8       5             9<br />
M7   8 NA  3  5  6  2  7  9  4   1       2            10<br />
M8   7  3  6 NA  1  4  9  8  2   5       4            10<br />
M9   8  7  3  6  2  4  5  1  9  NA      10            10<br />
M10  2  1  4  5  8 NA  3 NA  6   7       6             9<br />
> WM<br />
    M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 partner partner.score<br />
W1  NA NA NA  5  2  7 10  1  3   9       3             8<br />
W2   3 10  4  9  2 NA NA  1  6   7       7             8<br />
W3  NA NA 10 NA  1  4  5  9  8   3       4             7<br />
W4  NA NA  5 NA 10  2  9 NA  1   3       8             8<br />
W5   4  1 10 NA  7 NA  3  6  8   2       6             9<br />
W6   5  4  2 10  1  9  8  6  3  NA      10             7<br />
W7  10 NA  7  6  3  5  1  4  8   9       2             2<br />
W8  NA  6 10 NA  8  3  5  4  1  NA       1             9<br />
W9   4  1  2  8 NA  3  5  7  9   6       5            10<br />
W10  7  6 10  1  2  9  3  8 NA   4       9             5</p>
<p>

分数越高倾慕度越高，NA表示谈过或正在谈的。。。

整体来看，M,W到最后都可以找到比较满意的（分高的）
</p>

superdesolator

回复第5楼的 Robert_Hoo：看看大神编的,再看看我自己编的,简直一夜回到解放前啊,本来看过网上Python版，惊叹于python的index等功能的简洁，以及C语言函数调函数，标准函数库等的强大。。。心理再想R怎奈何啊！现在看来完全是自身水平不够导致。。。

superdesolator

回复第5楼的 Robert_Hoo：最后发现

MW[M,W] <- NA<br />
  WM[W,M] <- NA

是关键。。知道真相的我眼泪掉下来。。
</p>