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

我有一个与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的回答 在infert数据集的范围内效果很好,不过为了更好地扩展到更大的数据框,我写了下面的循环。

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用户有所启发!

解决方案:

对于这种情况,没有通用的解决方案。功能在 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")

UPDATE.一个更可扩展的方法。

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

给TA打赏
共{{data.count}}人
人已打赏
未分类

将阿拉伯字体导入React Material Theme

2022-9-13 14:40:24

未分类

使用Active Record在嵌套的多级Postgres JSON类型中搜索。

2022-9-13 14:40:26

0 条回复 A文章作者 M管理员
    暂无讨论,说说你的看法吧
个人中心
购物车
优惠劵
今日签到
有新私信 私信列表
搜索