如何用R模拟婚姻市场上的匹配问题

浏览: 1750

介绍

这学期我在做助教的时候接触到了一个很有趣的问题,而且可以用简单的R代码来解决,所以想在这里分享给大家。

这个问题是这样的:

到底怎么找对象?

俗话说书中自有颜如玉,没想到学好R语言,连人生大事都顺带解决了。

开玩笑,其实我今天要谈的是一个很经典的『稳定婚姻问题』,最早来源于David Gale和Lloyd Shapley*的论文 College Admissions and the Stability of Marriage。


Clipboard Image.png

*注:没错,这就是三月份刚刚去世的那位,诺贝尔经济学奖得主Shapley。虽然他一直认为自己是一个数学家,但毋庸置疑地说,他在经济学,尤其是博弈论领域,做出了无可比拟的贡献。

问题

假定有N个男生,M个女生,每个人都对异性有着自己的排序。如何设计一个结婚匹配机制,从而使所有人在婚后都不会出轨*?

*注:出轨的定义:A男觉得b女优于自己现任妻子a女,b女也认为A男优于自己现任丈夫B男,此时A男和b女即出轨

哎呀,这是啥问题啊,怎么让我想到集体相亲节目?我好像闻到了一股八卦的气息。


Clipboard Image.png

言归正传,为了理解题目,不妨拿具体数字举个例子。

假设社会里有10个男生,8个妹子,分别编号。大致来说1号最受欢迎,2号其次,依次类推,不过我也在排序中加入了一些随机性,允许每个人的偏好有所不同。

男生对妹子的排序如下:


Clipboard Image.png

横行代表男生。比如说我们看第一行,就是说对于1号男嘉宾来说,1号女嘉宾排第二,2号女嘉宾排第三,3号女嘉宾排第一,4号女嘉宾排第四,5号女嘉宾排第六,等等等等。

观察:

  • 我生成的这个例子里,很多男生都最喜欢1、2、3号女生。
  • 不过也有特立独行的10号男生,最喜欢4号女生。我们看看他们最后能不能在一起。

相应地,姑娘们对于男生也有自己的排序:

Clipboard Image.png

观察:

  • 1号男生估计是帅且身材好,最受各位妹子青睐。2号、3号也不错。
  • 5号女生碰巧最喜欢5号男生。
  • 可怜的10号男生,经常排名垫底,最好也就是排个第八名。

下面问题来了,我们如何把这些青年男女匹配在一起?

首先我们无情地排除了同性恋的可能性,也就是说最后只有8对男女牵手成功。至于剩下的两个男生要不要在一起,本文不进行讨论,他们的命运由读者自行安排。

其次,我们要假设男生主动追求女生。这个假设是为了写算法方便,我们也可以假设是女生主动,在这个例子中结果是一样的。如果参与者人数增加,那么结果则不一定相同。

最后,在介绍算法之前,大家要意识这个问题的复杂性以及特殊性。为了确定没有更好的结婚人选,主动的一方需要不断试探,搜索大量的信息,而这在生活中是不现实的。我们假设的是一个理想的情况。打个比方,就好像把所有人困在同一个房间里,不完成稳定的匹配,谁也不许走。所以,把这个例子当成一个有趣的数学模型,作为现实生活的一个投影,也就够了。

(对吧,比如相亲会有下面这种效率就不错了)


Clipboard Image.png

咳咳,跑偏了,赶快回到学术讨论。

讨论算法的部分可能有点枯燥。只对牵手结果感兴趣的读者请跳过本节!

算法

Gale-Shapley的算法是这样的(Pseudo-code):

Clipboard Image.png

等一下,上面说了个啥?

让我翻译成人话:

  • 对于每一个单身的男生m,向他尚未求婚过的女性中,排名最高那一位(记作w)求婚
    • 如果w单身,二人暂时订婚
    • 如果w已经和其他男生m'订婚,w会选择对她排名更高的一位男士,拒绝另一位
    • 被拒绝的男士重新回到单身。
  • 重复上述过程,直到匹配稳定

其实算法很简单,不过,在这个环环相扣的故事里,充满了狗血剧情。

  • 比如他喜欢她,但是她已经与人订婚,他只能横刀夺爱;
  • 或者他久被拒绝,已经失去了人生希望,突然在下一个女生的怀抱中寻到真爱;
  • 或者她朝三暮四,不断拒绝过去的感情,只因为了寻找更好的另一半...

人生百态,尽在其中!

当然,可能只是我比较能想象吧【笑】

哦,对了,既然题目叫『如何用R模拟婚姻市场的匹配问题』,那就不能忘了放上R代码是吧。为了行文流畅,我把代码放到了文后,请感兴趣的读者自行参考。

结果

终于到了大家期待的牵手结果阶段!让我们看看谁和谁在一起了!【八卦脸】


Clipboard Image.png


还是横行代表男生编号,纵列代表女生编号,『1』表示牵手成功。

整理结果如下:

Clipboard Image.png


每列分别代表:男生编号,女生编号,女生在男生心中的排名,男生在女生心中的排名。

我们观察到一些结果:

  • 1号男神和3号女神,2号男神和1号女神在一起了,而且都是对方心中的首选。恭喜他们!
  • 3号男生其实也不差,可是因为1、2号男生选走了他的首选,他只能选择了排名第三的6号女生。(当然6号女生是很开心的啦,3号男正好是她的首选)
  • 9号和10号最后还是单身,所以从上表中略去了。抱歉。
  • 虽然处于被动地位,但女生最终对于自己配偶的满意程度普遍高于男性的满意程度,尤其对于5-8号男生及其配偶来说。这是因为女生处于相对少数。

感想

做完这个练习,我也多少产生了一些感触:

  • Gale-Shapley算法真的很神奇,可以解决一系列类似的问题,比如(但不限于)
    • 美国大学应该如何招到最好的申请者?
    • 如何给学生分配室友?
    • 如何给病人安排病房?
  • Matching是一个很成熟的研究领域,感兴趣的读者可以继续阅读参考文献中的论文。
  • 我刚才发现,已经有人写出专门应用这个算法的R package了:
    R package: matchingMarkets

  • 看来网上果然是人才济济。我不是计算机专业出身,只是为了个人爱好才写这篇文章。欢迎懂行的各位与我交流!
  • 最后。

    你或许会觉得,你的另一半不是你最心仪的那个人。

    但是在他/她眼中,你的爱可能胜过一切。

    珍惜眼前人。

参考文献

Gale, D.; Shapley, L. S. 1962. College Admissions and the Stability of Marriage. American Mathematical Monthly 69: 9–14.

D. G. McVitie and L. B. Wilson. 1971. The stable marriage problem. Commun. ACM 14, 7 (July 1971), 486-490.

Roth, Alvin E.. 1982. “The Economics of Matching: Stability and Incentives”. Mathematics of Operations Research 7 (4). INFORMS: 617–28. 

Dubins, L. E., and D. A. Freedman. 1981. “Machiavelli and the Gale-shapley Algorithm”. The American Mathematical Monthly 88 (7). Mathematical Association of America: 485–94. 

Becker, Gary. "A Theory of Social Interactions." (1974).

Stable marriage problem -- Wikipedia

附录

R 代码:

# Fix randomize result
set.seed(907)

# Number of Agents
nMales <- 10
nFemales <- 8

# Match utility of agents

# each column represents the utility of the agent,
# when matched with the agent in the corresponding row

utilMale <- t(replicate(nMales,seq(100,1,length =nFemales)+100*runif(nFemales)))

utilFemale <- t(replicate(nFemales,seq(100,1,length =nMales)+100*runif(nMales)))

# Match preference order of agents
rankMale <- t(sapply(1:nMales,function(x) order(utilMale[x,],decreasing=T)))

rankFemale <- t(sapply(1:nFemales,function(x) order(utilFemale[x,],decreasing=T)))

# Match Function

DeferredAcceptanceAlgorithm <- function(males, females, females_propose = FALSE){

if(females_propose){
nProposers <- nrow(females)
proposers <- females
nAcceptors <- nrow(males)
acceptors <- males
} else {
nProposers <- nrow(males)
proposers <- males
nAcceptors <- nrow(females)
acceptors <- females
}

matches = matrix(0,nProposers,nAcceptors)
prev_matches = matrix(1,nProposers,nAcceptors)

#Iterates until matches are stable
while (all((matches==prev_matches))==F)
{
prev_matches = matches #Saves previous matches
for (m in 1:nProposers) #Loops over all proposers
{
#Loops over mates in order of preference
for (mate in order(proposers[m,]))
{
# if neither are engaged
if (sum(matches[m,])==0 & sum(matches[,mate])==0){
matches[m,mate]=1 # They get matched
}
# if woman is engaged
if (sum(matches[m,])==0 & sum(matches[,mate])>0)
{
# identify her current fiance's index
otherProp = match(1,matches[,mate])
# check if proposal is better than her current match
if (acceptors[mate,m] < acceptors[mate,otherProp])
{
matches[otherProp,mate] = 0 # If so other guy gets dumped
matches[m,mate] = 1 # And current guy gets matched
}
}
}
}
}

if(females_propose){
matches <- t(matches)
}

return(matches) # Return matches
}


output <- DeferredAcceptanceAlgorithm(rankMale,rankFemale)
list <- cbind(1:10,sapply(1:10, function(x) which.max(output[x,]) ))

F_in_M <- sapply(1:8, function(i) rankMale[list[i,1],list[i,2]])
M_in_F <- sapply(1:8, function(i) rankFemale[list[i,2],list[i,1]])
list <- data.frame(cbind(list[1:8,],F_in_M,M_in_F))
names(list) <- c("Male","Female", "F_in_M","M_in_F")

xtable(rankMale)
xtable(rankFemale)
xtable(output)
xtable(list)

注:感兴趣的读者复制到R console 或RStudio 中查看。

作者:李佳飞    

知乎专栏:知叶堂 

https://zhuanlan.zhihu.com/p/25446637  

image.png

推荐 2
本文由 R语言中文社区 创作,采用 知识共享署名-相同方式共享 3.0 中国大陆许可协议 进行许可。
转载、引用前需联系作者,并署名作者且注明文章出处。
本站文章版权归原作者及原出处所有 。内容为作者个人观点, 并不代表本站赞同其观点和对其真实性负责。本站是一个个人学习交流的平台,并不用于任何商业目的,如果有任何问题,请及时联系我们,我们将根据著作权人的要求,立即更正或者删除有关内容。本站拥有对此声明的最终解释权。

0 个评论

要回复文章请先登录注册