試しながら学ぶ統計・機械学習メモ

統計、機械学習、数理最適化の理論や実装に関する疑問について、実際に試しながら学んでいく過程を残したメモ

人名ビンゴ - 抽選回数は何回必要か?

とある飲み会で人名ビンゴをやることになった。

飲み会の人数は12人なので、参加者は12人の中から9人選び、3×3のマスの中に名前を記入していく。

12人のうち2人は人名ビンゴの企画者なので、ビンゴには参加しない。
(つまり参加者は10人)

何回か抽選を行い、その決められた回数以内にビンゴした人には賞品を渡すというルールにすることにした。
当選者が一人も出なかった場合は、企画者が賞品をもらえることにした。

誰もビンゴしないのもつまらないし、みんながビンゴしてもつまらない。
抽選回数は何回にしたらいいだろうか。


シミュレーションの実行

#抽選回数
ncall<-12

#参加人数
nmem<-10

#試行回数
nrep<-1000
simulation<-matrix(0,nrep,ncall)

for(x in 1:nrep){
  
  #出席者一覧
  name <- 1:12
  n<-length(name)
  
  #参加人数分のビンゴシートを用意する
  sheet<-array(0,dim=c(3,3,nmem))

  #カウント用
  bingo<-sheet

  #参加者のシート一覧 
  for(k in 1:nmem){
    sheet[,,k] <- matrix(sample(name,9),3,3)
  }
  
  
  #ビンゴパターンのリストアップ
  #くじ引き
  call<-sample(name,ncall)
  cnt<-matrix(0,nmem,ncall)
  
  #kは参加者番号
  for(k in 1:nmem){
    #iは呼ばれた出席者の順番
    for( i in 1:ncall ){
      #sheet[,,k]について、シート内に呼ばれた名前があれば、そのセルに1を代入
      row<-which(sheet[,,k]==call[i],arr.ind=TRUE)[1]
      col<-which(sheet[,,k]==call[i],arr.ind=TRUE)[2]
      bingo[row,col,k]<-1
      
      #ビンゴ数のカウント
      if(sum(bingo[,1,k])==3){cnt[k,i]=cnt[k,i]+1}
      if(sum(bingo[,2,k])==3){cnt[k,i]=cnt[k,i]+1}
      if(sum(bingo[,3,k])==3){cnt[k,i]=cnt[k,i]+1}
      if(sum(bingo[1,,k])==3){cnt[k,i]=cnt[k,i]+1}
      if(sum(bingo[2,,k])==3){cnt[k,i]=cnt[k,i]+1}
      if(sum(bingo[3,,k])==3){cnt[k,i]=cnt[k,i]+1}
      if(bingo[1,1,k]+bingo[2,2,k]+bingo[3,3,k]==3){cnt[k,i]=cnt[k,i]+1}
      if(bingo[1,3,k]+bingo[2,2,k]+bingo[3,1,k]==3){cnt[k,i]=cnt[k,i]+1}
    }}
  
  
  flag<-matrix(0,nmem,ncall)
  
  for(a in 1:nmem){
    for(b in 1:ncall){
      if(cnt[a,b]!=0){flag[a,b]=1}
    }
  }
  
  for(c in 1:nmem){
    if(c==1){FLG=flag[c,]}
    else{FLG=FLG+flag[c,]}
  }
  
  simulation[x,]<-FLG
}

X<-NA
for(d in 1:nrep){
  if(d==1){X=simulation[d,]}
  else{X=X+simulation[d,]}
}
X<-X/nrep

結果を可視化

opar<-par()
par(mfrow=c(2,4),family="serif",cex=1.2,
    bg="black",fg="white",
    col.axis="white",col.lab="white",col.main="white",col.sub="white")

plot(X,
     main="抽選回数と平均当選人数の関係",
     xlab="抽選回数",
     ylab="平均当選人数",
     las=1,
     type="o",
     col="#009000ff",
     pch=19
)

for(k in 3:8){ 
  hist(simulation[,k],breaks=0:(max(simulation[,k])+1),
     freq=F,
     right=F,
     main=sprintf("抽選%0d回目の時の当選人数_確率分布",k),
     ylab="確率",
     xlab="当選人数",
     ylim=c(0,0.70),
     xlim=c(0,11),
     col="#00900040",
     border="#009000",
     las=1
       )
}



Diff.sim<-simulation[,2:12]-simulation[,1:11]
Diff.sim<-cbind(0,Diff.sim)


Y<-NA
for(d in 1:nrep){
  if(d==1){Y=Diff.sim[d,]}
  else{Y=Y+Diff.sim[d,]}
}
Y<-Y/nrep

par(opar)
par(mfrow=c(2,4),family="serif",cex=1.2,
    bg="black",fg="white",
    col.axis="white",col.lab="white",col.main="white",col.sub="white")

plot(Y,
     main="抽選回数と平均当選人数の関係",
     xlab="抽選回数",
     ylab="当該抽選回数での平均当選人数",
     las=1,
     type="o",
     col="#500090ff",
     pch=19
)

for(k in 3:9){ 
  hist(Diff.sim[,k],breaks=0:(max(Diff.sim[,k])+1),
       freq=F,
       right=F,
       main=sprintf("抽選%0d回目の時点で当選する人数_確率分布",k),
       ylab="確率",
       xlab="当選人数",
       ylim=c(0,0.70),
       xlim=c(0,11),
       col="#50009040",
       border="#500090",
       las=1
  )
}


…抽選回数は4回にすることにした。