【问题标题】：Calculate multiple moving calculations in one statement在一个语句中计算多个移动计算
【发布时间】：2019-03-12 10:25:49
【问题描述】：

我想在一个语句中计算所有移动平均线，而不是重复自己。这是否可以使用 quantmod 或是否需要巧妙地使用 tidyeval 和/或 purrr？

library(tidyquant)
library(quantmod)
library(zoo)

tibble(date = as.Date('2018-01-01') + days(1:100), 
       value = 100 + cumsum(rnorm(100))) %>% 
  tq_mutate(mutate_fun = rollapply, select = "value", width = 10, FUN = mean, col_rename = "rm10") %>% 
  tq_mutate(mutate_fun = rollapply, select = "value", width = 5, FUN = mean, col_rename = "rm5") %>% 
  gather(series, value, -date) %>% 
  ggplot(aes(date, value, color = series)) + 
     geom_line()

【问题讨论】：

标签： r tidyverse quantmod tidyquant

【解决方案1】：

这是使用data.table 的新frollmean() 功能的解决方案
需要data.table v1.12.0 或更高版本。

样本数据

library( data.table )
set.seed(123)
dt <- data.table( date = as.Date('2018-01-01') + days(1:100), 
            value = 100 + cumsum(rnorm(100)))

代码

#set windwos you want to roll on
windows <- c(5,10)
#create a rm+window column for each roll
dt[, ( paste0( "rm", windows ) ) := lapply( windows, function(x) frollmean( value, x)) ]

输出

head( dt, 15 )
#           date     value      rm5     rm10
#  1: 2018-01-02  99.43952       NA       NA
#  2: 2018-01-03  99.20935       NA       NA
#  3: 2018-01-04 100.76806       NA       NA
#  4: 2018-01-05 100.83856       NA       NA
#  5: 2018-01-06 100.96785 100.2447       NA
#  6: 2018-01-07 102.68292 100.8933       NA
#  7: 2018-01-08 103.14383 101.6802       NA
#  8: 2018-01-09 101.87877 101.9024       NA
#  9: 2018-01-10 101.19192 101.9731       NA
# 10: 2018-01-11 100.74626 101.9287 101.0867
# 11: 2018-01-12 101.97034 101.7862 101.3398
# 12: 2018-01-13 102.33015 101.6235 101.6519
# 13: 2018-01-14 102.73092 101.7939 101.8482
# 14: 2018-01-15 102.84161 102.1239 102.0485
# 15: 2018-01-16 102.28577 102.4318 102.1802

情节

#plot molten data
library(ggplot2)
ggplot( data = melt(dt, id.vars = c("date") ), 
        aes(x = date, y = value, colour = variable)) + 
  geom_line()

更新 - 分组数据

library(data.table)
library(ggplot2)
set.seed(123)
#changed the sample data a bit, to get different values for grp=1 and grp=2
dt <- data.table(grp = rep(1:2, each = 100), date = rep(as.Date('2018-01-01') + days(1:100), 2), value = 100 + cumsum(rnorm(200)))
dt[, ( paste0( "rm", windows ) ) := lapply( windows, function(x) frollmean( value, x)), by = "grp" ]
ggplot( data = melt(dt, id.vars = c("date", "grp") ), 
        aes(x = date, y = value, colour = variable)) + 
  geom_line() +
  facet_wrap(~grp, nrow = 1)

【讨论】：

非常好，但是如果我们在 dt 中有一个分组变量呢？ dt
太好了，谢谢。当我自己尝试时，我认为大警告错误是一个错误。
@Rickard 什么警告？我更新了（微小）位上方的代码，follmean（）函数中的参数有错误。将 dt$value 更改为 value.. 我没有收到任何警告（除了在 ggplot 中绘制 NA，这很有意义）。
RHS 1 的长度为 200（大于第 1 组的大小（100））。最后 100 个元素将被丢弃。 RHS 2 是长度 .... RHS 警告是由使用 frollmean(dt$value, x) 而不是 frollmean(value, x) 引起的
好的，谢谢，我猜现在它已经修复了。使用更新后的代码不再出现警告？

【解决方案2】：

在此示例中，我使用通过 getSymbols 函数从 quantmod 下载的 AAPL 调整收盘价

假设您想要具有以下长度的 SMA：

smaLength = c(30,35,40,46,53,61,70,81,93)

现在像这样创建 SMA：

lapply(smaLength,function(x) SMA(AAPL$AAPL.Adjusted,x)) %>% do.call(cbind,.) %>% tail()

结果：

                SMA    SMA.1    SMA.2    SMA.3    SMA.4    SMA.5    SMA.6    SMA.7    SMA.8
2019-03-04 167.3703 165.2570 163.3706 162.1362 161.5904 162.9735 164.7770 169.3341 175.4143
2019-03-05 168.0162 165.9396 164.0682 162.5499 161.7934 162.8342 164.6408 168.9595 174.9418
2019-03-06 168.7454 166.6585 164.7488 162.9638 162.0062 162.8110 164.6165 168.6446 174.5135
2019-03-07 169.3866 167.2323 165.3086 163.3320 162.1409 162.7868 164.5661 168.2780 174.0284
2019-03-08 170.0820 167.7646 165.8150 163.6764 162.3807 162.8711 164.5855 167.8407 173.5334
2019-03-11 170.8092 168.4419 166.4589 164.1471 162.8097 163.0354 164.6573 167.4864 173.0806

【讨论】：

【解决方案3】：

定义输入，然后在宽度上应用，为每个宽度创建一个rollmean，将它们合并在一起。最后画出来。

library(ggplot2)
library(magrittr)
library(zoo)

set.seed(123)
w <- c(1, 5, 10)
zoo(100 * cumsum(rnorm(100)), as.Date("2018-01-01") + 1:100) %>%
  lapply(w, rollmeanr, x = .) %>%
  do.call("merge", .) %>%
  setNames(w) %>%
  autoplot(facet = NULL)

【讨论】：