Динамическая передача аргументов в таблицах Expss с пользовательскими функциями - PullRequest
Новая
       89

Динамическая передача аргументов в таблицах Expss с пользовательскими функциями

2 голосов
/ 26 апреля 2020

У меня есть (новый) вопрос, связанный с таблицами 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")

Таблица вычисляется, и результат для первой строки (почти) соответствует ожидаемому. Тогда все в порядке go для второй строки, поскольку оба аргумента z_indices явно ссылаются на infert$age, где ожидается infert$parity. Мой вопрос: есть ли способ динамически передавать переменные tab_cells в качестве аргумента функции в tab_stat_fun для соответствия обрабатываемой переменной? Я предполагаю, что это происходит внутри объявления функции, но не знаю, как поступить ...

Спасибо!

РЕДАКТИРОВАТЬ 28 апреля 2020 года: Ответ от @Gregory Demin прекрасно работает в область применения набора данных inert, хотя для лучшей масштабируемости для больших фреймов данных я написал следующее l oop: 

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 Ответ

1 голос
/ 27 апреля 2020

Универсального решения для этого случая не существует. Функция в tab_stat_fun всегда вычисляется внутри ячейки, поэтому вы не можете получить глобальные значения в ней. Однако в вашем случае мы можем рассчитать z-индекс перед суммированием. Не очень гибкое решение, но оно работает: 

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