R:period.apply 的更快替代方案
R: faster alternative of period.apply
我准备了以下数据
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
我想为每个组计算 sum(Weighted_Value)/sum(SumVal),因此例如对于第 3 组,结果将为 1.2。
我正在使用 period.apply 来做到这一点:
period.apply(x4, intervalIndex, function(z) sum(z[,4])/sum(z[,2]))
但它对我的应用程序来说太慢了,所以我想问问是否有人知道更快的替代方案? ave我已经试过了,但是好像更慢。
顺便说一句,我的目标是。计算时间加权平均值,将不规则时间序列转换为具有等距时间间隔的时间序列。
谢谢!
尝试使用 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))
library(data.table)
setDT(df)[, sum(Weighted_Value) / sum(SumVal), by = Group]
但我没有看到您所指的时间序列。
查看图书馆(动物园)。
这是一个基本的 R 解决方案。对于较大的 (500k+) 数据集,它不是最快的,但是您可以看到其他函数中可能发生的事情 "under the hood"。
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
使用 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
我准备了以下数据
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
我想为每个组计算 sum(Weighted_Value)/sum(SumVal),因此例如对于第 3 组,结果将为 1.2。
我正在使用 period.apply 来做到这一点:
period.apply(x4, intervalIndex, function(z) sum(z[,4])/sum(z[,2]))
但它对我的应用程序来说太慢了,所以我想问问是否有人知道更快的替代方案? ave我已经试过了,但是好像更慢。
顺便说一句,我的目标是。计算时间加权平均值,将不规则时间序列转换为具有等距时间间隔的时间序列。
谢谢!
尝试使用 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))
library(data.table)
setDT(df)[, sum(Weighted_Value) / sum(SumVal), by = Group]
但我没有看到您所指的时间序列。 查看图书馆(动物园)。
这是一个基本的 R 解决方案。对于较大的 (500k+) 数据集,它不是最快的,但是您可以看到其他函数中可能发生的事情 "under the hood"。
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
使用 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