如何修改expss自定义函数实现二分变量加权均值（百分比）计算？

使用R语言的expss包计算含缺失值的二分变量（0或1）的加权均值并以百分比呈现，编写了自定义函数tableau，调用代码为：

tableau(list(i1.3_1,i1.3_2,i1.3_3,i1.3_4,i1.3_5,i1.3_6),banner,'TABLE 1')

运行时出现报错：weight is provided but function% doesn't have formal weight argument，原函数代码如下：

tableau = function (Q, banner,titre) {

banner <- df %>% 
  tab_cols(a2,a3)

    eval.parent(substitute(
  {
    banner %>%
      tab_cells (list(Q)) %>%
   tab_weight(weighting_var) %>%
    tab_stat_fun("%" = function (x)  mean(x,na.rm = TRUE)*100) %>%
     tab_pivot() %>% 
      drop_empty_columns() %>%
      tab_transpose() %>% 
      set_caption(titre) #%>%
    # custom_format() 
  }
))
}

报错原因是tab_stat_fun中的自定义函数未接收权重参数，expss的加权统计要求函数必须支持权重输入。以下是修改后的函数：

tableau = function(Q, banner, titre) {
  # 若调用时已传入处理好的banner，可删除下方banner重新赋值的代码，避免覆盖参数
  # banner <- df %>% tab_cols(a2,a3)
  
  eval.parent(substitute({
    banner %>%
      tab_cells(list(Q)) %>%
      tab_weight(weighting_var) %>%
      tab_stat_fun("%" = function(x, w) {
        # 筛选非缺失的变量值与对应权重
        valid_idx <- !is.na(x)
        sum_xw <- sum(x[valid_idx] * w[valid_idx], na.rm = TRUE)
        sum_w <- sum(w[valid_idx], na.rm = TRUE)
        
        # 避免除以0，返回合理结果
        if (sum_w == 0) NA_real_ else (sum_xw / sum_w) * 100
      }) %>%
      tab_pivot() %>%
      drop_empty_columns() %>%
      tab_transpose() %>%
      set_caption(titre)
  }))
}

核心修改说明 #

• 自定义统计函数新增w参数，用于接收权重变量的值
• 替换普通均值计算为加权均值公式：先计算有效样本（非缺失值）的x*w总和，再除以有效样本的权重总和，最后乘以100转成百分比
• 增加除以0的判断逻辑，避免出现NaN错误
• 注意：原函数中banner <- df %>% tab_cols(a2,a3)会覆盖调用时传入的banner参数，若调用时已完成分组设置，建议删除该行；若需固定按a2,a3分组，则保留并确保df是全局环境中的数据框

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