Ниже, чем ожидалось, охват для важности выборки с моделированием


9

Я пытался ответить на вопрос Оценка интеграла Важность метода отбора проб в R . В основном, пользователь должен рассчитать

0πf(x)dx=0π1cos(x)2+x2dx

используя экспоненциальное распределение в качестве распределения важности

q(x)=λ expλx

и найдите значение которое дает лучшее приближение к интегралу (это ). Я переделал проблему как оценку среднего значения функции по : тогда интеграл равен просто . λself-studyμf(x)[0,π]πμ

Таким образом, пусть будет pdf для , и пусть : цель теперь состоит в том, чтобы оценитьp(x)XU(0,π)Yf(X)

μ=E[Y]=E[f(X)]=Rf(x)p(x)dx=0π1cos(x)2+x21πdx

используя важность выборки. Я выполнил симуляцию в R:

# clear the environment and set the seed for reproducibility
rm(list=ls())
gc()
graphics.off()
set.seed(1)

# function to be integrated
f <- function(x){
    1 / (cos(x)^2+x^2)
}

# importance sampling
importance.sampling <- function(lambda, f, B){
    x <- rexp(B, lambda) 
    f(x) / dexp(x, lambda)*dunif(x, 0, pi)
}

# mean value of f
mu.num <- integrate(f,0,pi)$value/pi

# initialize code
means  <- 0
sigmas <- 0
error  <- 0
CI.min <- 0
CI.max <- 0
CI.covers.parameter <- FALSE

# set a value for lambda: we will repeat importance sampling N times to verify
# coverage
N <- 100
lambda <- rep(20,N)

# set the sample size for importance sampling
B <- 10^4

# - estimate the mean value of f using importance sampling, N times
# - compute a confidence interval for the mean each time
# - CI.covers.parameter is set to TRUE if the estimated confidence 
#   interval contains the mean value computed by integrate, otherwise
# is set to FALSE
j <- 0
for(i in lambda){
    I <- importance.sampling(i, f, B)
    j <- j + 1
    mu <- mean(I)
    std <- sd(I)
    lower.CB <- mu - 1.96*std/sqrt(B)  
    upper.CB <- mu + 1.96*std/sqrt(B)  
    means[j] <- mu
    sigmas[j] <- std
    error[j] <- abs(mu-mu.num)
    CI.min[j] <- lower.CB
    CI.max[j] <- upper.CB
    CI.covers.parameter[j] <- lower.CB < mu.num & mu.num < upper.CB
}

# build a dataframe in case you want to have a look at the results for each run
df <- data.frame(lambda, means, sigmas, error, CI.min, CI.max, CI.covers.parameter)

# so, what's the coverage?
mean(CI.covers.parameter)
# [1] 0.19

Код в основном является простой реализацией выборки важности, следуя обозначениям, использованным здесь . Затем выборка важности повторяется раз, чтобы получить множественные оценки , и каждый раз проверяется, покрывает ли 95-процентный интервал фактическое среднее значение или нет.Nμ

Как видите, для фактическое покрытие составляет всего 0,19. И увеличение до значений, таких как , не помогает (охват еще меньше, 0,15). Почему это происходит?λ=20B106


1
Использование функции важности бесконечной поддержки для конечного интеграла поддержки не является оптимальным, так как часть моделирования используется, так сказать, для моделирования нулей. По крайней мере, обрежьте экспоненту в , что легко сделать и смоделировать. π
Сиань

@ Сиань, конечно, я согласен, если бы мне пришлось оценивать этот интеграл с помощью выборки по важности, я бы не использовал это распределение по важности, но я пытался ответить на исходный вопрос, который требовал использования экспоненциального распределения. Моя проблема заключалась в том, что, даже если этот подход далек от оптимального, охват все равно должен увеличиваться (в среднем) как . И это то, что показал Гринпаркер. B
DeltaIV

Ответы:


3

Выборка важности весьма чувствительна к выбору распределения важности. Поскольку вы выбрали , сэмплы, которые вы рисуете, будут иметь среднее значение с дисперсией . Это дистрибутив вы получаетеλ=20rexp1/201/400

введите описание изображения здесь

Тем не менее, интеграл, который вы хотите оценить, идет от 0 до . Итак, вы хотите использовать который дает вам такой диапазон. Я использую .π=3.14λλ=1

введите описание изображения здесь

Используя я смогу исследовать полное целое пространство от 0 до , и, похоже, будет потрачено только несколько ничьих над . Теперь я перезапускаю ваш код и меняю только .λ=1ππλ=1

# clear the environment and set the seed for reproducibility
rm(list=ls())
gc()
graphics.off()
set.seed(1)

# function to be integrated
f <- function(x){
  1 / (cos(x)^2+x^2)
}

# importance sampling
importance.sampling <- function(lambda, f, B){
  x <- rexp(B, lambda) 
  f(x) / dexp(x, lambda)*dunif(x, 0, pi)
}

# mean value of f
mu.num <- integrate(f,0,pi)$value/pi

# initialize code
means  <- 0
sigmas <- 0
error  <- 0
CI.min <- 0
CI.max <- 0
CI.covers.parameter <- FALSE

# set a value for lambda: we will repeat importance sampling N times to verify
# coverage
N <- 100
lambda <- rep(1,N)

# set the sample size for importance sampling
B <- 10^4

# - estimate the mean value of f using importance sampling, N times
# - compute a confidence interval for the mean each time
# - CI.covers.parameter is set to TRUE if the estimated confidence 
#   interval contains the mean value computed by integrate, otherwise
# is set to FALSE
j <- 0
for(i in lambda){
  I <- importance.sampling(i, f, B)
  j <- j + 1
  mu <- mean(I)
  std <- sd(I)
  lower.CB <- mu - 1.96*std/sqrt(B)  
  upper.CB <- mu + 1.96*std/sqrt(B)  
  means[j] <- mu
  sigmas[j] <- std
  error[j] <- abs(mu-mu.num)
  CI.min[j] <- lower.CB
  CI.max[j] <- upper.CB
  CI.covers.parameter[j] <- lower.CB < mu.num & mu.num < upper.CB
}

# build a dataframe in case you want to have a look at the results for each run
df <- data.frame(lambda, means, sigmas, error, CI.min, CI.max, CI.covers.parameter)

# so, what's the coverage?
mean(CI.covers.parameter)
#[1] .95

Если вы поиграете с , вы увидите, что если вы сделаете его действительно маленьким (.00001) или большим, вероятности покрытия будут плохими.λ

РЕДАКТИРОВАТЬ-------

Относительно уменьшения вероятности покрытия, когда вы переходите от к , это просто случайность, основанная на том факте, что вы используете повторений. Доверительный интервал для вероятности покрытия при составляет B=104B=106N=100B=104

.19±1.96.19(1.19)100=.19±.0769=(.1131,.2669).

Таким образом, вы не можете сказать, что увеличение значительно снижает вероятность покрытия.B=106

Фактически, в вашем коде для того же начального числа измените на , затем при вероятность покрытия составляет 0,123, а при вероятность покрытия равна .N=100N=1000B=104B=106.158

Теперь доверительный интервал около .123 составляет

.123±1.96.123(1.123)1000=.123±.0203=(.102,.143).

Таким образом, теперь с репликаций вы получаете, что вероятность покрытия значительно увеличивается.N=1000


Да, я знаю, что покрытие меняется с : в частности, наилучшее покрытие получается при . Теперь я понимаю, что, поскольку CI для выборочного среднего значения основан на CLT, это асимптотический результат. Таким образом, вполне может быть, что изменение влияет на число выборок, необходимых, чтобы, так сказать, приблизиться к "асимптотическому режиму". Но дело в том, почему при охват уменьшается от размера выборки до размера выборки ? Конечно, это должно увеличиться, если плохое покрытие было только из-за высокого значения ? 0,1 < λ < 2 λ λ = 20 10 4 10 6 λλ0.1<λ<2λλ=20104106λ
DeltaIV

1
@DeltaIV Я сделал правку, чтобы ответить на этот вопрос. Суть в том, что недостаточно для того, чтобы что-то сказать с уверенностью. N=100
Greenparker

1
ах блестящий! Я не думал о формировании доверительного интервала для самой доли покрытия , а не только для среднего значения. Так же, как ничтожество, я бы не использовал доверительный интервал Уолда для доверительного интервала пропорции. Однако, поскольку пропорция не равна 0 и 1, а количество повторов (во втором случае, ) относительно велико, вероятно, использование интервала Уилсона или Джеффриса не имело бы никакого значения. Я подожду немного, чтобы посмотреть, есть ли другие ответы, но я бы сказал, что вы полностью заслуживаете +100 :)N=1000
DeltaIV
Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.