如何用purrr按行处理df1，汇总df2并为df1添加汇总列？

问题 #

我有两个时间序列数据集，每个时间点都有测量值。df1每30分钟一个采样点，df2每5分钟一个采样点。我想关联这两个数据集，但需要先汇总df2，使其也变为每30分钟一个值。不过这些时间间隔并不总是固定的，我想到了当前的解决方案，但需要将该操作应用到df1的每一行。我认为可以用purrr函数按行映射自定义函数，但还没理清具体实现方式。

已完成的操作 #

0 - 加载包

library(lubridate)
library(tidyverse)
library(wakefield)
library(magrittr)

1 - 生成示例虚拟数据集

df1 <- data.frame(date_time = format(seq(as.POSIXct("2021-01-01 00:00:00", tz="GMT"), 
                                     as.POSIXct("2021-01-01 02:30:00", tz="GMT"), 
                                     by='30 min'), "%d-%m-%Y %H:%M:%S"), 
              other_vars = upper(6, k = 5, x = LETTERS, prob = NULL, name = "Upper"))


df2 <- data.frame(date_time = format(seq(as.POSIXct("2021-01-01 00:00:00", tz="GMT"), 
                                     as.POSIXct("2021-01-01 02:30:00", tz="GMT"), 
                                     by='5 min'), "%d-%m-%Y %H:%M:%S"),
              num_var1 = runif(31, 0, 255), 
              num_var2 = runif(31, 0, 255))

2 - 在df1中添加下一行的时间作为新列

df1 %<>% 
  mutate(date_time_lead = lead(date_time))

3 - 筛选df2中时间处于df1第1行时间区间内的行，并汇总数值（均值、标准差、求和）

df2_sub <- df2  %>% 
  filter(date_time >= df1$date_time[1] & date_time < df1$date_time_lead[1]) %>% 
  summarise(var1_mean = mean(num_var1, na.rm = T), 
            var1_sd = sd(num_var1, na.rm = T), 
            var1_sum = sum(num_var1, na.rm = T),
            var2_mean = mean(num_var2, na.rm = T), 
            var2_sd = sd(num_var2, na.rm = T), 
            var2_sum = sum(num_var2, na.rm = T))

4 - 在df1中生成新列

df1$var1_mean <- NA
df1$var1_sd <- NA
df1$var1_sum <- NA
df1$var2_mean <- NA
df1$var2_sd <- NA
df1$var2_sum <- NA

5 - 将新生成的汇总值添加到df1的第1行

df1[1, 4:9] <- df2_sub[1,]

解决方案 #

方法1：用purrr::pmap按行映射自定义函数 #

把筛选汇总逻辑封装成函数，再遍历df1每一行批量处理：

# 定义汇总函数，接收时间区间的起始和结束时间
summarize_df2 <- function(start_time, end_time) {
  df2 %>% 
    filter(date_time >= start_time & date_time < end_time) %>% 
    summarise(var1_mean = mean(num_var1, na.rm = TRUE), 
              var1_sd = sd(num_var1, na.rm = TRUE), 
              var1_sum = sum(num_var1, na.rm = TRUE),
              var2_mean = mean(num_var2, na.rm = TRUE), 
              var2_sd = sd(num_var2, na.rm = TRUE), 
              var2_sum = sum(num_var2, na.rm = TRUE))
}

# 处理df1最后一行的空值：用df2的最后一个时间作为区间终点
df1 <- df1 %>% 
  mutate(date_time_lead = ifelse(is.na(date_time_lead), max(df2$date_time), date_time_lead))

# 遍历df1每一行，生成所有区间的汇总结果
summary_results <- df1 %>% 
  select(date_time, date_time_lead) %>% 
  pmap_dfr(summarize_df2)

# 将汇总结果合并到df1中
df1 <- bind_cols(df1, summary_results)

方法2：高效模糊匹配（无需逐行循环） #

如果只是偶尔存在时间间隔不固定的情况，用模糊匹配批量关联区间再汇总，效率更高：

library(fuzzyjoin)

# 先将字符格式的时间转回POSIXct类型，方便区间比较
df1 <- df1 %>% mutate(across(c(date_time, date_time_lead), as.POSIXct, tz="GMT"))
df2 <- df2 %>% mutate(date_time = as.POSIXct(date_time, tz="GMT"))

# 模糊匹配df2到df1的时间区间
joined_df <- fuzzy_left_join(
  df2, df1,
  by = c("date_time" = "date_time", "date_time" = "date_time_lead"),
  match_fun = list(`>=`, `<`)
)

# 按df1的分组汇总数据
summary_df <- joined_df %>% 
  group_by(date_time.y, other_vars, date_time_lead.y) %>% 
  summarise(var1_mean = mean(num_var1, na.rm = TRUE), 
            var1_sd = sd(num_var1, na.rm = TRUE), 
            var1_sum = sum(num_var1, na.rm = TRUE),
            var2_mean = mean(num_var2, na.rm = TRUE), 
            var2_sd = sd(num_var2, na.rm = TRUE), 
            var2_sum = sum(num_var2, na.rm = TRUE),
            .groups = "drop") %>% 
  rename(date_time = date_time.y, date_time_lead = date_time_lead.y)

内容的提问来源于stack exchange，提问作者Virginia Morera Pujol