优化活跃用户统计For循环脚本 提升R语言数据处理速度

我有一个包含用户创建日期（Date）和删除日期（DATE_DELETION）的DataFrame：

ACTIVE_USERS <- data.frame(Date=c("2022-01-12", "2022-02-18", "2022-03-22", "2022-04-10", "2022-07-15" ) ,
                           USER_ID=c("user123","user311","user245","user245","user213"),
                           DATE_DELETION=c("2022-04-11","2022-04-12","2022-03-28","2022-07-12","2022-08-11"))

需求是生成每日活跃用户数的统计图表：用户在创建日期到删除日期之间的所有日期都视为活跃，未删除（DATE_DELETION为NA）的用户截止到当前日期。当前脚本可实现功能，但数据量大时运行极慢（耗时数小时），以下是当前实现逻辑，求优化方案。

当前实现步骤 #

1. 创建日期序列并关联原数据

Axis_X_Date <- data.frame(seq(as.Date(min(ACTIVE_USERS$DATE_CREATION)),as.Date(max(ACTIVE_USERS$DATE_CREATION)),by = 1))
colnames(Axis_X_Date) <- c("DATE_CREATION")

Axis_X_Date <- merge(Axis_X_Date, ACTIVE_USERS, by = "DATE_CREATION", all.x =TRUE , all.y = FALSE)
ACTIVE_USERS <- Axis_X_Date
rm(Axis_X_Date)
colnames(ACTIVE_USERS) <- c("DATE_CREATION", "USER_ID", "DATE_DELETION")

2. 计算活跃时长

ACTIVE_USERS$Age_Days <- ACTIVE_USERS$DATE_DELETION - ACTIVE_USERS$Date

3. 循环生成每日活跃记录

table_page_all <- data.frame()

for(i in 1:nrow(ACTIVE_USERS)){
  
  # 处理DATE_DELETION为NA的情况（仍活跃用户），设为当前日期
  ifelse( is.na(ACTIVE_USERS$DATE_DELETION[i] ), ACTIVE_USERS$DATE_DELETION[i] <- today_date, ACTIVE_USERS$DATE_DELETION[i]) 
  
  # 生成用户活跃的所有日期，并复制对应用户ID
  Dates_Active <- seq(ACTIVE_USERS$Date[i], ACTIVE_USERS$DATE_DELETION[i], by="days")
  Ref_ID <- rep(ACTIVE_USERS$USER_ID[i], length(Dates_Active))
  
  # 组合日期与用户ID，并合并到结果表
  data_frame <- data.frame(Dates_Active, Ref_ID)
  
  table_page_all  <- rbind(table_page_all, data_frame)
  
  cat('Row: ', i , 'out of', nrow(ACTIVE_USERS), '\n')
  
}

优化方案 #

原代码的核心性能问题 #

• 步骤1的合并操作完全冗余，反而增加无效数据行，浪费内存与计算资源
• 循环中反复使用rbind合并数据框是性能杀手：每次rbind都会复制整个已有数据，随着数据量增大，耗时呈指数级增长
• 逐行处理ifelse效率低下，未利用R的向量化操作优势

高效实现方案（两种可选） #

方案1：用dplyr + tidyr实现（代码简洁，易读性高）

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

# 1. 统一处理日期格式，替换缺失的删除日期为当前日期
ACTIVE_USERS_clean <- ACTIVE_USERS %>%
  mutate(
    Date = ymd(Date),
    DATE_DELETION = ymd(DATE_DELETION),
    DATE_DELETION = if_else(is.na(DATE_DELETION), today(), DATE_DELETION)
  )

# 2. 生成每个用户的活跃日期序列并展开，最后统计每日活跃数
daily_active <- ACTIVE_USERS_clean %>%
  # 为每个用户生成活跃日期区间的序列
  mutate(active_dates = map2(Date, DATE_DELETION, seq, by = "day")) %>%
  # 展开日期序列为单行记录
  unnest(active_dates) %>%
  # 去重：同一个用户同一天只计数一次
  distinct(active_dates, USER_ID) %>%
  # 按日期统计活跃用户数量
  count(active_dates, name = "active_user_count")

方案2：用data.table实现（大数据量下性能最优）

library(data.table)
library(lubridate)

# 转换为data.table格式，提升操作效率
setDT(ACTIVE_USERS)

# 1. 处理日期格式与缺失值
ACTIVE_USERS[, `:=`(
  Date = ymd(Date),
  DATE_DELETION = ymd(DATE_DELETION),
  DATE_DELETION = fifelse(is.na(DATE_DELETION), today(), DATE_DELETION)
)]

# 2. 生成活跃日期序列、去重、统计每日活跃数
daily_active <- ACTIVE_USERS[, .(active_dates = seq(Date, DATE_DELETION, by = "day")), by = USER_ID] %>%
  # 去重避免同一用户同一天重复计数
  unique(by = c("active_dates", "USER_ID")) %>%
  # 按日期统计用户数
  .[, .(active_user_count = .N), by = active_dates]

优化效果说明 #

• 两种方案都用向量化操作替代了逐行循环，避免了rbind的性能损耗
• data.table方案在百万级以上数据量下优势更明显，内存占用更低、运行速度更快
• 自动处理日期格式与缺失值，同时通过去重确保统计结果准确

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