基于条件在R中复制行：百万级数据集性能优化求助

问题描述 #

我编写了以下R代码，但在百万条记录的大数据集上运行耗时极长，是否存在更快的解决方案？

原代码：

# Define start and end dates
start <- as.Date("2023-01-01")
end <- as.Date("2023-03-31")

create_dataframe <- function(input){
  createcolumns <- function(row) { 
    #Create date range of report
    report_range = seq.Date(from = start, 
                            to = end,
                            by = "month")
    #Create date range of caseprsn2
    input_row_range = seq.Date(from = input[row,3],
                               to = input[row,4],
                               by = "month")
    
    start_day = as.Date(intersect(as.character(report_range),as.character(input_row_range)))
    
    end_day = ceiling_date(start_day, "month") - days(1)
    
    df = data.frame(start_day, end_day)
    replicated_rows <- as.data.frame(lapply(input[row,], rep, nrow(df)))  
    cbind(df, replicated_rows)
  } #helper func to create BegMo & EndMo
  output <- data.frame() # creates an empty data frame
  output <- do.call(rbind, lapply(1:nrow(input), createcolumns))
  
  return(output)
}

代码逻辑 #

createcolumns函数逐行处理输入数据框，生成包含重叠月份区间的新行：

• 先定义报表的月份范围report_range（2023年1月至3月）
• 对每一行数据，生成该行的月份区间input_row_range
• 找出两个区间的重叠月份作为start_day，再计算每个月份的最后一天作为end_day
• 复制原行的其他列，与start_day、end_day合并，最后逐行绑定所有结果

输入输出示例 #

输入数据集：

example_df = structure(list(CaseNumber = c("00000001", "00000001", "00000002", 
"00000002", "00000003", "00000004", "00000005", "00000006", "00000006", 
"00000006"), ProgramID = c("FS", "FS", "FS", "FS", "FS", "FS", 
"FS", "FS", "FS", "FS"), BenefitMonth = structure(c(19358, 19389, 
19297, 19417, 19358, 19358, 19358, 19358, 19389, 19417), class = "Date"), 
    DerivedEndDate = structure(c(19388, 19508, 19416, 19447, 
    19508, 19388, 19508, 19388, 19416, 19508), class = "Date")), class = "data.frame", row.names = c(NA, 
-10L))

期望输出数据集：

example_df_transformed = structure(list(start_day = structure(c(19358, 19389, 19417, 19358, 
19389, 19417, 19358, 19389, 19417, 19358, 19358, 19389, 19417, 
19358, 19389, 19417), class = "Date"), end_day = structure(c(19388, 
19416, 19447, 19388, 19416, 19447, 19388, 19416, 19447, 19388, 
19388, 19416, 19447, 19388, 19416, 19447), class = "Date"), CaseNumber = c("00000001", 
"00000001", "00000001", "00000002", "00000002", "00000002", "00000003", 
"00000003", "00000003", "00000004", "00000005", "00000005", "00000005", 
"00000006", "00000006", "00000006"), ProgramID = c("FS", "FS", 
"FS", "FS", "FS", "FS", "FS", "FS", "FS", "FS", "FS", "FS", "FS", 
"FS", "FS", "FS"), BenefitMonth = structure(c(19358, 19389, 19389, 
19297, 19297, 19417, 19358, 19358, 19358, 19358, 19358, 19358, 
19358, 19358, 19389, 19417), class = "Date"), DerivedEndDate = structure(c(19388, 
19508, 19508, 19416, 19416, 19447, 19508, 19508, 19508, 19388, 
19508, 19508, 19508, 19388, 19416, 19508), class = "Date")), row.names = c(NA, 
-16L), class = "data.frame")

优化方案 #

原代码的核心问题是逐行循环处理，百万级数据下循环开销极大。我们可以用向量化操作+非等值连接替代循环，利用dplyr和lubridate的底层优化提升效率。

优化后代码 #

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

# 定义报表时间范围
start <- as.Date("2023-01-01")
end <- as.Date("2023-03-31")

# 预先生成所有报表月份的起止日期
report_months <- tibble(
  start_day = seq.Date(start, end, by = "month"),
  end_day = ceiling_date(start_day, "month") - days(1)
)

create_dataframe_fast <- function(input) {
  input %>%
    # 交叉连接所有报表月份
    crossing(report_months) %>%
    # 筛选出重叠的月份区间
    filter(
      start_day <= DerivedEndDate,
      end_day >= BenefitMonth
    ) %>%
    # 调整列顺序与原输出一致
    select(start_day, end_day, CaseNumber, ProgramID, BenefitMonth, DerivedEndDate)
}

验证结果 #

# 运行优化后的函数
result <- create_dataframe_fast(example_df)
# 对比原输出，确认结果一致
all.equal(result, example_df_transformed)

效率提升原因 #

• 原代码使用lapply逐行处理，每次循环都要生成序列、做字符串交集，重复操作多，百万行数据下时间开销呈线性增长
• 优化后的代码采用向量化操作，通过交叉连接+非等值筛选一次性完成所有行的重叠判断，利用dplyr基于C++的底层实现，避免了循环开销，处理百万级数据的速度可提升数十倍甚至上百倍

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