Якщо я вас правильно зрозумів, ви бажаєте відібрати значення з багаточленного розподілу з ймовірностями таким чином, що , однак ви хочете, щоб розподіл був усічений таким чином для всіх .х1, … ,хкp1,… ,pк∑iхi= nаi≤хi≤бiхi
Я бачу три рішення (не такі елегантні, як у невкороченому корпусі):
- Прийняти-відхилити. Зразок із нестриженого мультиноміалу приймайте зразок, якщо він відповідає меж усічення, інакше відхиліть і повторіть процес. Це швидко, але може бути дуже неефективно.
rtrmnomReject <- function(R, n, p, a, b) {
x <- t(rmultinom(R, n, p))
x[apply(a <= x & x <= b, 1, all) & rowSums(x) == n, ]
}
- Пряме моделювання. Зразок в моді, що нагадує процес генерації даних, тобто зразок одинарного мармуру з випадкової урни і повторюйте цей процес, поки ви не відібрали загальних мармурів, але, коли ви розгорнете загальну кількість мармурів з даної урни ( вже дорівнює ) тоді перестаньте малювати з такої урни. Я реалізував це в сценарії нижче.нхiбi
# 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. Нарешті, третім та найефективнішим підходом було б використання алгоритму Metropolis . Алгоритм ініціалізується за допомогою прямого моделювання (але може бути ініціалізований по-різному), щоб намалювати перший зразок . На наступних етапах ітеративно: значення пропозиції
приймається як з ймовірністю , інакше значення приймається у це місце, де. В якості пропозиції я використав функцію яка приймає значення і випадковим чином перевертає з 0 на кількість випадків і переміщує її в іншу категорію.Х1у= q(Хi - 1)Хif( у) / ф(Хi - 1)Хi - 1f( x ) ∝∏ipхii/хi!qХ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)
}
Алгоритм починається з а потім бродить по різних регіонах розповсюдження. Це, очевидно, швидше, ніж попередні, але вам потрібно пам’ятати, що якби ви використовували його для вибірки невеликої кількості справ, то ви могли б закінчитися з малюнками, близькими один до одного. Інша проблема полягає в тому, що вам потрібно визначитися з розміром, тобто якими великими стрибками повинен робити алгоритм - занадто малі можуть призвести до повільного переміщення, занадто великі можуть призвести до створення занадто багато недійсних пропозицій та їх відхилення. Ви можете побачити приклад його використання нижче. На графіках ви можете бачити: граничні густини в першому ряду, трасплоти в другому ряду та графіки, що показують наступні стрибки для пар змінних.Х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)
Проблема вибірки з цього розподілу полягає в тому, що описується дуже неефективна стратегія вибірки загалом. Уявіть, що і , та близькі до , у такому випадку ви хочете зробити вибірку до категорій з різними ймовірностями, але очікуйте подібних частоти в підсумку. У крайньому випадку, уявіть розподіл, де , а ,p1≠ ⋯ ≠pка1= ⋯ =акб1= …бкаiбip1≫p2а1≪а2б1≪б2, у такому випадку ви очікуєте, що трапиться якась дуже рідкісна подія (в реальному прикладі такого розподілу буде дослідник, який повторює вибірку, поки не знайде зразок, що відповідає його гіпотезі, тому це має більше стосунку до обману, ніж до випадкового відбору) .
Розподіл набагато менш проблематичний, якщо ви визначаєте його як Рухін (2007, 2008), де ви випадків до кожної категорії, тобто вибірки пропорційно до .нpipi
Рухін, А. Л. (2007). Статистика звичайного порядку та суми геометричних випадкових змінних в задачах розподілу лікування. Статистика та ймовірнісні листи, 77 (12), 1312-1321.
Рухін, А. Л. (2008). Правила зупинки в задачах збалансованого розподілу: точні та асимптотичні розподіли. Послідовний аналіз, 27 (3), 277-292.