10 方差缩减技术

10.1 习题

习题1

先利用平均值法求解积分：

N <- 10000
u <- matrix(runif(N*2),N,2)
eta <- exp((u[,1]+u[,2])^2)
I1 <- mean(eta);I1
#> [1] 4.878306
var1 <- var(eta)/N;var1
#> [1] 0.003524155

利用对立变量法改进 ：

N <- 10000
u <- matrix(runif(N*2),N,2)
v <- 1-u
eta <- 0.5*(exp((u[,1]+u[,2])^2)+exp((v[,1]+v[,2])^2))
I2 <- mean(eta);I2
#> [1] 4.929019
var2 <- var(eta)/N;var2
#> [1] 0.001189351

习题2

mu <- 0
Sigma <- 1
N <- 100000
n <- c(5,10,30)
b1 <- vector("double",length(n))
b2 <- vector("double",length(n))
s1 <- vector("double",length(n))
s2 <- vector("double",length(n))

for(i in seq_along(n)){
    x <- matrix(rnorm(N*n[[i]],mu,Sigma),N,n[[i]])
    m <- apply(x,1,mean)  # 每组样本均值
    shat <- apply((x-m)^2,1,sum)
    shat.1 <- shat/(n[[i]]-1)  # 两个方差估计
    shat.2 <- shat/n[[i]]
    b1[[i]] <- mean(shat.1)-Sigma^2
    b2[[i]] <- mean(shat.2)-Sigma^2
    s1[[i]] <- mean((shat.1-Sigma)^2)
    s2[[i]] <- mean((shat.2-Sigma)^2) 
}

df <- data.frame(
    n = n,
    b1 = b1,
    b2 = b2,
    s1 = s1,
    s2 = s2,
    d = s1-s2
)
knitr::kable(df)

n	b1	b2	s1	s2	d
5	-0.0012968	-0.2010375	0.5002920	0.3606019	0.1396901
10	-0.0001247	-0.1001122	0.2228895	0.1905629	0.0323266
30	-0.0004414	-0.0337600	0.0688494	0.0654755	0.0033739

1是无偏估计，2是有偏估计。有由可以看出，估计1点偏差要更小但均方误差要更大，所有指标随着样本数的增大都逐渐下降。