Wenn ich Sie richtig verstehe, möchten Sie Werte aus der Multinomialverteilung mit den Wahrscheinlichkeiten so , dass ist. Sie möchten jedoch, dass die Verteilung so abgeschnitten wird, dass für alle .p 1 , … , p k ∑ i x i = n a i ≤ x i ≤ b i x ix1, … , X.kp1, … , P.k∑ichxich= neinich≤ xich≤ bichxich
Ich sehe drei Lösungen (weder so elegant wie im nicht abgeschnittenen Fall):
- Annehmen ablehnen. Probe aus nicht abgeschnittenem Multinom, akzeptieren Sie die Probe, wenn sie den Kürzungsgrenzen entspricht, andernfalls lehnen Sie den Vorgang ab und wiederholen Sie ihn. Es ist schnell, kann aber sehr ineffizient sein.
rtrmnomReject <- function(R, n, p, a, b) {
x <- t(rmultinom(R, n, p))
x[apply(a <= x & x <= b, 1, all) & rowSums(x) == n, ]
}
- Direkte Simulation. Probieren Sie auf eine Art und Weise, die dem Datenerzeugungsprozess ähnelt, dh probieren Sie einen einzelnen Marmor aus einer zufälligen Urne und wiederholen Sie diesen Vorgang, bis Sie insgesamt Murmeln abgetastet haben. Wenn Sie jedoch die Gesamtzahl der Murmeln aus einer bestimmten Urne bereitstellen ( ist bereits gleich ) dann hör auf aus einer solchen Urne zu zeichnen. Ich habe dies in einem Skript unten implementiert.x i b inxichbich
# single draw from truncated multinomial with a,b truncation points
rtrmnomDirect <- function(n, p, a, b) {
k <- length(p)
repeat {
pp <- p # reset pp
x <- numeric(k) # reset x
repeat {
if (sum(x<b) == 1) { # if only a single category is left
x[x<b] <- x[x<b] + n-sum(x) # fill this category with reminder
break
}
i <- sample.int(k, 1, prob = pp) # sample x[i]
x[i] <- x[i] + 1
if (x[i] == b[i]) pp[i] <- 0 # if x[i] is filled do
# not sample from it
if (sum(x) == n) break # if we picked n, stop
}
if (all(x >= a)) break # if all x>=a sample is valid
# otherwise reject
}
return(x)
}
- Metropolis-Algorithmus. Schließlich wäre der dritte und effizienteste Ansatz die Verwendung des Metropolis-Algorithmus . Der Algorithmus wird durch direkte Simulation initialisiert (kann aber auch anders initialisiert werden), um die erste Probe zu zeichnen . In den folgenden Schritten iterativ: Der Vorschlagswert
wird mit der Wahrscheinlichkeit als akzeptiert , andernfalls wird der Wert aufgenommen Es ist der Ort, an dem. Als Vorschlag habe ich die Funktion , die den Wert annimmt und zufällig von 0 auf die Anzahl der Fälle wechselt und diese in eine andere Kategorie verschiebt.X.1y= q( X.i - 1)X.ichf( y) / f( X.i - 1)X.i - 1f( x ) ∝ ∏ichpxichich/ xich!qX.i - 1
step
# draw R values
# 'step' parameter defines magnitude of jumps
# for Meteropolis algorithm
# 'init' is a vector of values to start with
rtrmnomMetrop <- function(R, n, p, a, b,
step = 1,
init = rtrmnomDirect(n, p, a, b)) {
k <- length(p)
if (length(a)==1) a <- rep(a, k)
if (length(b)==1) b <- rep(b, k)
# approximate target log-density
lp <- log(p)
lf <- function(x) {
if(any(x < a) || any(x > b) || sum(x) != n)
return(-Inf)
sum(lp*x - lfactorial(x))
}
step <- max(2, step+1)
# proposal function
q <- function(x) {
idx <- sample.int(k, 2)
u <- sample.int(step, 1)-1
x[idx] <- x[idx] + c(-u, u)
x
}
tmp <- init
x <- matrix(nrow = R, ncol = k)
ar <- 0
for (i in 1:R) {
proposal <- q(tmp)
prob <- exp(lf(proposal) - lf(tmp))
if (runif(1) < prob) {
tmp <- proposal
ar <- ar + 1
}
x[i,] <- tmp
}
structure(x, acceptance.rate = ar/R, step = step-1)
}
Der Algorithmus beginnt bei und wandert dann durch die verschiedenen Verteilungsbereiche. Es ist offensichtlich schneller als die vorherigen, aber Sie müssen bedenken, dass Sie, wenn Sie damit eine kleine Anzahl von Fällen untersuchen möchten, möglicherweise nahe beieinander liegende Draws erhalten. Ein weiteres Problem besteht darin, dass Sie sich für die Größe entscheiden müssen , dh wie große Sprünge der Algorithmus machen soll - zu klein kann dazu führen, dass Sie sich langsam bewegen, zu groß kann dazu führen, dass zu viele ungültige Vorschläge gemacht und abgelehnt werden. Unten sehen Sie ein Beispiel für die Verwendung. Auf den Plots sehen Sie: Randdichten in der ersten Reihe, Traceplots in der zweiten Reihe und Plots mit nachfolgenden Sprüngen für Variablenpaare.X.1step
n <- 500
a <- 50
b <- 125
p <- c(1,5,2,4,3)/15
k <- length(p)
x <- rtrmnomMetrop(1e4, n, p, a, b, step = 15)
cmb <- combn(1:k, 2)
par.def <- par(mfrow=c(4,5), mar = c(2,2,2,2))
for (i in 1:k)
hist(x[,i], main = paste0("X",i))
for (i in 1:k)
plot(x[,i], main = paste0("X",i), type = "l", col = "lightblue")
for (i in 1:ncol(cmb))
plot(jitter(x[,cmb[1,i]]), jitter(x[,cmb[2,i]]),
type = "l", main = paste(paste0("X", cmb[,i]), collapse = ":"),
col = "gray")
par(par.def)
Das Problem bei der Probenahme aus dieser Verteilung besteht darin, dass eine sehr ineffiziente Probenahmestrategie im Allgemeinen beschrieben wird. Stellen Sie sich vor, dass und , und nahe an . In diesem Fall möchten Sie Stichproben mit unterschiedlichen Wahrscheinlichkeiten erstellen, aber ähnliche erwarten Frequenzen am Ende. Stellen Sie sich im Extremfall eine zweikategoriale Verteilung vor, bei der und ,p1& Ne; ⋯ & ne; pkein1= ⋯ = akb1= … B.keinichbichp1≫ p2ein1≪ a2b1≪ b2In einem solchen Fall erwarten Sie, dass ein sehr seltenes Ereignis eintritt (ein reales Beispiel für eine solche Verteilung wäre ein Forscher, der die Stichprobe wiederholt, bis er die Stichprobe findet, die mit seiner Hypothese übereinstimmt. Es hat also mehr mit Betrug als mit Zufallsstichprobe zu tun). .
Die Verteilung ist viel weniger problematisch, wenn Sie sie als Rukhin (2007, 2008) definieren, bei dem Sie Fälle für jede Kategorie, dh proportional zu , untersuchen.n pichpich
Rukhin, AL (2007). Normale Ordnungsstatistiken und Summen geometrischer Zufallsvariablen bei Behandlungszuordnungsproblemen. Statistik & Wahrscheinlichkeitsbuchstaben, 77 (12), 1312-1321.
Rukhin, AL (2008). Regeln bei ausgeglichenen Zuordnungsproblemen stoppen: Genaue und asymptotische Verteilungen. Sequential Analysis, 27 (3), 277 & ndash; 292.
x[i] >= a
. Stellen Sie sich vor, Sie haben eine voreingenommene Münze mit einer Wahrscheinlichkeit von 0,9 geworfen. Sie werfen die Münze, bis Sie mindestens 10 Köpfe und 10 Schwänze erhalten. Am Haltepunkt hätten Sie im Durchschnitt viel mehr Köpfe als Schwänze. Beginnen beix[1] = ... = x[k] = a
bedeutet, dass Sie die Tatsache ignorieren, dass die Startpunkte von jedem vonx[i]
aufgrund unterschiedlicher unterschiedlich sindp[i]
.Hier ist mein Versuch, Tims R-Code in Python zu übersetzen. Da ich einige Zeit damit verbracht habe, dieses Problem zu verstehen und die Algorithmen in Python zu codieren, habe ich mir überlegt, sie hier zu teilen, falls Leute interessiert sind.
Eine vollständige Implementierung dieses Codes finden Sie in meinem Github-Repository unter
https://github.com/mohsenkarimzadeh/sampling
quelle