如何使用3个for循环加速此计算,该循环具有复杂的索引进度?

如何使用3个for循环加速此计算,该循环具有复杂的索引进度?,r,performance,loops,indices,R,Performance,Loops,Indices,给定以下数据帧df和包含一个值的数值向量p: df <- data.frame(id = c(rep(1, 110), rep(2, 290)), m = c(seq(1, 110), seq(1:290)), m1 = c(rep(108, 110), rep(288, 290)), m2 = c(rep(3, 400)), f1 = c(rep(-1

给定以下数据帧
df
和包含一个值的数值向量
p

df <- data.frame(id = c(rep(1, 110), rep(2, 290)),
                 m  = c(seq(1, 110), seq(1:290)),
                 m1 = c(rep(108, 110), rep(288, 290)),
                 m2 = c(rep(3, 400)),
                 f1 = c(rep(-100, 110), rep(-50, 290)),
                 f2 = c(rep(22, 110), rep(15, 290)),
                 f3 = c(rep(5, 110), rep(0, 290)),
                 u  = c(c(0.12, 0.16, 0.10), rep(0, 107), c(0.085, 0.09, 0.11), rep(0, 287)),
                 v  = c(rep(0.175, 3), rep(0, 107), rep(0.115, 3), rep(0, 287)),
                 y  = rep(0, 400))

df$s <- sqrt(df$m/(df$m1 + df$m2 - 1))/40

p <- 0.01
以下是有关数据的一些事实:

  • 变量
    id
    m
    唯一地标识每一行(主键)
  • 变量
    m
    表示“月”。因此,数据集是一个时间序列
  • 变量
    f1
    f2
    f3
    m1
    m2
    对于
    id
    的每个值都是常量。这些不依赖于变量
    m
  • 变量
    s
    u
    v
    对于
    id
    的每个值都不是常数,因此依赖于
    m
  • id
    的每个值的行数等于m1+m2-1。或等效值:对于
    id
    的每个值,
    m
    的最大值等于m1+m2-1
  • 目标是使用以下公式计算
    y

    我已经创建了一个解决方案,可以做到这一点:

    counter <- 0
    start   <- proc.time()
    
    for(n in 1:nrow(df)){
    
      #index k holds the current value for m
      k <- df$m[n]
      counter <- counter + 1
    
      #read the current value for m1 and m2
      m1 <- df$m1[n]
      m2 <- df$m2[n]
      counter <- counter + 2
    
      #calculate the sum of f1, f2 and f3.
      sum_of_fs <- df$f1[n] + df$f2[n] + df$f3[n]
      counter <- counter + 1
    
      #initialize y. Set it to zero.
      y <- 0
      counter <- counter + 1
    
      for(i in k:min(m1 + k - 1, m1 + m2 - 1)){
    
        #Initialize the sumproduct of u and v. Set it to zero.
        sumprod_uv <- 0
        counter <- counter + 1
    
        for(j in min(k, m2):max(1, i - m1 + 1)){
    
          sumprod_uv <- sumprod_uv + df$u[j] + df$v[i - j + 1]
          counter <- counter + 1
    
        }  
    
        z <- ((1 + p)/(1 + df$s[i]))^(i / 12)
        y <- y + sumprod_uv * z
        counter <- counter + 2  
      }  
    
      y <- y * sum_of_fs
      df$y[n] <- y
      counter <- counter + 2
    }
    
    counter
    
    proc.time() - start
    
    此持续时间对应的语句数为290188(脚本运行完成时,
    计数器的值)

    在现实生活中,我有一个包含超过90k条记录的数据集。除此之外,真实的数据集稍微复杂一些(7个变量组成id,而不是一个)。我使用这个数据集运行了脚本,它运行了大约17分钟


    问题是:我如何加速这个算法?应该有一个更整洁的方法来做到这一点

    最简单的改进应该是在循环之前将列重新定义为向量:(+在第一个循环中计算
    v1
    ,并删除
    sum\u of_fs
    计算,因为它不在任何地方使用)

    #将df列重新定义为向量
    DFM < P>她,你有一个C++变体,它比R.< /P>快。
    
    如果只添加一个整数,
    counter=289.788
    的值如何计算?您应该删除代码中与此问题无关的多余部分。例如,
    sum\u of_fs
    不在代码中的任何地方使用。另外,“代码>计数器< /C>”是否需要?@ DVD280,成千上万(28 9K)更一般的注释,这些类型的算法在本地R中有点坏,考虑编写C++函数,并从< <代码> Rcpp < /Cord>包中加载< <代码> Sourcecpp(“函数名”)<代码>。甚至你编写代码的方式完全是C++的。R并不是真正用来处理非并行时间序列的。我这么说是因为你的代码根本没有从矢量化操作中获益。@dvd280:我不小心用了点而不是逗号来分隔千@谢谢你对我代码的反馈。我犯了一个错误,没有将变量
    sum\u of_fs
    包含在计算
    y
    中。我已经更改了代码,因此它现在包含在
    y
    的计算中。太棒了!在R中使用C++函数对我来说是新的,但我要试试!我还发现了一些背景,为使用C++而不是R的理由提供了参数。
    counter <- 0
    start   <- proc.time()
    
    for(n in 1:nrow(df)){
    
      #index k holds the current value for m
      k <- df$m[n]
      counter <- counter + 1
    
      #read the current value for m1 and m2
      m1 <- df$m1[n]
      m2 <- df$m2[n]
      counter <- counter + 2
    
      #calculate the sum of f1, f2 and f3.
      sum_of_fs <- df$f1[n] + df$f2[n] + df$f3[n]
      counter <- counter + 1
    
      #initialize y. Set it to zero.
      y <- 0
      counter <- counter + 1
    
      for(i in k:min(m1 + k - 1, m1 + m2 - 1)){
    
        #Initialize the sumproduct of u and v. Set it to zero.
        sumprod_uv <- 0
        counter <- counter + 1
    
        for(j in min(k, m2):max(1, i - m1 + 1)){
    
          sumprod_uv <- sumprod_uv + df$u[j] + df$v[i - j + 1]
          counter <- counter + 1
    
        }  
    
        z <- ((1 + p)/(1 + df$s[i]))^(i / 12)
        y <- y + sumprod_uv * z
        counter <- counter + 2  
      }  
    
      y <- y * sum_of_fs
      df$y[n] <- y
      counter <- counter + 2
    }
    
    counter
    
    proc.time() - start
    
       user  system elapsed 
      1.829   0.002   1.872 
    
    # redefine df columns as vectors
    dfm <- df$m
    dfm1 <- df$m1
    dfm2 <- df$m2
    u <- df$u
    v <- df$v
    s <- df$s
    
    start   <- proc.time()
    for (n in 1:nrow(df)) {
      k <- dfm[n]
      m1 <- dfm1[n]
      m2 <- dfm2[n]
      v1 <- min(k, m2)
      # sum_of_fs <- df$f1[n] + df$f2[n] + df$f3[n] # not used anywhere !!
      y <- 0
      for (i in k:min(m1 + k - 1, m1 + m2 - 1)) {
        sumprod_uv <- 0
        for (j in v1:max(1, i - m1 + 1)) {
          sumprod_uv <- sumprod_uv + u[j] + v[i - j + 1]
        }  
        z <- ((1 + p)/(1 + s[i]))^(i / 12)
        y <- y + sumprod_uv * z
      }  
      df$y[n] <- y
    }
    proc.time() - start
    
    library(Rcpp)
    sourceCpp(code = "#include <Rcpp.h>
    #include <vector>
    #include <algorithm>
    
    using namespace Rcpp;
    
    // [[Rcpp::export]]
    std::vector<double> fun(double &p
    , std::vector<int> &dfm
    , std::vector<int> &dfm1
    , std::vector<int> &dfm2
    , std::vector<double> &u
    , std::vector<double> &v
    , std::vector<double> &s
    ) {
    std::vector<double> yy(s.size());
    for(size_t n=0; n<s.size(); ++n) {
      int k = dfm[n];
      int m1 = dfm1[n];
      int m2 = dfm2[n];
      int v1 = std::min(k, m2);
      double y = 0.;
      int ii = std::min(m1 + k - 1, m1 + m2 - 1);
      for(int i=std::min(k,ii); i<=std::max(k,ii); ++i) {
        double sumprod_uv = 0.;
        int jj = std::max(1, i - m1 + 1);
        for (int j=std::min(v1, jj); j<=std::max(v1, jj); ++j) {
          sumprod_uv += u[j-1] + v[i - j];
        }  
        y += sumprod_uv * std::pow(((1. + p)/(1. + s[i-1])), (i / 12.));
      }
      yy[n] = y;
    }
    return yy;
    }")
    system.time(df$y <- fun(p, df$m, df$m1, df$m2, df$u, df$v, df$s))
    #   user  system elapsed 
    #  0.005   0.000   0.004 
    
    df$y <- fun(p, df$m, df$m1, df$m2, df$u, df$v, df$s) * (df$f1 + df$f2 + df$f3)
    
    #Your code
    #   user  system elapsed 
    #  0.358   0.004   0.362 
    
    #@minem
    #  user  system elapsed 
    #  0.090   0.003   0.093