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

Question

Проблема: у меня есть опрос на 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.

Приветствия.

Answer 1

Ответ выше @ 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()
}

Answer 2

Вот решение, которое продолжает использовать 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>

^{Создано в 2019-01-10 пакетом Представить (v0.2.1)}