Передать список аргументов в mutate_at - PullRequest
1 голос
/ 10 октября 2019

Я уверен, что есть способ сделать это, но я не могу понять это. Я хотел бы иметь возможность передавать список аргументов mutate_at() внутри функции без необходимости указывать каждый аргумент

library(tidyverse)

fake_data <-
  tibble(
    id = letters[1:6],
    ind_group_a = rep(0:1, times = 3),
    ind_group_b = rep(1:0, each = 3)
  )

#  id    ind_group_a ind_group_b
#   a              0           1
#   b              1           1
#   c              0           1
#   d              1           0
#   e              0           0
#   f              1           0

Эта функция затем преобразует все 1 в "да" и 0 в "нет "

recode_indicator <- function(x, if_1 = "yes", if_0 = "no") {
  ifelse(x == 1, if_1, if_0)
}

И я могу использовать это нормально, вот так:

fake_data %>%
  mutate_at(
    vars(starts_with("ind_")),
    recode_indicator,
    if_1 = "Has",
    if_0 = "Missing"
  )

# id    ind_group_a ind_group_b
# chr> <chr>       <chr>      
#  a     Missing     Has        
#  b     Has         Has        
#  c     Missing     Has        
#  d     Has         Missing    
#  e     Missing     Missing    
#  f     Has         Missing 

Это упрощенный пример, но я хотел бы сделать его доступным в функции безнеобходимость выписать все аргументы. В идеале что-то короткое, например binary_values = list(...), но я не могу понять, как передать эти элементы в качестве дополнительных аргументов recode_indicator()

roll_up_indicators <- function(x,
                               #binary_values = list(if_1 = "yes", if_0 = "no"),
                               ...) {

  ind_cols <- grep("^ind_", names(x))

  df <-
    x %>%
    rename_at(ind_cols, str_remove, "^ind_") %>% 
    mutate_at(
      ind_cols,
      recode_indicator # ,
      # binary_values # <- here's the problem area
    ) %>%
    group_by_at(ind_cols) %>%
    count() %>%
    ungroup()

  knitr::kable(df, ...)
}


fake_data %>% roll_up_indicators()

#  |group_a |group_b |  n|
#  |:-------|:-------|--:|
#  |No      |No      |  1|
#  |No      |Yes     |  2|
#  |Yes     |No      |  2|
#  |Yes     |Yes     |  1|

Обновление

ВВ терминах не переписывания всех аргументов можно использовать функцию formals():

roll_up_indicators <- function(x,
                               binary_values = formals(recode_indicator), # <--- formals
                               ...) {

  ind_cols <- grep("^ind_", names(x))

  df <-
    x %>%
    rename_at(ind_cols, str_remove, "^ind_") %>%
    mutate_at(
      ind_cols,
      partial(recode_indicator, !!!binary_values) # <--- the winning answer
    ) %>%
    group_by_at(ind_cols) %>%
    count() %>%
    ungroup()

  knitr::kable(df, ...)
}

Ответы [ 2 ]

1 голос
/ 10 октября 2019

Одним из решений является использование purrr::partial для указания того, что if_1 и if_0 аргументы должны исходить от binary_values:

roll_up_indicators <- function(x,
                               binary_values = list(if_1 = "yes", if_0 = "no"),
                               ...) {

  ind_cols <- grep("^ind_", names(x))

  df <-
    x %>%
    rename_at(ind_cols, str_remove, "^ind_") %>%
    mutate_at(
      ind_cols,
      partial(recode_indicator, !!!binary_values)    ## <--- partial() here
    ) %>%
    group_by_at(ind_cols) %>%
    count() %>%
    ungroup()

  knitr::kable(df, ...)
}

fake_data %>% roll_up_indicators()
#  |group_a |group_b |  n|
#  |:-------|:-------|--:|
#  |No      |No      |  1|
#  |No      |Yes     |  2|
#  |Yes     |No      |  2|
#  |Yes     |Yes     |  1|
1 голос
/ 10 октября 2019

Вероятно, лучше использовать готовые функции, такие как перекодирование, но я также адаптировал вашу функцию, если вы хотите добавить дополнительные функции. Для этого я предполагаю, что binary_values имеет соответствующее имя и будет содержать только два значения.

Вариант 1: использовать recode

Для этого необходимо поместить начальные и конечные значения в список. Вам нужно будет заключать в кавычки строки, очевидно, и либо заключать в кавычки, либо использовать `` вокруг чисел.

binary_values = list("1" = "yes", "0" = "no") 
fake_data %>% 
  mutate_at(vars(starts_with("ind_")),
            list(~recode(.,!!!binary_values)))

Вариант 2: Укажите местоположение или имя в списке в функции

recode_value <- function(x, 
                         binary_values = list(if_1 = "yes", if_0 = "no")
                         ## You'll need to decide whether you'll name them as expected or always put them in this order; it's up to you
                         ) {
  if_1 = binary_values$if_1 # or binary_values[[1]]
  if_0 = binary_values$if_0 # or binary_values[[1]]
  ifelse(x == 1, if_1, if_0)
}

binary_values = list(if_1 = "yes", if_0 = "no")
fake_data %>%
  mutate_at(
    vars(starts_with("ind_")),
    recode_value, ## fixed typo
    binary_values
  )
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...