如何用循环或其他策略精简R语言重复计算代码？

数据样本 #

sample <- tibble::tibble(
    asbr15 =c(45.8,53.5,58.8,58.8,45.8,45.8,45.8,45.8,78.9,50.3,46.7,46.7,45.8,58.8,45.8,53.5,58.8,46.7,46.7,46.7),
    asbr16=  c(176,205.6,179.4,179.4,176,176,176,176,186.3,167.4,159.3,159.3,176,179.4,176,205.6,179.4,159.3,159.3,159.3),
    asbr17=  c(42.88,50.38,60.15,60.15,42.88,42.88, 42.88,42.88,80.69,50.05, 45.93,45.93, 42.88, 60.15, 42.88, 50.38, 60.15,45.93,45.93,45.93),
    u_parameter= c(38.00,46.50,41,43,38,36,40,36, 46.50, 31,23,  23, 40, 45, 40,46.50, 42.00, 22, 21, 22.00)
)

现有冗余代码 #

library(dplyr)
sample<-mutate(sample, f_curve_tilde_age15       =asbr15)
sample<-mutate(sample, f_curve_tilde_age15.25= asbr15*0.75+asbr16*0.25)                 
sample<-mutate(sample, f_curve_tilde_age15.5 = asbr15*0.50+asbr16*0.50)                     
sample<-mutate(sample, f_curve_tilde_age15.75= asbr15*0.25+asbr16*0.75)                     
sample<-mutate(sample, f_curve_tilde_age16   = asbr16) 
sample<-mutate(sample, f_curve_tilde_age16.25= asbr16*0.75+asbr17*0.25) 
sample<-mutate(sample, f_curve_tilde_age16.5 = asbr16*0.50+asbr17*0.50)   
sample<-mutate(sample, f_curve_tilde_age16.75= asbr16*0.25+asbr17*0.75)

### then

sample$f_curve_notched_age15   <-ifelse((sample$u_parameter + 0.75 < 15.00),0, 
sample$f_curve_tilde_age15)
sample$f_curve_notched_age15.25<-ifelse((sample$u_parameter + 0.75 < 15.25),0, 
sample$f_curve_tilde_age15)
sample$f_curve_notched_age15.5 <-ifelse((sample$u_parameter + 0.75 < 15.50),0, 
sample$f_curve_tilde_age15)
sample$f_curve_notched_age15.75<-ifelse((sample$u_parameter + 0.75 < 15.75),0, 
sample$f_curve_tilde_age15)
sample$f_curve_notched_age16   <-ifelse((sample$u_parameter + 0.75 < 16.00),0, 
sample$f_curve_tilde_age15)

需求：代码需延续至更高年龄组，当前写法效率极低，需通过循环或其他策略精简代码。

利用tidyverse的批量处理能力，将重复逻辑抽象为可复用的代码块，方便后续扩展。

1. 生成插值后的f_curve_tilde系列列 #

首先将整数年龄的asbr列直接映射为tilde列，再通过函数批量处理相邻年龄的插值计算：

library(tidyverse)

# 定义插值函数：对指定年龄，生成其与下一年龄的三个插值列
interpolate_asbr <- function(df, base_age) {
  col_current <- sym(paste0("asbr", base_age))
  col_next <- sym(paste0("asbr", base_age + 1))
  
  df %>%
    mutate(
      !!paste0("f_curve_tilde_age", base_age + 0.25) := !!col_current * 0.75 + !!col_next * 0.25,
      !!paste0("f_curve_tilde_age", base_age + 0.5) := !!col_current * 0.5 + !!col_next * 0.5,
      !!paste0("f_curve_tilde_age", base_age + 0.75) := !!col_current * 0.25 + !!col_next * 0.75
    )
}

# 第一步：生成所有整数年龄的tilde列
sample <- sample %>%
  mutate(across(starts_with("asbr"), ~., .names = "f_curve_tilde_age{str_remove(.col, 'asbr')}"))

# 第二步：对15、16年龄组应用插值（扩展时只需添加interpolate_asbr(17)这类调用）
sample <- sample %>%
  interpolate_asbr(15) %>%
  interpolate_asbr(16)

2. 生成f_curve_notched系列列 #

通过across批量处理所有tilde列，统一应用notched逻辑：

# 批量生成notched列（原逻辑：所有notched列取f_curve_tilde_age15的值）
sample <- sample %>%
  mutate(
    across(starts_with("f_curve_tilde_age"),
           ~ifelse(u_parameter + 0.75 < as.numeric(str_remove(.col, "f_curve_tilde_age")), 0, f_curve_tilde_age15),
           .names = "f_curve_notched_{str_remove(.col, 'f_curve_tilde_')}")
  )

如果实际需求是notched列对应同年龄的tilde值，只需将f_curve_tilde_age15替换为.：

sample <- sample %>%
  mutate(
    across(starts_with("f_curve_tilde_age"),
           ~ifelse(u_parameter + 0.75 < as.numeric(str_remove(.col, "f_curve_tilde_age")), 0, .),
           .names = "f_curve_notched_{str_remove(.col, 'f_curve_tilde_')}")
  )

扩展说明 #

后续添加更高年龄组时，只需：

• 在数据中新增对应的asbrXX列（如asbr18）
• 在插值步骤中添加interpolate_asbr(17)这类调用
• 所有tilde和notched列会自动生成，无需手动编写单列逻辑

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