r - 在 R : script works, 中的移动日期窗口上缩放变量，但速度慢得令人无法接受。优化方法？ rstats

Question

我有一个数据框，其中每一行代表特定日期特定类别的数据:

set.seed(1)
k <- 10
df <- data.frame(
    name = c(rep('a',k), rep('b',k)), 
    date = rep(seq(as.Date('2017-01-01'),as.Date('2017-01-01')+k-1, 'days'),2),
    x = runif(2*k,1,20),
    y = runif(2*k,100,300)
    )
View(df)

头:

 head(df)
  name       date         x        y
1    a 2017-01-01  6.044665 286.9410
2    a 2017-01-02  8.070354 142.4285
3    a 2017-01-03 11.884214 230.3348
4    a 2017-01-04 18.255948 125.1110
5    a 2017-01-05  4.831957 153.4441
6    a 2017-01-06 18.069404 177.2228

结构:

str(df)
'data.frame':   20 obs. of  4 variables:
 $ name: Factor w/ 2 levels "a","b": 1 1 1 1 1 1 1 1 1 1 ...
 $ date: Date, format: "2017-01-01" "2017-01-02" "2017-01-03" "2017-01-04" ...
 $ x   : num  6.04 8.07 11.88 18.26 4.83 ...
 $ y   : num  287 142 230 125 153 ...

我需要在特定日期窗口内缩放此数据的 x 和 y 变量。我想出的脚本如下:

library(dplyr)
library(lubridate)
df2 <- df
moving_window_days <- 4

##Iterate over each row in df
for(i in 1:nrow(df)){ 
    df2[i,] <- df %>% 
        ##Give me only rows for 'name' on the current row 
        ##which are within the date window of interest
        filter(date <= date(df[i,"date"]) & 
               date >= date(df[i,"date"]) - moving_window_days & 
               name == df[i,"name"]
               ) %>% 
        ##Now scale x and y on this date wondow
        mutate(x = percent_rank(x), 
               y = percent_rank(y)
        ) %>% 
        ##Get rid of the rest of the rows - leave only the row we are looking at
        filter(date == date(df[i,"date"])) 
}

它按预期工作(好吧，我最初想在移动窗口中获取每个观察值的百分位数，但缩放后的值就可以正常工作)问题是真实的数据集要大得多:

• 'name'栏有30个地方分公司
• 'date' 是每个分支至少一年的数据
• 我有 6 个变量，而不是 'x' 和 'y'
• 移动窗口为 90 天

我在真实数据上运行了这个脚本，在30,000 行 中，它在4 小时 中只能超过5,000。 ..这是我第一次遇到这样的问题。

我确定我的脚本效率非常低(我确定是因为我不是 R 专家。我只是假设总有更好的方法)

有什么方法可以优化/改进此脚本？

• 有什么方法可以“purrrify”(使用 purrr 中的一些 map 函数)？
• 嵌套数据框？ 嵌套()？认为这是一个解决方案...不确定如何实现...

我能做些什么来以不同的方式解决这个问题？

Answer 1

您可以做的一件事是并行处理。为此，我使用了 future 包。这可能会惹恼一些人，他们可能认为这是一种 hack，因为 future 包的目的是......好吧......对于 future (或者“ promise ”，如果你是前端开发人员)。这种方法很挑剔，但效果很好。

    library(future)

    # Create a function that iterates over each row in the df:
    my_function <- function(df, x) {
          x <- df
      for(i in 1:nrow(df)){ 
          x[i, ] <- df %>% 
              ##Give me only rows for 'name' on the current row 
              ##which are within the date window of interest
              filter(date <= date(df[i,"date"]) & 
                     date >= date(df[i,"date"]) - moving_window_days & 
                     name == df[i,"name"]
                     ) %>% 
              ##Now scale x and y on this date wondow
              mutate(x = percent_rank(x), 
                     y = percent_rank(y)
              ) %>% 
              ##Get rid of the rest of the rows - leave only the row we are looking at
              filter(date == date(df[i,"date"])) 
      }
          return(x)
    }

    plan(multiprocess) # make sure to always include this in a run of the code.

    # Divide df evenly into three separate dataframes:
    df1 %<-% my_function(df[1:7, ], df1)
    df2 %<-% my_function(df = df[(8 - moving_window_days):14, ], df2) # But from here on out, go back 4 days to include that data in the moving average calculation.
    df3 %<-% my_function(df = df[(15 - moving_window_days):20, ], df3)

# See if your computer is able to split df into 4 or 5 separate dataframes. 

    # Now bind the dataframes together, but get the indexing right:
    rbind(df1, df2[(nrow(df2) - 6):nrow(df2), ], df3[(nrow(df3) - 5):nrow(df3), ])

并行处理是优化代码以提高效率的众多方法之一。过去，正是这种技术显着为我加速了代码。它将程序的运行时间从一天半缩短到 3 或 4 小时!

现在，理想情况下，我们希望使用 apply 族和矩阵。这个答案只是我们可以加速代码的众多方法之一。此外，future 包允许我们在不学习新的循环结构的情况下并行处理，例如在 parallel 包中(尽管如此，它仍然是一个了不起的包)。

另请查看 Rcpp 包。学习它需要一些时间，但对于释放 C++ 的速度来说是不可思议的。