R语言如何按列名唯一编码批量配对求和NB开头的j/f后缀列

优化前置步骤 #

你之前的列筛选和编码提取可以做优化，避免编码长度变化时出错：

library(tidyverse) # 包含dplyr、stringr、tidyr、purrr等常用包

# 更精准的筛选列：仅匹配NB开头、中间为数字、结尾为j/f的列
df2 <- df %>% select(matches("^NB\\d+[jf]$"))

# 正则提取所有唯一编码，不受编码长度限制
codes <- unique(str_extract(names(df2), "(?<=NB)\\d+(?=[jf]$)"))

方案1：长表转换法（逻辑清晰，不易出错） #

通过长宽表转换实现按编码分组求和，无需循环：

# 1. 转长表，拆分出编码和后缀类型
df_long <- df2 %>% 
  mutate(row_id = row_number()) %>% # 保留行号用于后续合并
  pivot_longer(
    cols = -row_id,
    names_to = c("code", "suffix"),
    names_pattern = "NB(\\d+)([jf])"
  )

# 2. 按行、编码分组求和，生成新列名后转回宽表
df_sum <- df_long %>% 
  group_by(row_id, code) %>% 
  summarise(value = sum(value), .groups = "drop") %>% 
  mutate(col_name = paste0("NB", code, "jf")) %>% 
  pivot_wider(names_from = col_name, values_from = value)

# 3. 合并回原始数据框
df_final <- df %>% 
  mutate(row_id = row_number()) %>% 
  left_join(df_sum, by = "row_id") %>% 
  select(-row_id)

方案2：批量映射法（直接生成新列，效率更高） #

用purrr批量遍历编码生成求和列，直接合并到原数据：

# 批量生成所有NBxxxjf列
new_cols <- map_dfc(codes, function(x) {
  j_col <- paste0("NB", x, "j")
  f_col <- paste0("NB", x, "f")
  tibble(!!paste0("NB", x, "jf") := df[[j_col]] + df[[f_col]])
})

# 合并到原始数据框
df_final <- bind_cols(df, new_cols)

结果验证 #

两种方案最终输出的df_final都会在原数据基础上自动新增所有NBxxxjf列，计算结果和手动求和完全一致。

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