需要一种缩短代码并使之更有效的方法

时间:2018-10-04 18:57:46

标签: r

我想执行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=10n=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

1 个答案:

答案 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))