如何计算 dplyr 中的滚动标准差

Question

我在 R 中有以下数据框。

data <- structure(list(Date = structure(c(18682, 18683, 18684, 18687, 
18688), class = "Date"), Apple = c(125.349998, 120.989998, 121.260002, 
127.790001, 125.120003), Amazon = c(3159.530029, 3057.159912, 
3092.929932, 3146.139893, 3094.530029), Facebook = c(264.309998, 
254.690002, 257.619995, 264.910004, 259), Google = c(2083.810059, 
2015.949951, 2021.910034, 2069.659912, 2064.47998), Netflix = c(553.409973, 
546.700012, 538.849976, 550.640015, 547.820007)), row.names = c(NA, 
-5L), class = c("tbl_df", "tbl", "data.frame"))

我正在寻找一种简单的方法来计算

dplyr

中每列的滚动标准差。如果我的数据框是一个动物园对象，解决方案可能看起来像这样

library(tidyverse)
data %>% mutate_at(.vars = vars(2:6), .funs = ~zoo::rollapply(., width = 2, FUN = sd))

关于如何调整

.funs

命令以在 tbl 对象上工作有什么想法吗？

Answer 1

我喜欢这些

slider

套餐：

data %>%
  mutate(across(-Date, ~slider::slide_dbl(.x, sd, .before = Inf)))
  # or use `.before = 2` if you want to look back at the
  #  two prior values (3 in total)

# A tibble: 5 x 6
  Date       Apple Amazon Facebook Google Netflix
  <date>     <dbl>  <dbl>    <dbl>  <dbl>   <dbl>
1 2021-02-24 NA      NA      NA      NA     NA   
2 2021-02-25  3.08   72.4     6.80   48.0    4.74
3 2021-02-26  2.44   52.0     4.93   37.6    7.29
4 2021-03-01  3.30   47.5     5.03   34.0    6.33
5 2021-03-02  2.91   42.1     4.40   30.3    5.49

slider

还可以让您通过索引列调整窗口大小，因此您可以使用

slider::slide_index_dbl()

计算“过去 2 天的标准差”（相对于最后 2 个观测值）。

Answer 2

这里有几种可能性。请注意，您可能想要的是 rollapplyr 末尾带有 r （表示右窗口对齐而不是默认的中心对齐），使用相同的参数，但我们无法在没有完整解释的情况下判断什么是想要。

1a) 如果将

fill=NA

添加到

rollapply

调用中，问题中的代码将有效，尽管 mutate_at 已被弃用，有利于 across。

1b) 要使用 mutate/across 请改用它。

library(dplyr)
library(zoo)

data %>% mutate(across(-Date, ~ rollapply(., 2, sd, fill = NA)))

1c) 另一种可能性是像这样使用 %<>%:

library(magrittr)
library(zoo)

data2 <- data
data2[-1] %<>% rollapply(2, sd, fill = NA)

2) 转换为动物园，在这种情况下，代码就是这样，因为动物园对象不需要像数据框那样进行 NA 填充，并且由于日期不表示为第一列，我们不需要使用特殊措施来避免应用它。

library(zoo)
z <- read.zoo(data)
rollapply(z, 2, sd)

Answer 3

这是使用动物园的方法：

  library(zoo)

  rollsd <- function(x, ...){
    n <- rollsum(!is.na(x), ...)
    s <- rollsum(x, ...)
    ss <- rollsum(x * x, ...)
    v <- (ss - s * s / n) / (n - 1)
    return(sqrt(v))
  }
  rollsd(1:10, k = 10, align = "right", na.pad = TRUE)
  sd(1:10)