加速R语言DataFrame展开：17万行数据处理耗时过长问题排查

现有数据与处理需求 #

我有如下旅行预订数据：

library(dplyr)
library(zoo) # 注：原代码依赖yearmonth函数，需加载zoo包

bookings <- data.frame(
  Route = 'AB', 
  DepartureMonth = rep(yearmonth("2013-11"),9),
  EffectiveFrom = c(rep(yearmonth("2013-07"),5), rep(yearmonth("2013-08"),4)),
  EffectiveTo = c("2013-08", "2013-09", "2013-10", "2013-11", "2199-12",
                  "2013-09", "2013-10", "2013-11", "2199-12"),
  ConfirmedBooking = c(16, 6, 8, 15, 15, 76, 95, 81, 202)
) %>%
  mutate(EffectiveTo = yearmonth(EffectiveTo))

数据输出：

Route DepartureMonth EffectiveFrom EffectiveTo ConfirmedBooking
AB      2013 nov.       2013 july    2013 aug.              16
AB      2013 nov.       2013 july    2013 sept.             6
AB      2013 nov.       2013 july    2013 oct.              8
AB      2013 nov.       2013 july    2013 nov.              15
AB      2013 nov.       2013 july    2199 dec.              15
AB      2013 nov.       2013 aug.    2013 sept.             76
AB      2013 nov.       2013 aug.    2013 oct.              95
AB      2013 nov.       2013 aug.    2013 nov.              81
AB      2013 nov.       2013 aug.    2199 dec.              202

我需要获取出发前指定月末的预订总量，编写了以下代码：

library(purrr)

booking_month_decomposition <- function(Route, DepartureMonth, EffectiveFrom, EffectiveTo, ConfirmedBooking) {
  end_month = if_else(EffectiveTo < DepartureMonth, EffectiveTo, DepartureMonth)
  maxiter = end_month - EffectiveFrom
  
  return(map_dfr(1:maxiter, function(x) data.frame(Route = Route, DepartureMonth=DepartureMonth,
                                                   BookingMonth=EffectiveFrom + x -1,
                                                   ConfirmedBooking=ConfirmedBooking)))
}

bookings %>% pmap_dfr(booking_month_decomposition) %>%
  group_by(Route, DepartureMonth, BookingMonth) %>%
  summarise(ConfirmedBooking = sum(ConfirmedBooking)) %>%
  ungroup()

输出结果符合预期：

Route DepartureMonth BookingMonth ConfirmedBooking
AB      2013 nov.       2013 july              60
AB      2013 nov.       2013 aug.             498
AB      2013 nov.       2013 sept.            416
AB      2013 nov.       2013 oct.             313

但处理17万行原始数据时，代码耗时近1小时，核心问题出在booking_month_decomposition函数运行过慢，怀疑是purrr的使用方式有误。

问题根源与优化方案 #

核心问题 #

原代码用pmap_dfr逐行处理每条记录，且在循环内反复创建小数据框后再绑定。这种方式在大数据量下会产生巨大的内存和IO开销——每个小数据框的初始化、绑定操作都有额外成本，是性能瓶颈的核心原因。purrr本身没问题，但这里的用法不是最优解，应该用向量化操作替代逐行循环。

优化后的代码 #

方法1：用tidyr::uncount实现向量化展开（性能最优）

通过计算每条记录需要覆盖的月份数，一次性展开所有行，再计算对应月份：

library(dplyr)
library(tidyr)
library(zoo)

bookings_processed <- bookings %>%
  # 计算每个记录的实际结束月份（不晚于出发月）
  mutate(
    end_month = if_else(EffectiveTo < DepartureMonth, EffectiveTo, DepartureMonth),
    # 计算需要展开的月份数量
    num_months = as.integer(end_month - EffectiveFrom) + 1
  ) %>%
  # 按月份数展开行
  uncount(num_months, .id = "month_offset") %>%
  # 计算对应的预订月份
  mutate(BookingMonth = EffectiveFrom + month_offset - 1) %>%
  # 分组求和得到每月总预订量
  group_by(Route, DepartureMonth, BookingMonth) %>%
  summarise(ConfirmedBooking = sum(ConfirmedBooking), .groups = "drop")

方法2：用rowwise+unnest生成月份序列

如果需要保留类似原逻辑的写法，也可以用rowwise生成每行的月份序列后展开，性能优于原方法：

library(dplyr)
library(tidyr)
library(zoo)

bookings_processed <- bookings %>%
  rowwise() %>%
  mutate(
    end_month = if_else(EffectiveTo < DepartureMonth, EffectiveTo, DepartureMonth),
    # 生成当前记录覆盖的所有月份序列
    BookingMonth = list(seq(EffectiveFrom, end_month, by = 1))
  ) %>%
  # 展开序列为行
  unnest(BookingMonth) %>%
  # 分组求和
  group_by(Route, DepartureMonth, BookingMonth) %>%
  summarise(ConfirmedBooking = sum(ConfirmedBooking), .groups = "drop")

效果说明 #

优化后的代码全程采用向量化操作，避免了大量小数据框的创建与绑定，处理17万行数据的时间会大幅缩短（通常能压缩到几分钟以内）。

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