多人数でババ抜きをすると何ターンかかるか（訂正）

多人数でババ抜きをすると何ターンかかるか（訂正）

ばば抜きのシミュレーション - 裏 RjpWikiさんの記事のお陰で、間違いが見つかった。

訂正版を記載する。

今回も非常に勉強になった。blogをはじめて本当に良かった。

それにしても、一から作りなおしたほうが楽じゃないかと思った。

デバッグって辛い作業ですな。でも、一から作りなおしたのでは

勉強にならないので頑張りました。

裏 RjpWikiさんでのcheck()とか、しびれました。from-toの変数導入も目からうろこ。

## ばば抜き##

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) {
        lll <- seq(i, (i + n * ( (53 - i)%/%n)), n)  #i番目の人のカード
        x[[i]] <- tp[lll]
    }

    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):1) {
            if (length(x) == 1) {
                break
            }
            ct <- ct + 1  #カウンター
            if (toren == 1) {
                toren <- 0  #取るはずの人があがったら取れないルール
                next
            } else if (j == 1) 
                {
                  # 1番目の人は最後の人が引くので例外処理
                  get <- sample(length(x[[1]]), 1)  #ここも間違い
                  x[[length(x)]] <- c(x[[length(x)]], x[[1]][[get]])  #ここも間違い
                  if (is.null(tori(x, length(x)))) {
                    toren <- 1
                    x[[length(x)]] <- tori(x, length(x))
                    x[[1]][get] <- NA
                    x[[1]] <- tori(x, 1)
                    next
                  } else {
                    x[[length(x)]] <- tori(x, length(x))
                    x[[1]][get] <- NA
                    x[[1]] <- tori(x, 1)
                    next
                  }

                }  #1番目の人の例外処理終
 else {
                get <- sample(1:length(x[[j]]), 1, replace = FALSE)
                x[[j - 1]] <- c(x[[j - 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)
                  next
                }
            }
        }
    }
    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] 676.5

which(res_med == max(res_med))

## [1] 53

改訂版でも、５３回が一番多くのターン数がかかる。
そして、その中央値は６７７回だ。

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

## [1] 60

median(res[26, ])

## [1] 240

２６人の場合、１ターン１５秒だと６０分/２４０ターンかかる。

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

編集の都合で別の乱数になってしまうが
> quantile(xx,c(0.025,0.975))
   2.5%   97.5% 
134.975 394.025 
> sum(xx <= 187)
[1] 204

１８７ターンは２０％タイルくらいになる。普通の範囲だ。