如何在R中基于关联表重新分配数据表的指定变量值？

我有以下两个数据表：

myt <- data.frame(
  name = c("a", "b", "c", "d", "e", "f"),
  var1 = c(100, 20, 30, 40, 50, 60), 
  var2 = c(80, 25, 35, 45, 55, 65),   
  var3 = c(90, 30, 40, 50, 60, 70)    
)

rel_table <- data.frame(
  name = c("a", "b", "c"),
  proportion = c(0.5, 0.4, 0.1)
)

我的需求是：依据关联表rel_table定义的比例，将myt表中a行的var1和var2值重新分配——a行自身保留50%，b行获得40%，c行获得10%。

我自己尝试了两种实现方式：

自定义函数实现 #

redistribute_from_a <- function(df, rel_df) {
  a_var1 <- df[df$name == "a", "var1"]
  a_var2 <- df[df$name == "a", "var2"]
  
  df[df$name == "a", "var1"] <- a_var1 * rel_df[rel_df$name == "a", "proportion"]
  df[df$name == "a", "var2"] <- a_var2 * rel_df[rel_df$name == "a", "proportion"]
  
  for(target in c("b", "c")) {
    if(target %in% df$name) {
      prop <- rel_df[rel_df$name == target, "proportion"]
      df[df$name == target, "var1"] <- df[df$name == target, "var1"] + (a_var1 * prop)
      df[df$name == target, "var2"] <- df[df$name == target, "var2"] + (a_var2 * prop)
    }
  }
  
  return(df)
}

myt_redistributed <- redistribute_from_a(myt, rel_table)

dplyr mutate+case_when实现 #

a_var1_orig <- myt$var1[myt$name == "a"]
a_var2_orig <- myt$var2[myt$name == "a"]

myt_redistributed <- myt %>%
 mutate(
   var1 = case_when(
     name == "a" ~ var1 * 0.5,
     name == "b" ~ var1 + (a_var1_orig * 0.4),
     name == "c" ~ var1 + (a_var1_orig * 0.1),
     TRUE ~ var1
   ),
   var2 = case_when(
     name == "a" ~ var2 * 0.5,
     name == "b" ~ var2 + (a_var2_orig * 0.4),
     name == "c" ~ var2 + (a_var2_orig * 0.1),
     TRUE ~ var2
   )
 )

print(myt_redistributed)

请问在R语言中是否有更标准、通用的方法来实现该需求？

可以用dplyr结合表连接或批量处理函数，写出更通用、易维护的代码，避免硬编码比例值和目标名称：

方法一：表连接+批量处理 #

library(dplyr)

# 提取a行原始值并计算各目标的分配额
a_dist <- myt %>%
  filter(name == "a") %>%
  select(var1, var2) %>%
  tidyr::crossing(rel_table) %>%
  mutate(
    var1_dist = var1 * proportion,
    var2_dist = var2 * proportion
  ) %>%
  select(name, var1_dist, var2_dist)

# 合并分配额到原表并更新数值
myt_redistributed <- myt %>%
  left_join(a_dist, by = "name") %>%
  mutate(
    across(c(var1, var2), ~ ifelse(name == "a", var1_dist, .x + replace_na(var1_dist, 0))),
    .keep = "unused"
  )

print(myt_redistributed)

方法二：简洁版批量处理 #

library(dplyr)

# 提取a行原始值和比例映射
a_orig <- myt %>% filter(name == "a") %>% select(var1, var2)
prop_map <- rel_table %>% tibble::deframe()

# 批量更新变量
myt_redistributed <- myt %>%
  mutate(
    across(c(var1, var2), ~ case_when(
      name == "a" ~ .x * prop_map["a"],
      name %in% names(prop_map) ~ .x + a_orig[[cur_column()]] * prop_map[name],
      TRUE ~ .x
    ))
  )

这两种方法的优势：

• 完全依赖rel_table的配置，无需硬编码比例或名称
• 轻松扩展到更多变量（比如新增var4），只需修改across的变量列表
• 逻辑清晰，避免重复代码和循环操作

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