如何用dplyr更简洁实现分组汇总：按月份生成鸟类检测标记

问题背景 #

我有一个名为df的dataframe，包含近5年约250只命名鸟类个体的所有检测数据（共约11000行），列包含DATE、BIRD、YEAR、MONTH、DAY和OUTCOME。需要生成新表df2：每行对应一只鸟类个体，每个月份对应一列（列名格式为YYMM，如2020年3月对应2003），若该月该鸟类有检测记录（OUTCOME=1）则标记为1，未检测到则标记为0。目前手动为每个月份编写代码的方式过于冗长，希望通过指定起始日期startdate和结束日期enddate实现自动化。

示例数据 #

df <- data.frame(DATE = as.Date(c("02/16/18","03/16/18","03/16/18","04/16/18","05/16/18","05/19/18"),
                                format = "%m/%d/%y"),
                 BIRD = c("emww","emww","oaam","bbcm","bbcm","bbcm"),
                 YEAR = c(2018,2018,2018,2018,2018,2018),
                 MONTH = c(02,03,03,04,05,05),
                 OUTCOME = c(1,0,1,1,0,0))

指定日期范围 #

startdate <- as.Date("02/16/18", format = "%m/%d/%y")
enddate <- as.Date("12/16/23", format = "%m/%d/%y")

解决方案 #

方法一：使用tidyr::pivot_wider（推荐） #

这种方法无需手动生成月份列，直接通过数据重塑实现需求，步骤清晰简洁：

1. 过滤指定日期范围内的数据，生成YYMM格式的月份标识
2. 按BIRD和YYMM分组，标记该鸟该月是否存在OUTCOME=1的记录
3. 用pivot_wider将月份转为列，缺失的月份自动填充为0；若需要确保所有日期范围内的月份都存在，可额外生成完整月份序列补全

library(dplyr)
library(tidyr)
library(lubridate)

# 预处理数据：生成YYMM列并标记月度检测状态
df_processed <- df %>%
  filter(DATE >= startdate, DATE <= enddate) %>%
  mutate(YYMM = format(DATE, "%y%m")) %>%
  group_by(BIRD, YYMM) %>%
  summarise(has_detection = as.numeric(any(OUTCOME == 1)), .groups = "drop")

# 重塑为宽表，缺失月份填充为0
df2 <- df_processed %>%
  pivot_wider(
    id_cols = BIRD,
    names_from = YYMM,
    values_from = has_detection,
    values_fill = 0
  )

# 可选：补全日期范围内的所有月份（包括无任何检测记录的月份）
all_months <- seq.Date(
  floor_date(startdate, "month"),
  floor_date(enddate, "month"),
  by = "month"
) %>% format("%y%m")

df2 <- df2 %>%
  mutate(across(all_of(setdiff(all_months, colnames(.))), ~0)) %>%
  select(BIRD, all_of(all_months))

方法二：动态生成summarise表达式 #

如果需要保留group_by/summarise的结构，可通过动态生成表达式实现自动化，避免手动编写每一行代码：

library(dplyr)
library(lubridate)
library(purrr)

# 生成日期范围内的所有月份信息：YYMM格式列、年份、月份
month_seq <- seq.Date(floor_date(startdate, "month"), floor_date(enddate, "month"), by = "month")
month_info <- tibble(
  YYMM = format(month_seq, "%y%m"),
  YEAR = year(month_seq),
  MONTH = month(month_seq)
)

# 动态生成每个月份的summarise表达式
summarise_exprs <- map2(month_info$YEAR, month_info$MONTH, function(y, m) {
  expr(as.numeric(any(YEAR == !!y & MONTH == !!m & OUTCOME == 1)))
}) %>% set_names(month_info$YYMM)

# 执行分组汇总
df2 <- df %>%
  group_by(BIRD) %>%
  summarise(!!!summarise_exprs, .groups = "drop")

方法说明 #

• 方法一的pivot_wider是tidyverse生态下的标准数据重塑方式，代码简洁易维护，适合大多数场景
• 方法二直接对应原有group_by/summarise的思路，通过动态表达式实现自动化，适合需要保留该代码结构的场景

内容的提问来源于stack exchange，提问作者chill