矢量化功能/提高数据表中的计算速度

Question

目前，我有以下data.table：

item      city    dummyvar
A        Austin       1
A        Austin       1
A        Austin      100
B        Austin       2 
B        Austin       2
B        Austin      200
A          NY         1
A          NY         1
A          NY        100
B          NY         2 
B          NY         2
B          NY        200

并且我有一个名为ImbalancePoints的用户定义函数，该函数应用于dummyvar，它返回检测到dummyvar突然变化的行。我这样做的方式如下：

my.data.table[,
 .(item, city , imb.points = list(unique(try(ImbalancePoints(dummyvar), silent = T))) ),
 by = .(city, item)
]

对于NY情况，可以说我得到一个data.table对象，如下所示：

 item   city   imb.points
   A     NY     3,449

其中imb.points列是一个以嵌套列表为元素的列，在此示例中，数字3和449表示对于city = NY和item = A情况发生突然变化的行。但是，我面临的问题是我有大约。用于12个不同城市的3000个不同项目，计算此项目需要很长时间。我想知道您是否可以给我一个关于如何向量化/加速此计算的想法，因为我上次尝试此过程花了将近2个小时，但没有完成。

我不知道是否有帮助，但是我还附加了ImbalancePoints函数：

library(pracma)

ImbalancePr <- function(eval.column) {
  n <- length(eval.column)
  imbalance <- rep(0, n)
  b_t = rep(0,n)
  elem_diff <- diff(eval.column)
  for(i in 2:n)
  {
    imbalance[i] <- sign(elem_diff[i-1]) * (elem_diff[i-1] != 0)
    + imbalance[i-1]*(elem_diff[i-1] == 0)
  }
  return(imbalance)
}

ImbalancePoints <- function(eval.column, w0 = 100, bkw_T = 10, bkw_b = 10){
  bv_t <- ImbalancePr(eval.column)
  w0 <- min(min(which(cumsum(bv_t) != 0)), w0)
  Tstar <- w0
  E0t <- Tstar
  repeat{
    Tlast <- sum(Tstar)
    nbt <- min(bkw_b, Tlast-1)
    P <- pracma::movavg(bv_t[1:Tlast], n = nbt, type = "e")
    P <- tail(P,1)
    bv_t_expected <- E0t * abs(P)
    bv_t_cumsum <- abs(cumsum(bv_t[-(1:Tlast)]))
    if(max(bv_t_cumsum) < bv_t_expected){break}else{
      Tnew <- min(which(bv_t_cumsum >= bv_t_expected))
    }
    Tlast <- Tlast + Tnew
    if(Tlast > length(eval.column)[1]){break}else{
      Tstar <- c(Tstar,Tnew)
      if(length(Tstar) <= 2){
        E0t <- mean(Tstar)
      }else{
        nt <- min(bkw_T,length(Tstar)-1)
        E0t <- pracma::movavg(Tstar[1:length(Tstar)], n = nt, type = "e")
        E0t <- tail(E0t,1)
      }
    }
  }
  return(sort(unique(Tstar)))
}

EDIT：多亏Paul的见识，所以我的问题只是将ImbalancePoints函数中的重复循环矢量化。但是我不是很熟练的编码，我没有看到直接的解决方案。如果有人可以给我建议，或者您对辅助功能/库有所了解，我将不胜感激。

Answer 1

此发布由几个解决不同问题的部门组成。

矢量化ImbalancePr()

我相信ImbalancePr()可以替换为

fImbalancePr <- function(x) c(0, sign(diff(x)))

至少，它返回相同的结果，经过基准测试（检查结果）：

library(bench)
library(ggplot2)
bm <- press(
  n = c(10, 100, 1000, 10000),
  {
    x <- rep(0, n)
    set.seed(123)
    x[sample(n, n/5)] <- 100
    print(table(x))
    mark(
      ImbalancePr(x),
      fImbalancePr(x)
    )
  }

)

Running with:
      n
1    10
x
  0 100 
  8   2 
2   100
x
  0 100 
 80  20 
3  1000
x
  0 100 
800 200 
4 10000
x
   0  100 
8000 2000

autoplot(bm)

fImbalancePr()总是比OP的原始版本快。速度优势随着向量长度的增加而增加。

分析ImbalancePoints()

但是，此改进对ImbalancePoints()的整体性能没有太大影响：

library(bench)
library(ggplot2)
bm <- press(
  n = c(10L, 100L, 1000L),
  {
    x <- replace(rep(0, n), n, 100)
    y <- c(rep(2, n), rep(-3, n), rep(5, n))
    mark(
      original = {
        list(
          ImbalancePoints(x),
          ImbalancePoints(y)
        )
      },
      modified = {
        list(
          fImbalancePoints(x),
          fImbalancePoints(y)
        )
      }
    )
  }

)

[fImbalancePoint()是ImbalancePoint()的变体，其中ImbalancePr()已被fImbalancePr()替换。

autoplot(bm)

有一个小的改进，但这无助于将报告的执行时间大大减少2小时。

我们可以使用profvis来确定在profvis中花费的时间：

ImbalancePoints()

通过采样收集时间，因此需要足够的重复次数才能获得良好的覆盖率。

一次运行的结果显示在RStudio的此屏幕截图中：

library(profvis)
x <- c(rep(0, 480L), rep(c(0:9, 9:0), 2L), rep(0, 480L))
profvis({
  for (i in 1:100) ffImbalancePoints(x)
})

• [消耗movavg()中所花费时间的25％。
• 根据分析，ImbalancePoints()中的双冒号运算符需要另外20％。事先使用pracma::movavg()来加载pracma包是否有加速的可能是值得的。
• 10％用于呼叫library(pracma)。 tail()可以替换为tail(x, 1)，其速度要快一个数量级。

[如果我们通过键入x[length(x)]（不带括号）来查看movavg()的代码，我们会看到存在无法向量化的迭代循环：

pracma::movavg

此外，仅使用通过调用

...
else if (type == "e") {
    a <- 2/(n + 1)
    y[1] <- x[1]
    for (k in 2:nx) y[k] <- a * x[k] + (1 - a) * y[k - 1]
}
...

创建的时间序列的最后一个值。因此，这里可能有两个用于提高性能的选项：

• 选择不同的加权均值函数，该函数仅使用有限窗口内的数据点。
• 使用movavg()在C ++中重新实现movavg()。