计算 R 中每个周期的方差答案

【问题标题】：Compute Variance per Period in R计算 R 中每个周期的方差
【发布时间】：2015-02-27 03:37:50
【问题描述】：

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

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 中进行大部分数据操作，但我不反对使用替代解决方案，如果它可以满足我的需要

【问题讨论】：

标签： r dplyr

【解决方案1】：

将方差公式写成(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

【讨论】：

【解决方案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

返回与

相同的结果

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

【讨论】：

【解决方案3】：

您有大型数据集吗？如果 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 秒。

【讨论】：