优化 expand/pivot_wider R 以标记时间段的所有月份

Posted 2023-02-14

【中文标题】优化 expand/pivot_wider R 以标记时间段的所有月份

【英文标题】：Optimize expand/pivot_wider R to tag all months of a time period

【发布时间】：2022-01-17 21:14:34

【问题描述】：

我正在处理一个包含 130 万行和 4 列的数据集，每个策略 1 行，每个策略都有一个开始日期和一个结束日期。 我的目标是确定我每月获得多少有效策略，即在每个时间间隔 [deb;fin] 内，每个月有多少 obs。

使用 tidyverse，我设法创建了以下代码，这在小型数据集上很有效，但在上述输入数据集上运行需要将近 50 分钟。

关于优化 expand > pivot_wider 流程​​的任何建议？或者也许我没有以正确的方式做这件事？ 非常感谢您的想法！

library(tidyverse)
library(lubridate)

n <- 200

df <- data.frame(id = (1:n),
                 deb = sample(seq(as.Date('2020/01/01'), as.Date('2020/04/01'), by="day"), n, replace = T),
                 fin = sample(seq(as.Date('2020/05/01'), as.Date('2020/07/01'), by="day"), n, replace = T)
                 )

system.time((df2 <- df %>% 
              select(id, deb, fin) %>%
              group_by(id, deb, fin) %>% 
              expand(dtmonth = format(seq.Date(floor_date(deb, "month"),
                                               ceiling_date(fin, "month")-1,
                                               by = "month"), "%Y-%m")) %>%
              mutate(nb = 1) %>%
              pivot_wider(names_from = dtmonth, values_from = nb)))

【问题讨论】：

我现在无法提供测试代码，但您是否考虑过使用pivot_longer？与其每个活跃月有一个列，每个ID有一个观察，不如每个ID每个月有一个观察，然后按月分组并总结？

【参考方案1】：

这应该会快一点。它仅使用 base R 日期函数和 sapply

seqMon <- strftime( seq.Date( from=min(c(df$deb, df$fin)), 
  to=max(c(df$deb, df$fin)), by="month" ), format="%Y-%m" )

df2 <- cbind( df, sapply( seqMon, function(x) 
  strftime( df$deb, format="%Y-%m" ) <= x & strftime( df$fin, format="%Y-%m" ) >= x ) )

head(df2)
  id        deb        fin 2020-01 2020-02 2020-03 2020-04 2020-05 2020-06
1  1 2020-02-19 2020-05-24   FALSE    TRUE    TRUE    TRUE    TRUE   FALSE
2  2 2020-03-09 2020-05-15   FALSE   FALSE    TRUE    TRUE    TRUE   FALSE
3  3 2020-01-12 2020-05-26    TRUE    TRUE    TRUE    TRUE    TRUE   FALSE
4  4 2020-01-08 2020-05-05    TRUE    TRUE    TRUE    TRUE    TRUE   FALSE
5  5 2020-03-16 2020-05-29   FALSE   FALSE    TRUE    TRUE    TRUE   FALSE
6  6 2020-03-11 2020-06-03   FALSE   FALSE    TRUE    TRUE    TRUE    TRUE
  2020-07
1   FALSE
2   FALSE
3   FALSE
4   FALSE
5   FALSE
6   FALSE

获得 1 和 NA

df2[,4:10][df2[,4:10] == FALSE] <- NA
df2[,4:10] <- df2[,4:10] * 1

 head(df2)
  id        deb        fin 2020-01 2020-02 2020-03 2020-04 2020-05 2020-06
1  1 2020-02-19 2020-05-24      NA       1       1       1       1      NA
2  2 2020-03-09 2020-05-15      NA      NA       1       1       1      NA
3  3 2020-01-12 2020-05-26       1       1       1       1       1      NA
4  4 2020-01-08 2020-05-05       1       1       1       1       1      NA
5  5 2020-03-16 2020-05-29      NA      NA       1       1       1      NA
6  6 2020-03-11 2020-06-03      NA      NA       1       1       1       1
  2020-07
1      NA
2      NA
3      NA
4      NA
5      NA
6      NA