按分组带权重应用修正Z分数函数的实现问题

问题 #

我有一个计算修正Z分数的函数：

calculate_modified_z_score <- function(x) {
  median_x <- weighted.median(x, w = df$weight, na.rm = TRUE)
  mad_x <- mad(x, constant = 1, na.rm = TRUE) # MAD缩放因子设为1，排除NA值

  if (mad_x == 0) {
    meanAD_x <- mean(abs(x - median_x), na.rm = TRUE) # 计算均值绝对偏差，排除NA值
    return((x - median_x) / (1.253314 * meanAD_x))
  } else {
    return((x - median_x) / (1.486 * mad_x))
  }
}

直接在数据框上运行时一切正常：

df %>% mutate(z_of_var = calculate_modified_z_score(var))

但按group_var分组运行时，会因权重变量长度不匹配报错：

df %>% group_by(group_var) %>% mutate(z_of_var = calculate_modified_z_score(var))

报错信息：

Error in `mutate()`:
ℹ In argument: `z_of_var = calculate_modified_z_score(var)`.
ℹ In group 1: `group_var = "1"`.
Caused by error in `weighted.quantile()`:
! length(x) == length(w) is not TRUE

如果去掉函数里的df$直接用weight，又会出现变量找不到的错误：

calculate_modified_z_score <- function(x) {
  median_x <- weighted.median(x, w = weight, na.rm = TRUE)
  mad_x <- mad(x, constant = 1, na.rm = TRUE) # MAD缩放因子设为1，排除NA值

  if (mad_x == 0) {
    meanAD_x <- mean(abs(x - median_x), na.rm = TRUE) # 计算均值绝对偏差，排除NA值
    return((x - median_x) / (1.253314 * meanAD_x))
  } else {
    return((x - median_x) / (1.486 * mad_x))
  }
}

df %>% group_by(group_var) %>% mutate(z_of_var = calculate_modified_z_score(var))

报错信息：

Error in `mutate()`:
ℹ In argument: `z_po_mil = calculate_modified_z_score(var)`.
ℹ In group 1: `group_var = "a"`.
Caused by error in `calculate_modified_z_score()`:
! object 'weight' not found
Backtrace:
  1. ... %>% select(z_po_mil)
 10. global calculate_modified_z_score(var)
 11. spatstat.geom::weighted.median(x, w = vote, na.rm = TRUE)
 13. spatstat.geom::weighted.quantile(...)
 14. base::as.vector(w)

需要实现按分组计算修正Z分数，且每个分组使用对应观测的weight变量。

解决方案 #

核心是将weight作为参数传入函数，让dplyr在分组环境中自动传递当前分组的权重列，确保x和weight长度匹配且变量可被正确找到。

修改后的函数 #

calculate_modified_z_score <- function(x, weight) {
  median_x <- weighted.median(x, w = weight, na.rm = TRUE)
  mad_x <- mad(x, constant = 1, na.rm = TRUE) # MAD缩放因子设为1，排除NA值

  if (mad_x == 0) {
    meanAD_x <- mean(abs(x - median_x), na.rm = TRUE)
    return((x - median_x) / (1.253314 * meanAD_x))
  } else {
    return((x - median_x) / (1.486 * mad_x))
  }
}

分组调用方式 #

df %>% 
  group_by(group_var) %>% 
  mutate(z_of_var = calculate_modified_z_score(var, weight))

原理说明 #

• 原函数硬编码df$weight时，分组后x是当前组的子集，但df$weight是全量数据，导致长度不匹配；
• 直接用weight时，函数无法从dplyr的分组环境中自动获取该变量；
• 将weight作为参数传入后，dplyr会在每个分组内把对应列传入函数，保证x和weight长度一致，同时变量可被正确解析。

内容的提问来源于stack exchange，提问作者flâneur