Пользовательская функция с mutate и case_when в R

Question

Я хотел бы знать, можно ли / как превратить приведенный ниже вызов в функцию, которую можно использовать в задаче, которую я довольно часто выполняю со своими данными.К сожалению, я не могу понять, как спроектировать функцию из вызова, который включает mutate и case_when, обе эти функции основаны на пакете dplyr и требуют ряда дополнительных аргументов.

В качестве альтернативысам вызов кажется мне избыточным с таким количеством case_when, возможно, возможно уменьшить количество использованных им раз.

Приветствуется любая помощь и информация об альтернативных подходах.

Вызов выглядит так:

library(dplyr)
library(stringr)

test_data %>%
  mutate(
    multipleoptions_o1 = case_when(
      str_detect(multipleoptions, "option1") ~ 1,
      is.na(multipleoptions) ~ NA_real_,
      TRUE ~ 0),
    multipleoptions_o2 = case_when(
      str_detect(multipleoptions, "option2") ~ 1,
      is.na(multipleoptions) ~ NA_real_,
      TRUE ~ 0),
    multipleoptions_o3 = case_when(
      str_detect(multipleoptions, "option3") ~ 1,
      is.na(multipleoptions) ~ NA_real_,
      TRUE ~ 0),
    multipleoptions_o4 = case_when(
      str_detect(multipleoptions, "option4") ~ 1,
      is.na(multipleoptions) ~ NA_real_,
      TRUE ~ 0)
  )

Пример данных:

structure(list(multipleoptions = c("option1", "option2", "option3", 
NA, "option2,option3", "option4")), row.names = c(NA, -6L), class = c("tbl_df", 
"tbl", "data.frame"))

Желаемый вывод функции:

structure(list(multipleoptions = c("option1", "option2", "option3", 
NA, "option2,option3", "option4"), multipleoptions_o1 = c(1, 
0, 0, NA, 0, 0), multipleoptions_o2 = c(0, 1, 0, NA, 1, 0), multipleoptions_o3 = c(0, 
0, 1, NA, 1, 0), multipleoptions_o4 = c(0, 0, 0, NA, 0, 1)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -6L))

Аргументыфункция, вероятно, должна быть: data (т. е. входной набор данных), multipleoptions (т. е. столбец из данных, содержащий параметры ответа, всегда один столбец), patterns_to_look_for (т. е. шаблоны str_detect для поиска в множественных опциях), number_of_options, в идеале количество опций может быть больше или меньше 4, (я не уверен, достижимо ли это), output_columns (т. Е. Имена новых столбцов, это всегда имя или исходный столбец, за которым следует номер опцииили название опции).

Answer 1

Вы можете избежать длинного кода case_when, разделив параметры на отдельные элементы, воспользовавшись преимуществами вложенности / отмены размещения для получения одного столбца параметров, а затем расширения, чтобы получить отдельный столбец для каждого параметра.

Обновленный ответ

library(tidyverse)

# Arguments
# data     A data frame
# patterns Regular expression giving the pattern(s) at which to split the options strings
# ...      Grouping columns, the first of which must be the "options" column.
#           If options has repeated values, then there must be a second grouping 
#           column (an "ID" column) to differentiate these repeated values.
fnc = function(data, patterns, ...) {
  col = quos(...)

  data %>% 
    mutate(option=str_split(!!!col[[1]], patterns)) %>% 
    unnest %>% 
    mutate(value=1) %>% 
    group_by(!!!col) %>% 
    mutate(num_chosen = ifelse(is.na(!!!col[[1]]), 0, sum(value))) %>% 
    spread(option, value, fill=0) %>%
    select_at(vars(-matches("NA")))
}

fnc(test_data, ",", multipleoptions)

  multipleoptions num_chosen option1 option2 option3 option4
1         option1          1       1       0       0       0
2         option2          1       0       1       0       0
3 option2,option3          2       0       1       1       0
4         option3          1       0       0       1       0
5         option4          1       0       0       0       1
6            <NA>          0       0       0       0       0

# Fake data
ops = paste0("option",1:4)

set.seed(2)
d = data_frame(var=replicate(20, paste(sample(ops, sample(1:4,1, prob=c(10,8,5,1))), collapse=","))) 
# Add missing values
d = bind_rows(d[1:5,], data.frame(var=rep(NA,3)), d[6:nrow(d),])

fnc(d %>% mutate(ID=1:n()), ",", var, ID)

                               var ID num_chosen option1 option2 option3 option4
1                          option1 17          1       1       0       0       0
2                  option1,option2 12          2       1       1       0       0
3          option1,option2,option3  5          3       1       1       1       0
4  option1,option2,option4,option3  9          4       1       1       1       1
5                  option1,option3  2          2       1       0       1       0
6          option1,option3,option4  3          3       1       0       1       1
7          option1,option4,option2 20          3       1       1       0       1
8  option1,option4,option3,option2 13          4       1       1       1       1
9                          option2 11          1       0       1       0       0
10                 option2,option3 23          2       0       1       1       0
11         option2,option3,option4 21          3       0       1       1       1
12                         option3  1          1       0       0       1       0
13                         option3 15          1       0       0       1       0
14                 option3,option1  4          2       1       0       1       0
15         option3,option2,option4 14          3       0       1       1       1
16 option3,option4,option2,option1 22          4       1       1       1       1
17                         option4 10          1       0       0       0       1
18                         option4 16          1       0       0       0       1
19                         option4 18          1       0       0       0       1
20         option4,option2,option3 19          3       0       1       1       1
21                            <NA>  6          0       0       0       0       0
22                            <NA>  7          0       0       0       0       0
23                            <NA>  8          0       0       0       0       0

Оригинальный ответ

test_data %>% 
  filter(!is.na(multipleoptions)) %>% 
  mutate(option=str_split(multipleoptions, ",")) %>% 
  unnest %>% 
  mutate(value=1) %>% 
  spread(option, value)

  multipleoptions option1 option2 option3 option4
  <chr>             <dbl>   <dbl>   <dbl>   <dbl>
1 option1               1      NA      NA      NA
2 option2              NA       1      NA      NA
3 option2,option3      NA       1       1      NA
4 option3              NA      NA       1      NA
5 option4              NA      NA      NA       1

Упаковка этого в функцию:

fnc = function(data, col, patterns) {
  col = enquo(col)

  data %>% 
    filter(!is.na(!!col)) %>% 
    mutate(option=str_split(!!col, patterns)) %>% 
    unnest %>% 
    mutate(value=1) %>% 
    spread(option, value)
}


fnc(test_data, multipleoptions, ",")

Если ваши реальные данные имеют более одной строки с одинаковым значением multipleoptons, тоэтот код будет работать, только если есть также столбец ID, который различает разные строки с одинаковым значением multipleoptions.Например:

# Fake data
ops = paste0("option",1:4)

set.seed(2)
d = data.frame(var=replicate(20, paste(sample(ops, sample(1:4,1, prob=c(10,8,5,1))), collapse=",")))

fnc(d, var, ",")

Ошибка: дубликаты идентификаторов для строк (1, 27), (16, 28, 30)

# Add unique row identifier
fnc(d %>% mutate(ID = 1:n()), var, ",")

                               var ID option1 option2 option3 option4
1                          option1 14       1      NA      NA      NA
2                  option1,option2  9       1       1      NA      NA
3          option1,option2,option3  5       1       1       1      NA
4  option1,option2,option4,option3  6       1       1       1       1
5                  option1,option3  2       1      NA       1      NA
6          option1,option3,option4  3       1      NA       1       1
7          option1,option4,option2 17       1       1      NA       1
8  option1,option4,option3,option2 10       1       1       1       1
9                          option2  8      NA       1      NA      NA
10                 option2,option3 20      NA       1       1      NA
11         option2,option3,option4 18      NA       1       1       1
12                         option3  1      NA      NA       1      NA
13                         option3 12      NA      NA       1      NA
14                 option3,option1  4       1      NA       1      NA
15         option3,option2,option4 11      NA       1       1       1
16 option3,option4,option2,option1 19       1       1       1       1
17                         option4  7      NA      NA      NA       1
18                         option4 13      NA      NA      NA       1
19                         option4 15      NA      NA      NA       1
20         option4,option2,option3 16      NA       1       1       1