请选择 进入手机版 | 继续访问电脑版
楼主: cheetahfly
6439 11

[程序分享] 用R语言实验验证经典概率问题:The Monty Hall problem [推广有奖]

  • 2关注
  • 71粉丝

版主

院士

5%

还不是VIP/贵宾

-

威望
0
论坛币
58652 个
通用积分
1373.9804
学术水平
480 点
热心指数
587 点
信用等级
328 点
经验
126211 点
帖子
2058
精华
1
在线时间
3760 小时
注册时间
2010-10-27
最后登录
2024-3-26

cheetahfly 在职认证  发表于 2017-12-29 15:12:00 |显示全部楼层 |坛友微信交流群
相似文件 换一批

+2 论坛币
k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群
赵安豆老师微信:zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

感谢您参与论坛问题回答

经管之家送您两个论坛币!

+2 论坛币
问题:The Monty Hall problem有可能是历史上最富争议的概率问题。 问题很简单,Monty Hall原本是美国电视游戏节目 Let’s Make a Deal 的主持人, 蒙提霍尔问题就是源自该节目中的一个游戏。 如果你是参赛者, 以下是节目现场的情况。
  • 你会看到三扇关闭的门, 蒙提会告诉你每扇门后的奖励: 其中有一扇门后面是一辆车, 而另外两扇门后面则是诸如花生酱或假指甲之类不太值钱的东西。 奖品的摆放是随机的。
  • 你的目标就是要猜出哪扇门后是汽车。 如果猜对, 汽车就归你了。
  • 我们把你选择的门称为 A 门, 其他两扇门分别是 B 门和 C 门。
  • 在打开你所选择的 A 门之前, 蒙提往往会打开 B 门或 C 门扰乱你的选择。(如果汽车确实是在 A 门后面, 那蒙提随机打开 B 门或 C门都没有问题。)
  • 接下来, 蒙提会给你一个机会: 你是坚持原来的选择, 还是选择另一扇未打开的门。
问题是, 坚持原来的选择或选择另一扇门, 会有什么不同吗?

解答:大部分人凭直觉觉得这没有区别。 因为, 还剩下两扇门, 所以汽车在A门后面的概率是50%。
但是正确答案却是应该选择另一扇门,这样中奖的概率从原来的1/3变为了2/3,具体推导如下:
  • 假设第一次选的是有奖的门,则其概率是1/3,此时更改选择获奖概率为0,不更改选择获奖概率为1;
  • 假设第一次选的是没有奖的门,则其概率是2/3,此时更改选择获奖概率为1,不改选择获奖概率为0;
综上所述,更改选择获奖概率为(1/3)×0+(2/3)×1=(2/3),不更改选择获奖概率为(1/3)×1+(2/3)×0=(1/3),即更改选择获奖概率较大,为2/3。

但是,等一等:这真的与直觉相悖啊:当Monty Hall打开了一扇空的门,还剩下两个关闭的门的时候,你告诉我,现在我已选的这个门背后有大奖的概率是1/3,另外一扇门背后有大奖的概率是2/3,什么鬼啊?!

好吧,百思不如一试,让我们来做实验吧:
  1. # 建立一个实验函数
  2. Monty_Hall_Experiment <- function() {
  3.     # 有三个门,其中一个有奖品
  4.     doors <- sample(c(1L, 0L, 0L), 3L)
  5.     # 观众选取了其中的一个门
  6.     choice1 <- sample(1:3, 1)
  7.     # 主持人在未被选中的两个门中,打开了一个没有奖品的门
  8.     if (length(unique(doors[-choice1])) == 1) { # 如果剩下的两个门都没有奖品
  9.         drop <- sample((1:3)[-choice1], 1)
  10.     } else {  # 如果剩下的两个门中有一个有大奖
  11.         drop <- setdiff(which(doors == 0), choice1)
  12.     }
  13.     # 剩下的那个门,作为chioce2
  14.     choice2 <- (1:3)[-c(choice1, drop)]
  15.     out <- doors[c(choice1, choice2)]
  16.     names(out) <- c("choice1", "choice2")
  17.     out
  18. }

  19. # 做10000次实验
  20. result <- matrix(nrow = 1e4, ncol = 2)
  21. colnames(result) <- c("choice1", "choice2")
  22. for (i in seq_len(nrow(result))) {
  23.     result[i, ] <- Monty_Hall_Experiment()   
  24. }

  25. # 分析实验结果
  26. library(tidyverse)
  27. result %>%
  28.   tbl_df() %>%
  29.   summarise_all(.funs = mean)

  30. # output:
  31.      choice1        choice2
  32.      0.3386        0.6614
复制代码
还真是如此!这次数学战胜了直觉。
二维码

扫码加我 拉你入群

请注明:姓名-公司-职位

以便审核进群资格,未注明则拒绝


已有 1 人评分热心指数 收起 理由
happy_287422301 + 2 精彩帖子

总评分: 热心指数 + 2   查看全部评分

本帖被以下文库推荐

allain 在职认证  发表于 2017-12-29 16:07:11 |显示全部楼层 |坛友微信交流群
很厉害,牛叉

使用道具

cheetahfly 在职认证  发表于 2017-12-29 16:33:16 |显示全部楼层 |坛友微信交流群
补充累计“获奖”图:
  1. result %>%
  2.   tbl_df() %>%
  3.   mutate(num = seq_len(nrow(.))) %>%
  4.   mutate_at(.vars = vars(choice1, choice2), .funs = cumsum) %>%
  5.   gather(choices, cumWin, c("choice1", "choice2")) %>%
  6.   ggplot(aes(x = num, y = cumWin, color = choices)) +
  7.   geom_line(size = 1) +
  8.   labs(x = "实验次数", y = "累计获大奖的次数")
复制代码
experiment.png


使用道具

jinkelazzz 发表于 2017-12-29 17:57:46 |显示全部楼层 |坛友微信交流群
要充分利用已知信息
已有 1 人评分经验 论坛币 收起 理由
happy_287422301 + 100 + 40 观点有启发

总评分: 经验 + 100  论坛币 + 40   查看全部评分

使用道具

tmdxyz 发表于 2017-12-30 04:01:32 |显示全部楼层 |坛友微信交流群
不错 拜读了
已有 1 人评分论坛币 收起 理由
happy_287422301 + 20 补偿

总评分: 论坛币 + 20   查看全部评分

使用道具

allain 在职认证  发表于 2018-2-26 16:44:28 |显示全部楼层 |坛友微信交流群
doors <- sample(c(1L, 0L, 0L), 3L)

请问楼主,这里为什么要加L?

使用道具

cheetahfly 在职认证  发表于 2018-2-27 08:10:30 |显示全部楼层 |坛友微信交流群
allain 发表于 2018-2-26 16:44
doors
确保是integer

使用道具

allain 在职认证  发表于 2018-2-27 09:37:44 |显示全部楼层 |坛友微信交流群
cheetahfly 发表于 2018-2-27 08:10
确保是integer
不是integer会怎样呢?

使用道具

cheetahfly 在职认证  发表于 2018-2-27 10:42:36 |显示全部楼层 |坛友微信交流群
allain 发表于 2018-2-27 09:37
不是integer会怎样呢?
integer的对比,与double的对比不完全一样,如果不是integer,就要在后面的代码中考虑容错的问题。

使用道具

allain 在职认证  发表于 2018-2-27 14:11:54 |显示全部楼层 |坛友微信交流群
cheetahfly 发表于 2018-2-27 10:42
integer的对比,与double的对比不完全一样,如果不是integer,就要在后面的代码中考虑容错的问题。
哦,好的,谢谢楼主

使用道具

您需要登录后才可以回帖 登录 | 我要注册

本版微信群
加好友,备注cda
拉您进交流群

京ICP备16021002-2号 京B2-20170662号 京公网安备 11010802022788号 论坛法律顾问:王进律师 知识产权保护声明   免责及隐私声明

GMT+8, 2024-3-28 20:33