R：更快的period.apply替代品

Question

我准備了以下數據

Timestamp   Weighted Value  SumVal  Group
1           1600            800     1
2           1000            1000    2
3           1000            1000    2
4           1000            1000    2
5           800             500     3
6           400             500     3
7           2000            800     4
8           1200            1000    4

我想計算每個組的總和（Weighted_Value）/ sum（SumVal），所以例如對於組3，結果將是1.2。

我正在使用period.apply來做到這一點：

period.apply(x4, intervalIndex, function(z) sum(z[,4])/sum(z[,2]))

但是對於我的應用程序來說它太慢了，所以我想問一下是否有人知道更快的替代方案呢？ 我已經嘗試過了，但它似乎更慢了。

我的目標是btw。 計算時間加權平均值，將不規則時間序列轉換為具有等距時間間隔的時間序列。

謝謝！

Answer 1

library(data.table)
setDT(df)[, sum(Weighted_Value) / sum(SumVal), by = Group]

但我沒有看到你所指的時間序列。 看看圖書館（動物園）。

Answer 2

使用rowsum似乎比data.table方法更快（至少對於這個小示例數據集）：

sgibb <- function(datframe) {
  data.frame(Group = unique(df$Group),
             Avg = rowsum(df$Weighted_Value, df$Group)/rowsum(df$SumVal, df$Group))
}

將rowsum方法添加到@ platfort的基准：

library(microbenchmark)
library(dplyr)
library(data.table)

microbenchmark(
  Nader   = df %>%
              group_by(Group) %>%
              summarise(res = sum(Weighted_Value) / sum(SumVal)),
  Henk    = setDT(df)[, sum(Weighted_Value) / sum(SumVal), by = Group],
  plafort = weight.avg(df),
  sgibb = sgibb(df)
)
# Unit: microseconds
#     expr      min       lq      mean    median        uq      max neval
#    Nader 2179.890 2280.462 2583.8798 2399.0885 2497.6000 6647.236   100
#     Henk  648.191  693.519  788.1421  726.0940  751.0810 2386.260   100
#  plafort 2638.967 2740.541 2935.4756 2785.7425 2909.4640 5000.652   100
#    sgibb  347.125  384.830  442.6447  409.2815  441.8935 2039.563   100

Answer 3

嘗試使用dplyr它應該比基本R更快

library(dplyr)

df <- read.table(text = "Timestamp   Weighted_Value  SumVal  Group
1           1600            800     1
2           1000            1000    2
3           1000            1000    2
4           1000            1000    2
5           800             500     3
6           400             500     3
7           2000            800     4
8           1200            1000    4" , header = T)


df %>%
  group_by(Group) %>%
  summarise(res = sum(Weighted_Value) / sum(SumVal))

Answer 4

這是一個基礎R解決方案。 對於較大的（500k +）數據集來說，這不是最快的，但是你可以在其他函數中看到“引擎蓋下”可能發生的事情。

weight.avg <- function(datframe) {
  s <- split(datframe, datframe$Group)
  avg <- sapply(s, function(x) sum(x[ ,2]) / sum(x[ ,3]))
  data.frame(Group = names(avg), Avg = avg)
}

weight.avg(df)
  Group      Avg
1     1 2.000000
2     2 1.000000
3     3 1.200000
4     4 1.777778

函數的第一行按組拆分數據框。 第二個將公式應用於每個組。 最后一個創建一個新的數據框。

數據

df <- read.table(text = "Timestamp   Weighted_Value  SumVal  Group
                 1           1600            800     1
                 2           1000            1000    2
                 3           1000            1000    2
                 4           1000            1000    2
                 5           800             500     3
                 6           400             500     3
                 7           2000            800     4
                 8           1200            1000    4" , header = T)

最快的時間

library(microbenchmark)
library(dplyr)
library(data.table)

microbenchmark(
  Nader   = df %>%
              group_by(Group) %>%
              summarise(res = sum(Weighted_Value) / sum(SumVal)),
  Henk    = setDT(df)[, sum(Weighted_Value) / sum(SumVal), by = Group],
  plafort = weight.avg(df)
)
Unit: microseconds
    expr      min        lq      mean   median       uq      max
   Nader 2619.174 2827.0100 3094.5570 2949.976 3107.481 7980.684
    Henk  783.186  833.7155  932.5883  888.783  944.640 3275.646
 plafort 3550.787 3772.4395 4085.2323 3853.561 3995.869 7595.801