Copertura inferiore al previsto per il campionamento di importanza con la simulazione

Stavo cercando di rispondere alla domanda Valutare solidali importanza metodo di campionamento in R . Fondamentalmente, l'utente deve calcolare

\int_{0}^{π} f (x) d x = \int_{0}^{π} \frac{1}{\cos (x)^{2} + x^{2}} d x

$\int_{0}^{\pi}f(x)dx=\int_{0}^{\pi}\frac{1}{\cos(x)^2+x^2}dx$

usando la distribuzione esponenziale come distribuzione di importanza

q (x) = λ \exp^{- λ x}

$q(x)=\lambda\ \exp^{-\lambda x}$

e trova il valore di che fornisce la migliore approssimazione all'integrale (è ). Ho rifuso il problema come valutazione del valore medio di su : l'integrale è quindi solo . $\lambda$ self-study $\mu$ $f(x)$ $[0,\pi]$ $\pi\mu$

Quindi, sia il pdf di e sia : l'obiettivo ora è stimare $p(x)$ $X\sim\mathcal{U}(0,\pi)$ $Y\sim f(X)$

μ = E [Y] = E [f (X)] = \int_{R} f (x) p (x) d x = \int_{0}^{π} \frac{1}{\cos (x)^{2} + x^{2}} \frac{1}{π} d x

$\mu=\mathbb{E}[Y]=\mathbb{E}[f(X)]=\int_{\mathbb{R}}f(x)p(x)dx=\int_{0}^{\pi}\frac{1}{\cos(x)^2+x^2}\frac{1}{\pi}dx$

usando il campionamento di importanza. Ho eseguito una simulazione in 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

Il codice è sostanzialmente un'implementazione semplice del campionamento di importanza, seguendo la notazione usata qui . Il campionamento di importanza viene quindi ripetuto volte per ottenere stime multiple di , e ogni volta viene verificato se l'intervallo del 95% copre la media effettiva o meno. $N$ $\mu$

Come puoi vedere, per la copertura effettiva è solo 0,19. E aumentare a valori come non aiuta (la copertura è ancora più piccola, 0,15). Perché sta succedendo? $\lambda=20$ $B$ $10^6$

r simulation exponential importance-sampling

— DeltaIV
fonte

L'uso di una funzione di importanza del supporto infinito per un integrale di supporto finito non è ottimale poiché una parte delle simulazioni viene utilizzata per simulare zeri, per così dire. Tronca almeno l'esponenziale in , che è facile da fare e simulare.

π

$\pi$

— Xi'an,

@ Xi'an certo, sono d'accordo, se dovessi valutare quell'integrale tramite Importance Sampling, non userei quella distribuzione di importanza, ma stavo cercando di rispondere alla domanda originale, che richiedeva l'uso della distribuzione esponenziale. Il mio problema era che, anche se questo approccio è tutt'altro che ottimale, la copertura dovrebbe comunque aumentare (in media) da . Ed è quello che ha mostrato Greenparker.

B \to \infty

$B\to\infty$

— DeltaIV,

Il campionamento dell'importanza è piuttosto sensibile alla scelta della distribuzione dell'importanza. Poiché hai scelto , i campioni che utilizzi avranno una media di con varianza . Questa è la distribuzione che ottieni $\lambda = 20$ rexp $1/20$ $1/400$

Tuttavia, l'integrale che si desidera valutare va da 0 a . Quindi vuoi usare un che ti dia una tale gamma. Uso . $\pi =3.14$ $\lambda$ $\lambda = 1$

Usando sarò in grado di esplorare tutto lo spazio integrale compreso tra 0 e , e sembra che solo alcune estrazioni su verranno sprecate. Ora rieseguo il tuo codice e cambio solo . $\lambda = 1$ $\pi$ $\pi$ $\lambda = 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

Se giochi con , vedrai che se lo rendi davvero piccolo (.00001) o grande, le probabilità di copertura saranno cattive. $\lambda$

MODIFICARE-------

Per quanto riguarda la probabilità di copertura che diminuisce quando si passa da a , si tratta solo di un evento casuale, in base al fatto che si utilizzano repliche . L'intervallo di confidenza per la probabilità di copertura in è, $B = 10^4$ $B = 10^6$ $N = 100$ $B = 10^4$

.19 \pm 1.96 * \sqrt{\frac{.19 * (1 - .19)}{100}} = .19 \pm .0769 = (.1131, .2669) .

$.19 \pm 1.96*\sqrt{\dfrac{.19*(1-.19)}{100}} = .19 \pm .0769 = (.1131, .2669)\,.$

Quindi non puoi davvero dire che l'aumento di riduce significativamente la probabilità di copertura. $B = 10^6$

Infatti nel tuo codice per lo stesso seme, cambia in , quindi con , la probabilità di copertura è .123 e con probabilità di copertura è . $N = 100$ $N = 1000$ $B = 10^4$ $B = 10^6$ $.158$

Ora, l'intervallo di confidenza attorno a .123 è

.123 \pm 1.96 \sqrt{\frac{.123 * (1 - .123)}{1000}} = .123 \pm .0203 = (.102, .143) .

$.123 \pm 1.96\sqrt{\dfrac{.123*(1 - .123)}{1000}} = .123 \pm .0203 = (.102, .143)\,.$

Pertanto, ora con repliche, si ottiene un aumento significativo della probabilità di copertura. $N = 1000$

— Greenparker
fonte

λ

$\lambda$

0.1 < λ < 2

$0.1<\lambda<2$

λ

$\lambda$

λ = 20

$\lambda =20$

10^{4}

$10^4$

10^{6}

$10^6$

λ

$\lambda$

— DeltaIV,

N = 100

$N = 100$

N = 1000

$N=1000$