高效R语言实现：为数据框每行分配Vintage时间戳

规则回顾 #

• 核心目标：为每行标记客户成为新增（NEW Movement）的日期
• 若客户首次出现时标记为EXISTING，Vintage设为Back Book
• 同一客户后续出现NEW标记时，Vintage更新为该条目的Date
• NEW之后的EXISTING条目，沿用最近一次NEW的Date
• 客户再次出现NEW时，Vintage更新为新NEW条目的Date

示例数据集 #

library(tibble)
sample_data <- tibble(
  Name = c("Alice", "Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie", "Charlie"),
  Date = as.Date(c("2023-01-01", "2023-02-01", "2023-03-01", "2023-01-01", "2023-02-01", "2023-01-01", "2023-02-01", "2023-03-01")),
  Movement = c("EXISTING", "NEW", "EXISTING", "NEW", "EXISTING", "EXISTING", "EXISTING", "NEW")
)

方案1：dplyr向量化实现（简洁高效） #

通过分组窗口操作替代逐行计算，避免rowwise()的性能损耗：

library(dplyr)
library(zoo)

result_dplyr <- sample_data %>%
  arrange(Name, Date) %>%  # 按客户+日期排序，确保时间顺序正确
  group_by(Name) %>%
  mutate(
    # 提取所有NEW行的日期，非NEW行设为NA
    new_dates = if_else(Movement == "NEW", as.character(Date), NA_character_),
    # 向前填充NA，实现"沿用最近一次NEW日期"
    new_dates = na.locf(new_dates, na.rm = FALSE),
    # 处理首次为EXISTING的特殊情况
    Vintage = case_when(
      row_number() == 1 & Movement == "EXISTING" & is.na(new_dates) ~ "Back Book",
      TRUE ~ new_dates
    )
  ) %>%
  select(-new_dates) %>%
  ungroup()

方案2：data.table极致性能（适配百万级数据） #

针对超大数据集，data.table的分组操作速度远优于dplyr：

library(data.table)
library(zoo)

# 转换为data.table并排序
dt <- as.data.table(sample_data)
setorder(dt, Name, Date)

result_dt <- dt[, {
  # 提取NEW日期并向前填充
  new_dates <- fifelse(Movement == "NEW", as.character(Date), NA_character_)
  new_dates <- na.locf(new_dates, na.rm = FALSE)
  # 处理首次为EXISTING的场景
  Vintage <- ifelse(.I[1] == .GRP & Movement[1] == "EXISTING" & is.na(new_dates[1]), 
                    "Back Book", 
                    new_dates)
  .(Date, Movement, Vintage)
}, by = Name]

性能说明 #

两种方案均采用向量化/窗口操作，完全规避逐行计算的低效问题：

• 10万行数据处理时间通常在几秒内，相比rowwise()+自定义函数的20分钟，性能提升超100倍
• 若数据集持续增长至百万级，data.table方案的优势会更显著

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