在 R 中计算每个周期的方差

Question

我正在处理一组如下所示的数据：

team runs_scored       date
LAN           3        2014-03-22
ARI           1        2014-03-22
LAN           7        2014-03-23
ARI           5        2014-03-23
LAN           1        2014-03-30
SDN           3        2014-03-30

我正在尝试在此集合上测试预测模型，其中一个输入参数是 t-1 中 runs_scored 的方差。换句话说，要预测第 4 次观察的结果变量，我需要基于数据集中先前观察的 LAN 的方差。

我可以计算累积均值和总和，但我不太清楚如何计算数据集中的累积方差。我在 dplyr 中进行大部分数据操作，但我不反对使用替代解决方案，如果它能满足我的需求

Answer 1

你有大数据集吗？如果 for 循环不是太慢，你可以这样做：

data$vars <- NA
for(i in 2:nrow(data)){
  data$vars[i] <- var(data$runs_scored[1:(i - 1)])
}

这给出了

  team runs_scored      date     vars
1  LAN           3 3/22/2014       NA
2  ARI           1 3/22/2014       NA
3  LAN           7 3/23/2014 2.000000
4  ARI           5 3/23/2014 9.333333
5  LAN           1 3/30/2014 6.666667
6  SDN           3 3/30/2014 6.800000

编辑：如果你想做的稍微快一点，你可以为这个应用程序写一个特定的函数：

data$vars <- NA
cumVar <- function(position, df){
  return(var(data$runs_scored[1:(position - 1)]))
}

然后用sapply应用函数，得到一个向量出来：

position <- 3:nrow(data)
results <- c(NA,NA, sapply(position, cumVar,data))
data$var <- results

在我的机器上，对于大约 30000 行，对于 for 循环，大约需要 10.5 秒，而使用 sapply 大约需要 7.5 秒。

Answer 2

如果你想要累积方差，你可以实现 online-algorithm for variance。主要的好处是它是线性缩放的，而不是指数缩放的，就像迭代所有可能的子集时那样。

如果你有

x<-c(3,1,7,5,1,3)

你可以做到

cumvar<-function(x) {
   tail(Reduce(local({mm<-0; nn<-0; function(a,b) 
        {nn<<-nn+1; d<-b-mm; mm<<-mm+d/nn; a+d*(b-mm)}}), 
        x, 0, accumulate=TRUE), -1)/(seq_along(x)-1)
}
cumvar(x)
# [1]       NaN 24.500000 14.333333 10.000000  7.700000  6.166667  5.333333   4.696429  4.111111  3.777778

其中 returns 结果与

相同

cumvar2 <- function(x)  {
    sapply(seq_along(x), function(i) var(x[1:i]))
}
cumvar2(x)
# [1]        NA 24.500000 14.333333 10.000000  7.700000  6.166667  5.333333  4.696429  4.111111  3.777778

我们可以将效率与

进行比较

set.seed(15)
x<-rpois(100, 5)
microbenchmark:::microbenchmark(cumvar(x), cumvar2(x))

# Unit: microseconds
#        expr      min        lq      mean   median       uq      max neval cld
#   cumvar(x)  272.502  297.2425  335.2058  315.490  339.625  957.728   100  a 
#  cumvar2(x) 1672.323 1793.0960 2089.8104 1865.838 1956.208 6386.863   100   b

但是如果你想使用这个算法，我建议你阅读 wiki 页面，如果你只计算方差一，那么二次方法更稳健。

您可以将它与 dplyr 和

一起使用

dd<-read.table(text="team runs_scored       date
LAN           3        2014-03-22
ARI           1        2014-03-22
LAN           7        2014-03-23
ARI           5        2014-03-23
LAN           1        2014-03-30
SDN           3        2014-03-30", header=T)

dd %>% mutate(cvar=lag(cumvar(runs_scored)))

#   team runs_scored       date     cvar
# 1  LAN           3 2014-03-22       NA
# 2  ARI           1 2014-03-22      NaN
# 3  LAN           7 2014-03-23 2.000000
# 4  ARI           5 2014-03-23 9.333333
# 5  LAN           1 2014-03-30 6.666667
# 6  SDN           3 2014-03-30 6.800000

Answer 3

将方差公式写成(sum(x^2)-length(x)*mean(x)^2)/(length(x)-1)，你会发现它可以很容易地推广到累积方差，只需将其中的每个函数替换为它的累积版本（cummean 来自dplyr).所以，

library(dplyr)
cum_var <- function(x){
    n <- 1:length(x)
    (cumsum(x^2)-n*cummean(x)^2)/(n-1)
}

与@MrFlick 的 cumvar 的速度比较似乎令人鼓舞。

x <- rnorm(1e6)
all.equal(cum_var(x), cumvar(x))
#[1] TRUE
system.time(cumvar(x))[3]
elapsed 
   5.52 
system.time(cum_var(x))[3]
elapsed 
   0.04

在 R 中计算每个周期的方差

Compute Variance per Period in R

r

dplyr