シミュレーションによる重要度サンプリングのカバレッジが予想より低い


9

私はRの重要性サンプリング法と積分を評価する質問に答えようとしていました。基本的に、ユーザーは計算する必要があります

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

指数分布を重要度分布として使用する

q(x)=λ expλx

そして、積分のより良い近似を与えるの値を見つけます(それはです)。私は、平均値の評価などの問題を書き直すμF X 上に[ 0 π ]:積分次いでだけでπ μλself-studyμf(x)[0,π]πμ

このように、聞かせてのPDFであるX U0 π 、およびlet Y 〜のF X の目標は、現在推定することです。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です。また、B10 6などの値に増やしても効果がありません(カバレッジはさらに小さく、0.15)。なんでこんなことが起こっているの?λ=20B106


1
π

B

回答:


3

λ=20rexp1/201/400

ここに画像の説明を入力してください

π=3.14λλ=1

ここに画像の説明を入力してください

λ=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

λ

編集-------

B=104B=106N=100B=104

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

B=106

N=100N=1000B=104B=106.158

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

N=1000


λ0.1<λ<2λλ=20104106λ
DeltaIV

1
N=100

1
N=1000
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.