Question

对不起另一个＆＃34; vectorize for loop＆＃34;问题，但我无法弄清楚如何做到这一点。我试图写的功能很简单：

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

生成随机数并使用它来确定是否应对响应进行建模。

如果是，请为响应建模。如果不是，只需在每次登记时输入0.重复一次。

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

我尝试了很多不同的想法，但每个人都遇到了不同的问题。

hasMedClaims.in和MedClaims.in都是使用mgcv gam函数的GAM。

澄清为什么我要问这个问题：如输出所示，每个主题需要几秒钟来运行1000次模拟。我将在拥有成千上万个主题的数据集上使用它，我想运行至少50,000次模拟。我目前的代码工作，但它太慢了。我的目标是优化我的功能以便更快地运行。

尝试@ Parfait的func2

simMedClaims2<-function(hasMedClaims.in, MedClaims.in,  enroll.in, nsim = 100){
  set.seed(100)
  hasclaims<-predict(hasMedClaims.in, newdata = enroll.in, type = "response")
  means<-predict(MedClaims.in, newdata = enroll.in, type="response")
  results<-data.frame(t(vapply(seq(nrow(enroll.in)), function(ii, jj){
    ifelse(runif(jj) < hasclaims[ii],1,0)*exp(rnorm(nsim,mean = means[ii], sd = sqrt(MedClaims.in$sig2)))
  },numeric(nsim),seq(nsim))))
  return(results)
}

虽然我还没有完全审查过，但结果看起来很合理。我还编辑了我的原始循环函数来计算循环外的平均值。快得多

> 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

但是，运行all.equal(result, result2)表示输出不相同。我无法弄清楚为什么会这样。

Answer 1

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

，它仍然是有争议的

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))))    
}

或者，考虑采用expand.grid()方法，最后将争论转换为多列所需的格式。虽然没有数据争论，但这将被矢量化（没有使用R循环，但可能是C循环）。

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))])))

}

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

数据

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

基准测试表明，至少对于小数据，处理方法之间的处理要好得多。注意：大纳秒处理是由于功能＆＃39; set.seed()以便比较随机生成的数据。所以古老的格言认为： for循环没有错：

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

R - Vectorize Nested For Loop

1 个答案: