我想执行1000次引导仿真,并为不同的n = 10,20,...,100
大小计算1000%的百分数置信区间。我已经解决了这个问题,我只是问,而不是进行如此大的计算10次(覆盖300行代码),有没有一种方法可以缩短它?例如,一次又一次地运行此功能10次?我尝试了for循环,但是没有用。这是起作用的代码:
B = 1000 # number of replicates
kHat = Parameters[1] # approx = 2.06786
gammaHat = Parameters[2] # approx = 0.51144
TheoreticalMean = kHat/gammaHat
TheoreticalVariance = kHat/gammaHat^2
PercCoverage = vector("numeric", 10L)
n = 10 # sample size
getCI = function(B, k, gamma, n) {
getM = function(orgData, idx) {
bsM = mean(orgData[idx])
bsS2M = (((n-1) / n) * var(orgData[idx])) / n
c(bsM, bsS2M)
}
F = rgamma(n, kHat, gammaHat) # simulated data: original sample
M = mean(F) # M from original sample
S2M = (((n-1)/n)*var(F))/n # S^2(M) from original sample
# bootstrap
boots = t(replicate(B, getM(F, sample(seq(along=F), replace=TRUE))))
Mstar = boots[,1] # M* for each replicate
S2Mstar = boots[,2] # S^2*(M) for each replicate
biasM = mean(Mstar)-M # bias of estimator M
# indices for sorted vector of estimates
idx = trunc((B+1)*c(0.05/2,1-0.05/2))
ciPerc = sort(Mstar)[idx] # percentile CI
c(perc=ciPerc)
}
# 1000 bootstraps
Nrep <- 1000 # number of bootstraps
CIs <- t(replicate(Nrep, getCI(B, kHat, gammaHat, n)))
# coverage probabilities
PercCoverage[1] = sum((CIs[,"perc1"]<TheoreticalMean) & (CIs[,"perc2"]>TheoreticalMean)) / Nrep
但是,在这里,我需要将n=10
,n=20
等编写为n=100
的脚本,并且每次我需要将PercCoverage[1]
更改为P {{1 }},以便将这些值存储在数组中以供以后绘制。
我尝试设置ercCoverage[2]...PercCoverage[10]
,然后将以上所有内容放入for循环中,但是函数n=c(10,20,30,40,50,60,70,80,90,100)
需要数字值。
编辑:用于循环尝试:
getCI
答案 0 :(得分:2)
考虑定义多个功能:一个主要的 boostrap_proc , gCI 和 getM 。然后在lapply
中传递样本大小序列以返回列表,或在sapply
中传递数值向量,每个均调用主函数并返回一系列概率(函数的最后一行)。确保删除硬编码的n = 10
。
定义功能
B = 1000 # number of replicates
kHat = Parameters[1] # approx = 2.06786
gammaHat = Parameters[2] # approx = 0.51144
TheoreticalMean = kHat/gammaHat
TheoreticalVariance = kHat/gammaHat^2
bootstrap_proc <- function(n) {
Nrep <- 1000 # 1000 bootstraps
CIs <- t(replicate(Nrep, getCI(B, kHat, gammaHat, n)))
# coverage probabilities
sum((CIs[,"perc1"]<TheoreticalMean) & (CIs[,"perc2"]>TheoreticalMean)) / Nrep
}
getCI <- function(B, k, gamma, n) {
F <- rgamma(n, kHat, gammaHat) # simulated data: original sample
M <- mean(F) # M from original sample
S2M <- (((n-1)/n)*var(F))/n # S^2(M) from original sample
# bootstrap
boots <- t(replicate(B, getM(F, sample(seq(along=F), replace=TRUE),n)))
Mstar <- boots[,1] # M* for each replicate
S2Mstar <- boots[,2] # S^2*(M) for each replicate
biasM <- mean(Mstar)-M # bias of estimator M
# indices for sorted vector of estimates
idx <- trunc((B+1)*c(0.05/2,1-0.05/2))
ciPerc <- sort(Mstar)[idx] # percentile CI
c(perc=ciPerc)
}
getM <- function(orgData, idx, n) {
bsM <- mean(orgData[idx])
bsS2M <- (((n-1) / n) * var(orgData[idx])) / n
c(bsM, bsS2M)
}
呼叫功能
sample_sizes <- c(10,20,30,40,50,60,70,80,90,100)
# LIST
PercCoverage <- lapply(sample_sizes, bootstrap_proc)
# VECTOR
PercCoverage <- sapply(sample_sizes, bootstrap_proc)
# VECTOR
PercCoverage <- vapply(sample_sizes, bootstrap_proc, numeric(1))