R-嵌套For循环的向量化

对于另一个“循环矢量化”问题，我很抱歉，但我还没有弄明白如何做到这一点。我尝试编写的函数很简单：

对于enroll.in中的每一行，首先使用hasMedClaims逻辑模型输出作为响应概率

生成随机数，并使用该随机数确定是否应对响应进行建模

如果是，则对响应进行建模。如果没有，请输入0。对每行enroll.in nsim重复一次

simMedClaims.loop<-function(hasMedClaims.in, MedClaims.in,  enroll.in, nsim = 100){

  set.seed(100)
  #dataframe to hold results
  results<-matrix(0, ncol = nsim, nrow = nrow(enroll.in))
  results<-data.frame(results)

  hasclaims<-predict(hasMedClaims.in, newdata = enroll.in, type = "response")
  means<-predict(MedClaims.in, newdata = enroll.in, type="response")
  for(ii in 1:nrow(enroll.in))
  {
    for(jj in 1:nsim){
      unif.rand<-runif(1)
      results[ii,jj]<-ifelse(unif.rand < hasclaims[ii], exp(rnorm(1,mean = means[ii], sd = sqrt(MedClaims.in$sig2))), 0)
    }

  }

  return(results)
}

set.seed(100)
dummy<-data.frame(hasresponse = rbinom(100000, 1, .5), response = rnorm(100000, mean = 5, sd = 1), x1 = runif(100000, 0, 60), x2 = as.factor(rbinom(100000, 1, .5)+1))
dummy$response<-dummy$hasresponse*dummy$response
hasresponse_gam<-mgcv::gam(hasresponse ~ s(x1,bs="ps", by=x2)+x2, data=dummy, family = binomial(link="logit"), method="REML")
response<-mgcv::gam(response ~ s(x1,bs="ps", by=x2)+x2, data=dummy[dummy$hasresponse==1,])
dummyEnroll<-data.frame(x1 = runif(10, 20, 50), x2 = as.factor(rbinom(10, 1, .5)+1))
system.time(result<-simMedClaims.loop(hasresponse_gam, response, dummyEnroll, 1000))

user  system elapsed 
38.66    0.00   39.35 

---

simMedClaims.loop考虑在
sapply
或
vapply
中传递两个向量参数，以避免嵌套的
for
循环，并需要初始化结果数据帧。当然，如果：


以上方法已使用随机数据进行测试，并返回与嵌套
循环相同的结果（不包括OP的
predict
或
ifelse
，因为没有）：

数据

enroll.in <- sapply(1:5, function(i) rnorm(15))
nsim <- 100

基准测试表明，至少对于小数据而言，两种方法之间的处理效果并不是更好。注意：较大的纳秒处理是由于函数“
set.seed（）
用于比较随机生成的数据。所以古老的格言认为：
for

循环没有什么错：

---

你能提供一个MWE吗？很遗憾，我不能分享我使用的任何数据。我应该添加什么？不，不要使用您的数据，提供一个有效的虚拟示例：）我认为添加内容现在应该足够了。我还澄清了我到底想做什么。我做了一些补充来改进我的问题。您是否使用示例数据尝试了此解决方案？那么您还有什么问题？唯一剩下的问题是循环函数和向量化函数不会返回相同的结果。我不确定这是否只是一个随机化问题，或者向量化函数是否有其他问题，您需要对每个随机抽取

set.seed（）

。您的

ifelse（）

有一个

rnorm（）

调用。要为

循环

和

vapply

复制，请在

unif.rand之后添加一个编号相同的
set.seed（）
> system.time(result<-simMedClaims.loop(hasresponse_gam, response, dummyEnroll, 100))
   user  system elapsed 
   0.06    0.00    0.13
> system.time(result2<-simMedClaims2(hasresponse_gam, response, dummyEnroll, 100))
   user  system elapsed 
   0.02    0.00    0.02

simMedClaims.loop <- function(hasMedClaims.in, MedClaims.in, enroll.in, nsim = 100){

  hasclaims <- predict(hasMedClaims.in, newdata = enroll.in, type = "response")

  results <- data.frame(t(vapply(seq(nrow(enroll.in)), function(ii,jj) { 
                                      unif.rand <- runif(jj) 
                                      ifelse(unif.rand < hasclaims[ii], ..., 0)
                                  numeric(nsim), seq(nsim))))    
}

simMedClaims.loop <- function(hasMedClaims.in, MedClaims.in, enroll.in, nsim = 100){

  hasclaims <- predict(hasMedClaims.in, newdata = enroll.in, type = "response")

  # LONG FORMAT
  df <- expand.grid(1:nrow(enroll.in), 1:nsim)
  df$unif.rand <- runif(nrow(df))
  df$val <- ifelse(df$unif.rand < hasclaims[ii], ..., 0)

  # WIDE FORMAT 
  results <- data.frame(t(sapply(seq(1, nrow(df), by=nsim), function(i) 
                                 df$random_num[i:(i+(nsim-1))])))

}

enroll.in <- sapply(1:5, function(i) rnorm(15))
nsim <- 100

func1 <- function() {      
  set.seed(98)
  results1<-matrix(0, ncol = nsim, nrow = nrow(enroll.in))
  results1<-data.frame(results1)

  for(ii in 1:nrow(enroll.in))
  {
   for(jj in 1:nsim){

     results1[ii,jj] <- runif(1)
   }
  }
  return(results1)
}

func2 <- function() {
  set.seed(98)
  results2 <- data.frame(t(vapply(seq(nrow(enroll.in)), function(ii,jj) 
                                       runif(jj), 
                                  numeric(nsim), seq(nsim))))
}

func3 <- function() {
  set.seed(98)
  df <- expand.grid(1:nrow(enroll.in), 1:nsim)
  df$random_num <- runif(nrow(df))

  results3 <- data.frame(t(sapply(seq(1, nrow(df), by=nsim), function(i) 
                                  df$random_num[i:(i+(nsim-1))])))
}

all.equal(func1(), func2())
# [1] TRUE
all.equal(func2(), func3())
# [1] TRUE

library(microbenchmark)

microbenchmark(func1)
# Unit: nanoseconds
#   expr min lq  mean median uq max neval
#  func1  30 32 37.07     32 33 461   100

microbenchmark(func2)
# Unit: nanoseconds
#   expr min lq  mean median uq max neval
#  func2  29 31 39.41     32 33 729   100

microbenchmark(func3)
# Unit: nanoseconds
#   expr min lq mean median uq max neval
#  func3  30 31 35.6     32 33 370   100