Geringere Abdeckung als erwartet für die Stichprobenerhebung mit Simulation

9

Ich habe versucht, die Frage Integral mit Wichtigkeit Stichprobenmethode in R bewerten zu beantworten . Grundsätzlich muss der Benutzer berechnen

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

Verwenden der Exponentialverteilung als Wichtigkeitsverteilung

q(x)=λ expλx

und finde den Wert von der die bessere Annäherung an das Integral (es ist ) ergibt . Ich formuliere das Problem als die Bewertung des Mittelwerts von über : Das Integral ist dann nur . λself-studyμf(x)[0,π]πμ

Sei also das PDF von und sei : Das Ziel ist nun die Schätzungp(x)XU(0,π)Yf(X)

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

unter Verwendung von Wichtigkeitsstichproben. Ich habe eine Simulation in R durchgeführt:

# 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

Der Code ist im Grunde eine einfache Implementierung der Wichtigkeitsabtastung gemäß der hier verwendeten Notation . Die Wichtigkeitsabtastung wird dann mal wiederholt , um mehrere Schätzungen von , und jedes Mal wird überprüft, ob das 95% -Intervall den tatsächlichen Mittelwert abdeckt oder nicht.Nμ

Wie Sie sehen können, beträgt die tatsächliche Abdeckung für nur 0,19. Und das Erhöhen von auf Werte wie hilft nicht (die Abdeckung ist mit 0,15 sogar noch kleiner). Warum passiert dies?λ=20B106

DeltaIV
quelle
1
Die Verwendung einer unendlichen Unterstützungsbedeutungsfunktion für ein endliches Unterstützungsintegral ist nicht optimal, da ein Teil der Simulationen sozusagen zur Simulation von Nullen verwendet wird. Schneiden Sie zumindest das Exponential bei , was einfach zu tun und zu simulieren ist. π
Xi'an
@ Xi'an sicher, ich stimme zu, wenn ich dieses Integral durch Wichtigkeitsabtastung bewerten müsste, würde ich diese Wichtigkeitsverteilung nicht verwenden, aber ich habe versucht, die ursprüngliche Frage zu beantworten, die die Verwendung der Exponentialverteilung erforderte. Mein Problem war, dass, selbst wenn dieser Ansatz bei weitem nicht optimal ist, die Abdeckung (im Durchschnitt) immer noch als zunehmen sollte . Und das hat Greenparker gezeigt. B
DeltaIV

Antworten:

3

Die Stichprobenerhebung ist sehr empfindlich gegenüber der Wahl der Wichtigkeitsverteilung. Da Sie , haben die Stichproben, mit denen Sie zeichnen, einen Mittelwert von mit einer Varianz von . Dies ist die Verteilung, die Sie erhaltenλ=20rexp1/201/400

Geben Sie hier die Bildbeschreibung ein

Das Integral, das Sie auswerten möchten, reicht jedoch von 0 bis . Sie möchten also ein , das Ihnen einen solchen Bereich bietet. Ich benutze .π=3.14λλ=1

Geben Sie hier die Bildbeschreibung ein

Mit ich den gesamten Integralraum von 0 bis erkunden und es scheint, als würden nur ein paar Draws über verschwendet. Jetzt führe ich Ihren Code erneut aus und ändere nur .λ=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

Wenn Sie mit , werden Sie feststellen, dass die Abdeckungswahrscheinlichkeiten schlecht sind, wenn Sie es wirklich klein (.00001) oder groß machen.λ

BEARBEITEN-------

Wenn die Abdeckungswahrscheinlichkeit abnimmt, wenn Sie von auf , ist dies nur ein zufälliges Ereignis, basierend auf der Tatsache, dass Sie Replikationen verwenden. Das Konfidenzintervall für die Abdeckungswahrscheinlichkeit bei beträgt B=104B=106N=100B=104

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

Man kann also nicht wirklich sagen, dass eine Erhöhung von die Abdeckungswahrscheinlichkeit signifikant senkt.B=106

In der Tat im Code für die gleiche Saat, ändert bis , dann mit ist Deckungswahrscheinlichkeit .123 und mit Deckungswahrscheinlichkeit ist .N = 1000 B = 10 4 B = 10 6 .158N=100N=1000B=104B=106.158

Das Konfidenzintervall um .123 beträgt nun

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

Somit erhalten Sie jetzt mit Replikationen, dass die Abdeckungswahrscheinlichkeit signifikant zunimmt.N=1000

Greenparker
quelle
Ja, ich weiß, dass sich die Abdeckung mit ändert : Insbesondere wird die beste Abdeckung für erzielt . Ich verstehe jetzt, dass der CI für den Stichprobenmittelwert auf CLT basiert und ein asymptotisches Ergebnis ist. Es kann also durchaus sein, dass die Änderung von sozusagen die Anzahl der Proben beeinflusst, die benötigt werden, um sich dem "asymptotischen Regime" zu nähern. Aber der Punkt ist, warum mit die Abdeckung von Stichprobengröße auf Stichprobengröße abnimmt ? Sicherlich sollte es zunehmen, wenn eine schlechte Abdeckung nur auf einen hohen Wert zurückzuführen ist? 0,1 < λ < 2 λ λ = 20 10 4 10 6 λλ0.1<λ<2λλ=20104106λ
DeltaIV
1
@ DeltaIV Ich habe eine Bearbeitung vorgenommen, um diese Frage zu beantworten. Das Wesentliche ist, dass nicht ausreicht, um mit Sicherheit etwas zu sagen. N=100
Greenparker
1
ah genial! Ich habe nicht daran gedacht, das Konfidenzintervall für den Abdeckungsanteil selbst zu bilden , sondern nur für den Mittelwert. Nur als Trottel hätte ich das Wald-Konfidenzintervall nicht für das Konfidenzintervall eines Anteils verwendet. Da der Anteil jedoch von 0 und 1 abweicht und die Anzahl der Wiederholungen (in Ihrem zweiten Fall ) relativ groß ist, hätte die Verwendung des Wilson- oder Jeffreys-Intervalls wahrscheinlich keinen Unterschied gemacht. Ich werde nur ein bisschen warten, um zu sehen, ob es andere Antworten gibt, aber ich würde sagen, dass Sie die +100 voll verdient haben :)N=1000
DeltaIV