Предположим, что все стороны с имеют равные шансы. Давайте обобщим и найдем ожидаемое количество бросков, необходимое для того, чтобы сторона 1 появилась n 1 раз, сторона 2 появилась n 2 раза, ..., а сторона d появилась n d раз. Поскольку идентичности сторон не имеют значения (все они имеют равные шансы), описание этой цели может быть сжато: предположим, что i 0 сторон не должно появляться вообще, i 1 сторон должно появляться только один раз, ... и я пd=61n12n2dndi0i1inиз сторон должны появляться раз. Пусть i = ( i 0 , i 1 , … , i n ) обозначает эту ситуацию и записывает e ( i ) для ожидаемого количества бросков. Вопрос требует e ( 0 , 0 , 0 , 6 ) : i 3 =n=max(n1,n2,…,nd)
i=(i0,i1,…,in)
e(i)
e(0,0,0,6) означает, что все шесть сторон должны быть видны три раза каждая.
i3=6
Легкое повторение доступно. На следующем броске, сторона , которая появляется , соответствует одному из : то есть, либо мы не должны видеть его, или нам нужно один раз увидеть, ..., или мы должны увидеть п более раз. j - сколько раз нам нужно было это увидеть.ijnj
Когда , нам не нужно было это видеть, и ничего не меняется. Это происходит с вероятностью i 0 / d .J = 0я0/ д
Когда нам нужно было увидеть эту сторону. Теперь есть еще одна сторона, которую нужно увидеть j раз, и еще одна сторона, которую нужно увидеть j - 1 раз. Таким образом, i j становится i j - 1, а i j - 1 становится i j + 1 . Пусть эта операция над компонентами i обозначена i ⋅ j , так чтоj>0jj−1ijij−1ij−1ij+1ii⋅j
i⋅j=(i0,…,ij−2,ij−1+1,ij−1,ij+1,…,in).
Это происходит с вероятностью .ij/d
Мы просто должны посчитать этот бросок кубика и использовать рекурсию, чтобы сказать нам, сколько еще бросков ожидается. По законам ожидания и полной вероятности,
e(i)=1+i0de(i)+∑j=1nijde(i⋅j)
(Давайте поймем, что всякий раз, когда , соответствующий член в сумме равен нулю.)ij=0
Если , мы закончили и e ( i ) = 0 . В противном случае мы можем решить для e ( i ) , давая желаемую рекурсивную формулуi0=de(i)=0e(i)
e(i)=d+i1e(i⋅1)+⋯+ine(i⋅n)d−i0.(1)
Обратите внимание, что - общее количество событий, которые мы хотим увидеть. Операция ⋅ j уменьшает эту величину на единицу для любого j > 0, если i j > 0 , что всегда имеет место. Поэтому эта рекурсия заканчивается на глубине точно | я | (равно 3 ( 6 ) =
| я | =0( я0) + 1 ( я1) + ⋯ + n ( яN)
⋅ jj > 0яJ> 0| я | в вопросе). Более того (как нетрудно проверить) количество возможностей на каждой глубине рекурсии в этом вопросе невелико (никогда не превышает
8 ). Следовательно, это эффективный метод, по крайней мере, когда комбинаторные возможности не слишком многочисленны, и мы запоминаем промежуточные результаты (чтобы значение
e не вычислялось более одного раза).
3 ( 6 ) = 188е
Я вычисляю, что
e(0,0,0,6)=228687860450888369984000000000≈32.677.
Это показалось мне очень маленьким, поэтому я запустил симуляцию (используя R). После более трех миллионов бросков костей эта игра была завершена более 100 000 раз, при средней длине . Стандартная ошибка этой оценки составляет 0,027 : разница между этим средним и теоретическим значением незначительна, что подтверждает точность теоретического значения.32.6690.027
Распределение длин может представлять интерес. (Очевидно, он должен начинаться в , минимальное количество бросков, необходимое для сбора всех шести сторон по три раза каждый.)18
# Specify the problem
d <- 6 # Number of faces
k <- 3 # Number of times to see each
N <- 3.26772e6 # Number of rolls
# Simulate many rolls
set.seed(17)
x <- sample(1:d, N, replace=TRUE)
# Use these rolls to play the game repeatedly.
totals <- sapply(1:d, function(i) cumsum(x==i))
n <- 0
base <- rep(0, d)
i.last <- 0
n.list <- list()
for (i in 1:N) {
if (min(totals[i, ] - base) >= k) {
base <- totals[i, ]
n <- n+1
n.list[[n]] <- i - i.last
i.last <- i
}
}
# Summarize the results
sim <- unlist(n.list)
mean(sim)
sd(sim) / sqrt(length(sim))
length(sim)
hist(sim, main="Simulation results", xlab="Number of rolls", freq=FALSE, breaks=0:max(sim))
Реализация
Хотя рекурсивный расчет ее ( я )яя
RяEя ⋅j%.%
е
x <- (d + sum(sapply(1:n, function(i) j[i+1]*e.(j %.% i))))/(d - j[1])
прямо сопоставимо с формулой ( 1 )1R10
0,01e(c(0,0,0,6))
+32,6771634160506
Накопленная ошибка округления с плавающей запятой уничтожила последние две цифры (что должно быть, 68а не 06).
e <- function(i) {
#
# Create a data structure to "memoize" the values.
#
`[[<-.AA` <- function(x, i, value) {
class(x) <- NULL
x[[paste(i, collapse=",")]] <- value
class(x) <- "AA"
x
}
`[[.AA` <- function(x, i) {
class(x) <- NULL
x[[paste(i, collapse=",")]]
}
E <- list()
class(E) <- "AA"
#
# Define the "." operation.
#
`%.%` <- function(i, j) {
i[j+1] <- i[j+1]-1
i[j] <- i[j] + 1
return(i)
}
#
# Define a recursive version of this function.
#
e. <- function(j) {
#
# Detect initial conditions and return initial values.
#
if (min(j) < 0 || sum(j[-1])==0) return(0)
#
# Look up the value (if it has already been computed).
#
x <- E[[j]]
if (!is.null(x)) return(x)
#
# Compute the value (for the first and only time).
#
d <- sum(j)
n <- length(j) - 1
x <- (d + sum(sapply(1:n, function(i) j[i+1]*e.(j %.% i))))/(d - j[1])
#
# Store the value for later re-use.
#
E[[j]] <<- x
return(x)
}
#
# Do the calculation.
#
e.(i)
}
e(c(0,0,0,6))
Наконец, вот оригинальная реализация Mathematica, которая дала точный ответ. Запоминание осуществляется посредством идиоматического e[i_] := e[i] = ...выражения, исключающего почти все Rпредварительные сведения. Внутренне, тем не менее, две программы делают то же самое одинаково.
shift[j_, x_List] /; Length[x] >= j >= 2 := Module[{i = x},
i[[j - 1]] = i[[j - 1]] + 1;
i[[j]] = i[[j]] - 1;
i];
e[i_] := e[i] = With[{i0 = First@i, d = Plus @@ i},
(d + Sum[If[i[[k]] > 0, i[[k]] e[shift[k, i]], 0], {k, 2, Length[i]}])/(d - i0)];
e[{x_, y__}] /; Plus[y] == 0 := e[{x, y}] = 0
e[{0, 0, 0, 6}]
228687860450888369984000000000
