Создание функции пропорции из счетных таблиц с разными именами переменных

Проблема: у меня опрос из 100 вопросов. Они могут иметь 5 типов ответов, которые я сгруппировал и суммировал в отдельные таблицы (в виде списка). В каждой таблице разное количество столбцов с разными именами переменных.

ДАННЫЕ ОБРАЗЦА:

tbl1 <-   tribble(~"stakeholder", ~"Question", ~"1-Little", ~"2",   ~"3",   ~"4-Much",  ~"Do not know/ Not applicable", ~"no_response",
        "SH_1", "QUESTION 2",   2,  1,  4,  8, 1,   1,
        "SH_2", "QUESTION 2",   2,  1,  4,  8, 1,   1,
        "SH_3", "QUESTION 2",   2,  1,  4,  8, 1,   1,
        "SH_4", "QUESTION 2",   2,  1,  4,  8, 1,   1,
)

tbl2 <- tribble(~"stakeholder", ~"Question", ~"1-Little",   ~"2",   ~"3",   ~"4-Much", ~"5-MuchMuch",   ~"Do not know/ Not applicable", ~"no_response",
                "SH_1", "QUESTION 2",   2,  1,  4,  8, 1,   1,2,
                "SH_2", "QUESTION 2",   2,  1,  4,  8, 1,   1,2,
                "SH_3", "QUESTION 2",   2,  1,  4,  8, 1,   1,2,
                "SH_4", "QUESTION 2",   2,  1,  4,  8, 1,   1,2
)

Проблема: как рассчитать пропорции на основе суммы? Мне нужно создать таблицы пропорций на основе общего количества ответов на каждый вопрос.

Я создаю указанные выше значения в образцах таблиц из ответов персонажей путем подсчета на основе сгруппированной переменной. Замечу, что у меня есть 6 различных способов группировки и воспроизведения графики и таблиц (всего нужно около 600!):

    tally_function <- function(tbl) {
  tbl %>% 
  gather(key = Question, value = Response,
         12:length(.)) %>% 
  group_by(stakeholder, Question, Response) %>% 
  tally %>% 
  spread(Response, n, fill = 0) %>% 
  select(stakeholder, Question, everything(), no_response = `<NA>`) %>% 
    arrange(Question)

}

Предыдущая функция, которую я использовал, вызывала имена отдельных столбцов для получения сумм, но здесь это не сработает, поскольку имена столбцов в каждой таблице разные:

Prop_Function_Group1 <- function(tbl){
  tbl %>% 
    summarise(`Number of Responses (Count)` = sum(`1-Little` + `2`+`Do not know/ Not applicable`+
                                            `3`+`4-Much` + no_response, na.rm = TRUE),
              `1-Little`= sum(`1-Little`/`Number of Responses (Count)`, na.rm = TRUE) * 100,
              `2` = sum(`2` / `Number of Responses (Count)`, na.rm = TRUE) * 100,
              `Do not know/ Not applicable` = sum(`Do not know/ Not applicable` / `Number of Responses (Count)`, na.rm = TRUE)* 100,
              `3` = sum(`3` / `Number of Responses (Count)`, na.rm = TRUE) * 100,
              `4-Much` = sum(`4-Much` / `Number of Responses (Count)`, na.rm = TRUE) * 100,
              `no_response` = sum(no_response / `Number of Responses (Count)`, na.rm = TRUE) * 100
    ) %>% 
    mutate_if(is.numeric, round, digits = 2) %>% 
    arrange(desc(`Number of Responses (Count)`))
}

В настоящее время у меня есть это, но считаю, что мне понадобится какой-то цикл ifelse / case_when (), основанный на именах (tbl), но я действительно новичок в программировании и не уверен, с чего начать. Имена столбцов в функции суммирования должны совпадать с именами входной таблицы, которую они также суммируют.

    prop_function <- function(tbl){
  tbl %>% 
  summarise(`Number of Responses` = sum(3:length(.), na.rm = TRUE))
}

Мне не нужно полное решение, полезны любые небольшие идеи и предложения. Если это дублированный тип вопроса, будем благодарны за то, чтобы направить его в правильном направлении.

Я также добавляю их впоследствии в purr :: map () + ggplot (), поэтому оцените, если решения несколько удобны для tidyverse.

Ваше здоровье.


r dplyr purrr
person Corey Pembleton    schedule 09.01.2019    source источник

Ответы (2)


arrow_upward
0
arrow_downward

Вот решение, которое продолжает использовать dplyr / tidyverse и отражает формат / структуру вашего вывода из Prop_Function_Group1(tbl1). Однако эта функция должна быть применима к другим таблицам описанной вами формы.

library(tidyverse)

prop_function <- function(tbl){
tbl_counts <- tbl %>% 
  summarise_if(is.double, ~sum(.x))

tbl_counts %>% 
  mutate_all(~100 * .x / sum(tbl_counts)) %>%
  mutate(`Number of Responses (Count)` = sum(tbl_counts)) %>% 
  mutate_all(round, digits = 2) %>% 
  select(length(.), everything()) # move last col to first
}

list(tbl1, tbl2) %>% 
  map(prop_function)
#> [[1]]
#> # A tibble: 1 x 7
#>   `Number of Resp~ `1-Little`   `2`   `3` `4-Much` `Do not know/ N~
#>              <dbl>      <dbl> <dbl> <dbl>    <dbl>            <dbl>
#> 1               68       11.8  5.88  23.5     47.1             5.88
#> # ... with 1 more variable: no_response <dbl>
#> 
#> [[2]]
#> # A tibble: 1 x 8
#>   `Number of Resp~ `1-Little`   `2`   `3` `4-Much` `5-MuchMuch`
#>              <dbl>      <dbl> <dbl> <dbl>    <dbl>        <dbl>
#> 1               76       10.5  5.26  21.0     42.1         5.26
#> # ... with 2 more variables: `Do not know/ Not applicable` <dbl>,
#> #   no_response <dbl>

Создано 10 января 2019 г. пакетом REPEX (v0.2.1)

person Bryan Shalloway    schedule 10.01.2019
comment
Привет, Брайан, спасибо за это, я на правильном пути. Одна из проблем заключается в том, что я считаю, что mutate_all () удаляет заинтересованное лицо, которое на самом деле является переменной гибкой группировки, которую я заменю другими. Я добавил в свой вопрос собственную функцию tbl_counts, которую сейчас пытаюсь интегрировать в ваш подход. Спасибо за исчерпывающий ответ - person Corey Pembleton; 11.01.2019
comment
Рад, что это была полезная отправная точка. Переменная stakeholder была удалена на моем summarise_if шаге. Мой вывод был основан на выводе Prop_Function_Group1(tbl1) (до того, как вы добавили tally_function). Я предлагаю добавить, как должен выглядеть ваш предполагаемый результат. - person Bryan Shalloway; 14.01.2019
comment
да, именно тогда я начал искать альтернативы и узнал, задав другой вопрос о вложении mutate (map (select_if))), о котором я бы никогда не подумал! И вы правы, я сделаю это сейчас (и в будущем обязательно добавлю больше деталей в вопрос о том, какой именно результат мне нужен). Приветствую @ bryan-shalloway - person Corey Pembleton; 14.01.2019

arrow_upward
0
arrow_downward

Ответ @ bryan-shalloway, приведенный выше, направил меня на правильный путь - основные изменения, внесенные здесь, заключаются в том, что эта версия поддерживает имена группирующих переменных путем вложения операций map () в mutate ():

  proportion_function <- function(tbl){


  tbl_counts <- tbl %>%
    gather(key = Question, value = Response,
           12:length(.)) %>% 
    group_by(Region, Question, Response) %>% 
    tally %>% 
    spread(Response, n, fill = 0) %>% 
    select(Region, Question, everything(), no_response = `<NA>`) %>%
    arrange(Question)

  tbl_counts %>% 
    nest() %>% 
    mutate(data = map(data, ~ .x %>% select_if(is.numeric) 
                      %>% mutate(count = sum(rowSums(.))))) %>%
    mutate(data = map(data, ~ .x %>% select_if(is.numeric) 
                      %>% mutate_all(funs((. / count) * 100 )))) %>%
    mutate(data = map(data, ~ .x %>% select_if(is.numeric)
                      %>% mutate_all(round, digits = 2))) %>%
    unnest()
}
person Corey Pembleton    schedule 14.01.2019