내가 제대로 이해하면, 당신은 샘플로 원하는 확률로 다항 분포의 값은 등이 , 그러나 당신이 분포가 잘립니다하려는 때문에 모든 입니다 .x1,…,xkp1,…,pk∑ixi=nai≤xi≤bixi
세 가지 해결책이 있습니다 (절단되지 않은 경우처럼 우아하지 않음).
- 수락 거부 잘리지 않은 다항식에서 추출한 샘플은 절단 경계에 맞는 경우 샘플을 수락하고 그렇지 않으면 프로세스를 거부 및 반복합니다. 빠르지 만 매우 비효율적 일 수 있습니다.
rtrmnomReject <- function(R, n, p, a, b) {
x <- t(rmultinom(R, n, p))
x[apply(a <= x & x <= b, 1, all) & rowSums(x) == n, ]
}
- 직접 시뮬레이션. 데이터 생성 프로세스와 유사한 방식으로 샘플을 생성합니다. 즉, 임의의 항아리에서 단일 대리석을 샘플링 하고 총 대리석 을 샘플링 할 때까지이 프로세스를 반복 하지만 주어진 항아리에서 총 구슬 수를 배포 할 때 ( 는 이미 같습니다. ) 그런 다음 항아리에서 그림 그리기를 중지하십시오. 아래 스크립트에서 이것을 구현했습니다.nxibi
# 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 알고리즘 을 사용하는 것 입니다. 알고리즘은 직접 시뮬레이션을 사용하여 초기화되지만 첫 번째 샘플 을 그리기 위해 다르게 초기화 될 수 있습니다 . 다음 단계를 반복적으로 수행합니다. 제안 값
은 확률 가진 로 수락되고 , 그렇지 않으면 값이 이곳은. 제안으로 나는 함수 를 사용하여 값 을 취하고 0에서 사례 수로 임의로 뒤집어 다른 범주로 옮겼습니다.X1y=q(Xi−1)Xif(y)/f(Xi−1)Xi−1f(x)∝∏ipxii/xi!qXi−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)
}
알고리즘은 에서 시작한 다음 다른 분포 영역을 돌아 다닙니다. 이전 사례보다 훨씬 빠르지 만 소수의 사례를 샘플링하는 데 사용하면 서로 가까운 무승부로 끝날 수 있습니다. 또 다른 문제는 크기 를 결정해야한다는 것입니다 . 즉, 알고리즘이 얼마나 큰 점프를해야하는지-너무 작 으면 느리게 움직일 수 있고, 너무 크면 무효 한 제안을 너무 많이 만들어 거부 할 수 있습니다. 아래에서 사용법 예를 볼 수 있습니다. 플롯에서 볼 수 있습니다 : 첫 번째 행의 한계 밀도, 두 번째 행의 트레이스 플로트 및 변수 쌍에 대한 후속 점프를 보여주는 플롯.X1step
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≠⋯≠pka1=⋯=akb1=…bkaibip1≫p2a1≪a2b1≪b2이런 경우 매우 드문 일이 발생할 것으로 예상됩니다 (이러한 분포의 실제 사례는 가설과 일치하는 표본을 찾을 때까지 표본 추출을 반복하는 연구원 일 것이므로 무작위 표본 추출보다 부정 행위와 더 관련이 있습니다) .
분포를 Rukhin (2007, 2008)으로 정의하면 각 범주에 대해 사례를 샘플링합니다 (예 : 비례하여 샘플링) .npipi
루킨, AL (2007). 처리 할당 문제에서 일반적인 순서 통계와 기하 랜덤 변수의 합. 통계 및 확률 문자, 77 (12), 1312-1321.
루킨, AL (2008). 균형 할당 문제에서 규칙 중지 : 정확한 분포 및 점근 분포. 순차적 분석, 27 (3), 277-292.