如何高效判断大型保险单数据框中保单是否已续保？

我有一个包含约1800万条记录的保险单数据库，需要判断每份保单是否已续保。当前日期为2022年10月5日，部分样本数据如下：

样本说明：

• 第一条是当前有效保单，因为其到期日在未来；
• 第二条已续保，对应第一条是它的续保保单；
• 第三条已续保，因为第二条的prior_policy_number与它的policy_number匹配；
• 第四条未续保。

保单判定为已续保的条件：

• a) 存在另一保单，与当前保单拥有相同的policy_number和zip_code，且到期日更晚；
• b) 存在另一保单，其prior_policy_number等于当前保单的policy_number，且两者zip_code相同、到期日更晚。

（注：zip_code用于区分相同policy_number的不同保单，避免歧义）

我写了以下代码，虽然能运行但执行速度极慢。思路是先按expiration_date降序排序数据框，然后为每条记录创建一个仅包含相同policy_number或prior_policy_number且zip_code匹配的子数据框，检查最新记录的到期日是否晚于当前保单。我知道这种方法效率极低，求优化建议：

non_renewals <- valid_zip_policies %>% arrange(desc(expiration_date)) 

check_renewed <- function (policy,zip,exp) {
 # 创建主数据框的子集，仅包含当前保单号、或以当前保单为prior_policy_number的记录，且匹配zip_code
  
  cat(policy,zip,exp)
  
  test_renewed <- valid_zip_policies %>% select(c("policy_number","prior_policy_number","zip_code","expiration_date")) %>% filter(policy_number == policy | prior_policy_number == policy) %>% filter(zip_code == zip)
  
  # 查看该保单相关的最新到期日是否晚于当前记录的到期日，若是则标记为已续保
  
 if (test_renewed$expiration_date[1] > exp) { return (TRUE)} else {return (FALSE)}

  }

for (i in 1:nrow(non_renewals)) {
non_renewals$renewed [i] <- check_renewed(non_renewals$policy_number[i],non_renewals$zip_code[i],non_renewals$expiration_date[i])
}

优化思路与方案 #

原代码的核心问题是循环遍历每条记录时反复子集化1800万行的大表，这会带来极高的IO和计算开销。以下是两种高效优化方案：

方案1：dplyr分组聚合+连接实现

通过预计算两种续保条件对应的最晚到期日，再与原表合并判断，全程使用向量式操作避免循环：

library(dplyr)

# 确保日期格式为Date类型
valid_zip_policies <- valid_zip_policies %>%
  mutate(expiration_date = as.Date(expiration_date))

# 计算条件a的最晚到期日：同policy_number+zip_code组内的最大到期日
max_exp_a <- valid_zip_policies %>%
  group_by(policy_number, zip_code) %>%
  summarise(max_exp_a = max(expiration_date), .groups = "drop")

# 计算条件b的最晚到期日：以prior_policy_number为键，同zip_code组内的最大到期日
max_exp_b <- valid_zip_policies %>%
  filter(!is.na(prior_policy_number)) %>%
  group_by(prior_policy_number, zip_code) %>%
  summarise(max_exp_b = max(expiration_date), .groups = "drop") %>%
  rename(policy_number = prior_policy_number) # 重命名用于后续连接

# 合并数据并判断续保状态
result <- valid_zip_policies %>%
  left_join(max_exp_a, by = c("policy_number", "zip_code")) %>%
  left_join(max_exp_b, by = c("policy_number", "zip_code")) %>%
  mutate(
    renewed_a = max_exp_a > expiration_date,
    renewed_b = !is.na(max_exp_b) & max_exp_b > expiration_date,
    renewed = renewed_a | renewed_b
  ) %>%
  select(-max_exp_a, -max_exp_b, -renewed_a, -renewed_b) # 移除中间计算列

方案2：data.table内存优化实现

针对1800万条记录的超大规模数据集，data.table的内存效率和运算速度更具优势：

library(data.table)

setDT(valid_zip_policies)
valid_zip_policies[, expiration_date := as.Date(expiration_date)]

# 计算条件a的最大到期日
max_exp_a <- valid_zip_policies[, .(max_exp_a = max(expiration_date)), by = .(policy_number, zip_code)]

# 计算条件b的最大到期日
max_exp_b <- valid_zip_policies[!is.na(prior_policy_number), 
                                .(max_exp_b = max(expiration_date)), 
                                by = .(prior_policy_number, zip_code)]
setnames(max_exp_b, "prior_policy_number", "policy_number")

# 合并数据并生成续保标记
result <- valid_zip_policies[max_exp_a, on = .(policy_number, zip_code)]
result <- result[max_exp_b, on = .(policy_number, zip_code)]
result[, `:=`(
  renewed = (max_exp_a > expiration_date) | (!is.na(max_exp_b) & max_exp_b > expiration_date)
)]

优化说明 #

• 两种方案均采用分组聚合+连接的向量式操作，仅需遍历数据集几次，而非1800万次循环；
• 预计算组内最大到期日，避免了重复子集化大表的冗余操作；
• data.table通过内存地址直接操作数据，在处理超大规模数据集时，内存占用和运算速度显著优于dplyr；
• 先将expiration_date转为Date类型，避免字符比较导致的逻辑错误。

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