使函数中的for循环在R中更快

样本数据

set.seed(123)
df <- data.frame(day = 1:365, Precp = sample(1:30, 365, replace = T), 
  ETo = sample(1:10,  365, replace = T), top.FC = 23, CN = 61, DC = 0.4)

功能

water.model

将

water.update

应用于所有日期。它是递归的，即每天土壤水需要前一天的土壤水。因此，

water.model

函数中的循环就出现了

water.model <- function(dat){

 top.FC  <- unique(dat$top.FC)    

 # I make a vector to store the results 
 dat$WAT <- -9999.9
 dat$RO <- -9999.9
 dat$DR <- -9999.9

# First day (day 1) has a default value
dat$WAT[1] <- top.FC/2 # assuming top soil water is half the content on day 1   
dat$RO[1] <- NA 
dat$DR[1] <- NA

# Now calculate water content for day 2 onwards  

for(d in 1:(nrow(dat)-1)){

 dat[d + 1,7:9] <- water.update(WAT0 = dat$WAT[d], 
                                 RAIN.i = dat$Precp[d + 1], 
                                 ETo.i = dat$ETo[d + 1], 
                                 CN = unique(dat$CN), 
                                 DC = unique(dat$DC),
                                 top.FC = unique(dat$top.FC))
 }
 return(dat)
}


 ptm <- proc.time()
 result <- water.model(df)
 proc.time() - ptm

    user  system elapsed 
    0.18    0.00    0.17 

---

water.model使用
Rcpp
和
data.table
。下面的代码运行，但我得到的结果与您提供的R代码略有不同。我怀疑这与我解释你使用哪些指数来滞后/领先各个专栏的方式有关，但如果没有这些东西所代表的领域知识，我很难直观地理解正确的逻辑应该是什么。希望这是一个不错的起点

创建一个名为
WaterModel.cpp
的单独文件，其中包含以下内容：

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]

List WaterModel(NumericVector RAIN,
                NumericVector ETo,
                double CN,
                double DC,
                double topFC) {

  double S = 25400/CN - 254;
  double IA = 0.2*S;

  int n = RAIN.length();
  NumericVector WAT(n);
  NumericVector RO(n);
  NumericVector DR(n);

  WAT[0] = topFC/2;

  for (int i = 1; i < n; i++) {

    if (RAIN[i] > IA) {
      RO[i] = pow((RAIN[i-1] - 0.2 * S),2) / (RAIN[i-1] + 0.8 * S);
    } else { 
      RO[i] = 0;
    }

    if (WAT[i-1] + RAIN[i-1] - RO[i-1] > topFC) { 
      DR[i] = DC * (WAT[i-1] + RAIN[i-1] - RO[i-1] - topFC) ;
    } else { 
      DR[i] = 0 ;
    } 

    WAT[i] = WAT[i-1] + RAIN[i-1] - RO[i-1] - DR[i-1] - ETo[i-1];

    if (WAT[i] < 0){
      WAT[i] = 0;
    }

  }
    return Rcpp::List::create(Rcpp::Named("WAT") = WAT,
                              Rcpp::Named("RO") = RO,
                              Rcpp::Named("DR") = DR);

}

我删除了RCPP标签，因为这里没有C++代码。我回答了使用<代码> Rcpp <代码>，我建议在这里考虑类似的策略。你肯定for循环是不可避免的吗？你不能聪明地使用
cumsum
和
cumprod
？（很难说没有一个方程式。）几个明显的缓慢部分：在循环之前计算一次你的
unique（dat$*）
输入，而不是在循环内部的每次迭代中重复（不会有多大帮助，但原则上在循环外尽你所能）。@Crop89，我有两个小建议可以提高性能，但不像
Rcpp
解决方案那样多。首先，在
water.update
函数中，将
if
语句向量化，例如
RO=（RAIN.i>IA）*（RAIN.i-0.2*S）^2/（RAIN.i+0.8*S）
，和
DR=（WAT0+RAIN.i-RO>top.FC）*（DC*（WAT0+RAIN.i-RO-top.FC））
。其次，在
water.model
函数中，在循环之前创建
CN
、
DC
和
top.FC
，在这种情况下，您还可以避免1089次额外计算（3*（nrow（dat）-1）-3次，因为您在循环中使用了
d
一次和
d+1
3次，分别切换到
d-1
和
d
可以节省一些时间。在这种情况下，循环将
用于（2:nrow（dat）中的d）
。因此，在本例中，您将3个加法替换为1个减法，再次节省了一些时间。感谢Matt提供另一个示例。现在我明白了编写Rcpp的要点。
#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]

List WaterModel(NumericVector RAIN,
                NumericVector ETo,
                double CN,
                double DC,
                double topFC) {

  double S = 25400/CN - 254;
  double IA = 0.2*S;

  int n = RAIN.length();
  NumericVector WAT(n);
  NumericVector RO(n);
  NumericVector DR(n);

  WAT[0] = topFC/2;

  for (int i = 1; i < n; i++) {

    if (RAIN[i] > IA) {
      RO[i] = pow((RAIN[i-1] - 0.2 * S),2) / (RAIN[i-1] + 0.8 * S);
    } else { 
      RO[i] = 0;
    }

    if (WAT[i-1] + RAIN[i-1] - RO[i-1] > topFC) { 
      DR[i] = DC * (WAT[i-1] + RAIN[i-1] - RO[i-1] - topFC) ;
    } else { 
      DR[i] = 0 ;
    } 

    WAT[i] = WAT[i-1] + RAIN[i-1] - RO[i-1] - DR[i-1] - ETo[i-1];

    if (WAT[i] < 0){
      WAT[i] = 0;
    }

  }
    return Rcpp::List::create(Rcpp::Named("WAT") = WAT,
                              Rcpp::Named("RO") = RO,
                              Rcpp::Named("DR") = DR);

}

library(data.table)
library(Rcpp)

set.seed(123)
DT <- data.table(day = 1:365,
                 Precp = sample(1:30, 365, replace = T), 
                 ETo = sample(1:10,  365, replace = T))

## Don't make constant columns just to store constants
Const_topFC = 23
Const_CN = 61
Const_DC = 0.4

Rcpp::sourceCpp("WaterModel.cpp")

DT[,c("WAT","RO","DR"):= WaterModel(Precp,ETo,Const_CN,Const_DC,Const_topFC)]

DT
#       day Precp ETo     WAT  RO        DR
#   1:   1     9   8 11.50000  0  0.0000000
#   2:   2    24   2 12.50000  0  0.0000000
#   3:   3    13   1 34.50000  0  5.4000000
#   4:   4    27   5 41.10000  0  9.8000000
#   5:   5    29   5 53.30000  0 18.0400000
# ---                                     
# 361: 361     5   8 30.10327  0  8.6166592
# 362: 362     6   9 18.48661  0  4.8413088
# 363: 363    27   7 10.64530  0  0.5946452
# 364: 364    10   8 30.05066  0  5.8581216
# 365: 365    11   1 26.19254  0  6.8202636