Cobertura inferior a la esperada para muestreo de importancia con simulación

9

Yo estaba tratando de responder a la pregunta Evaluar solidario de Importancia método de muestreo en I . Básicamente, el usuario necesita calcular

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

usando la distribución exponencial como la distribución de importancia

q(x)=λ expλx

y encuentre el valor de que da la mejor aproximación a la integral (es ). Reformé el problema como la evaluación del valor medio de sobre : la integral es entonces solo . λself-studyμf(x)[0,π]πμ

Por lo tanto, sea el pdf de , y sea : el objetivo ahora es estimarp(x)XU(0,π)Yf(X)

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

utilizando muestreo de importancia. Realicé una simulación en 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

El código es básicamente una implementación directa de muestreo de importancia, siguiendo la notación utilizada aquí . La muestra de importancia se repite veces para obtener estimaciones múltiples de , y cada vez que se realiza una comprobación sobre si el intervalo del 95% cubre la media real o no.μNμ

Como puede ver, para la cobertura real es de solo 0.19. Y aumentar a valores como no ayuda (la cobertura es aún menor, 0,15). ¿Por qué está pasando esto?B 10 6λ=20B106

DeltaIV
fuente
1
El uso de una función de importancia de soporte infinito para una integral de soporte finito no es óptimo ya que una parte de las simulaciones se usa para simular ceros, por así decirlo. Al menos trunca el exponencial en , que es fácil de hacer y simular. π
Xi'an
@ Xi'an seguro, estoy de acuerdo, si tuviera que evaluar esa integral por muestreo de importancia, no usaría esa distribución de importancia, pero estaba tratando de responder la pregunta original, que requería usar la distribución exponencial. Mi problema fue que, incluso si este enfoque está lejos de ser óptimo, la cobertura debería aumentar (en promedio) como . Y eso es lo que mostró Greenparker. B
DeltaIV

Respuestas:

3

El muestreo de importancia es bastante sensible a la elección de la distribución de importancia. Como eligió , las muestras que extraiga tendrán una media de con una varianza de . Esta es la distribución que obtienes1 / 20 1 / 400λ=20rexp1/201/400

ingrese la descripción de la imagen aquí

Sin embargo, la integral que desea evaluar va de 0 a . Por lo tanto, desea utilizar un que le brinde ese rango. Yo uso .λ λ = 1π=3.14λλ=1

ingrese la descripción de la imagen aquí

Usando podré explorar el espacio integral completo de 0 a , y parece que solo se desperdiciarán algunos sorteos sobre . Ahora vuelvo a ejecutar su código y solo cambio .π π λ = 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

Si juegas con , verás que si lo haces realmente pequeño (.00001) o grande, las probabilidades de cobertura serán malas.λ

EDITAR-------

En cuanto a la probabilidad de cobertura que disminuye una vez que pasa de a , eso es solo una ocurrencia aleatoria, basada en el hecho de que usa repeticiones. El intervalo de confianza para la probabilidad de cobertura en es, B = 10 6 N = 100 B = 10 4 .19 ± 1.96 B=104B=106N=100B=104

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

Por lo tanto, no se puede decir que aumentar reduce significativamente la probabilidad de cobertura.B=106

De hecho, en su código para la misma semilla, cambie a , luego con , la probabilidad de cobertura es .123 y con probabilidad de cobertura es .N = 1000 B = 10 4 B = 10 6 .158N=100N=1000B=104B=106.158

Ahora, el intervalo de confianza alrededor de .123 es

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

Por lo tanto, ahora con repeticiones, obtienes que la probabilidad de cobertura aumenta significativamente.N=1000

Greenparker
fuente
Sí, sé que la cobertura cambia con : en particular, la mejor cobertura se obtiene para . Ahora, entiendo que dado que el IC para la media muestral se basa en CLT, es un resultado asintótico. Por lo tanto, puede ser que cambiar influya en el número de muestras necesarias para acercarse al "régimen asintótico", por así decirlo. Pero el punto es, ¿por qué con la cobertura disminuye del tamaño de la muestra al tamaño de la muestra ? Seguramente debería aumentar, si la mala cobertura se debió solo a un alto valor ? 0.1 < λ < 2 λ λ = 20 10 4 10 6 λλ0.1<λ<2λλ=20104106λ
DeltaIV
1
@DeltaIV Hice una edición para responder a esta pregunta. La esencia es que no son suficientes repeticiones para decir algo con certeza. N=100
Greenparker
1
ah genial! No pensé en formar el intervalo de confianza para la proporción de cobertura en sí , en lugar de solo para la media. Solo como un punto crítico, no hubiera usado el intervalo de confianza de Wald para el intervalo de confianza de una proporción. Sin embargo, dado que la proporción está lejos de 0 y 1 y el número de réplicas es (en su segundo caso, ) relativamente grande, probablemente usar el intervalo de Wilson o Jeffreys no habría hecho ninguna diferencia. Esperaré un poco para ver si hay otras respuestas, pero diría que te mereces totalmente el +100 :)N=1000
DeltaIV