如何优化以下R代码的运行处理时间？

针对你提到的两个统计目标，抛弃嵌套ddply的低效写法，改用data.table或**dplyr（tidyverse）**的向量化操作，配合合理的并行策略，能大幅提升运行速度，具体方案如下：

数据预处理前提 #

先确保o3.month.date为日期类型，生成标准化的“当前月份”和“上个月”字段，避免日期细节干扰分组：

library(lubridate)
# 标准化为当月第一天，统一分组维度
df$curr_month <- floor_date(df$o3.month.date, "month")
# 生成上一个月的标准化日期
df$prev_month <- df$curr_month %m-% months(1)

目标1：统计每个aid-pid对上上个月的合作项目数 #

用data.table实现（性能最优） #

library(data.table)
setDT(df)

# 第一步：按aid、pid、当前月分组，统计每组的项目数
monthly_pairs <- df[, .(project_count = uniqueN(oid)), by = .(aid, pid, curr_month)]

# 第二步：按aid-pid分组，取上一个月的项目数作为结果
result1 <- monthly_pairs[, 
                         prev_month_projects := shift(project_count, type = "lag"), 
                         by = .(aid, pid)]

# 按需保留字段
result1 <- result1[, .(aid, pid, curr_month, prev_month_projects)]

用dplyr实现 #

library(dplyr)

result1 <- df %>%
  distinct(aid, pid, curr_month, oid) %>% # 去重避免重复计数同一项目
  count(aid, pid, curr_month, name = "project_count") %>%
  group_by(aid, pid) %>%
  mutate(prev_month_projects = lag(project_count)) %>% # 取上一个月的计数
  ungroup() %>%
  select(aid, pid, curr_month, prev_month_projects)

目标2：当前月份内，按p3.role分组的aid-pid合作经历平均值 #

这里默认“合作经历”指每个aid-pid在当前月内的合作项目数，按角色分组求平均值：

用data.table实现 #

result2 <- df[, 
             # 先统计每个aid-pid在当前月的项目数
             .(pair_projects = uniqueN(oid)), 
             by = .(aid, pid, curr_month, p3.role)] %>%
  # 按角色和当前月分组，计算平均值
  .[, .(avg_pair_projects = mean(pair_projects)), 
    by = .(curr_month, p3.role)]

用dplyr实现 #

result2 <- df %>%
  distinct(aid, pid, curr_month, p3.role, oid) %>%
  count(aid, pid, curr_month, p3.role, name = "pair_projects") %>%
  group_by(curr_month, p3.role) %>%
  summarize(avg_pair_projects = mean(pair_projects), .groups = "drop")

并行优化的正确姿势 #

仅当数据量达到百万级以上时考虑并行，避免小数据并行带来的额外开销：

data.table + future.apply #

library(future.apply)
plan(multisession) # 开启多核并行

# 按角色拆分任务并行计算
result2_parallel <- future_lapply(unique(df$p3.role), function(role) {
  subset_df <- df[p3.role == role]
  subset_df[, .(pair_projects = uniqueN(oid)), by = .(aid, pid, curr_month)] %>%
    .[, .(avg_pair_projects = mean(pair_projects)), by = curr_month] %>%
    mutate(p3.role = role)
}) %>% rbindlist()

dplyr + furrr #

library(furrr)
plan(multisession)

result2_parallel <- df %>%
  nest_by(p3.role) %>%
  mutate(data = future_map(data, ~{
    .x %>%
      distinct(aid, pid, curr_month, oid) %>%
      count(aid, pid, curr_month, name = "pair_projects") %>%
      group_by(curr_month) %>%
      summarize(avg_pair_projects = mean(pair_projects), .groups = "drop")
  })) %>%
  unnest(data)

核心优化点 #

• 抛弃ddply：plyr包的循环式处理远慢于data.table的C级优化或dplyr的向量化操作
• 先去重再统计：用uniqueN()或distinct()避免同一项目被重复计数
• 统一日期维度：用月初日期分组，消除同一月份内不同日期的分组偏差
• 并行按需使用：小数据集并行反而会增加调度开销，仅在数据量极大时启用

内容的提问来源于stack exchange，提问作者J.K.