extracting column attribute inside a function

Question

Say I have the following tibble:

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"))

I want to make a plot function that takes as inputs the name of the tibble (df1) and the name of a column inside it (in this case, there is only var1, but in my actual tibble I have many more columns).

Inside the plot function I want to pull out the attribute connected to var1 and make that the plot title. For example, outside a function this looks like this:

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), "\""))

Note the title line above. However, when I put this inside a function and attempt to call it I get all sorts of errors. E.g.

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)

This returns the plot but with no title + the error Warning message: Unknown or uninitialised column: .y.. I've tried various other things (wrapping in !!ensym(), .data[[]], extracting the attribute first into a separate string, etc., but I never get what I want.

It seems the crux of the issue is that you can't pipe df into attr(), but it also doesn't like the .x$.y syntax. Can anyone here point me in the right direction?

Answer 1

The $ operator uses non-standard evaluation without substituting, so .x$.y will be interpreted as "the column called .y inside df1", which of course does not exist.

The usual way round this is to use [[ instead of $, but this is a little trickier here because you want to pass an unquoted column name.

One option is to use .x[[deparse(substitute(.y))]] (without the curly-curly operators)

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)

A pure tidyverse equivalent might be to use something like

rlang::eval_tidy(enquo(.y), data = .x)

in place of .x[[deparse(substitute(.y))]]

Answer 2

Use pull replacing {{.x$.y}} with pull(.x, {{.y}}) as shown in the line marked ## below. Also note that all library statements should be provided when posting to 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)

or we might want to rewrite the title= part as a pipeline and move to sprintf to make it a bit easier to read.

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)