Фон
У меня есть простая вспомогательная функция, которая применяет 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)
}