ババ抜きを多人数ですると何ターンくらいかかるか（粘りの珍百景をシミュレートする）

ババ抜きを多人数ですると何ターンかかるか（粘りの珍百景をシミュレートする）

＃＃＃＃＃＃＃

裏 RjpWikiさんのブログをみて、ざっと見たところ、

当方のコードに間違いを発見しました

＝＞とりあえず、間違いは直しました。

訂正後の記事はこちら

＃＃＃＃＃＃＃

ババ抜きを２６人でする珍百景があった。 http://tvtopic.goo.ne.jp/program/info/658627/index.html

全部で187ターン、タイムは44分46秒と意外に短かった。

では何人でするのが一番時間がかかるのか気になる。

また、この４４分というのは平均的なのかどうか。

Rでシミュレートしてみる

## ばば抜き##

baba <- function(n) {
    # n人数
    ct <- 0  #カウント
    tp <- c(rep( (1:13), 4), 14)
    tp <- sample(tp, replace = FALSE)  #シャッフル
    x <- as.list(NULL)  #各人で枚数が異なるのでlistにした

    for (i in 1:n) {
        line <- seq(i, (i + n * ( (53 - i)%/%n)), n)  #i番目の人のカード
        x[[i]] <- tp[line]
    }

    for (i in length(x):1) {
        # 除外するときに１行減ってズレるので数を減らす方向で回す
        y <- table(x[[i]])
        y <- y[(y != 2)]  #2枚同じもの消す
        y <- y[(y != 4)]  #４枚同じもの消す
        y <- as.integer(names(y))
        if (length(y) == 0) {
            x[[i]] <- NULL  #完全に消えたものは除外
        } else {
            x[[i]] <- y
        }
    }

    # ここまででまずは初期状態

    tori <- function(x, j) {
        # xのj番目でペアが出来たものを消す、NAも消す、終了も消す
        temp <- table(x[[j]])
        temp <- temp[(temp != 2)]
        temp <- as.integer(names(temp))
        if (length(temp) == 0) {
            return(NULL)
        } else {
            x[[j]] <- temp
        }
        return(x[[j]])
    }

    toren <- 0
    while (length(x) >= 2) {
        # 2人以上残ってる時に
        for (j in length(x):2) {
            ct <- ct + 1  #カウンター
            if (length(x) == 1) {
                # 最後の一人
                break
            } else if (j == 1) 
                {
                  # 1番目の人は最後の人が引くので例外処理
                  get <- sample(1:length(x[[j]]), 1, replace = FALSE)
                  x[[length(x)]][length(x[[length(x)]]) + 1] <- x[[j]][[get]]
                  x[[j]][get] <- NA
                  x[[j]] <- tori(x, j)
                  if (is.null(tori(x, length(x)))) {
                    toren <- 1
                    x[[length(x)]] <- tori(x, length(x))
                    next
                  } else {
                    x[[length(x)]] <- tori(x, length(x))
                    next
                  }

                }  #1番目の人の例外処理終
 else {
                if (toren == 1) {
                  toren <- 0  #取るはずの人があがったら取れないルール
                  next
                }
                get <- sample(1:length(x[[j]]), 1, replace = FALSE)
                x[[j - 1]][length(x[[j - 1]]) + 1] <- x[[j]][[get]]
                x[[j]][get] <- NA
                x[[j]] <- tori(x, j)
                if (is.null(tori(x, j - 1))) {
                  toren <- 1
                  x[[j - 1]] <- tori(x, j - 1)
                } else {
                  x[[j - 1]] <- tori(x, j - 1)
                }
            }
        }
    }
    return(ct)
}

niter <- 100
res <- matrix(0, niter, nrow = 53)

library(tcltk)

for (l in 2:53){
      pb <- txtProgressBar(min=1, max=53, style=3)
      setTxtProgressBar(pb, l)
for (k in 1:niter){
res[l,k] <- baba(l)
}
}
res_med <- apply(res, 1, median)
plot(res_med)

どうやら、人数が増えるほど時間がかかるようだ。
max(res_med)

## [1] 477.5

which(res_med == max(res_med))

## [1] 53

５３人でやった時が一番時間がかかり、中央値４７８回のようだ。

15 * median(res[26, ])/60  #1施行15秒で計算

## [1] 44.62

median(res[26, ])

## [1] 178.5

hist(res[26, ], col = "blue", main = "26babanuki", freq = FALSE)

1施行に15秒かかれば、26人ババ抜きの場合、中央値で178回で45分かかる。
番組の187ターン、タイムは44分46秒というのは、まあ普通。
ヒストグラムを描いても普通の範囲。