Код для броска кубика с выбыванием

Question

Я пытаюсь написать код r для этой задачи: предположим, что мы бросаем n кубиков, удаляем все кубики, которые выпали 1, и бросаем остальные снова.Если мы повторим этот процесс, в конечном итоге все кости будут удалены.Сколько рулонов мы сделаем в среднем?Вот что я пробовал до сих пор, но это не работает.Теоретический ответ учебника на 5 кубиков: 13.02

CODE ATTEMPT

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

Для сравнения с ответом @ 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 2

Вот обновленный код для вышеуказанной проблемы

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 

Answer 3

Вот рабочий скрипт, который подсчитывает, сколько раз нужно бросить кубик, чтобы сгенерировать каждое из шести значений:

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 бросковчтобы покрыть все значения на кристалле.