提高R中嵌套For循环的性能

您无需去Rcpp或data.table获得非常重大的改进。

获取原始数据并将其复制以获得更多可用时间：

d <- read.table(head = TRUE, text = 
"Patient_ID Age_in_days DEMAdmNo 
396076 28542 0 
396076 28570 0 
396076 28598 0 
396076 28626 0 
396076 28654 0 
396076 28682 0 
396076 28710 0 
396076 28738 0 
396076 28766 0 
396076 28794 0 
396076 28822 0 
396076 28850 0 
396076 28878 0 
396076 28906 0 
396076 28934 0 
396076 28962 0 
396076 28990 0 
396076 29018 0 
396076 29046 0 
396076 29074 0 
396076 29102 1 
396076 29165 0 
396076 29200 0 
396076 29228 0 
396076 29263 0 
396076 29200 0 
396076 29228 0 
396076 29263 0 ")

d <- rbind(d, d, d, d, d, d, d, d, d, d)

您的原始代码作为函数和计时运行：

f0 <- function(sh_data) {
    LACE_E <- numeric(0)

    for(i in 1:length(sh_data[,1])) {
        LACE_E[i] = 0
        for(j in 1:length(sh_data[,1])) {
            if(sh_data$Patient_ID[i] == sh_data$Patient_ID[j] &
               sh_data$Age_in_days[i] > sh_data$Age_in_days[j] &
               (sh_data$Age_in_days[i]- sh_data$Age_in_days[j])<= 183 &
               sh_data$DEMAdmNo[j] == 1) {
                LACE_E[i] = LACE_E[i] + 1
            }
        }
    }
}

system.time(v0 <- f0(d))
##   user  system elapsed 
##  4.803   0.007   4.812 

分析显示，$在内部循环中提取列花费了大约90％的时间：

Rprof()
v0 <- f0(d)
Rprof(NULL)
head(summaryRprof()$by.total)
## "f0"                  4.94    100.00      0.60    12.15
## "$"                   4.24     85.83      0.72    14.57
## "$.data.frame"        3.52     71.26      0.36     7.29
## "[["                  3.16     63.97      0.46     9.31
## "[[.data.frame"       2.70     54.66      0.96    19.43
## "%in%"                0.92     18.62      0.22     4.45

将柱提取物移出循环可大大提高性能：

f1 <- function(sh_data) {
    LACE_E <- numeric(0)

    Patient_ID <- sh_data$Patient_ID
    Age_in_days <- sh_data$Age_in_days
    DEMAdmNo <- sh_data$DEMAdmNo
    for(i in 1:length(sh_data[,1])) {
        LACE_E[i] = 0
        for(j in 1:length(sh_data[,1])) {
            if(Patient_ID[i] == Patient_ID[j] &
               Age_in_days[i] > Age_in_days[j] &
               (Age_in_days[i]- Age_in_days[j])<= 183 &
               DEMAdmNo[j] == 1) {
                LACE_E[i] = LACE_E[i] + 1
            }
        }
    }
}

system.time(v1 <- f1(d))
##   user  system elapsed 
##  0.163   0.000   0.164 

从一个空的结果开始并发展它几乎总是一个不好的主意。预先分配结果是更好的做法。在这种情况下，该算法已经O(n^2)足够使您不太在意了，但是它确实有所作为，特别是在添加了其他改进之后。f2预分配结果：

f2 <- function(sh_data) {
    n <- nrow(sh_data)
    LACE_E <- numeric(n)

    Patient_ID <- sh_data$Patient_ID
    Age_in_days <- sh_data$Age_in_days
    DEMAdmNo <- sh_data$DEMAdmNo
    for(i in 1:n) {
        LACE_E[i] = 0
        for(j in 1:n) {
            if(Patient_ID[i] == Patient_ID[j] &
               Age_in_days[i] > Age_in_days[j] &
               (Age_in_days[i]- Age_in_days[j])<= 183 &
               DEMAdmNo[j] == 1) {
                LACE_E[i] = LACE_E[i] + 1
            }
        }
    }
}

system.time(v2 <- f2(d))
##   user  system elapsed 
##  0.147   0.000   0.148 

使用正确的逻辑运算符&&而不是&进一步改进：

f3 <- function(sh_data) {
    n <- nrow(sh_data)
    LACE_E <- numeric(n)

    Patient_ID <- sh_data$Patient_ID
    Age_in_days <- sh_data$Age_in_days
    DEMAdmNo <- sh_data$DEMAdmNo
    for(i in 1:n) {
        LACE_E[i] = 0
        for(j in 1:n) {
            if(Patient_ID[i] == Patient_ID[j] &&
               Age_in_days[i] > Age_in_days[j] &&
               (Age_in_days[i] - Age_in_days[j]) <= 183 &&
               DEMAdmNo[j] == 1) {
                LACE_E[i] = LACE_E[i] + 1
            }
        }
    }
}

system.time(v3 <- f3(d))
##   user  system elapsed 
##  0.108   0.002   0.111 

这些都是您需要执行的所有步骤Rcpp，但是您无需执行Rcpp这些步骤。

为了提高速度，您可以字节编译：

f3c <- compiler::cmpfun(f3)
system.time(v3 <- f3c(d))
##   user  system elapsed 
## 0.036   0.000   0.036 

这些计算是在R 3.1.3中完成的。一个microbenchmark总结：

microbenchmark(f0(d), f1(d), f2(d), f3(d), f3c(d), times = 10)
## Unit: milliseconds
##   expr        min        lq       mean     median         uq        max  neval  cld
##   f0(d) 5909.39756 5924.8493 5963.63608 5947.23469 6011.94567 6048.03571    10    d
##   f1(d)  196.16466  197.3252  200.22471  197.93345  202.49236  210.22011    10   c 
##   f2(d)  187.68169  190.5644  194.02454  192.47596  195.63821  204.27415    10   c 
##   f3(d)  109.17816  110.6695  112.55218  111.93915  114.43341  116.92342    10  b  
##  f3c(d)   37.37348   38.8757   39.34564   39.58563   40.50597   40.58568    10 a

R.version$version.string
## [1] "R version 3.1.3 Patched (2015-03-16 r68072)"

即将在4月发布的R 3.2.0对解释器和字节码引擎进行了许多改进，从而进一步提高了性能：

## Unit: milliseconds
##    expr        min         lq       mean     median         uq        max neval  cld
##   f0(d) 4351.33908 4429.71559 4471.32960 4479.13901 4499.39769 4601.05390    10    d
##   f1(d)  183.57765  184.68961  190.10391  187.30951  199.56235  200.57238    10   c 
##   f2(d)  177.47063  181.09790  189.78291  185.58951  190.34782  233.90264    10   c 
##   f3(d)  105.79767  108.02553  114.48950  110.17056  112.85710  149.42474    10  b  
##  f3c(d)   14.41182   14.43227   14.70098   14.49289   14.84504   15.67709    10 a   

R.version$version.string
## [1] "R Under development (unstable) (2015-03-24 r68072)"

因此，良好的R编程实践和性能分析工具的使用可能会带给您很长的路要走。如果您想进一步改进，可以这样做，Rcpp但这可能足以满足您的目的。