三个月内每五个月滚动一次

【问题标题】：Rolling mean every five months over three months三个月内每五个月滚动一次
【发布时间】：2018-08-15 21:04:47
【问题描述】：

我想计算滚动平均值，规格如下：

  • 在给定月份的月底开始，例如五月
  • 使用过去三个月的（每日）数据计算此期间的平均值
  • 注意：特定月份中的某些日期可能存在缺失值，并且每个月的天数可能会有所不同，这使得每次计算的观察次数通常是可变的
  • 向前 5 个月重复此计算，例如如果在 5 月是最后一次计算，在 10 月底等，则窗口每 5 个月滑动一次，并分别使用最近 3 个可用月份的数据[假设数据从 2018 年 3 月开始，第一个窗口将是：3-4-5 月 18 日，然后是 8-9-10 月 18 日等]
  • 数据集/内存的大小对我来说很重要，因为我的真实数据集非常大

当width参数可变，窗口滑动时，我找了半天也没找到明确的解决办法。我特别在zoo 中寻找解决方案。 datatable 和 plyr（或 xts）也很有趣。

示例数据（注意：这里没有缺失值，因为我不能轻易删除数据表中的行）

set.seed(44)  
dataset <- data.table(ID=c(rep("A",2208),rep("B",2208)),
x = c(rnorm(2208*2)), time=c(seq(as.Date("1988/03/15"),
as.Date("2000/04/16"), "day"),seq(as.Date("1988/03/15"),
as.Date("2000/04/16"), "day")))

数据集包含 2 个个体 A 和 B 的数据点“x”，可用于计算平均值。

【问题讨论】：

    标签： r datatable plyr xts zoo


    【解决方案1】：

    下面我们使用最后注释中显示的数据，而不是问题中的示例数据。

    1) 2 rollapply 创建一个年/月变量ym，然后将每个ID和年/月的值相加，同时计算每个ID和年/月的值的数量。然后将总和的滚动总和除以相应的计数的滚动总和除以 ID。

    library(data.table)
library(zoo)

ym <- as.yearmon(dataset$time)
roll <- function(x) rollapplyr(x, 3, by = 5, sum, fill = NA)
ds <- na.omit(dataset[, list(x = sum(x), n = .N), by = list(ID, time = ym)][
 , list(time, mean = roll(x) / roll(n)), by = ID])

    给予：

    > ds
    ID     time         mean
 1:  A May 1988 -0.118017121
 2:  A Oct 1988 -0.045631016
 3:  A Mar 1989 -0.035498703
 4:  A Aug 1989 -0.055121507
 5:  A Jan 1990  0.018735210
 6:  A Jun 1990  0.091084791
 7:  A Nov 1990 -0.183955430
 8:  A Apr 1991  0.011909178
 9:  A Sep 1991 -0.040233435
10:  A Feb 1992  0.051567634
11:  A Jul 1992  0.006015941
12:  A Dec 1992  0.253320798
13:  A May 1993 -0.037722177
14:  A Oct 1993 -0.145811906
15:  A Mar 1994  0.134181429
16:  A Aug 1994 -0.119081185
17:  A Jan 1995  0.001921224
18:  A Jun 1995  0.232193754
19:  A Nov 1995 -0.077158954
20:  A Apr 1996 -0.070271862
21:  A Sep 1996  0.033858600
22:  A Feb 1997 -0.053623676
23:  A Jul 1997 -0.201388554
24:  A Dec 1997  0.051488747
25:  A May 1998 -0.073193772
26:  A Oct 1998 -0.094019699
27:  A Mar 1999 -0.078863959
28:  A Aug 1999  0.110231533
29:  A Jan 2000  0.141657202
30:  B May 1988  0.130180515
31:  B Oct 1988  0.025095818
32:  B Mar 1989 -0.032415997
33:  B Aug 1989  0.041286368
34:  B Jan 1990  0.219208544
35:  B Jun 1990 -0.023717715
36:  B Nov 1990 -0.049073449
37:  B Apr 1991 -0.051479646
38:  B Sep 1991  0.124340203
39:  B Feb 1992  0.040786822
40:  B Jul 1992  0.019159682
41:  B Dec 1992  0.083195470
42:  B May 1993  0.006695704
43:  B Oct 1993  0.119093846
44:  B Mar 1994  0.077608445
45:  B Aug 1994  0.132860266
46:  B Jan 1995 -0.225050074
47:  B Jun 1995 -0.091877628
48:  B Nov 1995 -0.157798169
49:  B Apr 1996 -0.219238136
50:  B Sep 1996  0.289506566
51:  B Feb 1997  0.118216626
52:  B Jul 1997  0.186950994
53:  B Dec 1997 -0.035447587
54:  B May 1998 -0.159754318
55:  B Oct 1998 -0.066470703
56:  B Mar 1999  0.230782925
57:  B Aug 1999 -0.052620748
58:  B Jan 2000 -0.190938190
    ID     time         mean

    2) 1 rollapply 上面的一个变体如下。它使用by.column = FALSE，因此mean2 可以同时处理x 和n。

    library(data.table)
library(zoo)

ym <- as.yearmon(dataset$time)
mean2 <- function(xn) sum(xn[, 1]) / sum(xn[, 2])
roll2 <- function(x) rollapplyr(x, 3, by = 5, mean2, by.column = FALSE, fill = NA)
ds2 <- na.omit(dataset[, list(x = sum(x), n = .N), by = list(ID, time = ym)][
 , list(time, mean = roll2(.SD)), .SDcols = c("x", "n"), by = ID])

    3) 向量宽度

    我们可以像这样定义一个向量宽度并在其上滚动。我们将宽度设置为大于那些不在月末的日期的元素数量，以便它不会计算这些日期的平均值。然后，我们计算每个月末的平均值，并在最后一行代码中将其细分为每 5 个月一次。

    library(data.table)
library(zoo)

ds3 <- dataset[, list(ID, time = as.yearmon(time), x)][, 
  list(time, x, width = seq_len(.N) - match(time - 2/12, time) + 1,
       is_last = !duplicated(time, fromLast = TRUE)), by = ID][, 
  list(time, x, width = na.fill(ifelse(is_last, width, .N + 1), .N+1)), by = ID][, 
  list(time, mean = rollapplyr(x, width, mean, fill = NA_real_)), 
  by = ID][, na.omit(.SD)[seq(1, .N, 5), ], by = ID]

    4) data.table join 这使用 data.table join 而不是 rollapply。 eom 是一个仅包含月末行的 data.table。它还有一个列 time2 代表 2 个月前的 yearmon。我们将其与 datasetym 连接并提取适当的行和列。

    library(data.table)
library(zoo)

datasetym <- dataset[, list(ID, time = as.yearmon(time), x)]
eom <- datasetym[, .SD[!duplicated(time, fromLast = TRUE), ], by = ID][
  , cbind(.SD, time2 = time - 2/12)]
ds4 <- datasetym[eom, list(mean = mean(x)), 
  on = .(ID, time >= time2, time <= time), by = .EACHI][
  , .SD[seq(3, .N, 5), -2], by = ID]

    5) sqldf 您可能更喜欢使用更熟悉的 SQL 语法来表达连接。创建datasetym 并每隔 5 行获取一次，如 (4) 所述。

    library(data.table)
library(sqldf)
library(zoo)

datasetym <- dataset[, list(ID, time = as.yearmon(time), x)]
s <- sqldf("select a.ID, a.time, avg(b.x) mean
       from (select ID, time from datasetym group by ID, time) a
       left join datasetym b
       on a.ID = b.ID and b.time between a.time - 2.0/12.0 and a.time
       group by a.ID, a.time")
ds5 <- data.table(s)[, .SD[seq(3, .N, 5), ], by = ID]

    6) zoo 如果我们使用宽格式，我们可以只使用 zoo 来解决这个问题。如果需要，我们可以随时转换回长格式（如注释行所示）。

    library(zoo)

z <- read.zoo(dataset, index = "time", split = "ID")
zsum <- aggregate(z, as.yearmon, sum)
zlength <- aggregate(z, as.yearmon, length)
zroll <- rollapplyr(zsum, 3, by = 5, sum) / rollapplyr(zlength, 3, by = 5, sum)
# fortify(zroll, melt = TRUE)  # if long form wanted

    给予：

    > zroll
                    A            B
May 1988 -0.118017121  0.130180515
Oct 1988 -0.045631016  0.025095818
Mar 1989 -0.035498703 -0.032415997
Aug 1989 -0.055121507  0.041286368
Jan 1990  0.018735210  0.219208544
Jun 1990  0.091084791 -0.023717715
Nov 1990 -0.183955430 -0.049073449
Apr 1991  0.011909178 -0.051479646
Sep 1991 -0.040233435  0.124340203
Feb 1992  0.051567634  0.040786822
Jul 1992  0.006015941  0.019159682
Dec 1992  0.253320798  0.083195470
May 1993 -0.037722177  0.006695704
Oct 1993 -0.145811906  0.119093846
Mar 1994  0.134181429  0.077608445
Aug 1994 -0.119081185  0.132860266
Jan 1995  0.001921224 -0.225050074
Jun 1995  0.232193754 -0.091877628
Nov 1995 -0.077158954 -0.157798169
Apr 1996 -0.070271862 -0.219238136
Sep 1996  0.033858600  0.289506566
Feb 1997 -0.053623676  0.118216626
Jul 1997 -0.201388554  0.186950994
Dec 1997  0.051488747 -0.035447587
May 1998 -0.073193772 -0.159754318
Oct 1998 -0.094019699 -0.066470703
Mar 1999 -0.078863959  0.230782925
Aug 1999  0.110231533 -0.052620748
Jan 2000  0.141657202 -0.190938190

    注意

    请注意，问题中定义的dataset 有 8832 行，但用于定义 ID 列的向量只有 4416 个元素，因此它会被回收，结果是前 2216 个日期在 A 中出现了两次，而根本没有在 B 中，接下来的 2216 日期在 B 中出现两次，而在 A 中根本没有。大概这不是预期的结果，我们通过在数据集的定义中将每次出现的 2208 替换为 4416 来解决此问题，以便每个日期出现一次在 A 中，在 B 中一次：

    set.seed(44)  
dataset <- data.table(ID = c(rep("A", 4416), rep("B", 4416)),
  x = rnorm(4416 * 2), 
  time = c(seq(as.Date("1988/03/15"), as.Date("2000/04/16"), "day")))

    【讨论】：

    • 只有一个问题：您在哪里设置：by.column = FALSE 在变体代码中？
    • 如果问题是如何进行滚动关联，那么如果x 有两列rollapplyr(x, width, function(x) cor(x[,1],x[,2]), by.column=FALSE, fill = NA)
    • 宽度可以是一个向量，你可以预先计算出来。
    • 宽度必须是数字，而不是字符。无论如何，我添加了第三种使用矢量宽度的解决方案。最后还加了注。还添加了 (4) 和 (5)。
    • 已添加 (6) 个。
    猜你喜欢
    • 1970-01-01
    • 2020-09-03
    • 2023-03-21
    • 1970-01-01
    • 1970-01-01
    • 2019-02-16
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode