如何编写函数基于数据框变量调整ASFR系列数值？

我有一份包含50余万女性信息的数据集，以下是其中一个样本案例：

library(tidyverse)
sample <- tibble( 
  iD=c(1),
  Mother.age=c(45),child.age1=c(21),child.age2=c(15),child.age3=c(8),child.age4=c(NA),child.age5=c(NA),
  ASFR15=(0.000000),ASFR16=(7.40444),ASFR17=(42.8774),ASFR18=(73.0532),ASFR19=(98.28869),
  ASFR20=(144.9568),ASFR21=(164.976),ASFR22=(180.280),ASFR23=(191.304),ASFR24=(198.4832),
  ASFR25=(202.0248),ASFR26=(202.136),ASFR27=(200.392),ASFR28=(197.684),ASFR29=(193.7632),
  ASFR30=(187.6072),ASFR31=(179.561),ASFR32=(170.509),ASFR33=(160.837),ASFR34=(150.4840),
  ASFR35=(139.3304),ASFR36=(127.796),ASFR37=(115.028),ASFR38=(100.720),ASFR39=(85.62560),
  ASFR40=(182.4384),ASFR41=(178.412),ASFR42=(171.928),ASFR43=(163.316),ASFR44=(152.9056),
  ASFR45=(141.0264),ASFR46=(128.008),ASFR47=(114.180),ASFR48=(99.8720),ASFR49=(85.41360))

需要完成以下任务：

• 计算每个孩子与母亲的年龄差；
• 将与年龄差匹配的对应ASFR值设为0；
• 将该零值对应的前后ASFR值乘以0.25（保留原数值的25%）；
• 最后将母亲年龄（如示例中的45岁）以上的ASFR值（含46至49岁）设为0。

举例说明：示例中母亲年龄为45岁，第一个孩子年龄为21岁，年龄差为24，因此ASFR24需设为0，ASFR23和ASFR25需乘以0.25。

采用长格式转换-批量处理-转回宽格式的思路，适配大样本量的高效处理：

library(tidyverse)

processed_data <- sample %>%
  # 计算所有非NA孩子的年龄差
  mutate(
    age_diffs = pmap(list(child.age1, child.age2, child.age3, child.age4, child.age5), 
                     ~ discard(c(...), is.na)) %>% map(~ Mother.age - .)
  ) %>%
  # 将分散的ASFR列转为长格式，统一处理
  pivot_longer(cols = starts_with("ASFR"), 
               names_to = "asfr_age", 
               values_to = "asfr_value",
               names_prefix = "ASFR") %>%
  mutate(asfr_age = as.integer(asfr_age)) %>%
  # 按个体分组处理ASFR值
  group_by(iD) %>%
  mutate(
    # 标记年龄差对应的ASFR、前后相邻的ASFR
    target_ages = unlist(age_diffs),
    is_target = asfr_age %in% target_ages,
    is_adjacent = asfr_age %in% (target_ages + 1) | asfr_age %in% (target_ages - 1),
    # 按规则更新ASFR值（母亲年龄以上设0优先级最高）
    asfr_value = case_when(
      asfr_age > Mother.age ~ 0,
      is_target ~ 0,
      is_adjacent & !is_target ~ asfr_value * 0.25,
      TRUE ~ asfr_value
    )
  ) %>%
  ungroup() %>%
  # 转回宽格式，恢复原始结构
  pivot_wider(names_from = "asfr_age", 
              values_from = "asfr_value",
              names_prefix = "ASFR") %>%
  # 移除中间辅助列
  select(-age_diffs, -target_ages, -is_target, -is_adjacent)

# 查看关键列的处理结果
processed_data %>% select(iD, Mother.age, ASFR23, ASFR24, ASFR25, ASFR46:ASFR49)

代码说明 #

1. 年龄差计算：通过pmap收集所有非NA的孩子年龄，批量计算与母亲的年龄差；
2. 长格式转换：将多列ASFR转为单年龄、单值的长格式，避免逐列处理的冗余代码；
3. ASFR值更新：
   • 优先将母亲年龄以上的ASFR设为0；
   • 标记年龄差对应的ASFR并设为0；
   • 标记目标ASFR的前后相邻项，乘以0.25；
4. 宽格式恢复：将处理后的长格式数据转回原始宽结构，保持数据兼容性。

该方法基于tidyverse的向量化操作，可高效处理50余万条数据，避免循环迭代的性能瓶颈。

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