r代码用于消除淘汰骰子

Question

我正在尝试为这个挑战编写r代码：假设我们掷出n个骰子，删除出现的所有骰子1，然后再次掷出其余的骰子。如果我们重复此过程，最终所有骰子都将被淘汰。我们平均要进行几卷？ 到目前为止，这是我尝试过的方法，但是没有用。教科书上5个骰子的理论答案是13.02

代码尝试

N=10000
myfun <- function(...) {
  for(i in list(...)){
  num=1
  S=sample(1:6,i,replace = TRUE)
  i=i-length(which(S==1))
  while(i!=0){
    i=i-length(which(S==1))
    num=num+1
  }
  result[i]=num
}

}

replicate(N,myfun(1:100))

Answer 1

这是一个有效的脚本，该脚本计算模具必须滚动多少次才能生成六个值中的每个值：

numRolls <- function() {
    cnt <- 0
    x <- c(1:6)
    while (length(x) > 0) {
        rand <- sample(1:6,1,replace = TRUE)   # generate random value 1 to 6
        x <- x[which(x!=rand)]                 # remove this value if not yet seen
        cnt <- cnt + 1                         # increment number of rolls
    }

    return(cnt)
}

totalRolls <- 0

for (i in 1:1000) {
    totalRolls <- totalRolls + numRolls()
}

totalRolls / 1000
[1] 14.819

我进行了1000次测试，平均14.819个掷骰来覆盖骰子上的每个值。

Answer 2

要与@TimBiegeleisen的答案进行比较，这是另一种方法

我们定义了一个模拟6面模具滚动的函数，该函数返回使所有面至少一次获得所需的最小滚动数。

myfun <- function(Nmax = 10^5) {
    smpl <- sample(1:6, Nmax, replace = T)
    for (n in 1:Nmax) if (length(table(smpl[1:n])) == 6) break;
    return(n)
}

我们现在将这一过程重复1000次

set.seed(2018)
x <- replicate(1000, myfun())

summary(x)
#Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
#6.00   10.00   13.00   14.45   17.00   51.00

我们绘制分布图

ggplot(data.frame(x = x), aes(x)) +
    geom_density()

请注意，该值与理论值非常吻合

6 * sum(1 / (1:6))
[1] 14.7

因此结果很接近，绝对错误百分比为

abs(mean(x) - 6 * sum(1 / (1:6))) / (6 * sum(1 / (1:6))) * 100
#[1] 1.727891

Answer 3

这是上述问题的更新代码

N=10000 # number of simulation
    set.seed(1873)
    NoOfRolls<-function(d){
      num=0
      while(d!=0){
        S=sample(1:6,d,replace = TRUE)
        d=d-length(which(S==1)) #Gives difference between number of dice and number of times 1 appears. 
        num=num+1
      }
      return(num)
    }

    Nrolls=replicate(N,NoOfRolls(5))
    hist(Nrolls, breaks=0:60, prob=T)
    mean(Nrolls)#Average changes depending on no of dice thrown. This is the  average for 5 dice.
13.03