Wie oft musst du voraussichtlich würfeln, bis jede Seite dreimal aufgetaucht ist?
Diese Frage wurde in der neuseeländischen Grundschule gestellt und mithilfe von Simulationen gelöst. Was ist die analytische Lösung für dieses Problem?
Wie oft musst du voraussichtlich würfeln, bis jede Seite dreimal aufgetaucht ist?
Diese Frage wurde in der neuseeländischen Grundschule gestellt und mithilfe von Simulationen gelöst. Was ist die analytische Lösung für dieses Problem?
Antworten:
Angenommen, alle Seiten haben gleiche Chancen. Lassen Sie uns verallgemeinern und finden die erwartete Anzahl von Rollen benötigt , bis Seite erschienen ist mal, Seite erschienen mal, ... und Seite erschienen mal. Da die Identität der Seiten keine Rolle spielt (sie haben alle die gleichen Chancen), kann die Beschreibung dieses Ziels zusammengefasst werden: Nehmen wir an, dass Seiten überhaupt nicht erscheinen müssen, Seiten müssen nur einmal erscheinen , ... und der Seiten müssen mal vorkommen. Lassen1 n 1 2 n 2 d n d i 0 i 1 i n n = max ( n 1 , n 2 , … , n d ) i = ( i 0 , i 1 , … , i n )
Eine einfache Wiederholung ist verfügbar. An der nächsten Rolle, die Seite , die entspricht einer der erscheint : das heißt, entweder brauchten wir nicht , es zu sehen, oder wir brauchten es einmal zu sehen, ... oder was wir brauchten, um zu sehen mehrmals . ist die Häufigkeit, mit der wir es gesehen haben. n j
Wenn , mussten wir es nicht sehen und nichts ändert sich. Dies geschieht mit der Wahrscheinlichkeit .i 0 / d
Bei wir diese Seite sehen. Jetzt gibt es eine Seite weniger, die mal gesehen werden muss, und eine weitere Seite, die mal gesehen werden muss. Somit wird zu und wird . Lassen Sie diese Operation für die Komponenten von als , so dassj j - 1 i j i j - 1 i j - 1 i j + 1 i i ⋅ j
Dies geschieht mit der Wahrscheinlichkeit .
Wir müssen nur diesen Würfelwurf zählen und rekursiv angeben, wie viele weitere Würfel zu erwarten sind. Durch die Gesetze der Erwartung und der Gesamtwahrscheinlichkeit,
(Lassen Sie uns verstehen, dass der entsprechende Term in der Summe Null ist , wenn ist.)
Wenn , sind wir fertig und . Andernfalls können wir nach auflösen und die gewünschte rekursive Formel angebene ( i ) = 0 e ( i )
Beachten Sie, dass ist die Gesamtzahl der Ereignisse, die wir sehen möchten. Die Operation reduziert diese Menge für jedes um eins, vorausgesetzt, , was immer der Fall ist. Daher endet diese Rekursion in einer Tiefe von genau(gleich in der Frage). Darüber hinaus ist (wie nicht schwer zu überprüfen ist) die Anzahl der Möglichkeiten bei jeder Rekursionstiefe in dieser Frage gering (niemals größer als ). Folglich ist dies eine effiziente Methode, zumindest wenn die kombinatorischen Möglichkeiten nicht zu zahlreich sind und wir die Zwischenergebnisse auswendig lernen (so dass kein Wert von vorliegt)⋅ j j > 0 i j > 0 | ich | 3 ( 6 ) = 18 8 e
Ich berechne, dass
Das kam mir schrecklich klein vor, also habe ich eine Simulation (mit R
) durchgeführt. Nach über drei Millionen Würfeln war dieses Spiel mehr als 100.000 Mal zu Ende gespielt worden, mit einer durchschnittlichen Länge von . Der Standardfehler dieser Schätzung beträgt : Die Differenz zwischen diesem Mittelwert und dem theoretischen Wert ist unbedeutend, was die Genauigkeit des theoretischen Werts bestätigt.0,027
Die Längenverteilung kann von Interesse sein. (Offensichtlich muss es bei beginnen , die minimale Anzahl von Rollen, die benötigt wird, um alle sechs Seiten dreimal zu sammeln.)
# 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))
Die rekursive Berechnung von ist zwar einfach, birgt jedoch in einigen Computerumgebungen einige Herausforderungen. Das Wichtigste unter diesen ist das Speichern der Werte von während sie berechnet werden. Dies ist wichtig, da ansonsten jeder Wert (redundant) sehr oft berechnet wird. Der Speicherplatz, der möglicherweise für ein von indiziertes Array benötigt wird, kann jedoch enorm sein. Im Idealfall sollten nur Werte von gespeichert werden, die während der Berechnung tatsächlich auftreten. Dies erfordert eine Art assoziatives Array.
Zur Veranschaulichung hier ist R
Arbeitscode. Die Kommentare beschreiben die Erstellung einer einfachen "AA" -Klasse (Assoziatives Array) zum Speichern von Zwischenergebnissen. Vektoren werden in Zeichenfolgen konvertiert und diese werden zum Indizieren in eine Liste verwendet , die alle Werte enthält. Die Operation wird implementiert als .E
%.%
Durch diese Vorkehrungen kann die rekursive Funktion ziemlich einfach in einer Weise definiert werden, die der mathematischen Notation entspricht. Insbesondere die Leitung
x <- (d + sum(sapply(1:n, function(i) j[i+1]*e.(j %.% i))))/(d - j[1])
ist direkt vergleichbar mit der obigen Formel . Beachten Sie, dass alle Indizes um erhöht wurden, da die Indizierung der Arrays bei und nicht bei beginnt .R
Das Timing zeigt, dass die Berechnung Sekunden dauert . sein Wert iste(c(0,0,0,6))
32.6771634160506
Kumulierte Gleitkomma- Rundungsfehler hat , die letzten beiden Ziffern zerstört (was sein sollte , 68
statt 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))
Schließlich ist hier die ursprüngliche Mathematica- Implementierung, die die genaue Antwort ergab. Das Auswendiglernen erfolgt über den e[i_] := e[i] = ...
Ausdruck " idiomatisch" , wodurch fast alle R
vorbereitenden Schritte entfallen . Intern tun die beiden Programme jedoch dasselbe.
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}]
Die ursprüngliche Version dieser Frage begann mit der Frage:
Wie viele Rollen werden benötigt, bis jede Seite dreimal aufgetaucht ist?
Natürlich ist das eine Frage, auf die @JuhoKokkala keine Antwort hat: Die Antwort ist eine Zufallsvariable mit einer Verteilung, die gefunden werden muss. Die Frage wurde dann geändert, um zu fragen: "Was ist die erwartete Anzahl von Rollen." Die folgende Antwort versucht, die ursprüngliche Frage zu beantworten: Wie kann man die Verteilung der Anzahl der Rollen ermitteln , ohne Simulation und nur mit konzeptionell einfachen Techniken, die jeder neuseeländische Student mit einem Computer implementieren könnte ? Warum nicht? Das Problem reduziert sich auf einen 1-Liner.
Verteilung der Anzahl der benötigten Rollen ... so, dass jede Seite dreimal erscheint
Wir würfeln Mal. Es sei die mit der die Seite des Würfels erscheint, wobei . Dann wird die gemeinsame PMF von ist das heißt :
Es sei:Dann ist der cdf von :
dh um das cdf , berechnen Sie einfach für jeden Wert von :
Hier ist zum Beispiel Mathematica- Code, der dies tut, da von 18 auf 60 ansteigt. Es ist im Grunde genommen ein Einzeiler:
cdf = ParallelTable[
Probability[x1 >= 3 && x2 >= 3 && x3 >= 3 && x4 >= 3 && x5 >= 3 && x6 >= 3,
{x1, x2, x3, x4, x5, x6} \[Distributed] MultinomialDistribution[n, Table[1/6, 6]]],
{n, 18, 60}]
... was die exakte cdf ergibt, wenn zunimmt:
Hier ist eine Darstellung des cdf als Funktion von :
Um die pmf abzuleiten , differenzieren Sie zunächst die cdf:
Natürlich hat die Verteilung keine Obergrenze, aber wir können hier so viele Werte auflösen, wie praktisch erforderlich. Die Vorgehensweise ist allgemein und sollte für jede gewünschte Kombination von Seiten geeignet sein.