使用用户定义的函数在 Expss 表中动态传递参数

Posted 2023-02-16

【中文标题】使用用户定义的函数在 Expss 表中动态传递参数

【英文标题】：Passing arguments dynamically in Expss tables with user-defined functions

【发布时间】：2020-08-10 00:44:36

【问题描述】：

我有一个与 expss 表相关的（新）问题。我写了一个非常简单的UDF（依赖几个expss函数），如下：

library(expss)
z_indices <- function(x, m_global, std_global, weight=NULL)
  if(is.null(weight)) weight = rep(1, length(x))
  z <- (w_mean(x, weight)-m_global)/std_global
  indices <- 100+(z*100)
  return(indices)

可重现的示例，基于infert 数据集（加上任意权重的向量）：

data(infert)
infert$w <- as.vector(x=rep(2, times=nrow(infert)), mode='numeric')
infert %>%
  tab_cells(age, parity) %>%
  tab_cols(total(), education, case %nest% list(total(), education)) %>%
  tab_weight(w) %>%
  tab_stat_valid_n(label="N") %>%
  tab_stat_mean(label="Mean") %>%
  tab_stat_fun(label="Z", function(x, m_global, std_global, weight=NULL)
    z_indices(x, m_global=w_mean(infert$age, infert$w),std_global=w_sd(infert$age, infert$w))
    ) %>%
  tab_pivot(stat_position="inside_columns")

计算表格并且第一行的输出（几乎）符合预期。 然后第二行的事情变得一团糟，因为z_indices 的两个参数都明确引用infert$age，其中infert$parity 是预期的。 我的问题：有没有办法将tab_cells 的变量作为函数参数动态传递给tab_stat_fun 以匹配正在处理的变量？我猜这发生在函数声明中，但不知道如何继续......

谢谢！

2020 年 4 月 28 日编辑： @Gregory Demin 的回答在推断数据集的范围内效果很好，尽管为了更好地扩展更大的数据帧，我编写了以下循环：

var_df <- data.frame("age"=infert$age, "parity"=infert$parity)
tabZ=infert
for(each in names(var_df))
  tabZ = tabZ %>%
    tab_cells(var_df[each]) %>%
    tab_cols(total(), education) %>%
    tab_weight(w) %>%
    tab_stat_valid_n(label="N") %>%
    tab_stat_mean(label="Mean") %>%
    tab_stat_fun(label="Z", function(x, m_global, std_global, weight=NULL)
      z_indices(x, m_global=w_mean(var_df[each], infert$w),std_global=w_sd(var_df[each], infert$w))
    )
 
tabZ = tabZ %>% tab_pivot()

希望这对未来的其他 expss 用户有所启发！

【参考方案1】：

这种情况没有通用的解决方案。 tab_stat_fun 中的函数始终在单元格内计算，因此您无法在其中获取全局值。 但是，在您的情况下，我们可以在汇总之前计算 z-index。不是那么灵活的解决方案，但它有效：

# function for weighted z-score
w_z_index = function(x, weight = NULL)
    if(is.null(weight)) weight = rep(1, length(x))
    z <- (x - w_mean(x, weight))/w_sd(x, weight)
    indices <- 100+(z*100)
    return(indices)


data(infert)
infert$w <- rep(2, times=nrow(infert))
infert %>%
    tab_cells(age, parity) %>%
    tab_cols(total(), education, case %nest% list(total(), education)) %>%
    tab_weight(w) %>%
    tab_stat_valid_n(label="N") %>%
    tab_stat_mean(label="Mean") %>%
    # here we get z-index instead of original variables
    tab_cells(age = w_z_index(age, w), parity = w_z_index(parity, w)) %>%
    tab_stat_mean(label="Z") %>%
    tab_pivot(stat_position="inside_columns")

更新。 更具可扩展性的方法：

w_z_index = function(x, weight = NULL)
    if(is.null(weight)) weight = rep(1, length(x))
    z <- (x - w_mean(x, weight))/w_sd(x, weight)
    indices <- 100+(z*100)
    return(indices)


w_z_index_df = function(df, weight = NULL)
    df[] = lapply(df, w_z_index, weight = weight)
    df


data(infert)
infert$w <- rep(2, times=nrow(infert))
infert %>%
    tab_cells(age, parity) %>%
    tab_cols(total(), education, case %nest% list(total(), education)) %>%
    tab_weight(w) %>%
    tab_stat_valid_n(label="N") %>%
    tab_stat_mean(label="Mean") %>%
    # here we get z-index instead of original variables
    # we process a lot of variables at once
    tab_cells(w_z_index_df(data.frame(age, parity))) %>%
    tab_stat_mean(label="Z") %>%
    tab_pivot(stat_position="inside_columns")

【讨论】：

按预期工作，即使您提到的很难扩展到大型数据帧。阅读您的答案后，出于可扩展性目的，我决定采用循环方法。我得到相同的结果 (Z)，但无法使用 stat_position="inside_columns" 旋转表格（即使它们共享相同的标签，它也不会合并列）。我应该如何安排表格以使结果显示为水平堆叠（如您的答案）而不是垂直堆叠？

@MaxenceDum。在某些情况下，stat_position="inside_columns" 似乎存在错误。请参阅更新以了解更具可扩展性的方法。