Взвешенные кумулятивные проценты (по возрастанию / убыванию) в таблицах expss - PullRequest
Новая
       28

Взвешенные кумулятивные проценты (по возрастанию / убыванию) в таблицах expss

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

Я хотел бы построить таблицы с совокупным процентом, используя пакет expss, включая как восходящие (0% -> 100%), так и нисходящие (100% -> 0%) ордера. Уже существует существующая функция (а именно fre()) для возрастания, хотя результирующая таблица не слишком настраиваема.

Я хотел бы включить эти вычисления в инструкцию tab_stat_fun, и мне удалось добраться до желаемый вывод для невзвешенных наборов данных. Рассмотрим следующий пример (infert набор данных): 

infert %>%
  tab_cells(age) %>%
  tab_cols(total()) %>%
  tab_stat_cases(label="N", total_row_position="above", total_statistic="u_cases", total_label="TOTAL") %>%
  tab_stat_cpct(label="%Col.", total_row_position="above", total_statistic="u_cpct", total_label="TOTAL") %>%
  tab_stat_fun(label="% Asc.", function(x){100*cumsum(table(sort(x)))/sum(table(sort(x)))}) %>%
  tab_stat_fun(label="% Desc.", function(x){100-(100*cumsum(table(sort(x)))/sum(table(sort(x))))}) %>%
  tab_pivot(stat_position="inside_columns")

Прекрасно работает, но если я когда-нибудь захочу взвесить эти результаты по числовому c вектору (для демонстрации: infert$w <- as.vector(x=rep(2, times=nrow(infert)), mode='numeric')) это неизбежно приведет к ошибке, поскольку ни сумма, ни сумма не принимают аргумент весов (насколько я знаю).

Существует ли специальная встроенная функция, которая бы справилась? Или комбинация функций, которая может подразумевать умножение вектора возраста на вектор веса?

1 Ответ

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

Нет такой готовой функции. Однако мы можем использовать ваш подход и просто заменить base::table на base::xtabs. Последний может рассчитать взвешенную частоту: 

library(expss)
data(infert)
infert$w <- as.vector(x=rep(2, times=nrow(infert)), mode='numeric')

cumpercent = function(x, weight = NULL){
    if(is.null(weight)) weight = rep(1, length(x))
    counts = xtabs(weight ~ x)
    100*cumsum(counts)/sum(counts)    
}

infert %>%
    tab_cells(age) %>%
    tab_cols(total()) %>%
    tab_weight(w) %>% 
    tab_stat_cases(label="N", total_row_position="above", total_statistic="u_cases", total_label="TOTAL") %>%
    tab_stat_cpct(label="%Col.", total_row_position="above", total_statistic="u_cpct", total_label="TOTAL") %>%
    tab_stat_fun(label="% Asc.", cumpercent) %>%
    tab_stat_fun(label="% Desc.", function(x, weight = NULL){100-cumpercent(x, weight)}) %>%
    tab_pivot(stat_position="inside_columns")
...