如何基于分组条件使用dplyr为每组ID应用自定义函数？

需求说明 #

仅当每个ID分组下的列满足「为数值型且分组内求和不为0」的条件时，对该分组的列应用自定义rescale函数。

可复现示例数据 #

dat <- as.Date("2021/08/04")
len <- 5
seq(dat, by = "day", length.out = len)

input <- data.frame(
  date = c(seq(dat, by = "day", length.out = len) , seq(dat, by = "day", length.out = len)),
  id = c("aa", "aa","aa","aa","aa","bb","bb","bb","bb","bb"),
  var1 = c(2,3,4,6,7,8,9,3,5,6),
  var2 = c(0, 0, 0, 0, 0, 1, 2, 3 ,4, 5),
  var3 = c("hi", "hi", "hi", "hi", "hi", 1, 2, 3 ,4, 5) 
)

自定义rescale函数 #

rescale = function(x,max_range=100){
  return(((x-min(x))/(max(x)-min(x)))*max_range)
}

期望输出 #

output <- data.frame(
  date = c(seq(dat, by = "day", length.out = len) , seq(dat, by = "day", length.out = len)),
  id = c("aa", "aa","aa","aa","aa","bb","bb","bb","bb","bb"),
  var1 = c(0, 20, 40, 80, 100, 83.3, 100, 0, 33.3, 50),
  var2 = c(0, 0, 0, 0, 0, 0, 25, 50 ,75, 100),
  var3 = c("hi", "hi", "hi", "hi", "hi", 0, 25, 50 ,75, 100)
)

原代码问题分析 #

原代码使用mutate_if时，条件判断是基于整个数据表的列（全局），而非每个分组内的列，导致逻辑错误：

• aa分组的var2（分组内求和为0）被错误执行rescale
• bb分组的var3（分组内为数值型且求和不为0）未被执行

原错误代码：

out = input %>%
      dplyr::group_by(id) %>%
      dplyr::mutate_if(~is.numeric(.) && sum(.x) != 0 ,rescale) %>%
      dplyr::arrange(date, .by_group = TRUE)  %>%
      dplyr::ungroup()

修正后的代码 #

使用dplyr::mutate结合dplyr::across，针对每个分组内的列单独进行条件判断，确保逻辑符合需求：

out <- input %>%
  dplyr::group_by(id) %>%
  dplyr::mutate(
    dplyr::across(
      -c(date, id),  # 排除不需要处理的date和id列
      ~ if (is.numeric(.x) && sum(.x) != 0) rescale(.x) else .x
    )
  ) %>%
  dplyr::arrange(date, .by_group = TRUE) %>%
  dplyr::ungroup()

修正逻辑说明 #

• across(-c(date, id), ...)：指定只处理除date、id外的其他列
• 针对每个分组内的列，先判断：
  1. 当前列是否为数值型
  2. 该列在当前分组内的求和是否不为0
• 同时满足两个条件时应用rescale函数，否则保留原列值

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