Извлечение атрибута столбца внутри функции
Скажем, у меня есть следующий тиббл:
df1 <- structure(list(var1 = structure(c("Didn't do a thing", "Almost did a thing",
"Once did a thing", "Have never done a thing", "Always do a thing"
), description = "This is the question i asked respondents (and the title of the plot)"),
wtd_pct = c(4L, 15L, 62L, 11L, 8L)), row.names = c(NA, -5L
), class = c("tbl_df", "tbl", "data.frame"))
Я хочу создать функцию построения графика, которая принимает в качестве входных данных имя тиббла (df1) и имя столбца внутри него (в данном случае есть только var1, но в моем реальном тиббле у меня гораздо больше столбцов).
Внутри функции сюжета я хочу извлечь атрибут, связанный с var1, и сделать его заголовком сюжета. Например, вне функции это выглядит так:
df1 %>%
ggplot(aes(y = var1, x = wtd_pct)) +
geom_col(aes(fill = var1)) +
geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5, vjust = -.5, hjust = -.3, color = 'black') +
theme_minimal() + theme(legend.position = "none") +
labs(y = "",
x = "Weighted percent",
title = paste0("\"", str_wrap(attr(df1$var1, "description"), 100), "\""))
Обратите внимание на строку title выше. Однако когда я помещаю это в функцию и пытаюсь вызвать ее, я получаю всевозможные ошибки. Например.
plot_function <- function(.x, .y){
.x %>%
ggplot(aes(y = {{.y}}, x = wtd_pct)) +
geom_col(aes(fill = {{.y}})) +
geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5, vjust = -.5, hjust = -.3, color = 'black') +
theme_minimal() + theme(legend.position = "none") +
labs(y = "",
x = "Weighted percent",
title = paste0("\"", str_wrap(attr({{.x$.y}}, "description"), 100), "\""))
}
plot_function(df1, var1)
Это возвращает сюжет, но без заголовка + ошибку Warning message: Unknown or uninitialised column: .y.. Я пробовал разные другие вещи (обертывание !!ensym(), .data[[]], предварительное извлечение атрибута в отдельную строку и т. д., но так и не получил того, что хочу.
Кажется, суть проблемы в том, что вы не можете передать df в attr(), но ему также не нравится синтаксис .x$.y. Может ли кто-нибудь здесь указать мне в правильном направлении?
Ответы 2
Оператор $ использует нестандартную оценку без подстановки, поэтому .x$.y будет интерпретироваться как «столбец с именем .y внутри df1», которого, конечно, не существует.
Обычный способ обойти это — использовать [[ вместо $, но здесь это немного сложнее, потому что вы хотите передать имя столбца без кавычек.
Один из вариантов — использовать .x[[deparse(substitute(.y))]] (без фигурных операторов)
plot_function <- function(.x, .y){
.x %>%
ggplot(aes(y = {{.y}}, x = wtd_pct)) +
geom_col(aes(fill = {{.y}})) +
geom_text(aes(label = paste0(round(wtd_pct, 0), "%")),
size = 3.5, vjust = -.5, hjust = -.3, color = 'black') +
theme_minimal() + theme(legend.position = "none") +
labs(y = "",
x = "Weighted percent",
title = paste0("\"", str_wrap(attr(.x[[deparse(substitute(.y))]],
"description"), 100), "\""))
}
plot_function(df1, var1)
Чистым эквивалентом tidyverse может быть использование чего-то вроде
rlang::eval_tidy(enquo(.y), data = .x)
вместо .x[[deparse(substitute(.y))]]
Используйте потянуть, заменив {{.x$.y}} на pull(.x, {{.y}}), как показано в строке, отмеченной ## ниже. Также обратите внимание, что все утверждения library должны быть предоставлены при публикации в SO.
library(dplyr)
library(ggplot2)
library(stringr)
plot_function <- function(.x, .y) {
.x %>%
ggplot(aes(y = {{.y}}, x = wtd_pct)) +
geom_col(aes(fill = {{.y}})) +
geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5,
vjust = -.5, hjust = -.3, color = 'black') +
theme_minimal() + theme(legend.position = "none") +
labs(y = "",
x = "Weighted percent",
title = paste0(
"\"",
str_wrap(attr(pull(.x, {{.y}}), "description"), 100), ##
"\"")
)
}
plot_function(df1, var1)
или мы можем переписать часть title= как конвейер и перейти к sprintf, чтобы ее было немного легче читать.
plot_function <- function(.x, .y) {
.x %>%
ggplot(aes(y = {{.y}}, x = wtd_pct)) +
geom_col(aes(fill = {{.y}})) +
geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5,
vjust = -.5, hjust = -.3, color = 'black') +
theme_minimal() + theme(legend.position = "none") +
labs(y = "",
x = "Weighted percent",
title = pull(.x, {{.y}}) %>% ##
attr("description") %>% ##
str_wrap(100) %>% ##
sprintf('"%s"', .) ##
)
}
plot_function(df1, var1)
Замечательный Аллан. Я бы никогда не догадался об этом самостоятельно (я могу подтвердить, что это работает для моего варианта использования, и сейчас я нахожусь в кроличьей норе, ища
deparseиsubstitute). Спасибо!