Передача имен объектов из многоточия в виде строк в left_join - PullRequest
3 голосов
/ 15 марта 2020

Фон

У меня есть простая вспомогательная функция, которая применяет left_join к любому количеству пропущенных таблиц в других к gather им и возвращает один объект .

Пример

# Settings ----------------------------------------------------------------

library("tidyverse")
set.seed(123)

# Data --------------------------------------------------------------------

sample_one <-
    tibble(
        column_a = c(1, 2),
        column_b = runif(n = 2),
        column_other = runif(n = 2)
    )
sample_two <-
    tibble(
        column_a = c(1, 2),
        column_b = runif(n = 2),
        column_other = runif(n = 2)
    )
sample_three <-
    tibble(
        column_a = c(1, 2),
        column_b = runif(n = 2),
        column_other = runif(n = 2)
    )

# Function ----------------------------------------------------------------

left_join_on_column_a <- function(keep_var, ...) {
    keep_var <- enquo(keep_var)
    dots <- list(...)
    clean_dfs <- map(dots, select, !!keep_var, "column_a")
    reduce(.x = clean_dfs,
           .f = left_join,
           "column_a") %>%
        gather(key = "model_type", !!keep_var, -column_a)
}

# Test --------------------------------------------------------------------

left_join_on_column_a(keep_var = column_b, sample_one, sample_two, sample_three)

Проблема

Я хотел бы иметь возможность программно изменить аргумент suffix для left_join:

суффикс Если в x и y есть несоединенные дублирующиеся переменные, эти суффиксы будут добавлены к выводу для устранения их неоднозначности. Должен быть символьным вектором длины 2.

Текущие результаты

# A tibble: 6 x 3
  column_a model_type column_b
     <dbl> <chr>         <dbl>
1        1 column_b.x   0.288 
2        2 column_b.x   0.788 
3        1 column_b.y   0.940 
4        2 column_b.y   0.0456
5        1 column_b     0.551 
6        2 column_b     0.457 

Желаемые результаты

# A tibble: 6 x 3
  column_a model_type      column_b
     <dbl> <chr>            <dbl>
1        1 sample_one       0.288 
2        2 sample_one       0.788 
3        1 sample_two       0.940 
4        2 sample_two       0.0456
5        1 sample_three     0.551 
6        2 sample_three     0.457 

Столбец model_type отражает имя объекта, переданного через ....

Попытки

Я пытался захватить имена объектов, переданных в ..., но это не именованный объект, поэтому он не имеет смысл:

left_join_on_column_a <- function(keep_var, ...) {
    keep_var <- enquo(keep_var)
    dots <- list(...)
    table_names <- names(dots)
    clean_dfs <- map(dots, select, !!keep_var, "column_a")
    reduce(.x = clean_dfs,
           .f = left_join,
           "column_a", 
           table_names) %>%
        gather(key = "model_type", !!keep_var, -column_a)
}

1 Ответ

2 голосов
/ 15 марта 2020

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

left_join_on_column_a <- function(keep_var, common_var, ...) {
    nm = unname(sapply(rlang::enexprs(...), as.character))
    keep_var <- as.character(substitute(keep_var))
    common_var = as.character(substitute(common_var))

    foo = function(x, y) {
        x %>% select(!!common_var, !!y := !!keep_var)
    }

    reduce(.x = Map(foo, list(...), nm),
           .f = left_join,
           common_var) %>%
        gather("model_type", !!keep_var, -!!common_var)
}

left_join_on_column_a(column_b, column_a, sample_one, sample_two, sample_three)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...