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

Question

我有一个与 expss tables 有关的（新）问题。我写了一个非常简单的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")

计算了 table，第一行的输出（几乎）符合预期。然后第二行的事情变得一团糟，因为 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 用户有所启发！

Answer 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")

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

Passing arguments dynamically in Expss tables with user-defined functions

r

user-defined-functions

weighted

expss