提取函数内的列属性

C.R*_*bin 1 r ggplot2 attr

假设我有以下内容:

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"))
Run Code Online (Sandbox Code Playgroud)

我想制作一个绘图函数,它将 tibble ( df1) 的名称和其中的列名称作为输入(在本例中,只有var1,但在我的实际 tibble 中我有更多列)。

在绘图函数内,我想提取连接到的属性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), "\""))
Run Code Online (Sandbox Code Playgroud)

请注意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)
Run Code Online (Sandbox Code Playgroud)

这将返回绘图,但没有标题+错误Warning message: Unknown or uninitialised column: .y .。我尝试过各种其他方法(包装在!!ensym(),中.data[[]],首先将属性提取到一个单独的字符串中,等等,但我从未得到我想要的。

问题的关键似乎是您无法将 df 通过管道传输到attr(),但它也不喜欢这种.x$.y语法。这里有人能指出我正确的方向吗?

G. *_*eck 5

使用替换{{.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)
Run Code Online (Sandbox Code Playgroud)

或者我们可能想将该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)
Run Code Online (Sandbox Code Playgroud)

截屏