Question

MWE。

library(data.table)
x <- data.table(
    g=rep(c("x", "y"), each=4), # grouping variable
    time=c(1,3,5,7,2,4,6,8),    # time index
    val=1:8)                    # value

setkeyv(x, c("g", "time"))

cumsd <- function(x) sapply(sapply(seq_along(x)-1, head, x=x), sd)

x[, cumsd(val), by=g]

## Output
#    g        V1
# 1: x        NA
# 2: x        NA
# 3: x 0.7071068
# 4: x 1.0000000
# 5: y        NA
# 6: y        NA
# 7: y 0.7071068
# 8: y 1.0000000

我想计算所有先前值（不包括当前值）的标准偏差（或更一般地，数学函数），每个观察，按组，在R中。

上面的cumsd（“累积sd”）函数可以满足我的需要。对于例如第3行V1 = sd(c(1, 2))，对应于第1行和第2行中的值。第7行，V1 = sd(c(5, 6))，对应第5行和第6行中的值。

但是，cumsd非常慢（在我的实际应用程序中使用太慢）。关于如何更有效地进行计算的任何想法？

修改

对于SD，我们可以使用来自库TTR的runSD，如下所述：Calculating cumulative standard deviation by group using R

下面的Gabor答案解决了先前值的任意数学函数的更一般情况。虽然潜在的普遍性可能会带来一定的效率成本。

Answer 1

我们可以将窗口宽度指定为向量，然后在窗口中省略sd的每个应用程序的最后一个值。

library(zoo)

x[, sd:=rollapplyr(val, seq_along(val), function(x) sd(head(x, -1)), fill = NA), by = g]

，并提供：

> x
   g time val        sd
1: x    1   1        NA
2: x    3   2        NA
3: x    5   3 0.7071068
4: x    7   4 1.0000000
5: y    2   5        NA
6: y    4   6        NA
7: y    6   7 0.7071068
8: y    8   8 1.0000000

或者，我们可以在列表中指定偏移量。这里使用的负偏移是指先前的值，因此-1是前一个值，-2是之前的值，依此类推。

negseq <- function(x) -seq_len(x))
x[, sd:=rollapplyr(val, lapply(seq_along(val)-1, negseq), sd, fill = NA), by = g]

，并提供：

> x
   g time val        sd
1: x    1   1        NA
2: x    3   2        NA
3: x    5   3 0.7071068
4: x    7   4 1.0000000
5: y    2   5        NA
6: y    4   6        NA
7: y    6   7 0.7071068
8: y    8   8 1.0000000

Answer 2

我们可以将TTR::runSD与shift：

一起使用

library(TTR);
setDT(x)[, cum_sd := shift(runSD(val, n = 2, cumulative = TRUE)) , g]
#    g time val    cum_sd
#1: x    1   1        NA
#2: x    3   2        NA
#3: x    5   3 0.7071068
#4: x    7   4 1.0000000
#5: y    2   5        NA
#6: y    4   6        NA
#7: y    6   7 0.7071068
#8: y    8   8 1.0000000

Answer 3

原来，这两个选项对我的申请都不够快（数百万组和观察）。但是你的评论激励我在Rcpp写一个小功能来完成这个伎俩。谢谢大家！

library(data.table)
library(Rcpp)
x <- data.table(
    g=rep(c("x", "y"), each=4), # grouping variable
    time=c(1,3,5,7,2,4,6,8),    # time index
    val=1:8)                    # value
setkeyv(x, c("g", "time"))

cumsd <- function(x) sapply(sapply(seq_along(x)-1, head, x=x), sd)
x[, v1:=cumsd(val), by=g]

cppFunction('
Rcpp::NumericVector rcpp_cumsd(Rcpp::NumericVector inputVector){
    int len = inputVector.size();
    Rcpp::NumericVector outputVector(len, NumericVector::get_na());
    if (len < 3) return (outputVector);
    for (int i = 2; i < len; ++i){
        outputVector(i) = Rcpp::sd(inputVector[Rcpp::seq(0, i - 1)]);
        }
    return(outputVector);
};
')
x[, v2:= rcpp_cumsd(val), by=g]

all.equal(x$v1, x$v2)
## TRUE

速度差异似乎取决于组的数量与data.table中每组的观察数量。我不会发布基准测试，但就我而言，Rcpp版本更快，更快。

按组的变量的所有先前值的数学函数（例如，sd）

3 个答案: